Merge r21-4-11-chise-0_20-=ucs.
[chise/xemacs-chise.git.1] / src / .gdbinit
index b08c0a0..03720ca 100644 (file)
 set print union off
 set print pretty off
 
 set print union off
 set print pretty off
 
+set $Lisp_Type_Int = -2
+
 define decode_object
   set $obj = (unsigned long) $arg0
   if $obj & 1
   # It's an int
     set $val = $obj >> 1
 define decode_object
   set $obj = (unsigned long) $arg0
   if $obj & 1
   # It's an int
     set $val = $obj >> 1
-    set $type = Lisp_Type_Int
+    set $type = $Lisp_Type_Int
   else
     set $type = $obj & dbg_typemask
     if $type == Lisp_Type_Char
   else
     set $type = $obj & dbg_typemask
     if $type == Lisp_Type_Char
@@ -65,9 +67,12 @@ define decode_object
   end
 
   if $type == Lisp_Type_Record
   end
 
   if $type == Lisp_Type_Record
-    set $lheader = (struct lrecord_header *) $val
-    set $imp = lrecord_implementations_table[$lheader->type]
+    set $lheader = ((struct lrecord_header *) $val)
+    set $lrecord_type = ($lheader->type)
+    set $imp = ((struct lrecord_implementation *) lrecord_implementations_table[(int) $lrecord_type])
   else
   else
+    set $lrecord_type = -1
+    set $lheader = -1
     set $imp = -1
   end
 end
     set $imp = -1
   end
 end
@@ -85,30 +90,13 @@ end
 
 define xtype
   decode_object $arg0
 
 define xtype
   decode_object $arg0
-  if $type == Lisp_Type_Int
+  if $type == $Lisp_Type_Int
     echo int\n
   else
   if $type == Lisp_Type_Char
     echo char\n
   else
     echo int\n
   else
   if $type == Lisp_Type_Char
     echo char\n
   else
-  if $type == Lisp_Type_Symbol
-    echo symbol\n
-  else
-  if $type == Lisp_Type_String
-    echo string\n
-  else
-  if $type == Lisp_Type_Vector
-    echo vector\n
-  else
-  if $type == Lisp_Type_Cons
-    echo cons\n
-  else
     printf "record type: %s\n", $imp->name
     printf "record type: %s\n", $imp->name
-  # barf
-  end
-  end
-  end
-  end
   end
   end
 end
   end
   end
 end
@@ -135,7 +123,7 @@ end
 
 define run-temacs
   environment-to-run-temacs
 
 define run-temacs
   environment-to-run-temacs
-  run -batch -l ../lisp/loadup.el run-temacs -q
+  run -nd -batch -l ../lisp/loadup.el run-temacs -q
 end
 
 document run-temacs
 end
 
 document run-temacs
@@ -156,7 +144,7 @@ end
 
 define check-temacs
   environment-to-run-temacs
 
 define check-temacs
   environment-to-run-temacs
-  run -batch -l ../lisp/loadup.el run-temacs -q -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated
+  run -nd -batch -l ../lisp/loadup.el run-temacs -q -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated
 end
 
 document check-temacs
 end
 
 document check-temacs
@@ -168,7 +156,7 @@ end
 
 define update-elc
   environment-to-run-temacs
 
 define update-elc
   environment-to-run-temacs
-  run -batch -l ../lisp/update-elc.el
+  run -nd -batch -l ../lisp/update-elc.el
 end
 
 document update-elc
 end
 
 document update-elc
@@ -178,21 +166,18 @@ Use when debugging temacs, not xemacs!
 Use this when temacs builds successfully, but xemacs does not.
 end
 
 Use this when temacs builds successfully, but xemacs does not.
 end
 
-define dump-temacs
+define dmp
   environment-to-run-temacs
   environment-to-run-temacs
-  run -batch -l ../lisp/loadup.el dump
+  run -nd -batch -l ../lisp/loadup.el dump
 end
 
 end
 
