X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e08813d023325dc02574ab9437441551f67d1487..ddb317ba828f05eb48e98fda530443955485e75d:/src/lisp.h

diff --git a/src/lisp.h b/src/lisp.h
index a9a2c259b5..c7f13e21e5 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -31,6 +31,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include <limits.h>
 
 #include <intprops.h>
+#include <verify.h>
 
 INLINE_HEADER_BEGIN
 
@@ -107,11 +108,12 @@ typedef EMACS_UINT uprintmax_t;
 
 /* Extra internal type checking?  */
 
-/* Define an Emacs version of 'assert (COND)', since some
-   system-defined 'assert's are flaky.  COND should be free of side
-   effects; it may or may not be evaluated.  */
+/* Define an Emacs version of 'assert (COND)'.  COND should be free of
+   side effects; it may be evaluated zero or more times.  If COND is false,
+   Emacs reliably crashes if ENABLE_CHECKING is defined and behavior
+   is undefined if not.  The compiler may assume COND while optimizing.  */
 #ifndef ENABLE_CHECKING
-# define eassert(X) ((void) (0 && (X))) /* Check that X compiles.  */
+# define eassert(cond) assume (cond)
 #else /* ENABLE_CHECKING */
 
 extern _Noreturn void die (const char *, const char *, int);
@@ -128,16 +130,10 @@ extern bool suppress_checking EXTERNALLY_VISIBLE;
 
 # define eassert(cond)						\
    (suppress_checking || (cond) 				\
-    ? (void) 0							\
+    ? assume (cond)						\
     : die (# cond, __FILE__, __LINE__))
 #endif /* ENABLE_CHECKING */
 
-/* When checking is enabled, identical to eassert.  When checking is
- * disabled, instruct the compiler (when the compiler has such
- * capability) to assume that cond is true and optimize
- * accordingly.  */
-#define eassert_and_assume(cond) (eassert (cond), assume (cond))
-
 
 /* Use the configure flag --enable-check-lisp-object-type to make
    Lisp_Object use a struct type instead of the default int.  The flag
@@ -1136,12 +1132,19 @@ struct vectorlike_header
     ptrdiff_t size;
   };
 
-/* Regular vector is just a header plus array of Lisp_Objects.  */
+/* Regular vector is just a header plus array of Lisp_Objects...  */
 
 struct Lisp_Vector
   {
     struct vectorlike_header header;
-    Lisp_Object contents[FLEXIBLE_ARRAY_MEMBER];
+    union {
+      /* ...but sometimes there is also a pointer internally used in
+	 vector allocation code.  Usually you don't want to touch this.  */
+      struct Lisp_Vector *next;
+
+      /* We can't use FLEXIBLE_ARRAY_MEMBER here.  */
+      Lisp_Object contents[1];
+    } u;
   };
 
 /* A boolvector is a kind of vectorlike, with contents are like a string.  */
@@ -1162,7 +1165,7 @@ struct Lisp_Bool_Vector
 
 enum
   {
-    header_size = offsetof (struct Lisp_Vector, contents),
+    header_size = offsetof (struct Lisp_Vector, u.contents),
     bool_header_size = offsetof (struct Lisp_Bool_Vector, data),
     word_size = sizeof (Lisp_Object)
   };
@@ -1172,13 +1175,13 @@ enum
 INLINE Lisp_Object
 AREF (Lisp_Object array, ptrdiff_t idx)
 {
-  return XVECTOR (array)->contents[idx];
+  return XVECTOR (array)->u.contents[idx];
 }
 
 INLINE Lisp_Object *
 aref_addr (Lisp_Object array, ptrdiff_t idx)
 {
-  return & XVECTOR (array)->contents[idx];
+  return & XVECTOR (array)->u.contents[idx];
 }
 
 INLINE ptrdiff_t
@@ -1191,7 +1194,7 @@ INLINE void
 ASET (Lisp_Object array, ptrdiff_t idx, Lisp_Object val)
 {
   eassert (0 <= idx && idx < ASIZE (array));
-  XVECTOR (array)->contents[idx] = val;
+  XVECTOR (array)->u.contents[idx] = val;
 }
 
 INLINE void
@@ -1200,7 +1203,7 @@ gc_aset (Lisp_Object array, ptrdiff_t idx, Lisp_Object val)
   /* Like ASET, but also can be used in the garbage collector:
      sweep_weak_table calls set_hash_key etc. while the table is marked.  */
   eassert (0 <= idx && idx < (ASIZE (array) & ~ARRAY_MARK_FLAG));
-  XVECTOR (array)->contents[idx] = val;
+  XVECTOR (array)->u.contents[idx] = val;
 }
 
 /* If a struct is made to look like a vector, this macro returns the length
@@ -2628,11 +2631,9 @@ typedef jmp_buf sys_jmp_buf;
    - 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.  */
+   - The handler stack: keeps track of active catch tags and condition-case
+     handlers.  Allocated in a manually managed stack implemented by a
+     doubly-linked list allocated via xmalloc and never freed.  */
 
 /* Structure for recording Lisp call stack for backtrace purposes.  */
 
@@ -2702,46 +2703,16 @@ SPECPDL_INDEX (void)
   return specpdl_ptr - specpdl;
 }
 
