X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/7b1123d824e51d40496c242e7a7f173de8936100..90db87027fadf1c67325659caea4a5ea41e8a27a:/src/lisp.h

diff --git a/src/lisp.h b/src/lisp.h
index 6838d4a93c..ba36a320a8 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -73,6 +73,7 @@ enum
     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)
   };
 
@@ -231,9 +232,9 @@ enum enum_USE_LSB_TAG { USE_LSB_TAG = 0 };
 #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
@@ -552,11 +553,6 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper)
 }
 
 
-/* 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)), \
@@ -590,10 +586,12 @@ LISP_INLINE struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object);
   (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))
@@ -1487,53 +1485,6 @@ struct Lisp_Save_Value
     } 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
   {
@@ -1555,13 +1506,6 @@ union Lisp_Misc
     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
@@ -1854,6 +1798,60 @@ SAVE_VALUEP (Lisp_Object x)
   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)
@@ -2179,12 +2177,24 @@ typedef jmp_buf sys_jmp_buf;
 #endif
 
 
+/* 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.
@@ -2197,35 +2207,77 @@ typedef jmp_buf sys_jmp_buf;
    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
@@ -2280,9 +2332,10 @@ struct catchtag
   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;
@@ -3340,10 +3393,15 @@ extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...);
 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;
@@ -3511,7 +3569,7 @@ extern Lisp_Object Qvisible;
 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);
@@ -3726,9 +3784,10 @@ extern void syms_of_fontset (void);
 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 */
@@ -3736,6 +3795,11 @@ extern void syms_of_w32notify (void);
 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;
@@ -3776,11 +3840,6 @@ extern void syms_of_xml (void);
 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);