1. xemacs
  2. XEmacs


XEmacs / src / .dbxrc

# -*- 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.

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.

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) \`alloc.c\`$1]"; }
  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

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.

# 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)]";;
    obj="$[(`alloc.c`unsigned long)($1)]";
  if test $[(int)($obj & 1)] = 1; then
    # It's an int
    val=$[(long)(((unsigned long long)$obj) >> 1)]
    type=$[(int)(((void*)$obj) & $dbg_typemask)]
    if test $type = $Lisp_Type_Char; then
      val=$[(void*)(long)(((unsigned long long)($obj & $dbg_valmask)) >> $dbg_gctypebits)]
      # It's a record pointer
      if test "$val" = "(nil)"; then type=null_pointer; fi

  if test $type = $Lisp_Type_Record; then
    lheader="((struct lrecord_header *) $val)"
    lrecord_type=$[(enum lrecord_type) $lheader->type]
    lheader="((struct lrecord_header *) -1)"
  # 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.

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"
    echo "record type with name: $[((struct lrecord_implementation *)$imp)->name]"

function lisp-shadows {
  run -batch -vanilla -f list-load-path-shadows

function environment-to-run-temacs {
  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.

function 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'.

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.

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.

function update-elc {
  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.

function dmp {
  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.

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
      print -f"Char: %d" $val
  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!!"
    echo "Unknown Lisp Object type"
    print $1

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"; }

function test_pobj {
  function doit { echo '==============================='; echo -n "$1: "; pobj "$1"; }

function test_various_objects {
  doit Vemacs_major_version
  doit Vhelp_char
  doit Qnil
  doit Qunbound
  doit Vobarray
  doit Vall_weak_lists
  doit Vxemacs_codename