Mercurial > hg > xemacs-beta
diff src/lrecord.h @ 2:ac2d302a0011 r19-15b2
Import from CVS: tag r19-15b2
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:46:35 +0200 |
parents | 376386a54a3c |
children | 3d6bfa290dbd |
line wrap: on
line diff
--- a/src/lrecord.h Mon Aug 13 08:45:53 2007 +0200 +++ b/src/lrecord.h Mon Aug 13 08:46:35 2007 +0200 @@ -57,65 +57,66 @@ the opaque type. */ struct lrecord_header - { - /* It would be better to put the mark-bit together with the - * following datatype identification field in an 8- or 16-bit integer - * rather than playing funny games with changing header->implementation - * and "wasting" 32 bits on the below pointer. - * The type-id would then be a 7 or 15 - * bit index into a table of lrecord-implementations rather than a - * direct pointer. There would be 24 (or 16) bits left over for - * datatype-specific per-instance flags. - * The below is the simplest thing to do for the present, - * and doesn't incur that much overhead as most Emacs records - * are of such a size that the overhead isn't too bad. - * (The marker datatype is the worst case.) - * It also has the very very very slight advantage that type-checking - * involves one memory read (of the "implementation" slot) and a - * comparison against a link-time constant address rather than a - * read and a comparison against a variable value. (Variable since - * it is a very good idea to assign the indices into the hypothetical - * type-code table dynamically rather that pre-defining them.) - * I think I remember that Elk Lisp does something like this. - * Gee, I wonder if some cretin has patented it? - */ - CONST struct lrecord_implementation *implementation; - }; +{ + /* It would be better to put the mark-bit together with the + following datatype identification field in an 8- or 16-bit + integer rather than playing funny games with changing + header->implementation and "wasting" 32 bits on the below + pointer. The type-id would then be a 7 or 15 bit index into a + table of lrecord-implementations rather than a direct pointer. + There would be 24 (or 16) bits left over for datatype-specific + per-instance flags. + + The below is the simplest thing to do for the present, + and doesn't incur that much overhead as most Emacs records + are of such a size that the overhead isn't too bad. + (The marker datatype is the worst case.) + + It also has the very very very slight advantage that type-checking + involves one memory read (of the "implementation" slot) and a + comparison against a link-time constant address rather than a + read and a comparison against a variable value. (Variable since + it is a very good idea to assign the indices into the hypothetical + type-code table dynamically rather that pre-defining them.) + I think I remember that Elk Lisp does something like this. + Gee, I wonder if some cretin has patented it? */ + CONST struct lrecord_implementation *implementation; +}; #define set_lheader_implementation(header,imp) (header)->implementation=(imp) struct lcrecord_header - { - struct lrecord_header lheader; - /* The "next" field is normally used to chain all lrecords together - * so that the GC can find (and free) all of them. - * "alloc_lcrecord" threads records together. - * The "next" field may be used for other purposes as long as some - * other mechanism is provided for letting the GC do its work. - * (For example, the event and marker datatypes allocates members out - * of memory chunks, and it are able to find all unmarked - * events by sweeping through the elements of the list of chunks) - */ - struct lcrecord_header *next; - /* This is just for debugging/printing convenience. - Having this slot doesn't hurt us much spacewise, since an lcrecord - already has the above slots together with malloc overhead. */ - int uid :31; - /* A flag that indicates whether this lcrecord is on a "free list". - Free lists are used to minimize the number of calls to malloc() - when we're repeatedly allocating and freeing a number of the - same sort of lcrecord. Lcrecords on a free list always get - marked in a different fashion, so we can use this flag as a - sanity check to make sure that free lists only have freed lcrecords - and no freed lcrecords are elsewhere. */ - int free :1; - }; +{ + struct lrecord_header lheader; + /* The "next" field is normally used to chain all lrecords together + so that the GC can find (and free) all of them. + "alloc_lcrecord" threads records together. + + The "next" field may be used for other purposes as long as some + other mechanism is provided for letting the GC do its work. (For + example, the event and marker datatypes allocate members out of + memory chunks, and are able to find all unmarked members by + sweeping through the elements of the list of chunks) */ + struct lcrecord_header *next; + /* This is just for debugging/printing convenience. + Having this slot doesn't hurt us much spacewise, since an lcrecord + already has the above slots together with malloc overhead. */ + unsigned int uid :31; + /* A flag that indicates whether this lcrecord is on a "free list". + Free lists are used to minimize the number of calls to malloc() + when we're repeatedly allocating and freeing a number of the + same sort of lcrecord. Lcrecords on a free list always get + marked in a different fashion, so we can use this flag as a + sanity check to make sure that free lists only have freed lcrecords + and there are no freed lcrecords elsewhere. */ + unsigned int free :1; +}; /* Used for lcrecords in an lcrecord-list. */ struct free_lcrecord_header - { - struct lcrecord_header lcheader; - Lisp_Object chain; - }; +{ + struct lcrecord_header lcheader; + Lisp_Object chain; +}; /* This as the value of lheader->implementation->finalizer * means that this record is already marked */ @@ -126,56 +127,56 @@ void (*markobj) (Lisp_Object)); struct lrecord_implementation - { - CONST char *name; - /* This function is called at GC time, to make sure that all Lisp_Objects - pointed to by this object get properly marked. It should call - the mark_object function on all Lisp_Objects in the object. If - the return value is non-nil, it should be a Lisp_Object to be - marked (don't call the mark_object function explicitly on it, - because the GC routines will do this). Doing it this way reduces - recursion, so the object returned should preferably be the one - with the deepest level of Lisp_Object pointers. This function - can be NULL, meaning no GC marking is necessary. */ - Lisp_Object (*marker) (Lisp_Object, void (*mark_object) (Lisp_Object)); - /* This can be NULL if the object is an lcrecord; the - default_object_printer() in print.c will be used. */ - void (*printer) (Lisp_Object, Lisp_Object printcharfun, int escapeflag); - /* This function is called at GC time when the object is about to - be freed, and at dump time (FOR_DISKSAVE will be non-zero in this - case). It should perform any necessary cleanup (e.g. freeing - malloc()ed memory. This can be NULL, meaning no special - finalization is necessary. +{ + CONST char *name; + /* This function is called at GC time, to make sure that all Lisp_Objects + pointed to by this object get properly marked. It should call + the mark_object function on all Lisp_Objects in the object. If + the return value is non-nil, it should be a Lisp_Object to be + marked (don't call the mark_object function explicitly on it, + because the GC routines will do this). Doing it this way reduces + recursion, so the object returned should preferably be the one + with the deepest level of Lisp_Object pointers. This function + can be NULL, meaning no GC marking is necessary. */ + Lisp_Object (*marker) (Lisp_Object, void (*mark_object) (Lisp_Object)); + /* This can be NULL if the object is an lcrecord; the + default_object_printer() in print.c will be used. */ + void (*printer) (Lisp_Object, Lisp_Object printcharfun, int escapeflag); + /* This function is called at GC time when the object is about to + be freed, and at dump time (FOR_DISKSAVE will be non-zero in this + case). It should perform any necessary cleanup (e.g. freeing + malloc()ed memory. This can be NULL, meaning no special + finalization is necessary. - WARNING: remember that the finalizer is called at dump time even - though the object is not being freed. */ - void (*finalizer) (void *header, int for_disksave); - /* This can be NULL, meaning compare objects with EQ(). */ - int (*equal) (Lisp_Object obj1, Lisp_Object obj2, int depth); - /* This can be NULL, meaning use the Lisp_Object itself as the hash; - but *only* if the `equal' function is EQ (if two objects are - `equal', they *must* hash to the same value or the hashing won't - work). */ - unsigned long (*hash) (Lisp_Object, int); - Lisp_Object (*getprop) (Lisp_Object obj, Lisp_Object prop); - int (*putprop) (Lisp_Object obj, Lisp_Object prop, Lisp_Object val); - int (*remprop) (Lisp_Object obj, Lisp_Object prop); - Lisp_Object (*plist) (Lisp_Object obj); + WARNING: remember that the finalizer is called at dump time even + though the object is not being freed. */ + void (*finalizer) (void *header, int for_disksave); + /* This can be NULL, meaning compare objects with EQ(). */ + int (*equal) (Lisp_Object obj1, Lisp_Object obj2, int depth); + /* This can be NULL, meaning use the Lisp_Object itself as the hash; + but *only* if the `equal' function is EQ (if two objects are + `equal', they *must* hash to the same value or the hashing won't + work). */ + unsigned long (*hash) (Lisp_Object, int); + Lisp_Object (*getprop) (Lisp_Object obj, Lisp_Object prop); + int (*putprop) (Lisp_Object obj, Lisp_Object prop, Lisp_Object val); + int (*remprop) (Lisp_Object obj, Lisp_Object prop); + Lisp_Object (*plist) (Lisp_Object obj); - /* Only one of these is non-0. If both are 0, it means that this type - is not instantiable by alloc_lcrecord(). */ - unsigned int static_size; - unsigned int (*size_in_bytes_method) (CONST void *header); - /* A unique subtag-code (dynamically) assigned to this datatype. */ - /* (This is a pointer so the rest of this structure can be read-only.) */ - int *lrecord_type_index; - /* A "basic" lrecord is any lrecord that's not an lcrecord, i.e. - one that does not have an lcrecord_header at the front and which - is (usually) allocated in frob blocks. We only use this flag - for some consistency checking, and that only when error-checking - is enabled. */ - int basic_p; - }; + /* Only one of these is non-0. If both are 0, it means that this type + is not instantiable by alloc_lcrecord(). */ + unsigned int static_size; + unsigned int (*size_in_bytes_method) (CONST void *header); + /* A unique subtag-code (dynamically) assigned to this datatype. */ + /* (This is a pointer so the rest of this structure can be read-only.) */ + int *lrecord_type_index; + /* A "basic" lrecord is any lrecord that's not an lcrecord, i.e. + one that does not have an lcrecord_header at the front and which + is (usually) allocated in frob blocks. We only use this flag for + some consistency checking, and that only when error-checking is + enabled. */ + int basic_p; +}; extern int gc_in_progress; @@ -274,51 +275,51 @@ #ifdef ERROR_CHECK_TYPECHECK -# define DECLARE_LRECORD(c_name, structtype) \ -extern CONST_IF_NOT_DEBUG struct lrecord_implementation \ - lrecord_##c_name[]; \ -INLINE structtype *error_check_##c_name (Lisp_Object _obj); \ -INLINE structtype * \ -error_check_##c_name (Lisp_Object _obj) \ -{ \ - XUNMARK (_obj); \ - assert (RECORD_TYPEP (_obj, lrecord_##c_name) || \ - MARKED_RECORD_P (_obj)); \ - return (structtype *) XPNTR (_obj); \ -} \ +# define DECLARE_LRECORD(c_name, structtype) \ +extern CONST_IF_NOT_DEBUG struct lrecord_implementation \ + lrecord_##c_name[]; \ +INLINE structtype *error_check_##c_name (Lisp_Object _obj); \ +INLINE structtype * \ +error_check_##c_name (Lisp_Object _obj) \ +{ \ + XUNMARK (_obj); \ + assert (RECORD_TYPEP (_obj, lrecord_##c_name) || \ + MARKED_RECORD_P (_obj)); \ + return (structtype *) XPNTR (_obj); \ +} \ extern Lisp_Object Q##c_name##p -# define DECLARE_NONRECORD(c_name, type_enum, structtype) \ -INLINE structtype *error_check_##c_name (Lisp_Object _obj); \ -INLINE structtype * \ -error_check_##c_name (Lisp_Object _obj) \ -{ \ - XUNMARK (_obj); \ - assert (XGCTYPE (_obj) == type_enum); \ - return (structtype *) XPNTR (_obj); \ -} \ +# define DECLARE_NONRECORD(c_name, type_enum, structtype) \ +INLINE structtype *error_check_##c_name (Lisp_Object _obj); \ +INLINE structtype * \ +error_check_##c_name (Lisp_Object _obj) \ +{ \ + XUNMARK (_obj); \ + assert (XGCTYPE (_obj) == type_enum); \ + return (structtype *) XPNTR (_obj); \ +} \ extern Lisp_Object Q##c_name##p # define XRECORD(x, c_name, structtype) error_check_##c_name (x) # define XNONRECORD(x, c_name, type_enum, structtype) error_check_##c_name (x) -# define XSETRECORD(var, p, c_name) do \ -{ \ - XSETOBJ (var, Lisp_Record, p); \ - assert (RECORD_TYPEP (var, lrecord_##c_name) || \ - MARKED_RECORD_P (var)); \ +# define XSETRECORD(var, p, c_name) do \ +{ \ + XSETOBJ (var, Lisp_Record, p); \ + assert (RECORD_TYPEP (var, lrecord_##c_name) || \ + MARKED_RECORD_P (var)); \ } while (0) #else /* not ERROR_CHECK_TYPECHECK */ -# define DECLARE_LRECORD(c_name, structtype) \ -extern Lisp_Object Q##c_name##p; \ -extern CONST_IF_NOT_DEBUG struct lrecord_implementation \ +# define DECLARE_LRECORD(c_name, structtype) \ +extern Lisp_Object Q##c_name##p; \ +extern CONST_IF_NOT_DEBUG struct lrecord_implementation \ lrecord_##c_name[] -# define DECLARE_NONRECORD(c_name, type_enum, structtype) \ +# define DECLARE_NONRECORD(c_name, type_enum, structtype) \ extern Lisp_Object Q##c_name##p # define XRECORD(x, c_name, structtype) ((structtype *) XPNTR (x)) -# define XNONRECORD(x, c_name, type_enum, structtype) \ +# define XNONRECORD(x, c_name, type_enum, structtype) \ ((structtype *) XPNTR (x)) # define XSETRECORD(var, p, c_name) XSETOBJ (var, Lisp_Record, p) @@ -350,21 +351,21 @@ FSF Emacs does not have this problem because RMS took the cheesy way out and disabled returning from a signal entirely. */ -#define CONCHECK_RECORD(x, c_name) do \ -{ if (!RECORD_TYPEP (x, lrecord_##c_name)) \ - x = wrong_type_argument (Q##c_name##p, x); } \ +#define CONCHECK_RECORD(x, c_name) do \ +{ if (!RECORD_TYPEP (x, lrecord_##c_name)) \ + x = wrong_type_argument (Q##c_name##p, x); } \ while (0) -#define CONCHECK_NONRECORD(x, lisp_enum, predicate) do \ -{ if (XTYPE (x) != lisp_enum) \ - x = wrong_type_argument (predicate, x); } \ +#define CONCHECK_NONRECORD(x, lisp_enum, predicate) do \ +{ if (XTYPE (x) != lisp_enum) \ + x = wrong_type_argument (predicate, x); } \ while (0) -#define CHECK_RECORD(x, c_name) do \ -{ if (!RECORD_TYPEP (x, lrecord_##c_name)) \ - dead_wrong_type_argument (Q##c_name##p, x); } \ +#define CHECK_RECORD(x, c_name) do \ +{ if (!RECORD_TYPEP (x, lrecord_##c_name)) \ + dead_wrong_type_argument (Q##c_name##p, x); } \ while (0) -#define CHECK_NONRECORD(x, lisp_enum, predicate) do \ -{ if (XTYPE (x) != lisp_enum) \ - dead_wrong_type_argument (predicate, x); } \ +#define CHECK_NONRECORD(x, lisp_enum, predicate) do \ +{ if (XTYPE (x) != lisp_enum) \ + dead_wrong_type_argument (predicate, x); } \ while (0) void *alloc_lcrecord (int size, CONST struct lrecord_implementation *); @@ -375,13 +376,13 @@ /* Copy the data from one lcrecord structure into another, but don't overwrite the header information. */ -#define copy_lcrecord(dst, src) \ - memcpy ((char *) dst + sizeof (struct lcrecord_header), \ - (char *) src + sizeof (struct lcrecord_header), \ +#define copy_lcrecord(dst, src) \ + memcpy ((char *) dst + sizeof (struct lcrecord_header), \ + (char *) src + sizeof (struct lcrecord_header), \ sizeof (*dst) - sizeof (struct lcrecord_header)) -#define zero_lcrecord(lcr) \ - memset ((char *) lcr + sizeof (struct lcrecord_header), 0, \ +#define zero_lcrecord(lcr) \ + memset ((char *) lcr + sizeof (struct lcrecord_header), 0, \ sizeof (*lcr) - sizeof (struct lcrecord_header)) #endif /* _XEMACS_LRECORD_H_ */