From e0b8c689e2b1d80da6ed235ae400ad10d117b706 Mon Sep 17 00:00:00 2001 From: Ken Raeburn Date: Wed, 29 Mar 2000 22:14:34 +0000 Subject: [PATCH] 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. --- src/ChangeLog | 28 ++++++++++++++++++++++++++++ src/alloc.c | 18 +++++++++++++++--- src/config.in | 3 +++ src/intervals.c | 2 ++ src/intervals.h | 19 ++++++++++--------- src/lisp.h | 32 +++++++++++++++++++++++++++----- 6 files changed, 85 insertions(+), 17 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 2232594d3b..cf1050bb1e 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,31 @@ +2000-03-29 Ken Raeburn + + * 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 * lread.c (read1): Accept `.' (period) as symbol start like in CL diff --git a/src/alloc.c b/src/alloc.c index d7e4214c6c..3b5d0e57ac 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -766,7 +766,7 @@ mark_interval_tree (tree) /* 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 @@ mark_interval_tree (tree) #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 @@ mark_interval_tree (tree) 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 @@ Frames, windows, buffers, and subprocesses count as vectors\n\ 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 --git a/src/config.in b/src/config.in index 9fb464e6f7..511919aa3e 100644 --- a/src/config.in +++ b/src/config.in @@ -504,3 +504,6 @@ extern char *getenv (); #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 --git a/src/intervals.c b/src/intervals.c index 2a03abbb76..f925d222db 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -570,6 +570,8 @@ interval_start_pos (source) 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 --git a/src/intervals.h b/src/intervals.h index eb50d72378..5db02e7862 100644 --- a/src/intervals.h +++ b/src/intervals.h @@ -43,7 +43,8 @@ Boston, MA 02111-1307, USA. */ #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 @@ Boston, MA 02111-1307, USA. */ #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 @@ Boston, MA 02111-1307, USA. */ /* 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 --git a/src/lisp.h b/src/lisp.h index af1ddb7a46..0e1cfff61a 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -46,6 +46,23 @@ Boston, MA 02111-1307, USA. */ #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 @@ struct interval 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 -- 2.20.1