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