--- a/src/gdbinit	Mon Aug 13 10:27:41 2007 +0200
+++ b/src/gdbinit	Mon Aug 13 10:28:48 2007 +0200
@@ -1,270 +1,400 @@
-# Some useful commands for debugging emacs with gdb 4.14.* or better.
-# Install this as your .gdbinit file in your home directory.
-# If you have an older version of gdb 4.x, consider using the
-# file "gdbinit.pre-4.14" in the XEmacs src directory.
-# If you're one of the few who has an XEmacs compiled with
-# --use-union-type, you'll need to use the file "gdbinit.union".
-# Currently that file is of the pre-4.14 variety, but it should
-# be easy to update it to 4.14+, along the same lines as this file.
+# -*- ksh -*-
+# Copyright (C) 1998 Free Software Foundation, Inc.
+
+# This file is part of XEmacs.
+
+# XEmacs is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by the
+# Free Software Foundation; either version 2, or (at your option) any
+# later version.
+
+# XEmacs is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+# for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with XEmacs; see the file COPYING.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+
+# Author: Martin Buchholz
+
+# Some useful commands for debugging emacs with gdb 4.16 or better.
+# Install this as your .gdbinit file in your home directory,
+# or source this file from your .gdbinit
+# Configure xemacs with --debug, and compile with -g.
 #
-# See also question 2.1.15 of the XEmacs FAQ, titled
+# See also the question of the XEmacs FAQ, titled
 # "How to Debug an XEmacs problem with a debugger".
+#
+# This can be used to debug XEmacs no matter how the following are
+# specified:
+
+# USE_UNION_TYPE
+# USE_MINIMAL_TAGBITS
+# USE_INDEXED_LRECORD_IMPLEMENTATION
+# LRECORD_(SYMBOL|STRING|VECTOR)
+
+# (the above all have configure equivalents)
+
+# Some functions defined here require a running process, but most
+# don't.  Considerable effort has been expended to this end.
+
+# See the dbg_ C support code in src/alloc.c that allows the functions
+# defined in this file to work correctly.
 
 set print union off
 set print pretty off
 
-define temacs
-  run -batch -l loadup.el run-temacs -q
+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
+    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
+    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
+    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
+  else
+    set $imp = -1
+  end
+end
+
+document decode_object
+Usage: decode_object lisp_object
+Extract implementation information from a Lisp Object.
+Defines variables $val, $type and $imp.
+end
+
+define xint
+decode_object $arg0
+print ((long) $val)
 end
 
