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.
+2000-03-29 Ken Raeburn <raeburn@gnu.org>
+
+ * 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.
+
2000-03-29 Gerd Moellmann <gerd@gnu.org>
* lread.c (read1): Accept `.' (period) as symbol start like in CL
/* 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);
}
#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)
do { \
if (! NULL_INTERVAL_P (i)) \
{ \
- XUNMARK (* (Lisp_Object *) (&(i)->parent)); \
+ XUNMARK ((i)->up.obj); \
(i) = balance_intervals (i); \
} \
} while (0)
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 ();
+}
\f
/* Initialization */
#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
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));
#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)
#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) \
/* 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
#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. */
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
projects / emacs.git / commitdiff