# -*- ksh -*- # Copyright (C) 1998 Free Software Foundation, Inc. # 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 2, 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; see the file COPYING. If not, write to # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA. # Author: Martin Buchholz # 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. if test -r $HOME/.dbxrc; then . $HOME/.dbxrc; fi dbxenv language_mode ansic ignore POLL ignore IO 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 ../tests/automated/test-harness.el -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 ../tests/automated/test-harness.el -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 objects.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 objects.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 elif test $lrecord_type = lrecord_type_lcrecord_list; then pstruct alloc.c lcrecord_list 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 $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 }