git.chise.org Git - chise/xemacs-chise.git.1/blob - src/.dbxrc

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