BITS_PER_SHORT = CHAR_BIT * sizeof (short),
BITS_PER_INT = CHAR_BIT * sizeof (int),
BITS_PER_LONG = CHAR_BIT * sizeof (long int),
+ BITS_PER_PTRDIFF_T = CHAR_BIT * sizeof (ptrdiff_t),
BITS_PER_EMACS_INT = CHAR_BIT * sizeof (EMACS_INT)
};
#define case_Lisp_Int case Lisp_Int0: case Lisp_Int1
#define LISP_INT_TAG_P(x) (((x) & ~Lisp_Int1) == 0)
-/* Stolen from GDB. The only known compiler that doesn't support
- enums in bitfields is MSVC. */
-#ifdef _MSC_VER
+/* Idea stolen from GDB. MSVC doesn't support enums in bitfields,
+ and xlc complains vociferously about them. */
+#if defined _MSC_VER || defined __IBMC__
#define ENUM_BF(TYPE) unsigned int
#else
#define ENUM_BF(TYPE) enum TYPE
}
\f
-/* Forward declarations. */
-
-LISP_INLINE bool SAVE_VALUEP (Lisp_Object);
-LISP_INLINE struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object);
-
/* Extract a value or address from a Lisp_Object. */
#define XCONS(a) (eassert (CONSP (a)), \
(eassert (KBOARD_OBJFWDP (a)), &((a)->u_kboard_objfwd))
/* Pseudovector types. */
-
+struct Lisp_Process;
+LISP_INLINE Lisp_Object make_lisp_proc (struct Lisp_Process *p)
+{ return make_lisp_ptr (p, Lisp_Vectorlike); }
#define XPROCESS(a) (eassert (PROCESSP (a)), \
(struct Lisp_Process *) XUNTAG (a, Lisp_Vectorlike))
-#define XWINDOW(a) (eassert (WINDOWP (a)), \
+#define XWINDOW(a) (eassert (WINDOWP (a)), \
(struct window *) XUNTAG (a, Lisp_Vectorlike))
#define XTERMINAL(a) (eassert (TERMINALP (a)), \
(struct terminal *) XUNTAG (a, Lisp_Vectorlike))
} data[SAVE_VALUE_SLOTS];
};
-/* Return the type of V's Nth saved value. */
-LISP_INLINE int
-save_type (struct Lisp_Save_Value *v, int n)
-{
- eassert (0 <= n && n < SAVE_VALUE_SLOTS);
- return (v->save_type >> (SAVE_SLOT_BITS * n) & ((1 << SAVE_SLOT_BITS) - 1));
-}
-
-/* Get and set the Nth saved pointer. */
-
-LISP_INLINE void *
-XSAVE_POINTER (Lisp_Object obj, int n)
-{
- eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER);
- return XSAVE_VALUE (obj)->data[n].pointer;;
-}
-LISP_INLINE void
-set_save_pointer (Lisp_Object obj, int n, void *val)
-{
- eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER);
- XSAVE_VALUE (obj)->data[n].pointer = val;
-}
-
-/* Likewise for the saved integer. */
-
-LISP_INLINE ptrdiff_t
-XSAVE_INTEGER (Lisp_Object obj, int n)
-{
- eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER);
- return XSAVE_VALUE (obj)->data[n].integer;
-}
-LISP_INLINE void
-set_save_integer (Lisp_Object obj, int n, ptrdiff_t val)
-{
- eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER);
- XSAVE_VALUE (obj)->data[n].integer = val;
-}
-
-/* Extract Nth saved object. */
-
-LISP_INLINE Lisp_Object
-XSAVE_OBJECT (Lisp_Object obj, int n)
-{
- eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_OBJECT);
- return XSAVE_VALUE (obj)->data[n].object;
-}
-
/* A miscellaneous object, when it's on the free list. */
struct Lisp_Free
{
struct Lisp_Save_Value u_save_value;
};
-LISP_INLINE struct Lisp_Save_Value *
-XSAVE_VALUE (Lisp_Object a)
-{
- eassert (SAVE_VALUEP (a));
- return & XMISC (a)->u_save_value;
-}
-
/* Forwarding pointer to an int variable.
This is allowed only in the value cell of a symbol,
and it means that the symbol's value really lives in the
return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value;
}
+LISP_INLINE struct Lisp_Save_Value *
+XSAVE_VALUE (Lisp_Object a)
+{
+ eassert (SAVE_VALUEP (a));
+ return & XMISC (a)->u_save_value;
+}
+
+/* Return the type of V's Nth saved value. */
+LISP_INLINE int
+save_type (struct Lisp_Save_Value *v, int n)
+{
+ eassert (0 <= n && n < SAVE_VALUE_SLOTS);
+ return (v->save_type >> (SAVE_SLOT_BITS * n) & ((1 << SAVE_SLOT_BITS) - 1));
+}
+
+/* Get and set the Nth saved pointer. */
+
+LISP_INLINE void *
+XSAVE_POINTER (Lisp_Object obj, int n)
+{
+ eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER);
+ return XSAVE_VALUE (obj)->data[n].pointer;;
+}
+LISP_INLINE void
+set_save_pointer (Lisp_Object obj, int n, void *val)
+{
+ eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER);
+ XSAVE_VALUE (obj)->data[n].pointer = val;
+}
+
+/* Likewise for the saved integer. */
+
+LISP_INLINE ptrdiff_t
+XSAVE_INTEGER (Lisp_Object obj, int n)
+{
+ eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER);
+ return XSAVE_VALUE (obj)->data[n].integer;
+}
+LISP_INLINE void
+set_save_integer (Lisp_Object obj, int n, ptrdiff_t val)
+{
+ eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER);
+ XSAVE_VALUE (obj)->data[n].integer = val;
+}
+
+/* Extract Nth saved object. */
+
+LISP_INLINE Lisp_Object
+XSAVE_OBJECT (Lisp_Object obj, int n)
+{
+ eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_OBJECT);
+ return XSAVE_VALUE (obj)->data[n].object;
+}
+
#define AUTOLOADP(x) (CONSP (x) && EQ (Qautoload, XCAR (x)))
#define INTFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Int)
#endif
\f
+/* Elisp uses several stacks:
+ - the C stack.
+ - the bytecode stack: used internally by the bytecode interpreter.
+ Allocated from the C stack.
+ - The specpdl stack: keeps track of active unwind-protect and
+ dynamic-let-bindings. Allocated from the `specpdl' array, a manually
+ managed stack.
+ - The catch stack: keeps track of active catch tags.
+ Allocated on the C stack. This is where the setmp data is kept.
+ - The handler stack: keeps track of active condition-case handlers.
+ Allocated on the C stack. Every entry there also uses an entry in
+ the catch stack. */
+
/* 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.
+ code to be executed for unwind-protect forms.
If func is non-zero, undoing this binding applies func to old_value;
This implements record_unwind_protect.
which means having bound a local value while CURRENT-BUFFER was active.
If WHERE is nil this means we saw the default value when binding SYMBOL.
WHERE being a buffer or frame means we saw a buffer-local or frame-local
- value. Other values of WHERE mean an internal error. */
+ value. Other values of WHERE mean an internal error.
+
+ NOTE: The specbinding struct is defined here, because SPECPDL_INDEX is
+ used all over the place, needs to be fast, and needs to know the size of
+ struct specbinding. But only eval.c should access it. */
typedef Lisp_Object (*specbinding_func) (Lisp_Object);
+enum specbind_tag {
+ SPECPDL_UNWIND, /* An unwind_protect function. */
+ SPECPDL_BACKTRACE, /* An element of the backtrace. */
+ SPECPDL_LET, /* A plain and simple dynamic let-binding. */
+ /* Tags greater than SPECPDL_LET must be "subkinds" of LET. */
+ SPECPDL_LET_LOCAL, /* A buffer-local let-binding. */
+ SPECPDL_LET_DEFAULT /* A global binding for a localized var. */
+};
+
struct specbinding
{
- Lisp_Object symbol, old_value;
- specbinding_func func;
- Lisp_Object unused; /* Dividing by 16 is faster than by 12. */
+ enum specbind_tag kind;
+ union {
+ struct {
+ Lisp_Object arg;
+ specbinding_func func;
+ } unwind;
+ struct {
+ /* `where' is not used in the case of SPECPDL_LET. */
+ Lisp_Object symbol, old_value, where;
+ } let;
+ struct {
+ Lisp_Object function;
+ Lisp_Object *args;
+ ptrdiff_t nargs : BITS_PER_PTRDIFF_T - 1;
+ bool debug_on_exit : 1;
+ } bt;
+ } v;
};
+LISP_INLINE Lisp_Object specpdl_symbol (struct specbinding *pdl)
+{ eassert (pdl->kind >= SPECPDL_LET); return pdl->v.let.symbol; }
+
+LISP_INLINE Lisp_Object specpdl_old_value (struct specbinding *pdl)
+{ eassert (pdl->kind >= SPECPDL_LET); return pdl->v.let.old_value; }
+
+LISP_INLINE Lisp_Object specpdl_where (struct specbinding *pdl)
+{ eassert (pdl->kind > SPECPDL_LET); return pdl->v.let.where; }
+
+LISP_INLINE Lisp_Object specpdl_arg (struct specbinding *pdl)
+{ eassert (pdl->kind == SPECPDL_UNWIND); return pdl->v.unwind.arg; }
+
+LISP_INLINE specbinding_func specpdl_func (struct specbinding *pdl)
+{ eassert (pdl->kind == SPECPDL_UNWIND); return pdl->v.unwind.func; }
+
+LISP_INLINE Lisp_Object backtrace_function (struct specbinding *pdl)
+{ eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.function; }
+
+LISP_INLINE ptrdiff_t backtrace_nargs (struct specbinding *pdl)
+{ eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.nargs; }
+
+LISP_INLINE Lisp_Object *backtrace_args (struct specbinding *pdl)
+{ eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.args; }
+
+LISP_INLINE bool backtrace_debug_on_exit (struct specbinding *pdl)
+{ eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.debug_on_exit; }
+
extern struct specbinding *specpdl;
extern struct specbinding *specpdl_ptr;
extern ptrdiff_t specpdl_size;
#define SPECPDL_INDEX() (specpdl_ptr - specpdl)
-struct backtrace
-{
- struct backtrace *next;
- Lisp_Object function;
- Lisp_Object *args; /* Points to vector of args. */
- ptrdiff_t nargs; /* Length of vector. */
- /* Nonzero means call value of debugger when done with this operation. */
- unsigned int debug_on_exit : 1;
-};
-
-extern struct backtrace *backtrace_list;
-
/* Everything needed to describe an active condition case.
Members are volatile if their values need to survive _longjmp when
Lisp_Object tag;
Lisp_Object volatile val;
struct catchtag *volatile next;
+#if 1 /* GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS, but they're defined later. */
struct gcpro *gcpro;
+#endif
sys_jmp_buf jmp;
- struct backtrace *backlist;
struct handler *handlerlist;
EMACS_INT lisp_eval_depth;
ptrdiff_t volatile pdlcount;
extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object);
extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object);
extern void init_eval (void);
-#if BYTE_MARK_STACK
-extern void mark_backtrace (void);
-#endif
extern void syms_of_eval (void);
+extern void record_in_backtrace (Lisp_Object function,
+ Lisp_Object *args, ptrdiff_t nargs);
+extern void mark_specpdl (void);
+extern void get_backtrace (Lisp_Object array);
+Lisp_Object backtrace_top_function (void);
+extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol);
+extern bool let_shadows_global_binding_p (Lisp_Object symbol);
+
/* Defined in editfns.c. */
extern Lisp_Object Qfield;
extern void store_frame_param (struct frame *, Lisp_Object, Lisp_Object);
extern void store_in_alist (Lisp_Object *, Lisp_Object, Lisp_Object);
extern Lisp_Object do_switch_frame (Lisp_Object, int, int, Lisp_Object);
-#if HAVE_NS
+#if HAVE_NS || defined(WINDOWSNT)
extern Lisp_Object get_frame_param (struct frame *, Lisp_Object);
#endif
extern void frames_discard_buffer (Lisp_Object);
extern Lisp_Object Qfont_param;
#endif
-#ifdef WINDOWSNT
-/* Defined on w32notify.c. */
-extern void syms_of_w32notify (void);
+/* Defined in gfilenotify.c */
+#ifdef HAVE_GFILENOTIFY
+extern void globals_of_gfilenotify (void);
+extern void syms_of_gfilenotify (void);
#endif
/* Defined in inotify.c */
extern void syms_of_inotify (void);
#endif
+#ifdef HAVE_W32NOTIFY
+/* Defined on w32notify.c. */
+extern void syms_of_w32notify (void);
+#endif
+
/* Defined in xfaces.c. */
extern Lisp_Object Qdefault, Qtool_bar, Qfringe;
extern Lisp_Object Qheader_line, Qscroll_bar, Qcursor;
extern void xml_cleanup_parser (void);
#endif
-#ifdef HAVE_MENUS
-/* Defined in (x|w32)fns.c, nsfns.m... */
-extern int have_menus_p (void);
-#endif
-
#ifdef HAVE_DBUS
/* Defined in dbusbind.c. */
void syms_of_dbusbind (void);
HCoop / bpt / emacs.git / blobdiff