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>
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;
struct specbinding
{
- Lisp_Object symbol, old_value;
+ Lisp_Object symbol;
+ Lisp_Object old_value;
Lisp_Object (*func) (Lisp_Object); /* for unwind-protect */
};
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. */
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 (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; \
+ 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 */
+#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) \
+ { \
+ 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_ */