xemacs-beta: src/.dbxrc comparison

comparison src/.dbxrc @ 438:84b14dcb0985 r21-2-27

Import from CVS: tag r21-2-27

author	cvs
date	Mon, 13 Aug 2007 11:32:25 +0200
parents
children	8de8e3f6228a

comparison

equal deleted inserted replaced

-:e2a4e8b94b82
+:84b14dcb0985
+# -*- 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
+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);
+}
+# A bug in dbx prevents string variables from having values beginning with `-'!!
+function XEmacsInit {
+function ToInt { eval "$1=\$[(int) $1]"; }
+ToInt dbg_USE_UNION_TYPE
+ToInt Lisp_Type_Int
+ToInt Lisp_Type_Char
+ToInt Lisp_Type_Cons
+ToInt Lisp_Type_String
+ToInt Lisp_Type_Vector
+ToInt Lisp_Type_Symbol
+ToInt Lisp_Type_Record
+ToInt dbg_valbits
+ToInt dbg_gctypebits
+function ToLong { eval "$1=\$[(unsigned long) $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="$[(unsigned long)(($1).i)]";;
+*) obj="$[(unsigned long)($1)]";;
+esac
+else
+obj="$[(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
+typeset lheader="((struct lrecord_header *) $val)"
+imp=$[(void*)(lrecord_implementations_table[$lheader->type])]
+else
+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 = $Lisp_Type_Symbol; then echo "symbol"
+elif test $type = $Lisp_Type_String; then echo "string"
+elif test $type = $Lisp_Type_Vector; then echo "vector"
+elif test $type = $Lisp_Type_Cons;   then echo "cons"
+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 -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 -batch -l ../lisp/update-elc.el
+}
+document dump-temacs << 'end'
+Usage: dump-temacs
+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 dump-temacs {
+environment-to-run-temacs
+run -batch -l ../lisp/loadup.el dump
+}
+function pstruct {
+xstruct="((struct $1 *) $val)"
+print $xstruct
+print *$xstruct
+}
+function lrecord_type_p {
+if eval test -z \"\$lrecord_$1\" && test $imp = $[(void*)(&lrecord_$1)]; then return 0; else return 1; fi
+}
+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 $type = $Lisp_Type_String || lrecord_type_p string; then
+pstruct Lisp_String
+elif test $type = $Lisp_Type_Cons   || lrecord_type_p cons; then
+pstruct Lisp_Cons
+elif test $type = $Lisp_Type_Symbol || lrecord_type_p symbol; then
+pstruct Lisp_Symbol
+echo "Symbol name: $[(char *)($xstruct->name->data)]"
+elif test $type = $Lisp_Type_Vector || lrecord_type_p vector; then
+pstruct Lisp_Vector
+echo "Vector of length $[$xstruct->size]"
+elif lrecord_type_p bit_vector; then
+pstruct Lisp_Bit_Vector
+elif lrecord_type_p buffer; then
+pstruct buffer
+elif lrecord_type_p char_table; then
+pstruct Lisp_Char_Table
+elif lrecord_type_p char_table_entry; then
+pstruct Lisp_Char_Table_Entry
+elif lrecord_type_p charset; then
+pstruct Lisp_Charset
+elif lrecord_type_p coding_system; then
+pstruct Lisp_Coding_System
+elif lrecord_type_p color_instance; then
+pstruct Lisp_Color_Instance
+elif lrecord_type_p command_builder; then
+pstruct command_builder
+elif lrecord_type_p compiled_function; then
+pstruct Lisp_Compiled_Function
+elif lrecord_type_p console; then
+pstruct console
+elif lrecord_type_p database; then
+pstruct Lisp_Database
+elif lrecord_type_p device; then
+pstruct device
+elif lrecord_type_p event; then
+pstruct Lisp_Event
+elif lrecord_type_p extent; then
+pstruct extent
+elif lrecord_type_p extent_auxiliary; then
+pstruct extent_auxiliary
+elif lrecord_type_p extent_info; then
+pstruct extent_info
+elif lrecord_type_p face; then
+pstruct Lisp_Face
+elif lrecord_type_p float; then
+pstruct Lisp_Float
+elif lrecord_type_p font_instance; then
+pstruct Lisp_Font_Instance
+elif lrecord_type_p frame; then
+pstruct frame
+elif lrecord_type_p glyph; then
+pstruct Lisp_Glyph
+elif lrecord_type_p hash_table; then
+pstruct Lisp_Hash_Table
+elif lrecord_type_p image_instance; then
+pstruct Lisp_Image_Instance
+elif lrecord_type_p keymap; then
+pstruct Lisp_Keymap
+elif lrecord_type_p lcrecord_list; then
+pstruct lcrecord_list
+elif lrecord_type_p lstream; then
+pstruct lstream
+elif lrecord_type_p marker; then
+pstruct Lisp_Marker
+elif lrecord_type_p opaque; then
+pstruct Lisp_Opaque
+elif lrecord_type_p opaque_ptr; then
+pstruct Lisp_Opaque_Ptr
+elif lrecord_type_p popup_data; then
+pstruct popup_data
+elif lrecord_type_p process; then
+pstruct Lisp_Process
+elif lrecord_type_p range_table; then
+pstruct Lisp_Range_Table
+elif lrecord_type_p specifier; then
+pstruct Lisp_Specifier
+elif lrecord_type_p subr; then
+pstruct Lisp_Subr
+elif lrecord_type_p symbol_value_buffer_local; then
+pstruct symbol_value_buffer_local
+elif lrecord_type_p symbol_value_forward; then
+pstruct symbol_value_forward
+elif lrecord_type_p symbol_value_lisp_magic; then
+pstruct symbol_value_lisp_magic
+elif lrecord_type_p symbol_value_varalias; then
+pstruct symbol_value_varalias
+elif lrecord_type_p toolbar_button; then
+pstruct toolbar_button
+elif lrecord_type_p tooltalk_message; then
+pstruct Lisp_Tooltalk_Message
+elif lrecord_type_p tooltalk_pattern; then
+pstruct Lisp_Tooltalk_Pattern
+elif lrecord_type_p weak_list; then
+pstruct weak_list
+elif lrecord_type_p window; then
+pstruct window
+elif lrecord_type_p window_configuration; then
+pstruct window_config
+elif test "$type" = "null_pointer"; then
+echo "Lisp Object is a null pointer!!"
+else
+echo "Unknown Lisp Object type"
+print $1
+fi
+}
+function pproc {
+print *(`process.c`struct Lisp_Process*)$1 ;
+ldp "(`process.c`struct Lisp_Process*)$1->name" ;
+ldp "(`process.c`struct Lisp_Process*)$1->command" ;
+}
+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
+}

Mercurial > hg > xemacs-beta

comparison src/.dbxrc @ 438:84b14dcb0985 r21-2-27