X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Fgdbinit;h=b7d238dcdb79927643c927e1033f69b42ebeef5a;hb=debb7eb5baa3e6aae77e4fc0b7704887baf3006e;hp=56cc68220852af87761578582882daa71d7280c2;hpb=4c0c5d1d054e60fb9ffa3dd9ec1c1d7bb8eedef0;p=chise%2Fxemacs-chise.git

diff --git a/src/gdbinit b/src/gdbinit
index 56cc682..b7d238d 100644
--- a/src/gdbinit
+++ b/src/gdbinit
@@ -32,9 +32,6 @@
 # specified:
 
 # USE_UNION_TYPE
-# USE_MINIMAL_TAGBITS
-# USE_INDEXED_LRECORD_IMPLEMENTATION
-# LRECORD_(SYMBOL|STRING|VECTOR)
 
 # (the above all have configure equivalents)
 
@@ -49,33 +46,23 @@ set print pretty off
 
 define decode_object
   set $obj = (unsigned long) $arg0
-  if dbg_USE_MINIMAL_TAGBITS
-    if $obj & 1
-    # It's an int
-      set $val = $obj >> 1
-      set $type = dbg_Lisp_Type_Int
+  if $obj & 1
+  # It's an int
+    set $val = $obj >> 1
+    set $type = Lisp_Type_Int
+  else
+    set $type = $obj & dbg_typemask
+    if $type == Lisp_Type_Char
+      set $val = ($obj & dbg_valmask) >> dbg_gctypebits
     else
-      set $type = $obj & dbg_typemask
-      if $type == dbg_Lisp_Type_Char
-        set $val = ($obj & dbg_valmask) >> dbg_gctypebits
-      else
-        # It's a record pointer
-        set $val = $obj
-      end
+      # It's a record pointer
+      set $val = $obj
     end
-  else
-    # not dbg_USE_MINIMAL_TAGBITS
-    set $val = $obj & dbg_valmask
-    set $type = ($obj & dbg_typemask) >> (dbg_valbits + 1)
   end
 
-  if $type == dbg_Lisp_Type_Record
+  if $type == Lisp_Type_Record
     set $lheader = (struct lrecord_header *) $val
-    if dbg_USE_INDEXED_LRECORD_IMPLEMENTATION
-      set $imp = lrecord_implementations_table[$lheader->type]
-    else
-      set $imp = $lheader->implementation
-    end
+    set $imp = lrecord_implementations_table[$lheader->type]
   else
     set $imp = -1
   end
@@ -94,22 +81,22 @@ end
 
 define xtype
   decode_object $arg0
-  if $type == dbg_Lisp_Type_Int
+  if $type == Lisp_Type_Int
     echo int\n
   else
-  if $type == dbg_Lisp_Type_Char
+  if $type == Lisp_Type_Char
     echo char\n
   else
-  if $type == dbg_Lisp_Type_Symbol
+  if $type == Lisp_Type_Symbol
     echo symbol\n
   else
-  if $type == dbg_Lisp_Type_String
+  if $type == Lisp_Type_String
     echo string\n
   else
-  if $type == dbg_Lisp_Type_Vector
+  if $type == Lisp_Type_Vector
     echo vector\n
   else
-  if $type == dbg_Lisp_Type_Cons
+  if $type == Lisp_Type_Cons
     echo cons\n
   else
     printf "record type: %s\n", $imp->name
@@ -122,9 +109,23 @@ define xtype
   end
 end
 
-define run-temacs
+define lisp-shadows
+  run -batch -vanilla -f list-load-path-shadows
+end
+
+document lisp-shadows
+Usage: lisp-shadows
+Run xemacs to check for lisp shadows
+end
+
+define environment-to-run-temacs
   unset env EMACSLOADPATH
-  set env EMACSBOOTSTRAPLOADPATH ../lisp/:..
+  set env EMACSBOOTSTRAPLOADPATH=../lisp/:..
+  set env EMACSBOOTSTRAPMODULEPATH=../modules/:..
+end
+
+define run-temacs
+  environment-to-run-temacs
   run -batch -l ../lisp/loadup.el run-temacs -q
 end
 
@@ -136,8 +137,7 @@ or when temacs builds successfully, but xemacs does not.
 end
 
 define update-elc
-  unset env EMACSLOADPATH
-  set env EMACSBOOTSTRAPLOADPATH ../lisp/:..
+  environment-to-run-temacs
   run -batch -l ../lisp/update-elc.el
 end
 
@@ -149,8 +149,7 @@ Use this when temacs builds successfully, but xemacs does not.
 end
 
 define dump-temacs
