Mercurial > hg > xemacs-beta

comparison src/dbxrc @ 272:c5d627a313b1 r21-0b34

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b34
author cvs
date Mon, 13 Aug 2007 10:28:48 +0200
parents ac2d302a0011
children 558f606b08ae
comparison
equal deleted inserted replaced
271:c7b7086b0a39 272:c5d627a313b1
1 # -*- ksh -*- 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
2 # You can use this file to debug XEmacs using Sun WorkShop's dbx. 23 # You can use this file to debug XEmacs using Sun WorkShop's dbx.
3 # Add the contents of this file to $HOME/.dbxrc or 24 # Add the contents of this file to $HOME/.dbxrc or
4 # Source the contents of this file with something like: 25 # Source the contents of this file with something like:
5 # test -r ./dbxrc && . ./dbxrc 26 # test -r ./dbxrc && . ./dbxrc
6 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
7 ignore POLL 36 ignore POLL
8 ignore IO 37 ignore IO
9 38
39 document lbt << 'end'
40 Usage: lbt
41 Print the current Lisp stack trace.
42 Requires a running xemacs process.
43 end
44
10 function lbt { 45 function lbt {
11 call Fbacktrace (Qexternal_debugging_output, Qt) 46 call debug_backtrace()
12 } 47 }
13 48
14 function dp { 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 {
15 call debug_print ($1); 56 call debug_print ($1);
16 } 57 }
17 58
18 function xptr { 59 # A bug in dbx prevents string variables from having values beginning with `-'!!
19 print ("$1"<<4) & 0xFFFFFFF) 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
20 } 114 }
21 115
22 function xint { 116 function xint {
23 print ((int)($1 << 4))>>4; 117 decode_object "$*"
24 } 118 print (long) ($val)
25 119 }
26 #function xstring { 120
27 # print *(struct Lisp_String *) ($1 & 0xFFFFFFF); 121 function xtype {
28 # #print ((struct Lisp_String *) ($1 & 0xFFFFFFF))->_data; 122 decode_object "$*"
29 #} 123 if test $type = $dbg_Lisp_Type_Int; then echo "int"
30 124 elif test $type = $dbg_Lisp_Type_Char; then echo "char"
31 function xlisp { 125 elif test $type = $dbg_Lisp_Type_Symbol; then echo "symbol"
32 print $1 ($2 & 0xFFFFFFF); 126 elif test $type = $dbg_Lisp_Type_String; then echo "string"
33 #print ((struct Lisp_String *) ($1 & 0xFFFFFFF))->_data; 127 elif test $type = $dbg_Lisp_Type_Vector; then echo "vector"
34 } 128 elif test $type = $dbg_Lisp_Type_Cons; then echo "cons"
35 129 else
36 function defxlisp { 130 echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]"
37 eval "function $1 { print $2 (\$1 & 0xFFFFFFF) ; }" 131 fi
38 } 132 }
39 133
40 function defxstruct { 134 document run-temacs << 'end'
41 defxlisp "$1" "*(struct $2 *)" 135 Usage: run-temacs
42 } 136 Run temacs interactively, like xemacs.
43 137 Use this with debugging tools (like purify) that cannot deal with dumping,
44 defxstruct xstring 'Lisp_String' 138 or when temacs builds successfully, but xemacs does not.
45 defxstruct xlstream 'lstream' 139 end
46 defxstruct xsubr 'Lisp_Subr' 140
47 defxstruct xbitvec 'Lisp_Bit_Vector' 141 function run-temacs {
48 defxstruct xbuffer 'buffer' 142 run -batch -l loadup.el run-temacs -q
49 defxstruct xbytecode 'Lisp_Bytecode' 143 }
50 defxstruct xcharset 'Lisp_Charset' 144
51 defxstruct xchartab 'Lisp_Char_Table' 145 document update-elc << 'end'
52 defxstruct xchartabentry 'Lisp_Char_Table_Entry' 146 Usage: update-elc
53 defxstruct xcodesys 'Lisp_Coding_System' 147 Run the elc compilation part of the build procedure.
54 defxstruct xcolorinst 'Lisp_Color_Instance' 148 Use when debugging temacs, not xemacs!
55 defxstruct xcons 'Lisp_Cons' 149 Use this when temacs builds successfully, but xemacs does not.
56 defxstruct xdevice 'device' 150 end
57 defxstruct xevent 'Lisp_Event' 151
58 defxstruct xextent 'extent' 152 function update-elc {
59 defxstruct xextentaux 'extent_auxilliary' 153 export EMACSLOADPATH=../lisp/
60 defxstruct xfloat 'Lisp_Float' 154 run -batch -l update-elc.el
61 defxstruct xfontinst 'Lisp_Font_Instance' 155 }
62 defxstruct xframe 'frame' 156
63 defxstruct xglyph 'Lisp_Glyph' 157 function pstruct {
64 defxstruct xhashtable 'hashtable_struct' 158 xstruct="((struct $1 *) $val)"
65 defxstruct ximageinst 'Lisp_Image_Instance' 159 print $xstruct
66 defxstruct xkeymap 'keymap' 160 print *$xstruct
67 defxstruct xmarker 'Lisp_Marker' 161 }
68 defxstruct xmenubardata 'menubar_data' 162
69 defxstruct xopaque 'Lisp_Opaque' 163 function lrecord_type_p {
70 defxstruct xprocess 'Lisp_Process' 164 if eval test -z \"\$lrecord_$1\" && test $imp = $[(void*)(&lrecord_$1)]; then return 0; else return 1; fi
71 defxstruct xrangetab 'Lisp_Range_Table' 165 }
72 defxstruct xspec 'Lisp_Specifier' 166
73 defxstruct xsubwindow 'Lisp_Subwindow' 167 document pobj << 'end'
74 defxstruct xsymbol 'Lisp_Symbol' 168 Usage: pobj lisp_object
75 defxstruct xtoolbarbutton 'toolbar_button' 169 Print the internal C structure of a underlying Lisp Object.
76 defxstruct xtoolbardata 'toolbar_data' 170 end
77 defxstruct xtooltalkmess 'Lisp_Tooltalk_Message' 171
78 defxstruct xtooltalkpatt 'Lisp_Tooltalk_Pattern' 172 function pobj {
79 defxstruct xvector 'Lisp_Vector' 173 decode_object $1
80 defxstruct xwindow 'window' 174 if test $type = $dbg_Lisp_Type_Int; then
81 defxstruct xwindowconfig 'window_config' 175 print -f"Integer: %d" $val
176 elif test $type = $dbg_Lisp_Type_Char; then
177 if $val < 128; then
178 print -f"Char: %c" $val
179 else
180 print -f"Char: %d" $val
181 fi
182 elif test $type = $dbg_Lisp_Type_String || lrecord_type_p string; then
183 pstruct Lisp_String
184 elif test $type = $dbg_Lisp_Type_Cons || lrecord_type_p cons; then
185 pstruct Lisp_Cons
186 elif test $type = $dbg_Lisp_Type_Symbol || lrecord_type_p symbol; then
187 pstruct Lisp_Symbol
188 echo "Symbol name: $[(char *)($xstruct->name->_data)]"
189 elif test $type = $dbg_Lisp_Type_Vector || lrecord_type_p vector; then
190 pstruct Lisp_Vector
191 echo "Vector of length $[$xstruct->size]"
192 elif lrecord_type_p bit_vector; then
193 pstruct Lisp_Bit_Vector
194 elif lrecord_type_p buffer; then
195 pstruct buffer
196 elif lrecord_type_p char_table; then
197 pstruct Lisp_Char_Table
198 elif lrecord_type_p char_table_entry; then
199 pstruct Lisp_Char_Table_Entry
200 elif lrecord_type_p charset; then
201 pstruct Lisp_Charset
202 elif lrecord_type_p coding_system; then
203 pstruct Lisp_Coding_System
204 elif lrecord_type_p color_instance; then
205 pstruct Lisp_Color_Instance
206 elif lrecord_type_p command_builder; then
207 pstruct command_builder
208 elif lrecord_type_p compiled_function; then
209 pstruct Lisp_Compiled_Function
210 elif lrecord_type_p console; then
211 pstruct console
212 elif lrecord_type_p database; then
213 pstruct database
214 elif lrecord_type_p device; then
215 pstruct device
216 elif lrecord_type_p event; then
217 pstruct Lisp_Event
218 elif lrecord_type_p extent; then
219 pstruct extent
220 elif lrecord_type_p extent_auxiliary; then
221 pstruct extent_auxiliary
222 elif lrecord_type_p extent_info; then
223 pstruct extent_info
224 elif lrecord_type_p face; then
225 pstruct Lisp_Face
226 elif lrecord_type_p float; then
227 pstruct Lisp_Float
228 elif lrecord_type_p font_instance; then
229 pstruct Lisp_Font_Instance
230 elif lrecord_type_p frame; then
231 pstruct frame
232 elif lrecord_type_p glyph; then
233 pstruct Lisp_Glyph
234 elif lrecord_type_p hashtable; then
235 pstruct hashtable
236 elif lrecord_type_p image_instance; then
237 pstruct Lisp_Image_Instance
238 elif lrecord_type_p keymap; then
239 pstruct keymap
240 elif lrecord_type_p lcrecord_list; then
241 pstruct lcrecord_list
242 elif lrecord_type_p lstream; then
243 pstruct lstream
244 elif lrecord_type_p marker; then
245 pstruct Lisp_Marker
246 elif lrecord_type_p opaque; then
247 pstruct Lisp_Opaque
248 elif lrecord_type_p opaque_list; then
249 pstruct Lisp_Opaque_List
250 elif lrecord_type_p popup_data; then
251 pstruct popup_data
252 elif lrecord_type_p process; then
253 pstruct Lisp_Process
254 elif lrecord_type_p range_table; then
255 pstruct Lisp_Range_Table
256 elif lrecord_type_p specifier; then
257 pstruct Lisp_Specifier
258 elif lrecord_type_p subr; then
259 pstruct Lisp_Subr
260 elif lrecord_type_p symbol_value_buffer_local; then
261 pstruct symbol_value_buffer_local
262 elif lrecord_type_p symbol_value_forward; then
263 pstruct symbol_value_forward
264 elif lrecord_type_p symbol_value_lisp_magic; then
265 pstruct symbol_value_lisp_magic
266 elif lrecord_type_p symbol_value_varalias; then
267 pstruct symbol_value_varalias
268 elif lrecord_type_p toolbar_button; then
269 pstruct toolbar_button
270 elif lrecord_type_p toolbar_data; then
271 pstruct toolbar_data
272 elif lrecord_type_p tooltalk_message; then
273 pstruct Lisp_Tooltalk_Message
274 elif lrecord_type_p tooltalk_pattern; then
275 pstruct Lisp_Tooltalk_Pattern
276 elif lrecord_type_p weak_list; then
277 pstruct weak_list
278 elif lrecord_type_p window; then
279 pstruct window
280 elif lrecord_type_p window_configuration; then
281 pstruct window_config
282 else
283 echo "Unknown Lisp Object type"
284 print $1
285 fi
286 }
82 287
83 function pproc { 288 function pproc {
84 print *(`process.c`struct Lisp_Process*)$1 ; 289 print *(`process.c`struct Lisp_Process*)$1 ;
85 dp "(`process.c`struct Lisp_Process*)$1->name" ; 290 ldp "(`process.c`struct Lisp_Process*)$1->name" ;
86 dp "(`process.c`struct Lisp_Process*)$1->command" ; 291 ldp "(`process.c`struct Lisp_Process*)$1->command" ;
87 }
88
89 function xtype {
90 print (enum Lisp_Type) (($1 >> 28) & 7)
91 } 292 }
92 293
93 dbxenv suppress_startup_message 4.0 294 dbxenv suppress_startup_message 4.0
94
95 function dp_args {
96 dp "*(((Lisp_Object*)($1))+0)"
97 dp "*(((Lisp_Object*)($1))+1)"
98 }
99 295
100 function dp_core { 296 function dp_core {
101 print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core 297 print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core
102 } 298 }
103 299