--- a/src/dbxrc	Mon Aug 13 10:27:41 2007 +0200
+++ b/src/dbxrc	Mon Aug 13 10:28:48 2007 +0200
@@ -1,102 +1,298 @@
 # -*- 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
+
 # You can use this file to debug XEmacs using Sun WorkShop's dbx.
 # Add the contents of this file to $HOME/.dbxrc or
 # Source the contents of this file with something like:
 # test -r ./dbxrc && . ./dbxrc
 
+# Some functions defined here require a running process, but most
+# don't.  Considerable effort has been expended to this end.
+
+# See also the comments in gdbinit.
+
+# See also the question of the XEmacs FAQ, titled
+# "How to Debug an XEmacs problem with a debugger".
+
 ignore POLL
 ignore IO
 
+document lbt << 'end'
+Usage: lbt
+Print the current Lisp stack trace.
+Requires a running xemacs process.
+end
+
 function lbt {
-  call Fbacktrace (Qexternal_debugging_output, Qt)
+  call debug_backtrace()
 }
 
-function dp {
+document ldp << 'end'
+Usage: ldp lisp_object
+Print a Lisp Object value using the Lisp printer.
+Requires a running xemacs process.
+end
+
+function ldp {
   call debug_print ($1);
 }
 
-function xptr {
-  print ("$1"<<4) & 0xFFFFFFF)
+# A bug in dbx prevents string variables from having values beginning with `-'!!
+function XEmacsInit {
+  eval $(echo $(whatis -t `alloc.c`dbg_constants) | \
+    perl -e 'print "@{[map {s/=(-\d+)/sprintf(q[=0x%x],$1)/oge; /\w+=[0-9a-fx]+/og} <>]}\n"')
+  xemacs_initted=yes
+  #printvar dbg_valbits dbg_valmask
+}
+
+function printvar {
+  for i in $*; do eval "echo $i=\$$i"; done
+}
+
+document decode_object << 'end'
+Usage: decode_object lisp_object
+Extract implementation information from a Lisp Object.
+Defines variables $val, $type and $imp.
+end
+
+# Various dbx bugs cause ugliness in following code
+function decode_object {
+  test -z "$xemacs_initted" && XEmacsInit
+  obj=$[*(void**)(&$1)]
+  test "$obj" = "(nil)" && obj="0x0"
+  if test $dbg_USE_MINIMAL_TAGBITS = 1; then
+    if test $[(int)($obj & 1)] = 1; then
+      # It's an int
+      val=$[(long)(((unsigned long long)$obj) >> 1)]
+      type=$dbg_Lisp_Type_Int
+    else
+      type=$[(int)(((void*)$obj) & $dbg_typemask)]
+      if test $type = $dbg_Lisp_Type_Char; then
+        val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)]
+      else
+        # It's a record pointer
+        val=$[(void*)$obj]
+      fi
+    fi
+  else
+    # not dbg_USE_MINIMAL_TAGBITS
+    val=$[(void*)($obj & $dbg_valmask)]
+    test "$val" = "(nil)" && val="0x0"
+    type=$[(int)(((unsigned long long)($obj & $dbg_typemask)) >> ($dbg_valbits + 1))]
+  fi
+
+  if test $type = $dbg_Lisp_Type_Record; then
+    typeset lheader="((struct lrecord_header *) $val)"
+    if test $dbg_USE_INDEXED_LRECORD_IMPLEMENTATION = 1; then
+      imp=$[(void*)(lrecord_implementations_table[$lheader->type])]
+    else
+      imp=$[(void*)($lheader->implementation)]
+    fi
+  else
+    imp="0xdeadbeef"
+  fi
+  #printvar obj val type imp
 }
 
 function xint {
-  print ((int)($1 << 4))>>4;
+  decode_object "$*"
+  print (long) ($val)
+}
+
+function xtype {
+  decode_object "$*"
+  if   test $type = $dbg_Lisp_Type_Int;    then echo "int"
+  elif test $type = $dbg_Lisp_Type_Char;   then echo "char"
+  elif test $type = $dbg_Lisp_Type_Symbol; then echo "symbol"
+  elif test $type = $dbg_Lisp_Type_String; then echo "string"
+  elif test $type = $dbg_Lisp_Type_Vector; then echo "vector"
+  elif test $type = $dbg_Lisp_Type_Cons;   then echo "cons"
+  else
+    echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]"
+  fi
 }
 