-  unset env EMACSLOADPATH
-  set env EMACSBOOTSTRAPLOADPATH ../lisp/:..
+  environment-to-run-temacs
   run -batch -l ../lisp/loadup.el dump
 end
 
@@ -185,6 +184,22 @@ Print the current Lisp stack trace.
 Requires a running xemacs process.
 end
 
+
+define leval
+ldp Feval(Fcar(Fread_from_string(build_string($arg0),Qnil,Qnil)))
+end
+
+document leval
+Usage: leval "SEXP"
+Eval a lisp expression.
+Requires a running xemacs process.
+
+Example:
+(gdb) leval "(+ 1 2)"
+Lisp ==> 3
+end
+
+
 define wtype
 print $arg0->core.widget_class->core_class.class_name
 end
@@ -203,161 +218,161 @@ end
 
 define pobj
   decode_object $arg0
-  if $type == dbg_Lisp_Type_Int
+  if $type == Lisp_Type_Int
     printf "Integer: %d\n", $val
   else
-  if $type == dbg_Lisp_Type_Char
-    if $val < 128
+  if $type == Lisp_Type_Char
+    if $val > 32 && $val < 128
       printf "Char: %c\n", $val
     else
       printf "Char: %d\n", $val
     end
   else
-  if $type == dbg_Lisp_Type_String || $imp == lrecord_string
+  if $type == Lisp_Type_String || $imp == &lrecord_string
     pstruct Lisp_String
   else
-  if $type == dbg_Lisp_Type_Cons   || $imp == lrecord_cons
+  if $type == Lisp_Type_Cons   || $imp == &lrecord_cons
     pstruct Lisp_Cons
   else
-  if $type == dbg_Lisp_Type_Symbol || $imp == lrecord_symbol
+  if $type == Lisp_Type_Symbol || $imp == &lrecord_symbol
     pstruct Lisp_Symbol
     printf "Symbol name: %s\n", $xstruct->name->data
   else
-  if $type == dbg_Lisp_Type_Vector || $imp == lrecord_vector
+  if $type == Lisp_Type_Vector || $imp == &lrecord_vector
     pstruct Lisp_Vector
     printf "Vector of length %d\n", $xstruct->size
     #print *($xstruct->data) @ $xstruct->size
   else
-  if $imp == lrecord_bit_vector
+  if $imp == &lrecord_bit_vector
     pstruct Lisp_Bit_Vector
   else
-  if $imp == lrecord_buffer
+  if $imp == &lrecord_buffer
     pstruct buffer
   else
-  if $imp == lrecord_char_table
+  if $imp == &lrecord_char_table
     pstruct Lisp_Char_Table
   else
-  if $imp == lrecord_char_table_entry
+  if $imp == &lrecord_char_table_entry
     pstruct Lisp_Char_Table_Entry
   else
-  if $imp == lrecord_charset
+  if $imp == &lrecord_charset
     pstruct Lisp_Charset
   else
-  if $imp == lrecord_coding_system
+  if $imp == &lrecord_coding_system
     pstruct Lisp_Coding_System
   else
-  if $imp == lrecord_color_instance
+  if $imp == &lrecord_color_instance
     pstruct Lisp_Color_Instance
   else
-  if $imp == lrecord_command_builder
+  if $imp == &lrecord_command_builder
     pstruct command_builder
   else
-  if $imp == lrecord_compiled_function
+  if $imp == &lrecord_compiled_function
     pstruct Lisp_Compiled_Function
   else
-  if $imp == lrecord_console
+  if $imp == &lrecord_console
     pstruct console
   else
-  if $imp == lrecord_database
+  if $imp == &lrecord_database
     pstruct Lisp_Database
   else
-  if $imp == lrecord_device
+  if $imp == &lrecord_device
     pstruct device
   else
-  if $imp == lrecord_event
+  if $imp == &lrecord_event
     pstruct Lisp_Event
   else
-  if $imp == lrecord_extent
+  if $imp == &lrecord_extent
     pstruct extent
   else
-  if $imp == lrecord_extent_auxiliary
+  if $imp == &lrecord_extent_auxiliary
     pstruct extent_auxiliary
   else
-  if $imp == lrecord_extent_info
+  if $imp == &lrecord_extent_info
     pstruct extent_info
   else
-  if $imp == lrecord_face
+  if $imp == &lrecord_face
     pstruct Lisp_Face
   else
-  if $imp == lrecord_float
+  if $imp == &lrecord_float
     pstruct Lisp_Float
   else
-  if $imp == lrecord_font_instance
+  if $imp == &lrecord_font_instance
     pstruct Lisp_Font_Instance
   else
-  if $imp == lrecord_frame
+  if $imp == &lrecord_frame
     pstruct frame
   else
