xemacs21-bin 21.4.22-4ubuntu3 / usr / lib / xemacs-21.4.22 / x86_64-linux-gnu / include / backtrace.h

/* The lisp stack.
   Copyright (C) 1985, 1986, 1987, 1992, 1993 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.  */

/* Synched up with: FSF 19.30.  Contained redundantly in various C files
   in FSFmacs. */

/* Authorship:

   FSF: Original version; a long time ago.
   XEmacs: split out of some C files. (For some obscure reason, a header
           file couldn't be used in FSF Emacs, but XEmacs doesn't have
	   that problem.)
   Mly (probably) or JWZ: Some changes.
 */

#ifndef INCLUDED_backtrace_h_
#define INCLUDED_backtrace_h_

#include <setjmp.h>

/* These definitions are used in eval.c and alloc.c */

struct backtrace
  {
    struct backtrace *next;
    Lisp_Object *function;
    Lisp_Object *args;		/* Points to vector of args. */
    int nargs;			/* Length of vector.
				   If nargs is UNEVALLED, args points to
				   slot holding list of unevalled args */
    int pdlcount;               /* specpdl_depth () when invoked */
    char evalargs;
    /* Nonzero means call value of debugger when done with this operation. */
    char debug_on_exit;
  };

/* This structure helps implement the `catch' and `throw' control
   structure.  A struct catchtag contains all the information needed
   to restore the state of the interpreter after a non-local jump.

   Handlers for error conditions (represented by `struct handler'
   structures) just point to a catch tag to do the cleanup required
   for their jumps.

   catchtag structures are chained together in the C calling stack;
   the `next' member points to the next outer catchtag.

   A call like (throw TAG VAL) searches for a catchtag whose `tag'
   member is TAG, and then unbinds to it.  The `val' member is used to
   hold VAL while the stack is unwound; `val' is returned as the value
   of the catch form.

   All the other members are concerned with restoring the interpreter
   state.  */

struct catchtag
  {
    Lisp_Object tag;
    Lisp_Object val;
    struct catchtag *next;
    struct gcpro *gcpro;
    JMP_BUF jmp;
    struct backtrace *backlist;
#if 0 /* FSFmacs */
    /* #### */
    struct handler *handlerlist;
#endif
    int lisp_eval_depth;
    int pdlcount;
#if 0 /* FSFmacs */
    /* This is the equivalent of async_timer_suppress_count.
       We probably don't have to bother with this. */
    int poll_suppress_count;
#endif
  };

/* Dynamic-binding-o-rama */

/* Structure for recording Lisp call stack for backtrace purposes.  */

/* The special binding stack holds the outer values of variables while
   they are bound by a function application or a let form, stores the
   code to be executed for Lisp unwind-protect forms, and stores the C
   functions to be called for record_unwind_protect.

   If func is non-zero, undoing this binding applies func to old_value;
      This implements record_unwind_protect.
   If func is zero and symbol is nil, undoing this binding evaluates
      the list of forms in old_value; this implements Lisp's unwind-protect
      form.
   Otherwise, undoing this binding stores old_value as symbol's value; this
      undoes the bindings made by a let form or function call.  */

struct specbinding
  {
    Lisp_Object symbol;
    Lisp_Object old_value;
    Lisp_Object (*func) (Lisp_Object); /* for unwind-protect */
  };

#if 0 /* FSFmacs */
/* #### */
/* Everything needed to describe an active condition case.  */
struct handler
  {
    /* The handler clauses and variable from the condition-case form.  */
    Lisp_Object handler;
    Lisp_Object var;
    /* Fsignal stores here the condition-case clause that applies,
       and Fcondition_case thus knows which clause to run.  */
    Lisp_Object chosen_clause;

    /* Used to effect the longjmp() out to the handler.  */
    struct catchtag *tag;

    /* The next enclosing handler.  */
    struct handler *next;
  };

extern struct handler *handlerlist;

#endif

