# HG changeset patch # User Ken Raeburn # Date 954368074 0 # Node ID 451721e784a8752ff4498a30f0283a910745e3a4 # Parent 870e99935503ad2a424dc55b925b6174134c12c0 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. diff -r 870e99935503 -r 451721e784a8 src/ChangeLog Binary file src/ChangeLog has changed diff -r 870e99935503 -r 451721e784a8 src/alloc.c --- 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 */ diff -r 870e99935503 -r 451721e784a8 src/config.in --- 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 diff -r 870e99935503 -r 451721e784a8 src/intervals.c --- 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)); diff -r 870e99935503 -r 451721e784a8 src/intervals.h --- 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 diff -r 870e99935503 -r 451721e784a8 src/lisp.h --- 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