-/* Everything needed to describe an active condition case.
+/* This structure helps implement the `catch/throw' and `condition-case/signal'
+   control structures.  A struct handler contains all the information needed to
+   restore the state of the interpreter after a non-local jump.
 
-   Members are volatile if their values need to survive _longjmp when
-   a 'struct handler' is a local variable.  */
-struct handler
-  {
-    /* The handler clauses and variable from the condition-case form.  */
-    /* For a handler set up in Lisp code, this is always a list.
-       For an internal handler set up by internal_condition_case*,
-       this can instead be the symbol t or `error'.
-       t: handle all conditions.
-       error: handle all conditions, and errors can run the debugger
-              or display a backtrace.  */
-    Lisp_Object handler;
-
-    Lisp_Object volatile var;
-
-    /* Fsignal stores here the condition-case clause that applies,
-       and Fcondition_case thus knows which clause to run.  */
-    Lisp_Object volatile chosen_clause;
-
-    /* Used to effect the longjump out to the handler.  */
-    struct catchtag *tag;
-
-    /* The next enclosing handler.  */
-    struct handler *next;
-  };
-
-/* This structure helps implement the `catch' and `throw' control
-   structure.  A struct catchtag contains all the information needed
-   to restore the state of the interpreter after a non-local jump.
-
-   Handlers for error conditions (represented by `struct handler'
-   structures) just point to a catch tag to do the cleanup required
-   for their jumps.
-
-   catchtag structures are chained together in the C calling stack;
-   the `next' member points to the next outer catchtag.
+   handler structures are chained together in a doubly linked list; the `next'
+   member points to the next outer catchtag and the `nextfree' member points in
+   the other direction to the next inner element (which is typically the next
+   free element since we mostly use it on the deepest handler).
 
-   A call like (throw TAG VAL) searches for a catchtag whose `tag'
+   A call like (throw TAG VAL) searches for a catchtag whose `tag_or_ch'
    member is TAG, and then unbinds to it.  The `val' member is used to
    hold VAL while the stack is unwound; `val' is returned as the value
    of the catch form.
@@ -2750,24 +2721,63 @@ struct handler
    state.
 
    Members are volatile if their values need to survive _longjmp when
-   a 'struct catchtag' is a local variable.  */
-struct catchtag
+   a 'struct handler' is a local variable.  */
+
+enum handlertype { CATCHER, CONDITION_CASE };
+
+struct handler
 {
-  Lisp_Object tag;
-  Lisp_Object volatile val;
-  struct catchtag *volatile next;
+  enum handlertype type;
+  Lisp_Object tag_or_ch;
+  Lisp_Object val;
+  struct handler *next;
+  struct handler *nextfree;
+
+  /* The bytecode interpreter can have several handlers active at the same
+     time, so when we longjmp to one of them, it needs to know which handler
+     this was and what was the corresponding internal state.  This is stored
+     here, and when we longjmp we make sure that handlerlist points to the
+     proper handler.  */
+  Lisp_Object *bytecode_top;
+  int bytecode_dest;
+
+  /* Most global vars are reset to their value via the specpdl mechanism,
+     but a few others are handled by storing their value here.  */
 #if 1 /* GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS, but they're defined later.  */
   struct gcpro *gcpro;
 #endif
   sys_jmp_buf jmp;
-  struct handler *handlerlist;
   EMACS_INT lisp_eval_depth;
-  ptrdiff_t volatile pdlcount;
+  ptrdiff_t pdlcount;
   int poll_suppress_count;
   int interrupt_input_blocked;
   struct byte_stack *byte_stack;
 };
 