/* These are extern because GC needs to mark them */
extern struct specbinding *specpdl;
extern struct specbinding *specpdl_ptr;
extern struct catchtag *catchlist;
extern struct backtrace *backtrace_list;

/* Most callers should simply use specbind() and unbind_to(), but if
   speed is REALLY IMPORTANT, you can use the faster macros below */
void specbind_magic (Lisp_Object, Lisp_Object);
void grow_specpdl (EMACS_INT reserved);
void unbind_to_hairy (int);
extern int specpdl_size;

/* Inline version of specbind().
   Use this instead of specbind() if speed is sufficiently important
   to save the overhead of even a single function call. */
#define SPECBIND(symbol_object, value_object) do {			\
  Lisp_Object SB_symbol = (symbol_object);				\
  Lisp_Object SB_newval = (value_object);				\
  Lisp_Object SB_oldval;						\
  Lisp_Symbol *SB_sym;							\
									\
  SPECPDL_RESERVE (1);							\
									\
  CHECK_SYMBOL (SB_symbol);						\
  SB_sym = XSYMBOL (SB_symbol);						\
  SB_oldval = SB_sym->value;						\
									\
  if (!SYMBOL_VALUE_MAGIC_P (SB_oldval) || UNBOUNDP (SB_oldval))	\
    {									\
      /* #### the following test will go away when we have a constant	\
         symbol magic object */						\
      if (EQ (SB_symbol, Qnil) ||					\
	  EQ (SB_symbol, Qt)   ||					\
	  SYMBOL_IS_KEYWORD (SB_symbol))				\
	reject_constant_symbols (SB_symbol, SB_newval, 0,		\
				 UNBOUNDP (SB_newval) ?			\
				 Qmakunbound : Qset);			\
									\
      specpdl_ptr->symbol    = SB_symbol;				\
      specpdl_ptr->old_value = SB_oldval;				\
      specpdl_ptr->func      = 0;					\
      specpdl_ptr++;							\
      specpdl_depth_counter++;						\
									\
      SB_sym->value = (SB_newval);					\
    }									\
  else									\
    specbind_magic (SB_symbol, SB_newval);				\
} while (0)

/* An even faster, but less safe inline version of specbind().
   Caller guarantees that:
   - SYMBOL is a non-constant symbol (i.e. not Qnil, Qt, or keyword).
   - specpdl_depth_counter >= specpdl_size.
   Else we crash.  */
#define SPECBIND_FAST_UNSAFE(symbol_object, value_object) do {		\
  Lisp_Object SFU_symbol = (symbol_object);				\
  Lisp_Object SFU_newval = (value_object);				\
  Lisp_Symbol *SFU_sym   = XSYMBOL (SFU_symbol);			\
  Lisp_Object SFU_oldval = SFU_sym->value;				\
  if (!SYMBOL_VALUE_MAGIC_P (SFU_oldval) || UNBOUNDP (SFU_oldval))	\
    {									\
      specpdl_ptr->symbol    = SFU_symbol;				\
      specpdl_ptr->old_value = SFU_oldval;				\
      specpdl_ptr->func      = 0;					\
      specpdl_ptr++;							\
      specpdl_depth_counter++;						\
									\
      SFU_sym->value = (SFU_newval);					\
    }									\
  else									\
    specbind_magic (SFU_symbol, SFU_newval);				\
} while (0)

/* Request enough room for SIZE future entries on special binding stack */
/* SR_size will typically be compared to an unsigned short */
#define SPECPDL_RESERVE(size) do {			\
  EMACS_INT SR_size = (size);				\
  if (specpdl_depth() + SR_size >= specpdl_size)	\
    grow_specpdl (SR_size);				\
} while (0)

/* Inline version of unbind_to().
   Use this instead of unbind_to() if speed is sufficiently important
   to save the overhead of even a single function call.

   Most of the time, unbind_to() is called only on ordinary
   variables, so optimize for that.  */
