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 ignore POLL
  43 ignore IO
  44
  45 document lbt << 'end'
  46 Usage: lbt
  47 Print the current Lisp stack trace.
  48 Requires a running xemacs 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 xemacs process.
  59 end
  60
  61 function ldp {
  62   call debug_print ($1);
  63 }
  64
  65 # A bug in dbx prevents string variables from having values beginning with `-'!!
  66 function XEmacsInit {
  67   function ToInt { eval "$1=\$[(int) $1]"; }
  68   ToInt dbg_USE_UNION_TYPE
  69   ToInt Lisp_Type_Int
  70   ToInt Lisp_Type_Char
  71   ToInt Lisp_Type_Cons
  72   ToInt Lisp_Type_String
  73   ToInt Lisp_Type_Vector
  74   ToInt Lisp_Type_Symbol
  75   ToInt Lisp_Type_Record
  76   ToInt dbg_valbits
  77   ToInt dbg_gctypebits
  78   function ToLong { eval "$1=\$[(unsigned long) $1]"; }
  79   ToLong dbg_valmask
  80   ToLong dbg_typemask
  81   xemacs_initted=yes
  82 }
  83
  84 function printvar {
  85   for i in $*; do eval "echo $i=\$$i"; done
  86 }
  87
  88 document decode_object << 'end'
  89 Usage: decode_object lisp_object
  90 Extract implementation information from a Lisp Object.
  91 Defines variables $val, $type and $imp.
  92 end
  93
  94 # Various dbx bugs cause ugliness in following code
  95 function decode_object {
  96   if test -z "$xemacs_initted"; then XEmacsInit; fi;
  97   if test $dbg_USE_UNION_TYPE = 1; then
  98     # Repeat after me... dbx sux, dbx sux, dbx sux...
  99     # Allow both `pobj Qnil' and `pobj 0x82746834' to work
 100     case $(whatis $1) in
 101       *Lisp_Object*) obj="$[(unsigned long)(($1).i)]";;
 102       *) obj="$[(unsigned long)($1)]";;
 103     esac
 104   else
 105     obj="$[(unsigned long)($1)]";
 106   fi
 107   if test $[(int)($obj & 1)] = 1; then
 108     # It's an int
 109     val=$[(long)(((unsigned long long)$obj) >> 1)]
 110     type=$Lisp_Type_Int
 111   else
 112     type=$[(int)(((void*)$obj) & $dbg_typemask)]
 113     if test $type = $Lisp_Type_Char; then
 114       val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)]
 115     else
 116       # It's a record pointer
 117       val=$[(void*)$obj]
 118       if test "$val" = "(nil)"; then type=null_pointer; fi
 119     fi
 120   fi
 121
 122   if test $type = $Lisp_Type_Record; then
 123     typeset lheader="((struct lrecord_header *) $val)"
 124     imp=$[(void*)(lrecord_implementations_table[$lheader->type])]
 125   else
 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 = $Lisp_Type_Symbol; then echo "symbol"
 146   elif test $type = $Lisp_Type_String; then echo "string"
 147   elif test $type = $Lisp_Type_Vector; then echo "vector"
 148   elif test $type = $Lisp_Type_Cons;   then echo "cons"
 149   elif test $type = null_pointer;      then echo "null_pointer"
 150   else
 151     echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]"
 152   fi
 153 }
 154
 155 function lisp-shadows {
 156   run -batch -vanilla -f list-load-path-shadows
 157 }
 158
 159 function environment-to-run-temacs {
 160   unset EMACSLOADPATH
 161   export EMACSBOOTSTRAPLOADPATH=../lisp/:..
 162   export EMACSBOOTSTRAPMODULEPATH=../modules/:..
 163 }
 164
 165 document run-temacs << 'end'
 166 Usage: run-temacs
 167 Run temacs interactively, like xemacs.
 168 Use this with debugging tools (like purify) that cannot deal with dumping,
 169 or when temacs builds successfully, but xemacs does not.
 170 end
 171
 172 function run-temacs {
 173   environment-to-run-temacs
 174   run -batch -l ../lisp/loadup.el run-temacs -q ${1+"$@"}
 175 }
 176
 177 document check-xemacs << 'end'
 178 Usage: check-xemacs
 179 Run the test suite.  Equivalent to 'make check'.
 180 end
 181
 182 function check-xemacs {
 183   run -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated
 184 }
 185
 186 document check-temacs << 'end'
 187 Usage: check-temacs
 188 Run the test suite on temacs.  Equivalent to 'make check-temacs'.
 189 Use this with debugging tools (like purify) that cannot deal with dumping,
 190 or when temacs builds successfully, but xemacs does not.
 191 end
 192
 193 function check-temacs {
 194   run-temacs -q -batch -l ../tests/automated/test-harness.el -f batch-test-emacs ../tests/automated
 195 }
 196
 197 document update-elc << 'end'
 198 Usage: update-elc
 199 Run the core lisp byte compilation part of the build procedure.
 200 Use when debugging temacs, not xemacs!
 201 Use this when temacs builds successfully, but xemacs does not.
 202 end
 203
 204 function update-elc {
 205   environment-to-run-temacs
 206   run -batch -l ../lisp/update-elc.el
 207 }
 208
 209 document dump-temacs << 'end'
 210 Usage: dump-temacs
 211 Run the dumping part of the build procedure.
 212 Use when debugging temacs, not xemacs!
 213 Use this when temacs builds successfully, but xemacs does not.
 214 end
 215
 216 function dump-temacs {
 217   environment-to-run-temacs
 218   run -batch -l ../lisp/loadup.el dump
 219 }
 220
 221 function pstruct {
 222   xstruct="((struct $1 *) $val)"
 223   print $xstruct
 224   print *$xstruct
 225 }
 226
 227 function lrecord_type_p {
 228   if eval test -z \"\$lrecord_$1\" && test $imp = $[(void*)(&lrecord_$1)]; then return 0; else return 1; fi
 229 }
 230
 231 document pobj << 'end'
 232 Usage: pobj lisp_object
 233 Print the internal C representation of a Lisp Object.
 234 end
 235
 236 function pobj {
 237   decode_object $1
 238   if test $type = $Lisp_Type_Int; then
 239     print -f"Integer: %d" $val
 240   elif test $type = $Lisp_Type_Char; then
 241     if test $[$val > 32 && $val < 128] = 1; then
 242       print -f"Char: %c" $val
 243     else
 244       print -f"Char: %d" $val
 245     fi
 246   elif test $type = $Lisp_Type_String || lrecord_type_p string; then
 247     pstruct Lisp_String
 248   elif test $type = $Lisp_Type_Cons   || lrecord_type_p cons; then
 249     pstruct Lisp_Cons
 250   elif test $type = $Lisp_Type_Symbol || lrecord_type_p symbol; then
 251     pstruct Lisp_Symbol
 252     echo "Symbol name: $[(char *)($xstruct->name->data)]"
 253   elif test $type = $Lisp_Type_Vector || lrecord_type_p vector; then
 254     pstruct Lisp_Vector
 255     echo "Vector of length $[$xstruct->size]"
 256   elif lrecord_type_p bit_vector; then
 257     pstruct Lisp_Bit_Vector
 258   elif lrecord_type_p buffer; then
 259     pstruct buffer
 260   elif lrecord_type_p char_table; then
 261     pstruct Lisp_Char_Table
 262   elif lrecord_type_p char_table_entry; then
 263     pstruct Lisp_Char_Table_Entry
 264   elif lrecord_type_p charset; then
 265     pstruct Lisp_Charset
 266   elif lrecord_type_p coding_system; then
 267     pstruct Lisp_Coding_System
 268   elif lrecord_type_p color_instance; then
 269     pstruct Lisp_Color_Instance
 270   elif lrecord_type_p command_builder; then
 271     pstruct command_builder
 272   elif lrecord_type_p compiled_function; then
 273     pstruct Lisp_Compiled_Function
 274   elif lrecord_type_p console; then
 275     pstruct console
 276   elif lrecord_type_p database; then
 277     pstruct Lisp_Database
 278   elif lrecord_type_p device; then
 279     pstruct device
 280   elif lrecord_type_p event; then
 281     pstruct Lisp_Event
 282   elif lrecord_type_p extent; then
 283     pstruct extent
 284   elif lrecord_type_p extent_auxiliary; then
 285     pstruct extent_auxiliary
 286   elif lrecord_type_p extent_info; then
 287     pstruct extent_info
 288   elif lrecord_type_p face; then
 289     pstruct Lisp_Face
 290   elif lrecord_type_p float; then
 291     pstruct Lisp_Float
 292   elif lrecord_type_p font_instance; then
 293     pstruct Lisp_Font_Instance
 294   elif lrecord_type_p frame; then
 295     pstruct frame
 296   elif lrecord_type_p glyph; then
 297     pstruct Lisp_Glyph
 298   elif lrecord_type_p hash_table; then
 299     pstruct Lisp_Hash_Table
 300   elif lrecord_type_p image_instance; then
 301     pstruct Lisp_Image_Instance
 302   elif lrecord_type_p keymap; then
 303     pstruct Lisp_Keymap
 304   elif lrecord_type_p lcrecord_list; then
 305     pstruct lcrecord_list
 306   elif lrecord_type_p lstream; then
 307     pstruct lstream
 308   elif lrecord_type_p marker; then
 309     pstruct Lisp_Marker
 310   elif lrecord_type_p opaque; then
 311     pstruct Lisp_Opaque
 312   elif lrecord_type_p opaque_ptr; then
 313     pstruct Lisp_Opaque_Ptr
 314   elif lrecord_type_p popup_data; then
 315     pstruct popup_data
 316   elif lrecord_type_p process; then
 317     pstruct Lisp_Process
 318   elif lrecord_type_p range_table; then
 319     pstruct Lisp_Range_Table
 320   elif lrecord_type_p specifier; then
 321     pstruct Lisp_Specifier
 322   elif lrecord_type_p subr; then
 323     pstruct Lisp_Subr
 324   elif lrecord_type_p symbol_value_buffer_local; then
 325     pstruct symbol_value_buffer_local
 326   elif lrecord_type_p symbol_value_forward; then
 327     pstruct symbol_value_forward
 328   elif lrecord_type_p symbol_value_lisp_magic; then
 329     pstruct symbol_value_lisp_magic
 330   elif lrecord_type_p symbol_value_varalias; then
 331     pstruct symbol_value_varalias
 332   elif lrecord_type_p toolbar_button; then
 333     pstruct toolbar_button
 334   elif lrecord_type_p tooltalk_message; then
 335     pstruct Lisp_Tooltalk_Message
 336   elif lrecord_type_p tooltalk_pattern; then
 337     pstruct Lisp_Tooltalk_Pattern
 338   elif lrecord_type_p weak_list; then
 339     pstruct weak_list
 340   elif lrecord_type_p window; then
 341     pstruct window
 342   elif lrecord_type_p window_configuration; then
 343     pstruct window_config
 344   elif test "$type" = "null_pointer"; then
 345     echo "Lisp Object is a null pointer!!"
 346   else
 347     echo "Unknown Lisp Object type"
 348     print $1
 349   fi
 350 }
 351
 352 function pproc {
 353   print *(`process.c`struct Lisp_Process*)$1 ;
 354   ldp "(`process.c`struct Lisp_Process*)$1->name" ;
 355   ldp "(`process.c`struct Lisp_Process*)$1->command" ;
 356 }
 357
 358 dbxenv suppress_startup_message 4.0
 359 dbxenv mt_watchpoints on
 360
 361 function dp_core {
 362   print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core
 363 }
 364
 365 # Barf!
 366 function print_shell {
 367   print *(`frame-x.c`TopLevelShellRec*) (((struct `frame-x.c`x_frame*) (((struct `frame-x.c`frame*) (Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget)
 368 }
 369
 370 # -------------------------------------------------------------
 371 # functions to test the debugging support itself.
 372 # If you change this file, make sure the following still work...
 373 # -------------------------------------------------------------
 374 function test_xtype {
 375   function doit { echo -n "$1: "; xtype "$1"; }
 376   test_various_objects
 377 }
 378
 379 function test_pobj {
 380   function doit { echo '==============================='; echo -n "$1: "; pobj "$1"; }
 381   test_various_objects
 382 }
 383
 384 function test_various_objects {
 385   doit Vemacs_major_version
 386   doit Vhelp_char
 387   doit Qnil
 388   doit Qunbound
 389   doit Vobarray
 390   doit Vall_weak_lists
 391   doit Vxemacs_codename
 392 }