-document dump-temacs
-Usage: dump-temacs
+document dmp
+Usage: dmp
 Run the dumping part of the build procedure.
 Use when debugging temacs, not xemacs!
 Use this when temacs builds successfully, but xemacs does not.
 end
 
 Run the dumping part of the build procedure.
 Use when debugging temacs, not xemacs!
 Use this when temacs builds successfully, but xemacs does not.
 end
 
-# if you use Purify, do this:
-# export PURIFYOPTIONS='-pointer-mask=0x0fffffff'
-
 define ldp
   printf "%s", "Lisp => "
   call debug_print($arg0)
 define ldp
   printf "%s", "Lisp => "
   call debug_print($arg0)
@@ -240,15 +225,21 @@ end
 
 # GDB's command language makes you want to ...
 
 
 # GDB's command language makes you want to ...
 
-define pstruct
-  set $xstruct = (struct $arg0 *) $val
-  print $xstruct
-  print *$xstruct
+define ptype
+  set $type_ptr = ($arg0 *) $val
+  print $type_ptr
+  print *$type_ptr
+end
+
+define pstructtype
+  set $type_ptr = (struct $arg0 *) $val
+  print $type_ptr
+  print *$type_ptr
 end
 
 define pobj
   decode_object $arg0
 end
 
 define pobj
   decode_object $arg0
-  if $type == Lisp_Type_Int
+  if $type == $Lisp_Type_Int
     printf "Integer: %d\n", $val
   else
   if $type == Lisp_Type_Char
     printf "Integer: %d\n", $val
   else
   if $type == Lisp_Type_Char
@@ -258,152 +249,161 @@ define pobj
       printf "Char: %d\n", $val
     end
   else
       printf "Char: %d\n", $val
     end
   else
-  if $type == Lisp_Type_String || $imp == &lrecord_string
-    pstruct Lisp_String
+  if $lrecord_type == lrecord_type_string
+    ptype Lisp_String
+  else
+  if $lrecord_type == lrecord_type_cons
+    ptype Lisp_Cons
+  else
+  if $lrecord_type == lrecord_type_symbol
+    ptype Lisp_Symbol
+    printf "Symbol name: %s\n", $type_ptr->name->data
   else
   else
-  if $type == Lisp_Type_Cons   || $imp == &lrecord_cons
-    pstruct Lisp_Cons
+  if $lrecord_type == lrecord_type_vector
+    ptype Lisp_Vector
+    printf "Vector of length %d\n", $type_ptr->size
+    #print *($type_ptr->data) @ $type_ptr->size
   else
   else
-  if $type == Lisp_Type_Symbol || $imp == &lrecord_symbol
-    pstruct Lisp_Symbol
-    printf "Symbol name: %s\n", $xstruct->name->data
+  if $lrecord_type == lrecord_type_bit_vector
+    ptype Lisp_Bit_Vector
   else
   else
-  if $type == Lisp_Type_Vector || $imp == &lrecord_vector
-    pstruct Lisp_Vector
-    printf "Vector of length %d\n", $xstruct->size
-    #print *($xstruct->data) @ $xstruct->size
+  if $lrecord_type == lrecord_type_buffer
+    pstructtype buffer
   else
   else
-  if $imp == &lrecord_bit_vector
-    pstruct Lisp_Bit_Vector
+  if $lrecord_type == lrecord_type_char_table
+    ptype Lisp_Char_Table
   else
   else
-  if $imp == &lrecord_buffer
-    pstruct buffer
+  if $lrecord_type == lrecord_type_char_table_entry
+    ptype Lisp_Char_Table_Entry
   else
   else
-  if $imp == &lrecord_char_table
-    pstruct Lisp_Char_Table
+  if $lrecord_type == lrecord_type_charset
+    ptype Lisp_Charset
   else
   else
-  if $imp == &lrecord_char_table_entry
-    pstruct Lisp_Char_Table_Entry
+  if $lrecord_type == lrecord_type_coding_system
+    ptype Lisp_Coding_System
   else
   else
-  if $imp == &lrecord_charset
-    pstruct Lisp_Charset
+  if $lrecord_type == lrecord_type_color_instance
+    ptype Lisp_Color_Instance
   else
   else