#define UNBIND_TO_GCPRO(count, value) do {		\
  int UNBIND_TO_count = (count);			\
  while (specpdl_depth_counter != UNBIND_TO_count)	\
    {							\
      Lisp_Symbol *sym;					\
      --specpdl_ptr;					\
      --specpdl_depth_counter;				\
							\
      if (specpdl_ptr->func != 0 ||			\
	  ((sym = XSYMBOL (specpdl_ptr->symbol)),	\
	   SYMBOL_VALUE_MAGIC_P (sym->value)))		\
	{						\
	  struct gcpro gcpro1;				\
	  GCPRO1 (value);				\
	  unbind_to_hairy (UNBIND_TO_count);		\
	  UNGCPRO;					\
	  break;					\
	}						\
							\
      sym->value = specpdl_ptr->old_value;		\
    }							\
} while (0)

/* A slightly faster inline version of unbind_to,
   that doesn't offer GCPROing services. */
#define UNBIND_TO(count) do {				\
  int UNBIND_TO_count = (count);			\
  while (specpdl_depth_counter != UNBIND_TO_count)	\
    {							\
      Lisp_Symbol *sym;					\
      --specpdl_ptr;					\
      --specpdl_depth_counter;				\
							\
      if (specpdl_ptr->func != 0 ||			\
	  ((sym = XSYMBOL (specpdl_ptr->symbol)),	\
	   SYMBOL_VALUE_MAGIC_P (sym->value)))		\
	{						\
	  unbind_to_hairy (UNBIND_TO_count);		\
	  break;					\
	}						\
							\
      sym->value = specpdl_ptr->old_value;		\
    }							\
} while (0)

#ifdef ERROR_CHECK_TYPECHECK
#define CHECK_SPECBIND_VARIABLE assert (specpdl_ptr->func == 0)
#else
#define CHECK_SPECBIND_VARIABLE DO_NOTHING
#endif

#if 0
/* Unused.  It's too hard to guarantee that the current bindings
   contain only variables.  */
/* Another inline version of unbind_to().  VALUE is GC-protected.
   Caller guarantees that:
   - all of the elements on the binding stack are variable bindings.
   Else we crash.  */
#define UNBIND_TO_GCPRO_VARIABLES_ONLY(count, value) do {	\
  int UNBIND_TO_count = (count);				\
  while (specpdl_depth_counter != UNBIND_TO_count)		\
    {								\
      Lisp_Symbol *sym;						\
      --specpdl_ptr;						\
      --specpdl_depth_counter;					\
								\
      CHECK_SPECBIND_VARIABLE;					\
      sym = XSYMBOL (specpdl_ptr->symbol);			\
      if (!SYMBOL_VALUE_MAGIC_P (sym->value))			\
	sym->value = specpdl_ptr->old_value;			\
      else							\
	{							\
	  struct gcpro gcpro1;					\
	  GCPRO1 (value);					\
	  unbind_to_hairy (UNBIND_TO_count);			\
	  UNGCPRO;						\
	  break;						\
	}							\
    }								\
} while (0)
#endif /* unused */

/* A faster, but less safe inline version of Fset().
   Caller guarantees that:
   - SYMBOL is a non-constant symbol (i.e. not Qnil, Qt, or keyword).
   Else we crash.  */
#define FSET_FAST_UNSAFE(sym, newval) do {				\
  Lisp_Object FFU_sym = (sym);						\
  Lisp_Object FFU_newval = (newval);					\
  Lisp_Symbol *FFU_symbol = XSYMBOL (FFU_sym);				\
  Lisp_Object FFU_oldval = FFU_symbol->value;				\
  if (!SYMBOL_VALUE_MAGIC_P (FFU_oldval) || UNBOUNDP (FFU_oldval))	\
    FFU_symbol->value = FFU_newval;					\
  else									\
    Fset (FFU_sym, FFU_newval);						\
} while (0)

#endif /* INCLUDED_backtrace_h_ */