Mercurial > hg > xemacs-beta
diff src/.dbxrc.in @ 5601:3e5d5e8e4bb7
Move etc/dbxrc.in to src/.dbxrc.in.
2011-11-21 Marcus Crestani <crestani@informatik.uni-tuebingen.de>
* .hgignore:
* configure.ac:
Reflect move of etc/dbxrc.in to src/.dbxrc.in.
* configure: Regenerate.
2011-11-21 Marcus Crestani <crestani@informatik.uni-tuebingen.de>
* dbxrc.in: Move to src/.dbxrc.in.
2011-11-21 Marcus Crestani <crestani@informatik.uni-tuebingen.de>
* .dbxrc.in: Move from etc/.dbxrc.in.
author | Marcus Crestani <crestani@informatik.uni-tuebingen.de> |
---|---|
date | Mon, 21 Nov 2011 19:46:04 +0100 |
parents | etc/dbxrc.in@bccc91a65536 |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/.dbxrc.in Mon Nov 21 19:46:04 2011 +0100 @@ -0,0 +1,405 @@ +## dbx init file for XEmacs -*- ksh -*- +## This is the source file for src/.dbxrc. Edit it, and rerun configure. +## (Running config.status is not enough.) +## The generated file depends on src/config.h (currently only in one place). + +## Copyright (C) 1998 Free Software Foundation, Inc. +## Copyright (C) 2010 Ben Wing. + +## This file is part of XEmacs. + +## XEmacs is free software: you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by the +## Free Software Foundation, either version 3 of the License, or (at your +## option) any later version. + +## XEmacs is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +## for more details. + +## You should have received a copy of the GNU General Public License +## along with XEmacs. If not, see <http://www.gnu.org/licenses/>. + +## Author: Martin Buchholz + +## Other contributors you could ask for help: Ivan Golubev, Jerry James, +## Stephen Turnbull. + +## You can use this file to debug XEmacs using Sun WorkShop's dbx. + +## Some functions defined here require a running process, but most +## don't. Considerable effort has been expended to this end. + +## Since this file is called `.dbxrc', it will be read by dbx +## automatically when dbx is run in the build directory, which is where +## developers usually debug their xemacs. + +## See also the comments in .gdbinit. + +## See also the question of the XEmacs FAQ, titled +## "How to Debug an XEmacs problem with a debugger". + +## gdb sources the ./.gdbinit in _addition_ to ~/.gdbinit. +## But dbx does _not_ source ~/.dbxrc if it found ./.dbxrc. +## So we simulate the gdb algorithm by doing it ourselves here. + +#define NOT_C_CODE +#include "config.h" + +if test -r $HOME/.dbxrc; then . $HOME/.dbxrc; fi + +dbxenv language_mode ansic + +ignore POLL +ignore IO + +#ifdef VDB_POSIX +ignore SIGSEGV +ignore SIGBUS +#endif + +document lbt << 'end' +Usage: lbt +Print the current Lisp stack trace. +Requires a running xemacs process. +end + +function lbt { + call debug_backtrace() +} + +document ldp << 'end' +Usage: ldp lisp_object +Print a Lisp Object value using the Lisp printer. +Requires a running xemacs process. +end + +function ldp { + call debug_print ($1); +} + +Lisp_Type_Int=-2 + +## A bug in dbx prevents string variables from having values beginning with `-'!! +function XEmacsInit { + function ToInt { eval "$1=\$[(int) \`alloc.c\`$1]"; } + ToInt dbg_USE_UNION_TYPE + ToInt Lisp_Type_Char + ToInt Lisp_Type_Record + ToInt dbg_valbits + ToInt dbg_gctypebits + function ToLong { eval "$1=\$[(\`alloc.c\`unsigned long) \`alloc.c\`$1]"; } + ToLong dbg_valmask + ToLong dbg_typemask + xemacs_initted=yes +} + +function printvar { + for i in $*; do eval "echo $i=\$$i"; done +} + +document decode_object << 'end' +Usage: decode_object lisp_object +Extract implementation information from a Lisp Object. +Defines variables $val, $type and $imp. +end + +## Various dbx bugs cause ugliness in following code +function decode_object { + if test -z "$xemacs_initted"; then XEmacsInit; fi; + if test $dbg_USE_UNION_TYPE = 1; then + ## Repeat after me... dbx sux, dbx sux, dbx sux... + ## Allow both `pobj Qnil' and `pobj 0x82746834' to work + case $(whatis $1) in + *Lisp_Object*) obj="$[(`alloc.c`unsigned long)(($1).i)]";; + *) obj="$[(`alloc.c`unsigned long)($1)]";; + esac + else + obj="$[(`alloc.c`unsigned long)($1)]"; + fi + if test $[(int)($obj & 1)] = 1; then + ## It's an int + val=$[(long)(((unsigned long long)$obj) >> 1)] + type=$Lisp_Type_Int + else + type=$[(int)(((void*)$obj) & $dbg_typemask)] + if test $type = $Lisp_Type_Char; then + val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)] + else + ## It's a record pointer + val=$[(void*)$obj] + if test "$val" = "(nil)"; then type=null_pointer; fi + fi + fi + + if test $type = $Lisp_Type_Record; then + lheader="((struct lrecord_header *) $val)" + lrecord_type=$[(enum lrecord_type) $lheader->type] + imp=$[(void*)(`alloc.c`lrecord_implementations_table[$lheader->type])] + else + lheader="((struct lrecord_header *) -1)" + lrecord_type=-1 + imp="0xdeadbeef" + fi + ## printvar obj val type imp +} + +function xint { + decode_object "$*" + print (long) ($val) +} + +document xtype << 'end' +Usage: xtype lisp_object +Print the Lisp type of a lisp object. +end + +function xtype { + decode_object "$*" + if test $type = $Lisp_Type_Int; then echo "int" + elif test $type = $Lisp_Type_Char; then echo "char" + elif test $type = null_pointer; then echo "null_pointer" + else + echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]" + fi +} + +function lisp-shadows { + run -batch -vanilla -f list-load-path-shadows +} + +function environment-to-run-temacs { + unset EMACSLOADPATH + export EMACSBOOTSTRAPLOADPATH=../lisp/:.. + export EMACSBOOTSTRAPMODULEPATH=../modules/:.. +} + +document run-temacs << 'end' +Usage: run-temacs +Run temacs interactively, like xemacs. +Use this with debugging tools (like purify) that cannot deal with dumping, +or when temacs builds successfully, but xemacs does not. +end + +function run-temacs { + environment-to-run-temacs + run -nd -batch -l ../lisp/loadup.el run-temacs -q ${1+"$@"} +} + +document check-xemacs << 'end' +Usage: check-xemacs +Run the test suite. Equivalent to 'make check'. +end + +function check-xemacs { + run -batch -l test-harness -f batch-test-emacs ../tests/automated +} + +document check-temacs << 'end' +Usage: check-temacs +Run the test suite on temacs. Equivalent to 'make check-temacs'. +Use this with debugging tools (like purify) that cannot deal with dumping, +or when temacs builds successfully, but xemacs does not. +end + +function check-temacs { + run-temacs -q -batch -l test-harness -f batch-test-emacs ../tests/automated +} + +document update-elc << 'end' +Usage: update-elc +Run the core lisp byte compilation part of the build procedure. +Use when debugging temacs, not xemacs! +Use this when temacs builds successfully, but xemacs does not. +end + +function update-elc { + environment-to-run-temacs + run -nd -batch -l ../lisp/update-elc.el +} + +document dmp << 'end' +Usage: dmp +Run the dumping part of the build procedure. +Use when debugging temacs, not xemacs! +Use this when temacs builds successfully, but xemacs does not. +end + +function dmp { + environment-to-run-temacs + run -nd -batch -l ../lisp/loadup.el dump +} + +function pstruct { ## pstruct foo.c struct-name + module "$1" > /dev/null + type_ptr="((struct $2 *) $val)" + print $type_ptr + print *$type_ptr +} + +document pobj << 'end' +Usage: pobj lisp_object +Print the internal C representation of a Lisp Object. +end + +function pobj { + decode_object $1 + if test $type = $Lisp_Type_Int; then + print -f"Integer: %d" $val + elif test $type = $Lisp_Type_Char; then + if test $[$val > 32 && $val < 128] = 1; then + print -f"Char: %c" $val + else + print -f"Char: %d" $val + fi + elif test $lrecord_type = lrecord_type_string; then + pstruct alloc.c Lisp_String + elif test $lrecord_type = lrecord_type_cons; then + pstruct alloc.c Lisp_Cons + elif test $lrecord_type = lrecord_type_symbol; then + pstruct symbols.c Lisp_Symbol + echo "Symbol name: $[(char *)($type_ptr->name->data)]" + elif test $lrecord_type = lrecord_type_vector; then + pstruct alloc.c Lisp_Vector + echo "Vector of length $[$type_ptr->size]" + elif test $lrecord_type = lrecord_type_bit_vector; then + pstruct fns.c Lisp_Bit_Vector + elif test $lrecord_type = lrecord_type_buffer; then + pstruct buffer.c buffer + elif test $lrecord_type = lrecord_type_char_table; then + pstruct chartab.c Lisp_Char_Table + elif test $lrecord_type = lrecord_type_char_table_entry; then + pstruct chartab.c Lisp_Char_Table_Entry + elif test $lrecord_type = lrecord_type_charset; then + pstruct mule-charset.c Lisp_Charset + elif test $lrecord_type = lrecord_type_coding_system; then + pstruct file-coding.c Lisp_Coding_System + elif test $lrecord_type = lrecord_type_color_instance; then + pstruct fontcolor.c Lisp_Color_Instance + elif test $lrecord_type = lrecord_type_command_builder; then + pstruct event-stream.c command_builder + elif test $lrecord_type = lrecord_type_compiled_function; then + pstruct bytecode.c Lisp_Compiled_Function + elif test $lrecord_type = lrecord_type_console; then + pstruct console.c console + elif test $lrecord_type = lrecord_type_database; then + pstruct database.c Lisp_Database + elif test $lrecord_type = lrecord_type_device; then + pstruct device.c device + elif test $lrecord_type = lrecord_type_event; then + pstruct events.c Lisp_Event + elif test $lrecord_type = lrecord_type_extent; then + pstruct extents.c extent + elif test $lrecord_type = lrecord_type_extent_auxiliary; then + pstruct extents.c extent_auxiliary + elif test $lrecord_type = lrecord_type_extent_info; then + pstruct extents.c extent_info + elif test $lrecord_type = lrecord_type_face; then + pstruct faces.c Lisp_Face + elif test $lrecord_type = lrecord_type_float; then + pstruct floatfns.c Lisp_Float + elif test $lrecord_type = lrecord_type_font_instance; then + pstruct fontcolor.c Lisp_Font_Instance + elif test $lrecord_type = lrecord_type_frame; then + pstruct frame.c frame + elif test $lrecord_type = lrecord_type_glyph; then + pstruct glyph.c Lisp_Glyph + elif test $lrecord_type = lrecord_type_gui_item; then + pstruct gui.c Lisp_Gui_Item + elif test $lrecord_type = lrecord_type_hash_table; then + pstruct elhash.c Lisp_Hash_Table + elif test $lrecord_type = lrecord_type_image_instance; then + pstruct glyphs.c Lisp_Image_Instance + elif test $lrecord_type = lrecord_type_keymap; then + pstruct keymap.c Lisp_Keymap +#ifndef NEW_GC + elif test $lrecord_type = lrecord_type_lcrecord_list; then + pstruct alloc.c lcrecord_list +#endif + elif test $lrecord_type = lrecord_type_ldap; then + pstruct ldap.c Lisp_LDAP + elif test $lrecord_type = lrecord_type_lstream; then + pstruct lstream.c lstream + elif test $lrecord_type = lrecord_type_marker; then + pstruct marker.c Lisp_Marker + elif test $lrecord_type = lrecord_type_opaque; then + pstruct opaque.c Lisp_Opaque + elif test $lrecord_type = lrecord_type_opaque_ptr; then + pstruct opaque.c Lisp_Opaque_Ptr + elif test $lrecord_type = lrecord_type_popup_data; then + pstruct gui-x.c popup_data + elif test $lrecord_type = lrecord_type_process; then + pstruct process.c Lisp_Process + elif test $lrecord_type = lrecord_type_range_table; then + pstruct rangetab.c Lisp_Range_Table + elif test $lrecord_type = lrecord_type_specifier; then + pstruct specifier.c Lisp_Specifier + elif test $lrecord_type = lrecord_type_subr; then + pstruct eval.c Lisp_Subr + elif test $lrecord_type = lrecord_type_symbol_value_buffer_local; then + pstruct symbols.c symbol_value_buffer_local + elif test $lrecord_type = lrecord_type_symbol_value_forward; then + pstruct symbols.c symbol_value_forward + elif test $lrecord_type = lrecord_type_symbol_value_lisp_magic; then + pstruct symbols.c symbol_value_lisp_magic + elif test $lrecord_type = lrecord_type_symbol_value_varalias; then + pstruct symbols.c symbol_value_varalias + elif test $lrecord_type = lrecord_type_timeout; then + pstruct event-stream.c Lisp_Timeout + elif test $lrecord_type = lrecord_type_toolbar_button; then + pstruct toolbar.c toolbar_button + elif test $lrecord_type = lrecord_type_tooltalk_message; then + pstruct tooltalk.c Lisp_Tooltalk_Message + elif test $lrecord_type = lrecord_type_tooltalk_pattern; then + pstruct tooltalk.c Lisp_Tooltalk_Pattern + elif test $lrecord_type = lrecord_type_weak_list; then + pstruct data.c weak_list + elif test $lrecord_type = lrecord_type_window; then + pstruct window.c window + elif test $lrecord_type = lrecord_type_window_configuration; then + pstruct window.c window_config + elif test "$type" = "null_pointer"; then + echo "Lisp Object is a null pointer!!" + else + echo "Unknown Lisp Object type" + print $lrecord_type + print $1 + fi +} + +dbxenv suppress_startup_message 4.0 +## dbxenv mt_watchpoints on + +function dp_core { + print ((struct x_frame *)(((struct frame*)(Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget->core +} + +## Barf! +function print_shell { + print *(`frame-x.c`TopLevelShellRec*) (((struct `frame-x.c`x_frame*) (((struct `frame-x.c`frame*) (Fselected_frame(Qnil)&0x00FFFFFF))->frame_data))->widget) +} + +## ------------------------------------------------------------- +## functions to test the debugging support itself. +## If you change this file, make sure the following still work... +## ------------------------------------------------------------- +function test_xtype { + function doit { echo -n "$1: "; xtype "$1"; } + test_various_objects +} + +function test_pobj { + function doit { echo '==============================='; echo -n "$1: "; pobj "$1"; } + test_various_objects +} + +function test_various_objects { + doit Vemacs_major_version + doit Vhelp_char + doit Qnil + doit Qunbound + doit Vobarray + doit Vall_weak_lists + doit Vxemacs_codename +}