-  if $imp == &lrecord_coding_system
-    pstruct Lisp_Coding_System
+  if $lrecord_type == lrecord_type_command_builder
+    ptype command_builder
   else
   else
-  if $imp == &lrecord_color_instance
-    pstruct Lisp_Color_Instance
+  if $lrecord_type == lrecord_type_compiled_function
+    ptype Lisp_Compiled_Function
   else
   else
-  if $imp == &lrecord_command_builder
-    pstruct command_builder
+  if $lrecord_type == lrecord_type_console
+    pstructtype console
   else
   else
-  if $imp == &lrecord_compiled_function
-    pstruct Lisp_Compiled_Function
+  if $lrecord_type == lrecord_type_database
+    ptype Lisp_Database
   else
   else
-  if $imp == &lrecord_console
-    pstruct console
+  if $lrecord_type == lrecord_type_device
+    pstructtype device
   else
   else
-  if $imp == &lrecord_database
-    pstruct Lisp_Database
+  if $lrecord_type == lrecord_type_event
+    ptype Lisp_Event
   else
   else
-  if $imp == &lrecord_device
-    pstruct device
+  if $lrecord_type == lrecord_type_extent
+    pstructtype extent
   else
   else
-  if $imp == &lrecord_event
-    pstruct Lisp_Event
+  if $lrecord_type == lrecord_type_extent_auxiliary
+    pstructtype extent_auxiliary
   else
   else
-  if $imp == &lrecord_extent
-    pstruct extent
+  if $lrecord_type == lrecord_type_extent_info
+    pstructtype extent_info
   else
   else
-  if $imp == &lrecord_extent_auxiliary
-    pstruct extent_auxiliary
+  if $lrecord_type == lrecord_type_face
+    ptype Lisp_Face
   else
   else
-  if $imp == &lrecord_extent_info
-    pstruct extent_info
+  if $lrecord_type == lrecord_type_float
+    ptype Lisp_Float
   else
   else
-  if $imp == &lrecord_face
-    pstruct Lisp_Face
+  if $lrecord_type == lrecord_type_font_instance
+    ptype Lisp_Font_Instance
   else
   else
-  if $imp == &lrecord_float
-    pstruct Lisp_Float
+  if $lrecord_type == lrecord_type_frame
+    pstructtype frame
   else
   else
-  if $imp == &lrecord_font_instance
-    pstruct Lisp_Font_Instance
+  if $lrecord_type == lrecord_type_glyph
+    ptype Lisp_Glyph
   else
   else
-  if $imp == &lrecord_frame
-    pstruct frame
+  if $lrecord_type == lrecord_type_gui_item
+    ptype Lisp_Gui_Item
   else
   else
-  if $imp == &lrecord_glyph
-    pstruct Lisp_Glyph
+  if $lrecord_type == lrecord_type_hash_table
+    ptype Lisp_Hash_Table
   else
   else
-  if $imp == &lrecord_hash_table
-    pstruct Lisp_Hash_Table
+  if $lrecord_type == lrecord_type_image_instance
+    ptype Lisp_Image_Instance
   else
   else
-  if $imp == &lrecord_image_instance
-    pstruct Lisp_Image_Instance
+  if $lrecord_type == lrecord_type_keymap
+    ptype Lisp_Keymap
   else
   else
-  if $imp == &lrecord_keymap
-    pstruct Lisp_Keymap
+  if $lrecord_type == lrecord_type_lcrecord_list
+    pstructtype lcrecord_list
   else
   else
-  if $imp == &lrecord_lcrecord_list
-    pstruct lcrecord_list
+  if $lrecord_type == lrecord_type_ldap
+    ptype Lisp_LDAP
   else
   else
-  if $imp == &lrecord_lstream
-    pstruct lstream
+  if $lrecord_type == lrecord_type_lstream
+    pstructtype lstream
   else
   else
-  if $imp == &lrecord_marker
-    pstruct Lisp_Marker
+  if $lrecord_type == lrecord_type_marker
+    ptype Lisp_Marker
   else
   else
