cgit.sxemacs.org Git - sxemacs/blob - src/dbxrc

   1 # -*- ksh -*-
   2 # Copyright (C) 1998 Free Software Foundation, Inc.
   3
   4 # This file is part of SXEmacs
   5
   6 # SXEmacs is free software: you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation, either version 3 of the License, or
   9 # (at your option) any later version.
  10
  11 # SXEmacs is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 # Author: Martin Buchholz
  20
  21 # You can use this file to debug SXEmacs using Sun WorkShop's dbx.
  22
  23 # Some functions defined here require a running process, but most
  24 # don't.  Considerable effort has been expended to this end.
  25
  26 # Since this file is called `.dbxrc', it will be read by dbx
  27 # automatically when dbx is run in the build directory, which is where
  28 # developers usually debug their SXEmacs.
  29
  30 # See also the comments in .gdbinit.
  31
  32 # See also the question of the SXEmacs FAQ, titled
  33 # "How to Debug a SXEmacs problem with a debugger".
  34
  35 # gdb sources the ./.gdbinit in _addition_ to ~/.gdbinit.
  36 # But dbx does _not_ source ~/.dbxrc if it found ./.dbxrc.
  37 # So we simulate the gdb algorithm by doing it ourselves here.
  38 if test -r $HOME/.dbxrc; then . $HOME/.dbxrc; fi
  39
  40 dbxenv language_mode ansic
  41
  42 ignore POLL
  43 ignore IO
  44
  45 document lbt << 'end'
  46 Usage: lbt
  47 Print the current Lisp stack trace.
  48 Requires a running SXEmacs process.
  49 end
  50
  51 function lbt {
  52   call debug_backtrace()
  53 }
  54
  55 document ldp << 'end'
  56 Usage: ldp lisp_object
  57 Print a Lisp Object value using the Lisp printer.
  58 Requires a running SXEmacs process.
  59 end
  60
  61 function ldp {
  62   call debug_print ($1);
  63 }
  64
  65 Lisp_Type_Int=-2
  66
  67 # A bug in dbx prevents string variables from having values beginning with `-'!!
  68 function SXEmacsInit {
  69   function ToInt { eval "$1=\$[(int) \`alloc.c\`$1]"; }
  70   ToInt dbg_USE_UNION_TYPE
  71   ToInt Lisp_Type_Char
  72   ToInt Lisp_Type_Record
  73   ToInt dbg_valbits
  74   ToInt dbg_gctypebits
  75   function ToLong { eval "$1=\$[(\`alloc.c\`unsigned long) \`alloc.c\`$1]"; }
  76   ToLong dbg_valmask
  77   ToLong dbg_typemask
  78   sxemacs_initted=yes
  79 }
  80
  81 function printvar {
  82   for i in $*; do eval "echo $i=\$$i"; done
  83 }
  84
  85 document decode_object << 'end'
  86 Usage: decode_object lisp_object
  87 Extract implementation information from a Lisp Object.
  88 Defines variables $val, $type and $imp.
  89 end
  90
  91 # Various dbx bugs cause ugliness in following code
  92 function decode_object {
  93   if test -z "$sxemacs_initted"; then SXEmacsInit; fi;
  94   if test $dbg_USE_UNION_TYPE = 1; then
  95     # Repeat after me... dbx sux, dbx sux, dbx sux...
  96     # Allow both `pobj Qnil' and `pobj 0x82746834' to work
  97     case $(whatis $1) in
  98       *Lisp_Object*) obj="$[(`alloc.c`unsigned long)(($1).i)]";;
  99       *) obj="$[(`alloc.c`unsigned long)($1)]";;
 100     esac
 101   else
 102     obj="$[(`alloc.c`unsigned long)($1)]";
 103   fi
 104   if test $[(int)($obj & 1)] = 1; then
 105     # It's an int
 106     val=$[(long)(((unsigned long long)$obj) >> 1)]
 107     type=$Lisp_Type_Int
 108   else
 109     type=$[(int)(((void*)$obj) & $dbg_typemask)]
 110     if test $type = $Lisp_Type_Char; then
 111       val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)]
 112     else
 113       # It's a record pointer
 114       val=$[(void*)$obj]
 115       if test "$val" = "(nil)"; then type=null_pointer; fi
 116     fi
 117   fi
 118
 119   if test $type = $Lisp_Type_Record; then
 120     lheader="((struct lrecord_header *) $val)"
 121     lrecord_type=$[(enum lrecord_type) $lheader->type]
 122     imp=$[(void*)(`alloc.c`lrecord_implementations_table[$lheader->type])]
 123   else
 124     lheader="((struct lrecord_header *) -1)"
 125     lrecord_type=-1
 126     imp="0xdeadbeef"
 127   fi
 128   # printvar obj val type imp
 129 }
 130
 131 function xint {
 132   decode_object "$*"
 133   print (long) ($val)
 134 }
 135
 136 document xtype << 'end'
 137 Usage: xtype lisp_object
 138 Print the Lisp type of a lisp object.
 139 end
 140
 141 function xtype {
 142   decode_object "$*"
 143   if   test $type = $Lisp_Type_Int;    then echo "int"
 144   elif test $type = $Lisp_Type_Char;   then echo "char"
 145   elif test $type = null_pointer;      then echo "null_pointer"
 146   else
 147     echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]"
 148   fi
 149 }
 150
 151 function lisp-shadows {
 152   run -batch -vanilla -f list-load-path-shadows
 153 }
 154
 155 function environment-to-run-temacs {
 156   unset EMACSLOADPATH
 157   export EMACSBOOTSTRAPLOADPATH=@abs_top_srcdir@/lisp/
 158   export EMACSBOOTSTRAPMODULEPATH=@abs_top_srcdir@/modules/
 159 }
 160
 161 document run-temacs << 'end'
 162 Usage: run-temacs
 163 Run temacs interactively, like SXEmacs.
 164 Use this with debugging tools (like purify) that cannot deal with dumping,
 165 or when temacs builds successfully, but SXEmacs does not.
 166 end
 167
 168 function run-temacs {
 169   environment-to-run-temacs
 170   run -nd -batch -l @abs_top_srcdir@/lisp/loadup.el run-temacs -q ${1+"$@"}
 171 }
 172
 173 document check-sxemacs << 'end'
 174 Usage: check-sxemacs
 175 Run the test suite.  Equivalent to 'make check'.
 176 end
 177
 178 function check-sxemacs {
 179   run -batch -l @abs_top_srcdir@/tests/automated/test-harness.el -f batch-test-emacs @abs_top_srcdir@/tests/automated
 180 }
 181
 182 document check-temacs << 'end'
 183 Usage: check-temacs
 184 Run the test suite on temacs.  Equivalent to 'make check-temacs'.
 185 Use this with debugging tools (like purify) that cannot deal with dumping,
 186 or when temacs builds successfully, but SXEmacs does not.
 187 end
 188
 189 function check-temacs {
 190   run-temacs -q -batch -l @abs_top_srcdir@/tests/automated/test-harness.el -f batch-test-emacs @abs_top_srcdir@/tests/automated
 191 }
 192
 193 document update-elc << 'end'
 194 Usage: update-elc
 195 Run the core lisp byte compilation part of the build procedure.
 196 Use when debugging temacs, not SXEmacs!
 197 Use this when temacs builds successfully, but SXEmacs does not.
 198 end
 199
 200 function update-elc {
 201   environment-to-run-temacs
 202   run -nd -batch -l @abs_top_srcdir@/lisp/update-elc.el
 203 }
 204
 205 document dmp << 'end'
 206 Usage: dmp
 207 Run the dumping part of the build procedure.
 208 Use when debugging temacs, not SXEmacs!
 209 Use this when temacs builds successfully, but SXEmacs does not.
 210 end
 211
 212 function dmp {
 213   environment-to-run-temacs
 214   run -nd -batch -l @abs_top_srcdir@/lisp/loadup.el dump
 215 }
 216
 217 function pstruct { # pstruct foo.c struct-name
 218   module "$1" > /dev/null
 219   type_ptr="((struct $2 *) $val)"
 220   print $type_ptr
 221   print *$type_ptr
 222 }
 223
 224 document pobj << 'end'
 225 Usage: pobj lisp_object
 226 Print the internal C representation of a Lisp Object.
 227 end
 228
 229 function pobj {
 230   decode_object $1
 231   if test $type = $Lisp_Type_Int; then
 232     print -f"Integer: %d" $val
 233   elif test $type = $Lisp_Type_Char; then
 234     if test $[$val > 32 && $val < 128] = 1; then
 235       print -f"Char: %c" $val
 236     else
 237       print -f"Char: %d" $val
 238     fi
 239   elif test $lrecord_type = lrecord_type_string; then
 240     pstruct alloc.c Lisp_String
 241   elif test $lrecord_type = lrecord_type_cons; then
 242     pstruct alloc.c Lisp_Cons
 243   elif test $lrecord_type = lrecord_type_symbol; then
 244     pstruct symbols.c Lisp_Symbol
 245     echo "Symbol name: $[(char *)($type_ptr->name->data)]"
 246   elif test $lrecord_type = lrecord_type_vector; then
 247     pstruct alloc.c Lisp_Vector
 248     echo "Vector of length $[$type_ptr->size]"
 249   elif test $lrecord_type = lrecord_type_bit_vector; then
 250     pstruct fns.c Lisp_Bit_Vector
 251   elif test $lrecord_type = lrecord_type_buffer; then
 252     pstruct buffer.c buffer
 253   elif test $lrecord_type = lrecord_type_char_table; then
 254     pstruct chartab.c Lisp_Char_Table
 255   elif test $lrecord_type = lrecord_type_char_table_entry; then
 256     pstruct chartab.c Lisp_Char_Table_Entry
 257   elif test $lrecord_type = lrecord_type_charset; then
 258     pstruct mule-charset.c Lisp_Charset
 259   elif test $lrecord_type = lrecord_type_coding_system; then
 260     pstruct file-coding.c Lisp_Coding_System
 261   elif test $lrecord_type = lrecord_type_color_instance; then
 262     pstruct objects.c Lisp_Color_Instance
 263   elif test $lrecord_type = lrecord_type_command_builder; then
 264     pstruct event-stream.c command_builder
 265   elif test $lrecord_type = lrecord_type_compiled_function; then
 266     pstruct bytecode.c Lisp_Compiled_Function
 267   elif test $lrecord_type = lrecord_type_console; then
 268     pstruct console.c console
 269   elif test $lrecord_type = lrecord_type_database; then
 270     pstruct database.c Lisp_Database
 271   elif test $lrecord_type = lrecord_type_device; then
 272     pstruct device.c device
 273   elif test $lrecord_type = lrecord_type_event; then
 274     pstruct events.c Lisp_Event
 275   elif test $lrecord_type = lrecord_type_extent; then
 276     pstruct extents.c extent
 277   elif test $lrecord_type = lrecord_type_extent_auxiliary; then
 278     pstruct extents.c extent_auxiliary
 279   elif test $lrecord_type = lrecord_type_extent_info; then
 280     pstruct extents.c extent_info
 281   elif test $lrecord_type = lrecord_type_face; then
 282     pstruct faces.c Lisp_Face
 283   elif test $lrecord_type = lrecord_type_float; then
 284     pstruct floatfns.c Lisp_Float
 285   elif test $lrecord_type = lrecord_type_font_instance; then
 286     pstruct objects.c Lisp_Font_Instance
 287   elif test $lrecord_type = lrecord_type_frame; then
 288     pstruct frame.c frame
 289   elif test $lrecord_type = lrecord_type_glyph; then
 290     pstruct glyph.c Lisp_Glyph
 291   elif test $lrecord_type = lrecord_type_gui_item; then
 292     pstruct gui.c Lisp_Gui_Item
 293   elif test $lrecord_type = lrecord_type_hash_table; then
 294     pstruct elhash.c Lisp_Hash_Table
 295   elif test $lrecord_type = lrecord_type_image_instance; then
 296     pstruct glyphs.c Lisp_Image_Instance
 297   elif test $lrecord_type = lrecord_type_keymap; then
 298     pstruct keymap.c Lisp_Keymap
 299   elif test $lrecord_type = lrecord_type_lcrecord_list; then
 300     pstruct alloc.c lcrecord_list
 301   elif test $lrecord_type = lrecord_type_ldap; then
 302     pstruct ldap.c Lisp_LDAP
 303   elif test $lrecord_type = lrecord_type_lstream; then
 304     pstruct lstream.c lstream
 305   elif test $lrecord_type = lrecord_type_marker; then
 306     pstruct marker.c Lisp_Marker
 307   elif test $lrecord_type = lrecord_type_opaque; then
 308     pstruct opaque.c Lisp_Opaque
 309   elif test $lrecord_type = lrecord_type_opaque_ptr; then
 310     pstruct opaque.c Lisp_Opaque_Ptr
 311   elif test $lrecord_type = lrecord_type_popup_data; then
 312     pstruct gui-x.c popup_data
 313   elif test $lrecord_type = lrecord_type_process; then
 314     pstruct process.c Lisp_Process
 315   elif test $lrecord_type = lrecord_type_range_table; then
 316     pstruct rangetab.c Lisp_Range_Table
 317   elif test $lrecord_type = lrecord_type_specifier; then
 318     pstruct specifier.c Lisp_Specifier
 319   elif test $lrecord_type = lrecord_type_subr; then
 320     pstruct eval.c Lisp_Subr
 321   elif test $lrecord_type = lrecord_type_symbol_value_buffer_local; then
 322     pstruct symbols.c symbol_value_buffer_local
 323   elif test $lrecord_type = lrecord_type_symbol_value_forward; then
 324     pstruct symbols.c symbol_value_forward
 325   elif test $lrecord_type = lrecord_type_symbol_value_lisp_magic; then
 326     pstruct symbols.c symbol_value_lisp_magic
 327   elif test $lrecord_type = lrecord_type_symbol_value_varalias; then
 328     pstruct symbols.c symbol_value_varalias
 329   elif test $lrecord_type = lrecord_type_timeout; then
 330     pstruct event-stream.c Lisp_Timeout
 331   elif test $lrecord_type = lrecord_type_toolbar_button; then
 332     pstruct toolbar.c toolbar_button
 333   elif test $lrecord_type = lrecord_type_weak_list; then
 334     pstruct data.c weak_list
 335   elif test $lrecord_type = lrecord_type_window; then
 336     pstruct window.c window
 337   elif test $lrecord_type = lrecord_type_window_configuration; then
 338     pstruct window.c window_config
 339   elif test "$type" = "null_pointer"; then
 340     echo "Lisp Object is a null pointer!!"
 341   else
 342     echo "Unknown Lisp Object type"
 343     print $1
 344   fi
 345 }
 346
 347 dbxenv suppress_startup_message 4.0
 348 # dbxenv mt_watchpoints on
 349
 350 function dp_core {
 351   print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core
 352 }
 353
 354 # Barf!
 355 function print_shell {
 356   print *(`frame-x.c`TopLevelShellRec*) (((struct `frame-x.c`x_frame*) (((struct `frame-x.c`frame*) (Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget)
 357 }
 358
 359 # -------------------------------------------------------------
 360 # functions to test the debugging support itself.
 361 # If you change this file, make sure the following still work...
 362 # -------------------------------------------------------------
 363 function test_xtype {
 364   function doit { echo -n "$1: "; xtype "$1"; }
 365   test_various_objects
 366 }
 367
 368 function test_pobj {
 369   function doit { echo '==============================='; echo -n "$1: "; pobj "$1"; }
 370   test_various_objects
 371 }
 372
 373 function test_various_objects {
 374   doit Vemacs_major_version
 375   doit Vhelp_char
 376   doit Qnil
 377   doit Qunbound
 378   doit Vobarray
 379   doit Vall_weak_lists
 380   doit Vsxemacs_codename
 381 }