+/* Fill in the components of c, and put it on the list.  */
+#define PUSH_HANDLER(c, tag_ch_val, handlertype)	\
+  if (handlerlist && handlerlist->nextfree)		\
+    (c) = handlerlist->nextfree;			\
+  else							\
+    {							\
+      (c) = xmalloc (sizeof (struct handler));		\
+      (c)->nextfree = NULL;				\
+      if (handlerlist)					\
+	handlerlist->nextfree = (c);			\
+    }							\
+  (c)->type = (handlertype);				\
+  (c)->tag_or_ch = (tag_ch_val);			\
+  (c)->val = Qnil;					\
+  (c)->next = handlerlist;				\
+  (c)->lisp_eval_depth = lisp_eval_depth;		\
+  (c)->pdlcount = SPECPDL_INDEX ();			\
+  (c)->poll_suppress_count = poll_suppress_count;	\
+  (c)->interrupt_input_blocked = interrupt_input_blocked;\
+  (c)->gcpro = gcprolist;				\
+  (c)->byte_stack = byte_stack_list;			\
+  handlerlist = (c);
+
+
 extern Lisp_Object memory_signal_data;
 
 /* An address near the bottom of the stack.
@@ -3028,7 +3038,7 @@ INLINE void
 vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Object *args, ptrdiff_t count)
 {
   eassert (0 <= offset && 0 <= count && offset + count <= ASIZE (v));
-  memcpy (XVECTOR (v)->contents + offset, args, count * sizeof *args);
+  memcpy (XVECTOR (v)->u.contents + offset, args, count * sizeof *args);
 }
 
 /* Functions to modify hash tables.  */
@@ -3374,7 +3384,6 @@ extern Lisp_Object Qimage, Qtext, Qboth, Qboth_horiz, Qtext_image_horiz;
 extern Lisp_Object Qspace, Qcenter, QCalign_to;
 extern Lisp_Object Qbar, Qhbar, Qbox, Qhollow;
 extern Lisp_Object Qleft_margin, Qright_margin;
-extern Lisp_Object Qglyphless_char;
 extern Lisp_Object QCdata, QCfile;
 extern Lisp_Object QCmap;
 extern Lisp_Object Qrisky_local_variable;
@@ -3670,10 +3679,8 @@ extern Lisp_Object Qand_rest;
 extern Lisp_Object Vautoload_queue;
 extern Lisp_Object Vsignaling_function;
 extern Lisp_Object inhibit_lisp_code;
-#if BYTE_MARK_STACK
-extern struct catchtag *catchlist;
 extern struct handler *handlerlist;
-#endif
+
 /* To run a normal hook, use the appropriate function from the list below.
    The calling convention:
 
@@ -4078,9 +4085,9 @@ extern _Noreturn void emacs_abort (void) NO_INLINE;
 extern int emacs_open (const char *, int, int);
 extern int emacs_pipe (int[2]);
 extern int emacs_close (int);
-extern ptrdiff_t emacs_read (int, char *, ptrdiff_t);
-extern ptrdiff_t emacs_write (int, const char *, ptrdiff_t);
-extern ptrdiff_t emacs_write_sig (int, char const *, ptrdiff_t);
+extern ptrdiff_t emacs_read (int, void *, ptrdiff_t);
+extern ptrdiff_t emacs_write (int, void const *, ptrdiff_t);
+extern ptrdiff_t emacs_write_sig (int, void const *, ptrdiff_t);
 extern void emacs_perror (char const *);
 
 extern void unlock_all_files (void);
@@ -4359,33 +4366,6 @@ functionp (Lisp_Object object)
     return 0;
 }
 
-INLINE
-uint16_t
-swap16 (uint16_t val)
-{
-    return (val << 8) | (val & 0xFF);
-}
-
-INLINE
-uint32_t
-swap32 (uint32_t val)
-{
-  uint32_t low = swap16 (val & 0xFFFF);
-  uint32_t high = swap16 (val >> 16);
-  return (low << 16) | high;
-}
-
-#ifdef UINT64_MAX
-INLINE
-uint64_t
-swap64 (uint64_t val)
-{
-  uint64_t low = swap32 (val & 0xFFFFFFFF);
-  uint64_t high = swap32 (val >> 32);
-  return (low << 32) | high;
-}
-#endif
-
 #if ((SIZE_MAX >> 31) >> 1) & 1
 # define BITS_PER_SIZE_T 64
 #else