-echo \n>>> Use the `temacs' command to run temacs\n\n
+define xtype
+  decode_object $arg0
+  if $type == dbg_Lisp_Type_Int
+    echo int\n
+  else
+  if $type == dbg_Lisp_Type_Char
+    echo char\n
+  else
+  if $type == dbg_Lisp_Type_Symbol
+    echo symbol\n
+  else
+  if $type == dbg_Lisp_Type_String
+    echo string\n
+  else
+  if $type == dbg_Lisp_Type_Vector
+    echo vector\n
+  else
+  if $type == dbg_Lisp_Type_Cons
+    echo cons\n
+  else
+    printf "record type: %s\n", $imp->name
+  # barf
+  end
+  end
+  end
+  end
+  end
+  end
+end
+
+define run-temacs
+run -batch -l loadup.el run-temacs -q
+end
+
+document run-temacs
+Usage: run-temacs
+Run temacs interactively, like xemacs.
+Use this with debugging tools (like purify) that cannot deal with dumping,
+or when temacs builds successfully, but xemacs does not.
+end
+
+define update-elc
+  set env EMACSLOADPATH=../lisp/
+  set env EMACSBOOTSTRAPLOADPATH=../lisp/:..
+  run -batch -l update-elc.el
+end
+
+document update-elc
+Usage: update-elc
+Run the elc compilation part of the build procedure.
+Use when debugging temacs, not xemacs!
+Use this when temacs builds successfully, but xemacs does not.
+end
+
+define dump-temacs
+  set env EMACSLOADPATH=../lisp/:..
+  run -batch -l loadup.el dump
+end
+
+document dump-temacs
+Usage: dump-temacs
+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:
-# set env PURIFYOPTIONS -pointer-mask=0x0fffffff
-
-################ Print using the Lisp printer
+# export PURIFYOPTIONS='-pointer-mask=0x0fffffff'
 
-define p1
-  call debug_print ($arg0)
-  printf "\n"
+define ldp
+  printf "%s", "Lisp => "
+  call debug_print($arg0)
+end
+
+document ldp
+Usage: ldp lisp_object
+Print a Lisp Object value using the Lisp printer.
+Requires a running xemacs process.
 end
 
 define lbt
-# "&" to compensate for GDB struct-passing bug
-# but I've removed the &'s because it doesn't work with my GDB,
-# and not having them works fine.
-call Fbacktrace (Qexternal_debugging_output, Qt)
-end
-
-################ Print using GDB built-ins
-
-define xint
-print ((int)($arg0 << 4))>>4
-end
-
-define xbitvec
-print (struct Lisp_Bit_Vector *) ($arg0 & 0xFFFFFFF)
-end
-
-define xbuffer
-print (struct buffer *) ($arg0 & 0xFFFFFFF)
-end
-
-define xbytecode
-print (struct Lisp_Bytecode *) ($arg0 & 0xFFFFFFF)
+call debug_backtrace()
 end
 
-define xcharset
-print (struct Lisp_Charset *) ($arg0 & 0xFFFFFFF)
-end
-
-define xchartab
-print (struct Lisp_Char_Table *) ($arg0 & 0xFFFFFFF)
-end
-
-define xchartabentry
-print (struct Lisp_Char_Table_Entry *) ($arg0 & 0xFFFFFFF)
-end
-
-define xcodesys
-print (struct Lisp_Coding_System *) ($arg0 & 0xFFFFFFF)
-end
-
-define xcolorinst
-print (struct Lisp_Color_Instance *) ($arg0 & 0xFFFFFFF)
-end
-
-define xcons
-print (struct Lisp_Cons *) ($arg0 & 0xFFFFFFF)
-end
-
-define xdevice
-print (struct device *) ($arg0 & 0xFFFFFFF)
-end
-
-define xevent
-print (struct Lisp_Event *) ($arg0 & 0xFFFFFFF)
+document lbt
+Usage: lbt
+Print the current Lisp stack trace.
+Requires a running xemacs process.
 end
 
-define xextent
-print (struct extent *) ($arg0 & 0xFFFFFFF)
-end
-
-define xextentaux
-print (struct extent_auxiliary *) ($arg0 & 0xFFFFFFF)
-end
-
-define xextentinfo
-print (struct extent_info *) ($arg0 & 0xFFFFFFF)
-end
-
-define xfloat
-print (struct Lisp_Float *) ($arg0 & 0xFFFFFFF)
-output (double) $arg0->data.d
-echo \n
-end
-
-define xfontinst
-print (struct Lisp_Font_Instance *) ($arg0 & 0xFFFFFFF)
-end
-
-define xframe
-print (struct frame *) ($arg0 & 0xFFFFFFF)
-end
-
-define xglyph
-print (struct Lisp_Glyph *) ($arg0 & 0xFFFFFFF)
+define wtype
+print $arg0->core.widget_class->core_class.class_name
 end
 
-define xhashtable
-print (struct hashtable_struct *) ($arg0 & 0xFFFFFFF)
-end
-
-define ximageinst
-print (struct Lisp_Image_Instance *) ($arg0 & 0xFFFFFFF)
-end
-
-define xkeymap
-print (struct keymap *) ($arg0 & 0xFFFFFFF)
+define xtname
+print XrmQuarkToString(((Object)($arg0))->object.xrm_name)
 end
 
-define xlstream
-print (struct lstream *) ($arg0 & 0xFFFFFFF)
-end
-
-define xmarker
-print (struct Lisp_Marker *) ($arg0 & 0xFFFFFFF)
-end
+# GDB's command language makes you want to ...
 
-define xmenubardata
-print (struct menubar_data *) ($arg0 & 0xFFFFFFF)
-end
-
-define xopaque
-print (struct Lisp_Opaque *) ($arg0 & 0xFFFFFFF)
-end
-
-define xprocess
-print (struct Lisp_Process *) ($arg0 & 0xFFFFFFF)
+define pstruct
+  set $xstruct = (struct $arg0 *) $val
+  print $xstruct
+  print *$xstruct
 end
 
-define xrangetab
-print (struct Lisp_Range_Table *) ($arg0 & 0xFFFFFFF)
-end
-
-define xspec
-print (struct Lisp_Specifier *) ($arg0 & 0xFFFFFFF)
-end
-
-define xstring
-print (struct Lisp_String *) ($arg0 & 0xFFFFFFF)
-output (char *) $arg0->_data
-echo \n
-end
-
-define xsubr
-print (struct Lisp_Subr *) ($arg0 & 0xFFFFFFF)
-end
-
-define xsubwindow
-print (struct Lisp_Subwindow *) ($arg0 & 0xFFFFFFF)
-end
-
-define xsymbol
-set $tem = (struct Lisp_Symbol *) ($arg0 & 0xFFFFFFF)
-output $tem->name->_data
-printf "\n"
-print $tem
-end
-
-define xtoolbarbutton
-print (struct toolbar_button *) ($arg0 & 0xFFFFFFF)
-end
-
-define xtoolbardata
-print (struct toolbar_data *) ($arg0 & 0xFFFFFFF)
-end
-
-define xtooltalkmess
-print (struct Lisp_Tooltalk_Message *) ($arg0 & 0xFFFFFFF)
-end
-
-define xtooltalkpatt
-print (struct Lisp_Tooltalk_Pattern *) ($arg0 & 0xFFFFFFF)
-end
-
-define xvector
-print (struct Lisp_Vector *) ($arg0 & 0xFFFFFFF)
-end
-
-define xwindow
-print (struct window *) ($arg0 & 0xFFFFFFF)
-end
-
-define xwindowconfig
-print (struct window_config *) ($arg0 & 0xFFFFFFF)
-end
-
-define xrecord
-  print ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))
-  output (((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation->name)
-  echo \n
-  if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_symbol
-    xsymbol $arg0
+define pobj
+  decode_object $arg0
+  if $type == dbg_Lisp_Type_Int
+    printf "Integer: %d\n", $val
+  else
+  if $type == dbg_Lisp_Type_Char
+    if $val < 128
+      printf "Char: %c\n", $val
+    else
+      printf "Char: %d\n", $val
+    end
+  else
+  if $type == dbg_Lisp_Type_String || $imp == lrecord_string
+    pstruct Lisp_String
+  else
+  if $type == dbg_Lisp_Type_Cons   || $imp == lrecord_cons
+    pstruct Lisp_Cons
+  else
+  if $type == dbg_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
+    pstruct Lisp_Vector
+    printf "Vector of length %d\n", $xstruct->size
+    #print *($xstruct->_data) @ $xstruct->size
+  else
+  if $imp == lrecord_bit_vector
+    pstruct Lisp_Bit_Vector
+  else
+  if $imp == lrecord_buffer
+    pstruct buffer
+  else
+  if $imp == lrecord_char_table
+    pstruct Lisp_Char_Table
+  else
+  if $imp == lrecord_char_table_entry
+    pstruct Lisp_Char_Table_Entry
+  else
+  if $imp == lrecord_charset
+    pstruct Lisp_Charset
+  else
+  if $imp == lrecord_coding_system
+    pstruct Lisp_Coding_System
+  else
+  if $imp == lrecord_color_instance
+    pstruct Lisp_Color_Instance
+  else
+  if $imp == lrecord_command_builder
+    pstruct command_builder
+  else
+  if $imp == lrecord_compiled_function
+    pstruct Lisp_Compiled_Function
+  else
+  if $imp == lrecord_console
+    pstruct console
+  else
+  if $imp == lrecord_database
+    pstruct database
+  else
+  if $imp == lrecord_device
+    pstruct device
+  else
+  if $imp == lrecord_event
+    pstruct Lisp_Event
+  else
+  if $imp == lrecord_extent
+    pstruct extent
+  else
+  if $imp == lrecord_extent_auxiliary
+    pstruct extent_auxiliary
+  else
+  if $imp == lrecord_extent_info
+    pstruct extent_info
+  else
+  if $imp == lrecord_face
+    pstruct Lisp_Face
+  else
+  if $imp == lrecord_float
+    pstruct Lisp_Float
+  else
+  if $imp == lrecord_font_instance
+    pstruct Lisp_Font_Instance
+  else
+  if $imp == lrecord_frame
+    pstruct frame
+  else
+  if $imp == lrecord_glyph
+    pstruct Lisp_Glyph
+  else
+  if $imp == lrecord_hashtable
+    pstruct hashtable
+  else
+  if $imp == lrecord_image_instance
+    pstruct Lisp_Image_Instance
+  else
+  if $imp == lrecord_keymap
+    pstruct keymap
   else
-  if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_extent
-    xextent $arg0
+  if $imp == lrecord_lcrecord_list
+    pstruct lcrecord_list
+  else
+  if $imp == lrecord_lstream
+    pstruct lstream
   else
-  if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_marker
-    xmarker $arg0
+  if $imp == lrecord_marker
+    pstruct Lisp_Marker
+  else
+  if $imp == lrecord_opaque
+    pstruct Lisp_Opaque
   else
-  if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_event
-    xevent $arg0
+  if $imp == lrecord_opaque_list
+    pstruct Lisp_Opaque_List
+  else
+  if $imp == lrecord_popup_data
+    pstruct popup_data
   else
-  if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_buffer
-    xbuffer $arg0
+  if $imp == lrecord_process
+    pstruct Lisp_Process
+  else
+  if $imp == lrecord_range_table
+    pstruct Lisp_Range_Table
   else
-  if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_window
-    xwindow $arg0
+  if $imp == lrecord_specifier
+    pstruct Lisp_Specifier
+  else
+  if $imp == lrecord_subr
+    pstruct Lisp_Subr
   else
-  if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_frame
-    xframe $arg0
+  if $imp == lrecord_symbol_value_buffer_local
+    pstruct symbol_value_buffer_local
+  else
+  if $imp == lrecord_symbol_value_forward
+    pstruct symbol_value_forward
   else
-  if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_device
-    xdevice $arg0
+  if $imp == lrecord_symbol_value_lisp_magic
+    pstruct symbol_value_lisp_magic
+  else
+  if $imp == lrecord_symbol_value_varalias
+    pstruct symbol_value_varalias
   else
-  if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_console
-    xconsole $arg0
+  if $imp == lrecord_toolbar_button
+    pstruct toolbar_button
   else
-  if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_process
-    xprocess $arg0
+  if $imp == lrecord_toolbar_data
+    pstruct toolbar_data
   else
-  if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_subr
-    xsubr $arg0
+  if $imp == lrecord_tooltalk_message
+    pstruct Lisp_Tooltalk_Message
   else
-  if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_compiled_function
-    xbytecode $arg0
+  if $imp == lrecord_tooltalk_pattern
+    pstruct Lisp_Tooltalk_Pattern
   else
-  if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_window_configuration
-    xwindowconfig $arg0
+  if $imp == lrecord_weak_list
+    pstruct weak_list
   else
-  if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_float
-    xfloat $arg0
+  if $imp == lrecord_window
+    pstruct window
+  else
+  if $imp == lrecord_window_configuration
+    pstruct window_config
   else
-  if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_opaque
-    xopaque $arg0
-  else
-  if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_glyph
-    xglyph $arg0
-  else
-  if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_keymap
-    xkeymap $arg0
-  else
-  if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_lstream
-    xlstream $arg0
-  else
-  if ((struct lrecord_header *) ($arg0 & 0xFFFFFFF))->implementation == lrecord_bit_vector
-    xbitvec $arg0
+    echo Unknown Lisp Object type\n
+    print $arg0
+  # Barf, gag, retch
+  end
+  end
+  end
+  end
+  end
+  end
+  end
+  end
+  end
+  end
+  end
+  end
+  end
+  end
+  end
+  end
+  end
+  end
+  end
+  end
+  end
+  end
+  end
+  end
+  end
+  end
+  end
+  end
+  end
+  end
+  end
+  end
   end
   end
   end
@@ -286,124 +416,7 @@
   end
 end
 
-define frob
-  if (enum Lisp_Type) (($arg0 >> 28) & 7) == Lisp_Int
-    xint $arg0
-  else
-  if (enum Lisp_Type) (($arg0 >> 28) & 7) == Lisp_String
-    xstring $arg0
-  else
-  if (enum Lisp_Type) (($arg0 >> 28) & 7) == Lisp_Cons
-    xcons $arg0
-  else
-  if (enum Lisp_Type) (($arg0 >> 28) & 7) == Lisp_Vector
-    xvector $arg0
-  else
-  if (enum Lisp_Type) (($arg0 >> 28) & 7) == Lisp_Record
-    xrecord $arg0
-  else
-    printf "Unknown type?\n"
-  end
-  end
-  end
-  end
-  end
-end
-
-################ Miscellaneous
-
-define xtype
-# this is really xgctype, as we mask off the mark bit
-output (enum Lisp_Type) (($arg0 >> 28) & 7)
-echo \n
-end
-
-define xmarkbit
-print ($arg0 >> 31)
-end
-
-define nilp
-print $arg0 == Qnil
-end
-
-define xcar
-  frob ((struct Lisp_Cons *) ($arg0 & 0xFFFFFFF))->car
-end
-
-define xcdr
-  frob ((struct Lisp_Cons *) ($arg0 & 0xFFFFFFF))->cdr
-end
-
-set $vector_length_mask = ~(1<<31)
-
-define string-length
-  print ((struct Lisp_String *) ($arg0 & 0xFFFFFFF))->_size & $vector_length_mask
-end
-
-define string-contents
-  print (char *) ((struct Lisp_String *) ($ & 0xFFFFFFF))->_data
-end
-
-define vector-length
-  print ((struct Lisp_Vector *) ($ & 0xFFFFFFF))->size & $vector_length_mask
+document pobj
+Usage: pobj lisp_object
+Print the internal C structure of a underlying Lisp Object.
 end
-
-define vector-contents
-set $tem = (struct Lisp_Vector *) ($ & 0xFFFFFFF)
-print *($tem->contents) @ ($tem->size & $vector_length_mask)
-set $ = $tem->contents
-end
-
-define symbol-name
-set $tem = ((struct Lisp_Symbol *) ($ & 0xFFFFFFF))->name
-# output *($tem->_data) @ ($tem->_size & $vector_length_mask)
-output ($tem->_data) 
-echo \n
-set $type = Lisp_String
-echo \n
-end
-
-define symbol-value
-set $tem = ((struct Lisp_Symbol *) ($ & 0xFFFFFFF))->value
-end
-
-define symbol-function
-set $tem = ((struct Lisp_Symbol *) ($ & 0xFFFFFFF))->function
-end
-
-define symbol-plist
-set $tem = ((struct Lisp_Symbol *) ($ & 0xFFFFFFF))->plist
-end
-
-define wtype
-p $->core.widget_class->core_class.class_name
-end
-
-define xtname
-print XrmQuarkToString(((Object)($))->object.xrm_name)
-end
-
-# 
-# GDB, with the losing command-line parser that it has,
-# cannot handle nested blocks.
-# 
-define breaks
-
-br Fsignal
-# command
-# bt 3
-# p sig
-# xsymbol
-# end
-
-br Fkill_emacs
-# command
-# bt 3
-# end
-
-br assertion_failed
-# command
-# bt 3
-# end
-
-end