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 # Add the contents of this file to $HOME/.dbxrc or
  25 # Source the contents of this file with something like:
  26 # test -r ./dbxrc && . ./dbxrc
  27
  28 # Some functions defined here require a running process, but most
  29 # don't.  Considerable effort has been expended to this end.
  30
  31 # See also the comments in gdbinit.
  32
  33 # See also the question of the XEmacs FAQ, titled
  34 # "How to Debug an XEmacs problem with a debugger".
  35
  36 ignore POLL
  37 ignore IO
  38
  39 document lbt << 'end'
  40 Usage: lbt
  41 Print the current Lisp stack trace.
  42 Requires a running xemacs process.
  43 end
  44
  45 function lbt {
  46   call debug_backtrace()
  47 }
  48
  49 document ldp << 'end'
  50 Usage: ldp lisp_object
  51 Print a Lisp Object value using the Lisp printer.
  52 Requires a running xemacs process.
  53 end
  54
  55 function ldp {
  56   call debug_print ($1);
  57 }
  58
  59 # A bug in dbx prevents string variables from having values beginning with `-'!!
  60 function XEmacsInit {
  61   eval $(echo $(whatis -t `alloc.c`dbg_constants) | \
  62     perl -e 'print "@{[map {s/=(-\d+)/sprintf(q[=0x%x],$1)/oge; /\w+=[0-9a-fx]+/og} <>]}\n"')
  63   xemacs_initted=yes
  64   #printvar dbg_valbits dbg_valmask
  65 }
  66
  67 function printvar {
  68   for i in $*; do eval "echo $i=\$$i"; done
  69 }
  70
  71 document decode_object << 'end'
  72 Usage: decode_object lisp_object
  73 Extract implementation information from a Lisp Object.
  74 Defines variables $val, $type and $imp.
  75 end
  76
  77 # Various dbx bugs cause ugliness in following code
  78 function decode_object {
  79   test -z "$xemacs_initted" && XEmacsInit
  80   obj=$[*(void**)(&$1)]
  81   test "$obj" = "(nil)" && obj="0x0"
  82   if test $dbg_USE_MINIMAL_TAGBITS = 1; then
  83     if test $[(int)($obj & 1)] = 1; then
  84       # It's an int
  85       val=$[(long)(((unsigned long long)$obj) >> 1)]
  86       type=$dbg_Lisp_Type_Int
  87     else
  88       type=$[(int)(((void*)$obj) & $dbg_typemask)]
  89       if test $type = $dbg_Lisp_Type_Char; then
  90         val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)]
  91       else
  92         # It's a record pointer
  93         val=$[(void*)$obj]
  94       fi
  95     fi
  96   else
  97     # not dbg_USE_MINIMAL_TAGBITS
  98     val=$[(void*)($obj & $dbg_valmask)]
  99     test "$val" = "(nil)" && val="0x0"
 100     type=$[(int)(((unsigned long long)($obj & $dbg_typemask)) >> ($dbg_valbits + 1))]
 101   fi
 102
 103   if test $type = $dbg_Lisp_Type_Record; then
 104     typeset lheader="((struct lrecord_header *) $val)"
 105     if test $dbg_USE_INDEXED_LRECORD_IMPLEMENTATION = 1; then
 106       imp=$[(void*)(lrecord_implementations_table[$lheader->type])]
 107     else
 108       imp=$[(void*)($lheader->implementation)]
 109     fi
 110   else
 111     imp="0xdeadbeef"
 112   fi
 113   #printvar obj val type imp
 114 }
 115
 116 function xint {
 117   decode_object "$*"
 118   print (long) ($val)
 119 }
 120
 121 function xtype {
 122   decode_object "$*"
 123   if   test $type = $dbg_Lisp_Type_Int;    then echo "int"
 124   elif test $type = $dbg_Lisp_Type_Char;   then echo "char"
 125   elif test $type = $dbg_Lisp_Type_Symbol; then echo "symbol"
 126   elif test $type = $dbg_Lisp_Type_String; then echo "string"
 127   elif test $type = $dbg_Lisp_Type_Vector; then echo "vector"
 128   elif test $type = $dbg_Lisp_Type_Cons;   then echo "cons"
 129   else
 130     echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]"
 131   fi
 132 }
 133
 134 document run-temacs << 'end'
 135 Usage: run-temacs
 136 Run temacs interactively, like xemacs.
 137 Use this with debugging tools (like purify) that cannot deal with dumping,
 138 or when temacs builds successfully, but xemacs does not.
 139 end
 140
 141 function run-temacs {
 142   unset EMACSLOADPATH
 143   export EMACSBOOTSTRAPLOADPATH=../lisp/:..
 144   run -batch -l ../lisp/loadup.el run-temacs -q
 145 }
 146
 147 document update-elc << 'end'
 148 Usage: update-elc
 149 Run the core lisp byte compilation part of the build procedure.
 150 Use when debugging temacs, not xemacs!
 151 Use this when temacs builds successfully, but xemacs does not.
 152 end
 153
 154 function update-elc {
 155   unset EMACSLOADPATH
 156   export EMACSBOOTSTRAPLOADPATH=../lisp/:..
 157   run -batch -l ../lisp/update-elc.el
 158 }
 159
 160
 161 function dump-temacs {
 162   unset EMACSLOADPATH
 163   export EMACSBOOTSTRAPLOADPATH=../lisp/:..
 164   run -batch -l ../lisp/loadup.el dump
 165 }
 166
 167 document dump-temacs << 'end'
 168 Usage: dump-temacs
 169 Run the dumping part of the build procedure.
 170 Use when debugging temacs, not xemacs!
 171 Use this when temacs builds successfully, but xemacs does not.
 172 end
 173
 174 function pstruct {
 175   xstruct="((struct $1 *) $val)"
 176   print $xstruct
 177   print *$xstruct
 178 }
 179
 180 function lrecord_type_p {
 181   if eval test -z \"\$lrecord_$1\" && test $imp = $[(void*)(&lrecord_$1)]; then return 0; else return 1; fi
 182 }
 183
 184 document pobj << 'end'
 185 Usage: pobj lisp_object
 186 Print the internal C structure of a underlying Lisp Object.
 187 end
 188
 189 function pobj {
 190   decode_object $1
 191   if test $type = $dbg_Lisp_Type_Int; then
 192     print -f"Integer: %d" $val
 193   elif test $type = $dbg_Lisp_Type_Char; then
 194     if $val < 128; then
 195       print -f"Char: %c" $val
 196     else
 197       print -f"Char: %d" $val
 198     fi
 199   elif test $type = $dbg_Lisp_Type_String || lrecord_type_p string; then
 200     pstruct Lisp_String
 201   elif test $type = $dbg_Lisp_Type_Cons   || lrecord_type_p cons; then
 202     pstruct Lisp_Cons
 203   elif test $type = $dbg_Lisp_Type_Symbol || lrecord_type_p symbol; then
 204     pstruct Lisp_Symbol
 205     echo "Symbol name: $[(char *)($xstruct->name->_data)]"
 206   elif test $type = $dbg_Lisp_Type_Vector || lrecord_type_p vector; then
 207     pstruct Lisp_Vector
 208     echo "Vector of length $[$xstruct->size]"
 209   elif lrecord_type_p bit_vector; then
 210     pstruct Lisp_Bit_Vector
 211   elif lrecord_type_p buffer; then
 212     pstruct buffer
 213   elif lrecord_type_p char_table; then
 214     pstruct Lisp_Char_Table
 215   elif lrecord_type_p char_table_entry; then
 216     pstruct Lisp_Char_Table_Entry
 217   elif lrecord_type_p charset; then
 218     pstruct Lisp_Charset
 219   elif lrecord_type_p coding_system; then
 220     pstruct Lisp_Coding_System
 221   elif lrecord_type_p color_instance; then
 222     pstruct Lisp_Color_Instance
 223   elif lrecord_type_p command_builder; then
 224     pstruct command_builder
 225   elif lrecord_type_p compiled_function; then
 226     pstruct Lisp_Compiled_Function
 227   elif lrecord_type_p console; then
 228     pstruct console
 229   elif lrecord_type_p database; then
 230     pstruct database
 231   elif lrecord_type_p device; then
 232     pstruct device
 233   elif lrecord_type_p event; then
 234     pstruct Lisp_Event
 235   elif lrecord_type_p extent; then
 236     pstruct extent
 237   elif lrecord_type_p extent_auxiliary; then
 238     pstruct extent_auxiliary
 239   elif lrecord_type_p extent_info; then
 240     pstruct extent_info
 241   elif lrecord_type_p face; then
 242     pstruct Lisp_Face
 243   elif lrecord_type_p float; then
 244     pstruct Lisp_Float
 245   elif lrecord_type_p font_instance; then
 246     pstruct Lisp_Font_Instance
 247   elif lrecord_type_p frame; then
 248     pstruct frame
 249   elif lrecord_type_p glyph; then
 250     pstruct Lisp_Glyph
 251   elif lrecord_type_p hashtable; then
 252     pstruct hashtable
 253   elif lrecord_type_p image_instance; then
 254     pstruct Lisp_Image_Instance
 255   elif lrecord_type_p keymap; then
 256     pstruct keymap
 257   elif lrecord_type_p lcrecord_list; then
 258     pstruct lcrecord_list
 259   elif lrecord_type_p lstream; then
 260     pstruct lstream
 261   elif lrecord_type_p marker; then
 262     pstruct Lisp_Marker
 263   elif lrecord_type_p opaque; then
 264     pstruct Lisp_Opaque
 265   elif lrecord_type_p opaque_list; then
 266     pstruct Lisp_Opaque_List
 267   elif lrecord_type_p popup_data; then
 268     pstruct popup_data
 269   elif lrecord_type_p process; then
 270     pstruct Lisp_Process
 271   elif lrecord_type_p range_table; then
 272     pstruct Lisp_Range_Table
 273   elif lrecord_type_p specifier; then
 274     pstruct Lisp_Specifier
 275   elif lrecord_type_p subr; then
 276     pstruct Lisp_Subr
 277   elif lrecord_type_p symbol_value_buffer_local; then
 278     pstruct symbol_value_buffer_local
 279   elif lrecord_type_p symbol_value_forward; then
 280     pstruct symbol_value_forward
 281   elif lrecord_type_p symbol_value_lisp_magic; then
 282     pstruct symbol_value_lisp_magic
 283   elif lrecord_type_p symbol_value_varalias; then
 284     pstruct symbol_value_varalias
 285   elif lrecord_type_p toolbar_button; then
 286     pstruct toolbar_button
 287   elif lrecord_type_p tooltalk_message; then
 288     pstruct Lisp_Tooltalk_Message
 289   elif lrecord_type_p tooltalk_pattern; then
 290     pstruct Lisp_Tooltalk_Pattern
 291   elif lrecord_type_p weak_list; then
 292     pstruct weak_list
 293   elif lrecord_type_p window; then
 294     pstruct window
 295   elif lrecord_type_p window_configuration; then
 296     pstruct window_config
 297   else
 298     echo "Unknown Lisp Object type"
 299     print $1
 300   fi
 301 }
 302
 303 function pproc {
 304   print *(`process.c`struct Lisp_Process*)$1 ;
 305   ldp "(`process.c`struct Lisp_Process*)$1->name" ;
 306   ldp "(`process.c`struct Lisp_Process*)$1->command" ;
 307 }
 308
 309 dbxenv suppress_startup_message 4.0
 310
 311 function dp_core {
 312   print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core
 313 }
 314
 315 # Barf!
 316 function print_shell {
 317   print *(`frame-x.c`TopLevelShellRec*) (((struct `frame-x.c`x_frame*) (((struct `frame-x.c`frame*) (Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget)
 318 }