diff src/backtrace.h @ 380:8626e4521993 r21-2-5

Import from CVS: tag r21-2-5
author cvs
date Mon, 13 Aug 2007 11:07:10 +0200
parents c5d627a313b1
children aabb7f5b1c81
line wrap: on
line diff
--- a/src/backtrace.h	Mon Aug 13 11:06:08 2007 +0200
+++ b/src/backtrace.h	Mon Aug 13 11:07:10 2007 +0200
@@ -46,12 +46,6 @@
 				   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 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 @@
        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,179 @@
 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 (size_t 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;						\
+  struct 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);				\
+  struct 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 */
+#define SPECPDL_RESERVE(size) do {			\
+  size_t 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)	\
+    {							\
+      struct 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)	\
+    {							\
+      struct 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
+
+/* 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)		\
+    {								\
+      struct 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)
+
+/* 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);					\
+  struct 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 /* _XEMACS_BACKTRACE_H_ */