changeset 28406:451721e784a8

Stop assuming interval pointers and lisp objects can be distinguished by inspection. Beginnings of support for expensive internal consistency checks. * config.in (ENABLE_CHECKING): Undef. * lisp.h (struct interval): Replace "parent" field with a union of interval pointer and Lisp_Object; add new bitfield to use as discriminant. Change other flag fields to bitfields. (CHECK): New macro for consistency checking. If ENABLE_CHECKING is defined and the supplied test fails, print a message and abort. (eassert): New macro. Use CHECK to provide an assert-like facility. * intervals.h (NULL_INTERVAL_P): Now applies only to real interval pointers; abort if the value looks like a lisp object. (NULL_INTERVAL_P, NULL_PARENT, HAS_PARENT, HAS_OBJECT, SET_PARENT, SET_OBJECT, INTERVAL_PARENT, GET_INTERVAL_OBJECT, COPY_PARENT): Modify for new interval parent definition. * alloc.c (mark_interval_tree, MARK_INTERVAL_TREE, UNMARK_BALANCE_INTERVALS): Update references that need an addressable lisp object in the interval structure. (die): New function. (suppress_checking): New variable. * intervals.c (interval_start_pos): Just return 0 if there's no parent object.

Binary file src/ChangeLog has changed

--- a/src/alloc.c	Wed Mar 29 21:57:22 2000 +0000
+++ b/src/alloc.c	Wed Mar 29 22:14:34 2000 +0000
@@ -766,7 +766,7 @@
 
   /* XMARK expands to an assignment; the LHS of an assignment can't be
      a cast.  */
-  XMARK (* (Lisp_Object *) &tree->parent);
+  XMARK (tree->up.obj);
 
   traverse_intervals (tree, 1, 0, mark_interval, Qnil);
 }
@@ -777,7 +777,7 @@
 #define MARK_INTERVAL_TREE(i)				\
   do {							\
     if (!NULL_INTERVAL_P (i)				\
-	&& ! XMARKBIT (*(Lisp_Object *) &i->parent))	\
+	&& ! XMARKBIT (i->up.obj))			\
       mark_interval_tree (i);				\
   } while (0)
 
@@ -790,7 +790,7 @@
   do {							\
    if (! NULL_INTERVAL_P (i))				\
      {							\
-       XUNMARK (* (Lisp_Object *) (&(i)->parent));	\
+       XUNMARK ((i)->up.obj);				\
        (i) = balance_intervals (i);			\
      }							\
   } while (0)
@@ -4649,6 +4649,18 @@
 
   return Flist (8, consed);
 }
+
+int suppress_checking;
+void
+die (msg, file, line)
+     const char *msg;
+     const char *file;
+     int line;
+{
+  fprintf (stderr, "\r\nEmacs fatal error: %s:%d: %s\r\n",
+	   file, line, msg);
+  abort ();
+}
 
 /* Initialization */
 

--- a/src/config.in	Wed Mar 29 21:57:22 2000 +0000
+++ b/src/config.in	Wed Mar 29 22:14:34 2000 +0000
@@ -504,3 +504,6 @@
 #if defined HAVE_X11R6 && !defined INHIBIT_X11R6_XIM
 #define HAVE_X11R6_XIM
 #endif
+
+/* Should we enable expensive run-time checking of data types?  */
+#undef ENABLE_CHECKING

--- a/src/intervals.c	Wed Mar 29 21:57:22 2000 +0000
+++ b/src/intervals.c	Wed Mar 29 22:14:34 2000 +0000
@@ -570,6 +570,8 @@
   if (NULL_INTERVAL_P (source))
     return 0;
 
+  if (! INTERVAL_HAS_OBJECT (source))
+    return 0;
   GET_INTERVAL_OBJECT (parent, source);
   if (BUFFERP (parent))
     return BUF_BEG (XBUFFER (parent));

--- a/src/intervals.h	Wed Mar 29 21:57:22 2000 +0000
+++ b/src/intervals.h	Wed Mar 29 22:14:34 2000 +0000
@@ -43,7 +43,8 @@
 #define INT_LISPLIKE(i) (BUFFERP ((Lisp_Object){(EMACS_INT)(i)}) \
 			 || STRINGP ((Lisp_Object){(EMACS_INT)(i)}))
 #endif
-#define NULL_INTERVAL_P(i) ((i) == NULL_INTERVAL || INT_LISPLIKE (i))
+#define NULL_INTERVAL_P(i) (CHECK(!INT_LISPLIKE(i),"non-interval"),(i) == NULL_INTERVAL)
+/* old #define NULL_INTERVAL_P(i) ((i) == NULL_INTERVAL || INT_LISPLIKE (i)) */
 
 /* True if this interval has no right child. */
 #define NULL_RIGHT_CHILD(i) ((i)->right == NULL_INTERVAL)
@@ -52,7 +53,7 @@
 #define NULL_LEFT_CHILD(i) ((i)->left == NULL_INTERVAL)
 
 /* True if this interval has no parent. */
