XEmacs 21.4.9 "Informed Management".
[chise/xemacs-chise.git.1] / src / backtrace.h
index d25ddb3..7ca942b 100644 (file)
@@ -30,8 +30,8 @@ Boston, MA 02111-1307, USA.  */
    Mly (probably) or JWZ: Some changes.
  */
 
-#ifndef _XEMACS_BACKTRACE_H_
-#define _XEMACS_BACKTRACE_H_
+#ifndef INCLUDED_backtrace_h_
+#define INCLUDED_backtrace_h_
 
 #include <setjmp.h>
 
@@ -46,12 +46,6 @@ struct backtrace
                                   If nargs is UNEVALLED, args points to
                                   slot holding list of unevalled args */
     int pdlcount;               /* specpdl_depth () when invoked */
-#ifdef EMACS_BTL
-    /* The value of a Lisp integer that specifies the symbol being
-       "invoked" by this node in the backtrace, or 0 if the backtrace
-       doesn't correspond to a such an invocation */
-    int id_number;
-#endif
     char evalargs;
     /* Nonzero means call value of debugger when done with this operation. */
     char debug_on_exit;
@@ -116,7 +110,8 @@ struct catchtag
 
 struct specbinding
   {
-    Lisp_Object symbol, old_value;
+    Lisp_Object symbol;
+    Lisp_Object old_value;
     Lisp_Object (*func) (Lisp_Object); /* for unwind-protect */
   };
 
@@ -132,7 +127,7 @@ struct handler
        and Fcondition_case thus knows which clause to run.  */
     Lisp_Object chosen_clause;
 
-    /* Used to effect the longjump out to the handler.  */
+    /* Used to effect the longjmp() out to the handler.  */
     struct catchtag *tag;
 
     /* The next enclosing handler.  */
@@ -149,4 +144,184 @@ extern struct specbinding *specpdl_ptr;
 extern struct catchtag *catchlist;
 extern struct backtrace *backtrace_list;
 
-#endif /* _XEMACS_BACKTRACE_H_ */
+/* 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_ */