-  if $imp == &lrecord_opaque
-    pstruct Lisp_Opaque
+  if $lrecord_type == lrecord_type_opaque
+    ptype Lisp_Opaque
   else
   else
-  if $imp == &lrecord_opaque_ptr
-    pstruct Lisp_Opaque_Ptr
+  if $lrecord_type == lrecord_type_opaque_ptr
+    ptype Lisp_Opaque_Ptr
   else
   else
-  if $imp == &lrecord_popup_data
-    pstruct popup_data
+  if $lrecord_type == lrecord_type_popup_data
+    ptype popup_data
   else
   else
-  if $imp == &lrecord_process
-    pstruct Lisp_Process
+  if $lrecord_type == lrecord_type_process
+    ptype Lisp_Process
   else
   else
-  if $imp == &lrecord_range_table
-    pstruct Lisp_Range_Table
+  if $lrecord_type == lrecord_type_range_table
+    ptype Lisp_Range_Table
   else
   else
-  if $imp == &lrecord_specifier
-    pstruct Lisp_Specifier
+  if $lrecord_type == lrecord_type_specifier
+    ptype Lisp_Specifier
   else
   else
-  if $imp == &lrecord_subr
-    pstruct Lisp_Subr
+  if $lrecord_type == lrecord_type_subr
+    ptype Lisp_Subr
   else
   else
-  if $imp == &lrecord_symbol_value_buffer_local
-    pstruct symbol_value_buffer_local
+  if $lrecord_type == lrecord_type_symbol_value_buffer_local
+    pstructtype symbol_value_buffer_local
   else
   else
-  if $imp == &lrecord_symbol_value_forward
-    pstruct symbol_value_forward
+  if $lrecord_type == lrecord_type_symbol_value_forward
+    pstructtype symbol_value_forward
   else
   else
-  if $imp == &lrecord_symbol_value_lisp_magic
-    pstruct symbol_value_lisp_magic
+  if $lrecord_type == lrecord_type_symbol_value_lisp_magic
+    pstructtype symbol_value_lisp_magic
   else
   else
-  if $imp == &lrecord_symbol_value_varalias
-    pstruct symbol_value_varalias
+  if $lrecord_type == lrecord_type_symbol_value_varalias
+    pstructtype symbol_value_varalias
   else
   else
-  if $imp == &lrecord_toolbar_button
-    pstruct toolbar_button
+  if $lrecord_type == lrecord_type_timeout
+    ptype Lisp_Timeout
   else
   else
-  if $imp == &lrecord_tooltalk_message
-    pstruct Lisp_Tooltalk_Message
+  if $lrecord_type == lrecord_type_toolbar_button
+    pstructtype toolbar_button
   else
   else
-  if $imp == &lrecord_tooltalk_pattern
-    pstruct Lisp_Tooltalk_Pattern
+  if $lrecord_type == lrecord_type_tooltalk_message
+    ptype Lisp_Tooltalk_Message
   else
   else
-  if $imp == &lrecord_weak_list
-    pstruct weak_list
+  if $lrecord_type == lrecord_type_tooltalk_pattern
+    ptype Lisp_Tooltalk_Pattern
   else
   else
-  if $imp == &lrecord_window
-    pstruct window
+  if $lrecord_type == lrecord_type_weak_list
+    pstructtype weak_list
   else
   else
-  if $imp == &lrecord_window_configuration
-    pstruct window_config
+  if $lrecord_type == lrecord_type_window
+    pstructtype window
+  else
+  if $lrecord_type == lrecord_type_window_configuration
+    pstructtype window_config
   else
     echo Unknown Lisp Object type\n
     print $arg0
   else
     echo Unknown Lisp Object type\n
     print $arg0
@@ -423,6 +423,8 @@ define pobj
   end
   end
   end
   end
   end
   end
+  end
+  end
   # Repeat after me... gdb sux, gdb sux, gdb sux...
   end
   end
   # Repeat after me... gdb sux, gdb sux, gdb sux...
   end
   end
@@ -460,6 +462,7 @@ define pobj
   end
   end
   end
   end
   end
   end
+  end
 end
 
 document pobj
 end
 
 document pobj