-#function xstring {
-#  print *(struct Lisp_String *) ($1 & 0xFFFFFFF);
-#  #print ((struct Lisp_String *) ($1 & 0xFFFFFFF))->_data;
-#}
+document run-temacs << 'end'
+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
 
-function xlisp {
-  print $1 ($2 & 0xFFFFFFF);
-  #print ((struct Lisp_String *) ($1 & 0xFFFFFFF))->_data;
+function run-temacs {
+  run -batch -l loadup.el run-temacs -q
 }
 
-function defxlisp {
-  eval "function $1 { print $2 (\$1 & 0xFFFFFFF) ; }"
+document update-elc << 'end'
+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
+
+function update-elc {
+  export EMACSLOADPATH=../lisp/
+  run -batch -l update-elc.el
 }
 
-function defxstruct {
-  defxlisp "$1" "*(struct $2 *)"
+function pstruct {
+  xstruct="((struct $1 *) $val)"
+  print $xstruct
+  print *$xstruct
+}
+
+function lrecord_type_p {
+  if eval test -z \"\$lrecord_$1\" && test $imp = $[(void*)(&lrecord_$1)]; then return 0; else return 1; fi
 }
 
-defxstruct xstring        'Lisp_String'
-defxstruct xlstream       'lstream'
-defxstruct xsubr          'Lisp_Subr'
-defxstruct xbitvec        'Lisp_Bit_Vector'
-defxstruct xbuffer        'buffer'
-defxstruct xbytecode      'Lisp_Bytecode'
-defxstruct xcharset       'Lisp_Charset'
-defxstruct xchartab       'Lisp_Char_Table'
-defxstruct xchartabentry  'Lisp_Char_Table_Entry'
-defxstruct xcodesys       'Lisp_Coding_System'
-defxstruct xcolorinst     'Lisp_Color_Instance'
-defxstruct xcons          'Lisp_Cons'
-defxstruct xdevice        'device'
-defxstruct xevent         'Lisp_Event'
-defxstruct xextent        'extent'
-defxstruct xextentaux     'extent_auxilliary'
-defxstruct xfloat         'Lisp_Float'
-defxstruct xfontinst      'Lisp_Font_Instance'
-defxstruct xframe         'frame'
-defxstruct xglyph         'Lisp_Glyph'
-defxstruct xhashtable     'hashtable_struct'
-defxstruct ximageinst     'Lisp_Image_Instance'
-defxstruct xkeymap        'keymap'
-defxstruct xmarker        'Lisp_Marker'
-defxstruct xmenubardata   'menubar_data'
-defxstruct xopaque        'Lisp_Opaque'
-defxstruct xprocess       'Lisp_Process'
-defxstruct xrangetab      'Lisp_Range_Table'
-defxstruct xspec          'Lisp_Specifier'
-defxstruct xsubwindow     'Lisp_Subwindow'
-defxstruct xsymbol        'Lisp_Symbol'
-defxstruct xtoolbarbutton 'toolbar_button'
-defxstruct xtoolbardata   'toolbar_data'
-defxstruct xtooltalkmess  'Lisp_Tooltalk_Message'
-defxstruct xtooltalkpatt  'Lisp_Tooltalk_Pattern'
-defxstruct xvector        'Lisp_Vector'
-defxstruct xwindow        'window'
-defxstruct xwindowconfig  'window_config'
+document pobj << 'end'
+Usage: pobj lisp_object
+Print the internal C structure of a underlying Lisp Object.
+end
+
+function pobj {
+  decode_object $1
+  if test $type = $dbg_Lisp_Type_Int; then
+    print -f"Integer: %d" $val
+  elif test $type = $dbg_Lisp_Type_Char; then
+    if $val < 128; then
+      print -f"Char: %c" $val
+    else
+      print -f"Char: %d" $val
+    fi
+  elif test $type = $dbg_Lisp_Type_String || lrecord_type_p string; then
+    pstruct Lisp_String
+  elif test $type = $dbg_Lisp_Type_Cons   || lrecord_type_p cons; then
+    pstruct Lisp_Cons
+  elif test $type = $dbg_Lisp_Type_Symbol || lrecord_type_p symbol; then
+    pstruct Lisp_Symbol
+    echo "Symbol name: $[(char *)($xstruct->name->_data)]"
+  elif test $type = $dbg_Lisp_Type_Vector || lrecord_type_p vector; then
+    pstruct Lisp_Vector
+    echo "Vector of length $[$xstruct->size]"
+  elif lrecord_type_p bit_vector; then
+    pstruct Lisp_Bit_Vector
+  elif lrecord_type_p buffer; then
+    pstruct buffer
+  elif lrecord_type_p char_table; then
+    pstruct Lisp_Char_Table
+  elif lrecord_type_p char_table_entry; then
+    pstruct Lisp_Char_Table_Entry
+  elif lrecord_type_p charset; then
+    pstruct Lisp_Charset
+  elif lrecord_type_p coding_system; then
+    pstruct Lisp_Coding_System
+  elif lrecord_type_p color_instance; then
+    pstruct Lisp_Color_Instance
+  elif lrecord_type_p command_builder; then
+    pstruct command_builder
+  elif lrecord_type_p compiled_function; then
+    pstruct Lisp_Compiled_Function
+  elif lrecord_type_p console; then
+    pstruct console
+  elif lrecord_type_p database; then
+    pstruct database
+  elif lrecord_type_p device; then
+    pstruct device
+  elif lrecord_type_p event; then
+    pstruct Lisp_Event
+  elif lrecord_type_p extent; then
+    pstruct extent
+  elif lrecord_type_p extent_auxiliary; then
+    pstruct extent_auxiliary
+  elif lrecord_type_p extent_info; then
+    pstruct extent_info
+  elif lrecord_type_p face; then
+    pstruct Lisp_Face
+  elif lrecord_type_p float; then
+    pstruct Lisp_Float
+  elif lrecord_type_p font_instance; then
+    pstruct Lisp_Font_Instance
+  elif lrecord_type_p frame; then
+    pstruct frame
+  elif lrecord_type_p glyph; then
+    pstruct Lisp_Glyph
+  elif lrecord_type_p hashtable; then
+    pstruct hashtable
+  elif lrecord_type_p image_instance; then
+    pstruct Lisp_Image_Instance
+  elif lrecord_type_p keymap; then
+    pstruct keymap
+  elif lrecord_type_p lcrecord_list; then
+    pstruct lcrecord_list
+  elif lrecord_type_p lstream; then
+    pstruct lstream
+  elif lrecord_type_p marker; then
+    pstruct Lisp_Marker
+  elif lrecord_type_p opaque; then
+    pstruct Lisp_Opaque
+  elif lrecord_type_p opaque_list; then
+    pstruct Lisp_Opaque_List
+  elif lrecord_type_p popup_data; then
+    pstruct popup_data
+  elif lrecord_type_p process; then
+    pstruct Lisp_Process
+  elif lrecord_type_p range_table; then
+    pstruct Lisp_Range_Table
+  elif lrecord_type_p specifier; then
+    pstruct Lisp_Specifier
+  elif lrecord_type_p subr; then
+    pstruct Lisp_Subr
+  elif lrecord_type_p symbol_value_buffer_local; then
+    pstruct symbol_value_buffer_local
+  elif lrecord_type_p symbol_value_forward; then
+    pstruct symbol_value_forward
+  elif lrecord_type_p symbol_value_lisp_magic; then
+    pstruct symbol_value_lisp_magic
+  elif lrecord_type_p symbol_value_varalias; then
+    pstruct symbol_value_varalias
+  elif lrecord_type_p toolbar_button; then
+    pstruct toolbar_button
+  elif lrecord_type_p toolbar_data; then
+    pstruct toolbar_data
+  elif lrecord_type_p tooltalk_message; then
+    pstruct Lisp_Tooltalk_Message
+  elif lrecord_type_p tooltalk_pattern; then
+    pstruct Lisp_Tooltalk_Pattern
+  elif lrecord_type_p weak_list; then
+    pstruct weak_list
+  elif lrecord_type_p window; then
+    pstruct window
+  elif lrecord_type_p window_configuration; then
+    pstruct window_config
+  else
+    echo "Unknown Lisp Object type"
+    print $1
+  fi
+}
 
 function pproc {
   print *(`process.c`struct Lisp_Process*)$1 ;
-  dp "(`process.c`struct Lisp_Process*)$1->name" ;
-  dp "(`process.c`struct Lisp_Process*)$1->command" ;
-}
-
-function xtype {
-  print (enum Lisp_Type) (($1 >> 28) & 7)
+  ldp "(`process.c`struct Lisp_Process*)$1->name" ;
+  ldp "(`process.c`struct Lisp_Process*)$1->command" ;
 }
 
 dbxenv suppress_startup_message 4.0
 
-function dp_args {
-  dp "*(((Lisp_Object*)($1))+0)"
-  dp "*(((Lisp_Object*)($1))+1)"
-}
-
 function dp_core {
   print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core
 }