-#define NULL_PARENT(i) (NULL_INTERVAL_P ((i)->parent))
+#define NULL_PARENT(i) ((i)->up_obj || (i)->up.interval == 0)
 
 /* True if this interval is the left child of some other interval. */
 #define AM_LEFT_CHILD(i) (! NULL_PARENT (i) \
@@ -104,24 +105,24 @@
 
 /* Test what type of parent we have.  Three possibilities: another
    interval, a buffer or string object, or NULL_INTERVAL.  */
-#define INTERVAL_HAS_PARENT(i) ((i)->parent && ! INT_LISPLIKE ((i)->parent))
-#define INTERVAL_HAS_OBJECT(i) ((i)->parent &&   INT_LISPLIKE ((i)->parent))
+#define INTERVAL_HAS_PARENT(i) ((i)->up_obj == 0 && (i)->up.interval != 0)
+#define INTERVAL_HAS_OBJECT(i) ((i)->up_obj)
 
 /* Set/get parent of an interval.
 
    The choice of macros is dependent on the type needed.  Don't add
    casts to get around this, it will break some development work in
    progress.  */
-#define SET_INTERVAL_PARENT(i,p) ((i)->parent = (p))
-#define SET_INTERVAL_OBJECT(i,o) ((i)->parent = (INTERVAL) XFASTINT (o))
-#define INTERVAL_PARENT(i) ((i)->parent)
+#define SET_INTERVAL_PARENT(i,p) (eassert (!BUFFERP ((Lisp_Object)(p)) && !STRINGP ((Lisp_Object)(p))),(i)->up_obj = 0, (i)->up.interval = (p))
+#define SET_INTERVAL_OBJECT(i,o) (eassert ((o) != 0), eassert (BUFFERP (o) || STRINGP (o)),(i)->up_obj = 1, (i)->up.obj = (o))
+#define INTERVAL_PARENT(i) (eassert((i) != 0 && (i)->up_obj == 0),(i)->up.interval)
 /* Because XSETFASTINT has to be used, this can't simply be
    value-returning.  */
-#define GET_INTERVAL_OBJECT(d,s) XSETFASTINT((d), (EMACS_INT) (s)->parent)
+#define GET_INTERVAL_OBJECT(d,s) (eassert((s)->up_obj == 1),XSETFASTINT ((d), (s)->up.obj))
 
 /* Make the parent of D be whatever the parent of S is, regardless of
    type.  This is used when balancing an interval tree.  */
-#define COPY_INTERVAL_PARENT(d,s) ((d)->parent = (s)->parent)
+#define COPY_INTERVAL_PARENT(d,s) ((d)->up = (s)->up, (d)->up_obj = (s)->up_obj)
 
 /* Get the parent interval, if any, otherwise a null pointer.  Useful
    for walking up to the root in a "for" loop; use this to get the

--- a/src/lisp.h	Wed Mar 29 21:57:22 2000 +0000
+++ b/src/lisp.h	Wed Mar 29 22:14:34 2000 +0000
@@ -46,6 +46,23 @@
 #endif
 #endif
 
+/* Extra internal type checking?  */
+extern int suppress_checking;
+#ifdef ENABLE_CHECKING
+extern void die P_((const char *, const char *, int));
+#define CHECK(check,msg) ((check || suppress_checking ? 0 : die (msg, __FILE__, __LINE__)), 0)
+#else
+/* Produce same side effects and result, but don't complain.  */
+#define CHECK(check,msg) ((check),0)
+#endif
+/* Define an Emacs version of "assert", since some system ones are
+   flaky.  */
+#if defined (__GNUC__) && __GNUC__ >= 2 && defined (__STDC__)
+#define eassert(cond) CHECK(cond,"assertion failed: " #cond)
+#else
+#define eassert(cond) CHECK(cond,"assertion failed")
+#endif
+
 /* Define the fundamental Lisp data structures.  */
 
 /* This is the set of Lisp data types.  */
@@ -494,17 +511,22 @@
      You'd think we could store this information in the parent object
      somewhere (after all, that should be visited once and then
      ignored too, right?), but strings are GC'd strangely.  */
-  struct interval *parent;
+  union
+  {
+    struct interval *interval;
+    Lisp_Object obj;
+  } up;
+  unsigned int up_obj : 1;
 
   /* The remaining components are `properties' of the interval.
      The first four are duplicates for things which can be on the list,
      for purposes of speed.  */
 
-  unsigned char write_protect;	    /* Non-zero means can't modify.  */
-  unsigned char visible;	    /* Zero means don't display.  */
-  unsigned char front_sticky;	    /* Non-zero means text inserted just
+  unsigned int write_protect : 1;    /* Non-zero means can't modify.  */
+  unsigned int visible : 1;	    /* Zero means don't display.  */
+  unsigned int front_sticky : 1;    /* Non-zero means text inserted just
 				       before this interval goes into it.  */
-  unsigned char rear_sticky;	    /* Likewise for just after it.  */
+  unsigned int rear_sticky : 1;	    /* Likewise for just after it.  */
 
   /* Properties of this interval.
      The mark bit on this field says whether this particular interval