cgit.sxemacs.org Git - sxemacs/blob - src/backtrace.h

   1 /* The lisp stack.
   2    Copyright (C) 1985, 1986, 1987, 1992, 1993 Free Software Foundation, Inc.
   3
   4 This file is part of SXEmacs
   5
   6 SXEmacs is free software: you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation, either version 3 of the License, or
   9 (at your option) any later version.
  10
  11 SXEmacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
  18
  19
  20 /* Synched up with: FSF 19.30.  Contained redundantly in various C files
  21    in FSFmacs. */
  22
  23 /* Authorship:
  24
  25    FSF: Original version; a long time ago.
  26    XEmacs: split out of some C files. (For some obscure reason, a header
  27            file couldn't be used in FSF Emacs, but XEmacs doesn't have
  28            that problem.)
  29    Mly (probably) or JWZ: Some changes.
  30  */
  31
  32 #ifndef INCLUDED_backtrace_h_
  33 #define INCLUDED_backtrace_h_
  34
  35 #include <setjmp.h>
  36
  37 /* These definitions are used in eval.c and alloc.c */
  38
  39 struct backtrace {
  40         struct backtrace *next;
  41         Lisp_Object *function;
  42         Lisp_Object *args;      /* Points to vector of args. */
  43         int nargs;              /* Length of vector.
  44                                    If nargs is UNEVALLED, args points to
  45                                    slot holding list of unevalled args */
  46         int pdlcount;           /* specpdl_depth () when invoked */
  47         char evalargs;
  48         /* Nonzero means call value of debugger when done with this operation. */
  49         char debug_on_exit;
  50 };
  51
  52 /* This structure helps implement the `catch' and `throw' control
  53    structure.  A struct catchtag contains all the information needed
  54    to restore the state of the interpreter after a non-local jump.
  55
  56    Handlers for error conditions (represented by `struct handler'
  57    structures) just point to a catch tag to do the cleanup required
  58    for their jumps.
  59
  60    catchtag structures are chained together in the C calling stack;
  61    the `next' member points to the next outer catchtag.
  62
  63    A call like (throw TAG VAL) searches for a catchtag whose `tag'
  64    member is TAG, and then unbinds to it.  The `val' member is used to
  65    hold VAL while the stack is unwound; `val' is returned as the value
  66    of the catch form.
  67
  68    All the other members are concerned with restoring the interpreter
  69    state.  */
  70
  71 struct catchtag {
  72         Lisp_Object tag;
  73         Lisp_Object val;
  74         struct catchtag *next;
  75         struct gcpro *gcpro;
  76         JMP_BUF jmp;
  77         struct backtrace *backlist;
  78 #if 0                           /* FSFmacs */
  79         /* #### */
  80         struct handler *handlerlist;
  81 #endif
  82         int lisp_eval_depth;
  83         int pdlcount;
  84 #if 0                           /* FSFmacs */
  85         /* This is the equivalent of async_timer_suppress_count.
  86            We probably don't have to bother with this. */
  87         int poll_suppress_count;
  88 #endif
  89 };
  90
  91 /* Dynamic-binding-o-rama */
  92
  93 /* Structure for recording Lisp call stack for backtrace purposes.  */
  94
  95 /* The special binding stack holds the outer values of variables while
  96    they are bound by a function application or a let form, stores the
  97    code to be executed for Lisp unwind-protect forms, and stores the C
  98    functions to be called for record_unwind_protect.
  99
 100    If func is non-zero, undoing this binding applies func to old_value;
 101       This implements record_unwind_protect.
 102    If func is zero and symbol is nil, undoing this binding evaluates
 103       the list of forms in old_value; this implements Lisp's unwind-protect
 104       form.
 105    Otherwise, undoing this binding stores old_value as symbol's value; this
 106       undoes the bindings made by a let form or function call.  */
 107
 108 struct specbinding {
 109         Lisp_Object symbol;
 110         Lisp_Object old_value;
 111         Lisp_Object(*func)(Lisp_Object);        /* for unwind-protect */
 112 };
 113
 114 #if 0                           /* FSFmacs */
 115 /* #### */
 116 /* Everything needed to describe an active condition case.  */
 117 struct handler {
 118         /* The handler clauses and variable from the condition-case form.  */
 119         Lisp_Object handler;
 120         Lisp_Object var;
 121         /* Fsignal stores here the condition-case clause that applies,
 122            and Fcondition_case thus knows which clause to run.  */
 123         Lisp_Object chosen_clause;
 124
 125         /* Used to effect the longjmp() out to the handler.  */
 126         struct catchtag *tag;
 127
 128         /* The next enclosing handler.  */
 129         struct handler *next;
 130 };
 131
 132 extern struct handler *handlerlist;
 133
 134 #endif
 135
 136 /* These are extern because GC needs to mark them */
 137 extern struct specbinding *specpdl;
 138 extern struct specbinding *specpdl_ptr;
 139 extern struct catchtag *catchlist;
 140 extern struct backtrace *backtrace_list;
 141
 142 /* Most callers should simply use specbind() and unbind_to(), but if
 143    speed is REALLY IMPORTANT, you can use the faster macros below */
 144 void specbind_magic(Lisp_Object, Lisp_Object);
 145 void grow_specpdl(EMACS_INT reserved);
 146 void unbind_to_hairy(int);
 147 extern int specpdl_size;
 148
 149 /* Inline version of specbind().
 150    Use this instead of specbind() if speed is sufficiently important
 151    to save the overhead of even a single function call. */
 152 #define SPECBIND(symbol_object, value_object) do {                      \
 153   Lisp_Object SB_symbol = (symbol_object);                              \
 154   Lisp_Object SB_newval = (value_object);                               \
 155   Lisp_Object SB_oldval;                                                \
 156   Lisp_Symbol *SB_sym;                                                  \
 157                                                                         \
 158   SPECPDL_RESERVE (1);                                                  \
 159                                                                         \
 160   CHECK_SYMBOL (SB_symbol);                                             \
 161   SB_sym = XSYMBOL (SB_symbol);                                         \
 162   SB_oldval = SB_sym->value;                                            \
 163                                                                         \
 164   if (!SYMBOL_VALUE_MAGIC_P (SB_oldval) || UNBOUNDP (SB_oldval))        \
 165     {                                                                   \
 166       /* #### the following test will go away when we have a constant   \
 167          symbol magic object */                                         \
 168       if (EQ (SB_symbol, Qnil) ||                                       \
 169           EQ (SB_symbol, Qt)   ||                                       \
 170           SYMBOL_IS_KEYWORD (SB_symbol))                                \
 171         reject_constant_symbols (SB_symbol, SB_newval, 0,               \
 172                                  UNBOUNDP (SB_newval) ?                 \
 173                                  Qmakunbound : Qset);                   \
 174                                                                         \
 175       specpdl_ptr->symbol    = SB_symbol;                               \
 176       specpdl_ptr->old_value = SB_oldval;                               \
 177       specpdl_ptr->func      = 0;                                       \
 178       specpdl_ptr++;                                                    \
 179       specpdl_depth_counter++;                                          \
 180                                                                         \
 181       SB_sym->value = (SB_newval);                                      \
 182     }                                                                   \
 183   else                                                                  \
 184     specbind_magic (SB_symbol, SB_newval);                              \
 185 } while (0)
 186
 187 /* An even faster, but less safe inline version of specbind().
 188    Caller guarantees that:
 189    - SYMBOL is a non-constant symbol (i.e. not Qnil, Qt, or keyword).
 190    - specpdl_depth_counter >= specpdl_size.
 191    Else we crash.  */
 192 #define SPECBIND_FAST_UNSAFE(symbol_object, value_object) do {          \
 193   Lisp_Object SFU_symbol = (symbol_object);                             \
 194   Lisp_Object SFU_newval = (value_object);                              \
 195   Lisp_Symbol *SFU_sym   = XSYMBOL (SFU_symbol);                        \
 196   Lisp_Object SFU_oldval = SFU_sym->value;                              \
 197   if (!SYMBOL_VALUE_MAGIC_P (SFU_oldval) || UNBOUNDP (SFU_oldval))      \
 198     {                                                                   \
 199       specpdl_ptr->symbol    = SFU_symbol;                              \
 200       specpdl_ptr->old_value = SFU_oldval;                              \
 201       specpdl_ptr->func      = 0;                                       \
 202       specpdl_ptr++;                                                    \
 203       specpdl_depth_counter++;                                          \
 204                                                                         \
 205       SFU_sym->value = (SFU_newval);                                    \
 206     }                                                                   \
 207   else                                                                  \
 208     specbind_magic (SFU_symbol, SFU_newval);                            \
 209 } while (0)
 210
 211 /* Request enough room for SIZE future entries on special binding stack */
 212 /* SR_size will typically be compared to an unsigned short */
 213 #define SPECPDL_RESERVE(size) do {                      \
 214   EMACS_INT SR_size = (size);                           \
 215   if (specpdl_depth() + SR_size >= specpdl_size)        \
 216     grow_specpdl (SR_size);                             \
 217 } while (0)
 218
 219 /* Inline version of unbind_to().
 220    Use this instead of unbind_to() if speed is sufficiently important
 221    to save the overhead of even a single function call.
 222
 223    Most of the time, unbind_to() is called only on ordinary
 224    variables, so optimize for that.  */
 225 #define UNBIND_TO_GCPRO(count, value) do {              \
 226   int UNBIND_TO_count = (count);                        \
 227   while (specpdl_depth_counter != UNBIND_TO_count)      \
 228     {                                                   \
 229       Lisp_Symbol *sym;                                 \
 230       --specpdl_ptr;                                    \
 231       --specpdl_depth_counter;                          \
 232                                                         \
 233       if (specpdl_ptr->func != 0 ||                     \
 234           ((sym = XSYMBOL (specpdl_ptr->symbol)),       \
 235            SYMBOL_VALUE_MAGIC_P (sym->value)))          \
 236         {                                               \
 237           struct gcpro gcpro1;                          \
 238           GCPRO1 (value);                               \
 239           unbind_to_hairy (UNBIND_TO_count);            \
 240           UNGCPRO;                                      \
 241           break;                                        \
 242         }                                               \
 243                                                         \
 244       sym->value = specpdl_ptr->old_value;              \
 245     }                                                   \
 246 } while (0)
 247
 248 /* A slightly faster inline version of unbind_to,
 249    that doesn't offer GCPROing services. */
 250 #define UNBIND_TO(count) do {                           \
 251   int UNBIND_TO_count = (count);                        \
 252   while (specpdl_depth_counter != UNBIND_TO_count)      \
 253     {                                                   \
 254       Lisp_Symbol *sym;                                 \
 255       --specpdl_ptr;                                    \
 256       --specpdl_depth_counter;                          \
 257                                                         \
 258       if (specpdl_ptr->func != 0 ||                     \
 259           ((sym = XSYMBOL (specpdl_ptr->symbol)),       \
 260            SYMBOL_VALUE_MAGIC_P (sym->value)))          \
 261         {                                               \
 262           unbind_to_hairy (UNBIND_TO_count);            \
 263           break;                                        \
 264         }                                               \
 265                                                         \
 266       sym->value = specpdl_ptr->old_value;              \
 267     }                                                   \
 268 } while (0)
 269
 270 #ifdef ERROR_CHECK_TYPECHECK
 271 #define CHECK_SPECBIND_VARIABLE assert (specpdl_ptr->func == 0)
 272 #else
 273 #define CHECK_SPECBIND_VARIABLE DO_NOTHING
 274 #endif
 275
 276 #if 0
 277 /* Unused.  It's too hard to guarantee that the current bindings
 278    contain only variables.  */
 279 /* Another inline version of unbind_to().  VALUE is GC-protected.
 280    Caller guarantees that:
 281    - all of the elements on the binding stack are variable bindings.
 282    Else we crash.  */
 283 #define UNBIND_TO_GCPRO_VARIABLES_ONLY(count, value) do {       \
 284   int UNBIND_TO_count = (count);                                \
 285   while (specpdl_depth_counter != UNBIND_TO_count)              \
 286     {                                                           \
 287       Lisp_Symbol *sym;                                         \
 288       --specpdl_ptr;                                            \
 289       --specpdl_depth_counter;                                  \
 290                                                                 \
 291       CHECK_SPECBIND_VARIABLE;                                  \
 292       sym = XSYMBOL (specpdl_ptr->symbol);                      \
 293       if (!SYMBOL_VALUE_MAGIC_P (sym->value))                   \
 294         sym->value = specpdl_ptr->old_value;                    \
 295       else                                                      \
 296         {                                                       \
 297           struct gcpro gcpro1;                                  \
 298           GCPRO1 (value);                                       \
 299           unbind_to_hairy (UNBIND_TO_count);                    \
 300           UNGCPRO;                                              \
 301           break;                                                \
 302         }                                                       \
 303     }                                                           \
 304 } while (0)
 305 #endif                          /* unused */
 306
 307 /* A faster, but less safe inline version of Fset().
 308    Caller guarantees that:
 309    - SYMBOL is a non-constant symbol (i.e. not Qnil, Qt, or keyword).
 310    Else we crash.  */
 311 #define FSET_FAST_UNSAFE(sym, newval) do {                              \
 312   Lisp_Object FFU_sym = (sym);                                          \
 313   Lisp_Object FFU_newval = (newval);                                    \
 314   Lisp_Symbol *FFU_symbol = XSYMBOL (FFU_sym);                          \
 315   Lisp_Object FFU_oldval = FFU_symbol->value;                           \
 316   if (!SYMBOL_VALUE_MAGIC_P (FFU_oldval) || UNBOUNDP (FFU_oldval))      \
 317     FFU_symbol->value = FFU_newval;                                     \
 318   else                                                                  \
 319     Fset (FFU_sym, FFU_newval);                                         \
 320 } while (0)
 321
 322 #endif                          /* INCLUDED_backtrace_h_ */