-  if $imp == lrecord_glyph
+  if $imp == &lrecord_glyph
     pstruct Lisp_Glyph
   else
-  if $imp == lrecord_hash_table
+  if $imp == &lrecord_hash_table
     pstruct Lisp_Hash_Table
   else
-  if $imp == lrecord_image_instance
+  if $imp == &lrecord_image_instance
     pstruct Lisp_Image_Instance
   else
-  if $imp == lrecord_keymap
+  if $imp == &lrecord_keymap
     pstruct Lisp_Keymap
   else
-  if $imp == lrecord_lcrecord_list
+  if $imp == &lrecord_lcrecord_list
     pstruct lcrecord_list
   else
-  if $imp == lrecord_lstream
+  if $imp == &lrecord_lstream
     pstruct lstream
   else
-  if $imp == lrecord_marker
+  if $imp == &lrecord_marker
     pstruct Lisp_Marker
   else
-  if $imp == lrecord_opaque
+  if $imp == &lrecord_opaque
     pstruct Lisp_Opaque
   else
-  if $imp == lrecord_opaque_list
+  if $imp == &lrecord_opaque_list
     pstruct Lisp_Opaque_List
   else
-  if $imp == lrecord_popup_data
+  if $imp == &lrecord_popup_data
     pstruct popup_data
   else
-  if $imp == lrecord_process
+  if $imp == &lrecord_process
     pstruct Lisp_Process
   else
-  if $imp == lrecord_range_table
+  if $imp == &lrecord_range_table
     pstruct Lisp_Range_Table
   else
-  if $imp == lrecord_specifier
+  if $imp == &lrecord_specifier
     pstruct Lisp_Specifier
   else
-  if $imp == lrecord_subr
+  if $imp == &lrecord_subr
     pstruct Lisp_Subr
   else
-  if $imp == lrecord_symbol_value_buffer_local
+  if $imp == &lrecord_symbol_value_buffer_local
     pstruct symbol_value_buffer_local
   else
-  if $imp == lrecord_symbol_value_forward
+  if $imp == &lrecord_symbol_value_forward
     pstruct symbol_value_forward
   else
-  if $imp == lrecord_symbol_value_lisp_magic
+  if $imp == &lrecord_symbol_value_lisp_magic
     pstruct symbol_value_lisp_magic
   else
-  if $imp == lrecord_symbol_value_varalias
+  if $imp == &lrecord_symbol_value_varalias
     pstruct symbol_value_varalias
   else
-  if $imp == lrecord_toolbar_button
+  if $imp == &lrecord_toolbar_button
     pstruct toolbar_button
   else
-  if $imp == lrecord_tooltalk_message
+  if $imp == &lrecord_tooltalk_message
     pstruct Lisp_Tooltalk_Message
   else
-  if $imp == lrecord_tooltalk_pattern
+  if $imp == &lrecord_tooltalk_pattern
     pstruct Lisp_Tooltalk_Pattern
   else
-  if $imp == lrecord_weak_list
+  if $imp == &lrecord_weak_list
     pstruct weak_list
   else
-  if $imp == lrecord_window
+  if $imp == &lrecord_window
     pstruct window
   else
-  if $imp == lrecord_window_configuration
+  if $imp == &lrecord_window_configuration
     pstruct window_config
   else
     echo Unknown Lisp Object type\n
@@ -421,3 +436,42 @@ document pobj
 Usage: pobj lisp_object
 Print the internal C structure of a underlying Lisp Object.
 end
+
+# -------------------------------------------------------------
+# functions to test the debugging support itself.
+# If you change this file, make sure the following still work...
+# -------------------------------------------------------------
+define test_xtype
+  printf "Vemacs_major_version: "
+  xtype Vemacs_major_version
+  printf "Vhelp_char: "
+  xtype Vhelp_char
+  printf "Qnil: "
+  xtype Qnil
+  printf "Qunbound: "
+  xtype Qunbound
+  printf "Vobarray: "
+  xtype Vobarray
+  printf "Vall_weak_lists: "
+  xtype Vall_weak_lists
+  printf "Vxemacs_codename: "
+  xtype Vxemacs_codename
+end
+
+define test_pobj
+  printf "Vemacs_major_version: "
+  pobj Vemacs_major_version
+  printf "Vhelp_char: "
+  pobj Vhelp_char
+  printf "Qnil: "
+  pobj Qnil
+  printf "Qunbound: "
+  pobj Qunbound
+  printf "Vobarray: "
+  pobj Vobarray
+  printf "Vall_weak_lists: "
+  pobj Vall_weak_lists
+  printf "Vxemacs_codename: "
+  pobj Vxemacs_codename
+end
+