X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Flrecord.h;h=1858552897a05e00ee0e7d614c4d48fd63103307;hb=f8c889244f022ae695ea8dc67267499286921903;hp=b15c1cbd34e27d059404d4345bf23ed35b6c06f9;hpb=77dcef404dc78635f6ffa8f71a803d2bc7cc8921;p=chise%2Fxemacs-chise.git- diff --git a/src/lrecord.h b/src/lrecord.h index b15c1cb..1858552 100644 --- a/src/lrecord.h +++ b/src/lrecord.h @@ -59,60 +59,26 @@ Boston, MA 02111-1307, USA. */ 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? */ - - /* - * If USE_INDEXED_LRECORD_IMPLEMENTATION is defined, we are - * implementing the scheme described in the 'It would be better - * ...' paragraph above. - */ -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION /* index into lrecord_implementations_table[] */ - unsigned char type; - /* 1 if the object is marked during GC, 0 otherwise. */ - char mark; - /* 1 if the object resides in pure (read-only) space */ - char pure; -#else - CONST struct lrecord_implementation *implementation; -#endif + unsigned type :8; + /* 1 if the object is marked during GC. */ + unsigned mark :1; + /* 1 if the object resides in read-only space */ + unsigned c_readonly : 1; + /* 1 if the object is readonly from lisp */ + unsigned lisp_readonly : 1; }; struct lrecord_implementation; int lrecord_type_index (CONST struct lrecord_implementation *implementation); -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION # define set_lheader_implementation(header,imp) do { \ struct lrecord_header* SLI_header = (header); \ (SLI_header)->type = lrecord_type_index (imp); \ (SLI_header)->mark = 0; \ - (SLI_header)->pure = 0; \ + (SLI_header)->c_readonly = 0; \ + (SLI_header)->lisp_readonly = 0; \ } while (0) -#else -# define set_lheader_implementation(header,imp) \ - ((void) ((header)->implementation = (imp))) -#endif struct lcrecord_header { @@ -152,10 +118,6 @@ struct free_lcrecord_header Lisp_Object chain; }; -/* This as the value of lheader->implementation->finalizer - means that this record is already marked */ -void this_marks_a_marked_record (void *, int); - /* see alloc.c for an explanation */ Lisp_Object this_one_is_unmarkable (Lisp_Object obj, void (*markobj) (Lisp_Object)); @@ -192,6 +154,10 @@ struct lrecord_implementation `equal', they *must* hash to the same value or the hashing won't work). */ unsigned long (*hash) (Lisp_Object, int); + + /* External data layout description */ + const struct lrecord_description *description; + 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); @@ -212,45 +178,125 @@ struct lrecord_implementation int basic_p; }; -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION extern CONST struct lrecord_implementation *lrecord_implementations_table[]; -# define XRECORD_LHEADER_IMPLEMENTATION(obj) \ +#define XRECORD_LHEADER_IMPLEMENTATION(obj) \ (lrecord_implementations_table[XRECORD_LHEADER (obj)->type]) -# define LHEADER_IMPLEMENTATION(lh) (lrecord_implementations_table[(lh)->type]) -#else -# define XRECORD_LHEADER_IMPLEMENTATION(obj) \ - (XRECORD_LHEADER (obj)->implementation) -# define LHEADER_IMPLEMENTATION(lh) ((lh)->implementation) -#endif +#define LHEADER_IMPLEMENTATION(lh) (lrecord_implementations_table[(lh)->type]) extern int gc_in_progress; -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION -# define MARKED_RECORD_P(obj) (gc_in_progress && XRECORD_LHEADER (obj)->mark) -#else -# define MARKED_RECORD_P(obj) (gc_in_progress && \ - XRECORD_LHEADER (obj)->implementation->finalizer == \ - this_marks_a_marked_record) -#endif +#define MARKED_RECORD_P(obj) (gc_in_progress && XRECORD_LHEADER (obj)->mark) +#define MARKED_RECORD_HEADER_P(lheader) ((lheader)->mark) +#define MARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 1)) +#define UNMARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 0)) -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION +#define UNMARKABLE_RECORD_HEADER_P(lheader) \ + (LHEADER_IMPLEMENTATION (lheader)->marker == this_one_is_unmarkable) -# define MARKED_RECORD_HEADER_P(lheader) ((lheader)->mark) -# define MARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 1)) -# define UNMARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 0)) +#define C_READONLY_RECORD_HEADER_P(lheader) ((lheader)->c_readonly) +#define LISP_READONLY_RECORD_HEADER_P(lheader) ((lheader)->lisp_readonly) +#define SET_C_READONLY_RECORD_HEADER(lheader) \ + ((void) ((lheader)->c_readonly = (lheader)->lisp_readonly = 1)) +#define SET_LISP_READONLY_RECORD_HEADER(lheader) \ + ((void) ((lheader)->lisp_readonly = 1)) + +/* External description stuff + + A lrecord external description is an array of values. The first + value of each line is a type, the second the offset in the lrecord + structure. Following values are parameters, their presence, type + and number is type-dependant. + + The description ends with a "XD_END" record. + + Some example descriptions : + static const struct lrecord_description cons_description[] = { + { XD_LISP_OBJECT, offsetof(struct Lisp_Cons, car), 2 }, + { XD_END } + }; + + Which means "two lisp objects starting at the 'car' element" + + static const struct lrecord_description string_description[] = { + { XD_STRING_DATA, offsetof(Lisp_String, data) }, + { XD_LISP_OBJECT, offsetof(Lisp_String, plist), 1 }, + { XD_END } + }; + "A string data pointer at 'data', one lisp object at 'plist'" + + The existing types : + XD_LISP_OBJECT + Lisp objects. The third element is the count. This is also the type to use + for pointers to other lrecords. + + XD_STRING_DATA + Pointer to string data. + + XD_OPAQUE_PTR + Pointer to undumpable data. Must be NULL when dumping. + + XD_STRUCT_PTR + Pointer to described struct. Parameters are number of structures and + struct_description. + + XD_OPAQUE_DATA_PTR + Pointer to dumpable opaque data. Parameter is the size of the data. + Pointed data must be relocatable without changes. + + XD_SIZE_T + size_t value. Used for counts. + + XD_INT + int value. Used for counts. + + XD_LONG + long value. Used for counts. + + XD_END + Special type indicating the end of the array. + + + Special macros: + XD_INDIRECT(line) + Usable where a "count" or "size" is requested. Gives the value of the element + which is at line number 'line' in the description (count starts at zero). + + XD_PARENT_INDIRECT(line) + Same as XD_INDIRECT but the element number refers to the parent structure. + Usable only in struct descriptions. +*/ + +enum lrecord_description_type { + XD_LISP_OBJECT, + XD_STRING_DATA, + XD_OPAQUE_PTR, + XD_STRUCT_PTR, + XD_OPAQUE_DATA_PTR, + XD_SIZE_T, + XD_INT, + XD_LONG, + XD_END +}; -#else /* ! USE_INDEXED_LRECORD_IMPLEMENTATION */ +struct lrecord_description { + enum lrecord_description_type type; + int offset; + EMACS_INT data1; + const struct struct_description *data2; +}; -# define MARKED_RECORD_HEADER_P(lheader) \ - ((lheader)->implementation->finalizer == this_marks_a_marked_record) -# define MARK_RECORD_HEADER(lheader) ((void) (((lheader)->implementation)++)) -# define UNMARK_RECORD_HEADER(lheader) ((void) (((lheader)->implementation)--)) +struct struct_description { + size_t size; + const struct lrecord_description *description; +}; -#endif /* ! USE_INDEXED_LRECORD_IMPLEMENTATION */ +#define XD_INDIRECT(count) (-1-(count)) +#define XD_PARENT_INDIRECT(count) (-1000-(count)) -#define UNMARKABLE_RECORD_HEADER_P(lheader) \ - (LHEADER_IMPLEMENTATION (lheader)->marker == this_one_is_unmarkable) +#define XD_DYNARR_DESC(base_type, sub_desc) \ + { XD_STRUCT_PTR, offsetof(base_type, base), XD_INDIRECT(1), sub_desc }, \ + { XD_INT, offsetof(base_type, max) } /* Declaring the following structures as const puts them in the text (read-only) segment, which makes debugging inconvenient @@ -273,44 +319,38 @@ extern int gc_in_progress; # define DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype) #endif -#define DEFINE_BASIC_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,structtype) \ -DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,0,0,0,0,structtype) +#define DEFINE_BASIC_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \ +DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) -#define DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,structtype) \ -MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,sizeof(structtype),0,1,structtype) +#define DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,props,structtype) \ +MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,props,sizeof(structtype),0,1,structtype) -#define DEFINE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,structtype) \ -DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,0,0,0,0,structtype) +#define DEFINE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,structtype) \ +DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) -#define DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,structtype) \ -MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,sizeof (structtype),0,0,structtype) +#define DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,props,structtype) \ +MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,props,sizeof (structtype),0,0,structtype) -#define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,sizer,structtype) \ -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,0,0,0,0,sizer,structtype) +#define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ +DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype) -#define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,sizer,structtype) \ -MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,0,sizer,0,structtype) \ +#define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,props,sizer,structtype) \ +MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,props,0,sizer,0,structtype) \ -#define MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,size,sizer,basic_p,structtype) \ +#define MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,props,size,sizer,basic_p,structtype) \ DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype) \ static int lrecord_##c_name##_lrecord_type_index; \ -CONST_IF_NOT_DEBUG struct lrecord_implementation lrecord_##c_name[2] = \ - { { name, marker, printer, nuker, equal, hash, \ - getprop, putprop, remprop, props, size, sizer, \ - &(lrecord_##c_name##_lrecord_type_index), basic_p }, \ - { 0, 0, 0, this_marks_a_marked_record, 0, 0, 0, 0, 0, 0, 0, 0, 0, basic_p } } +CONST_IF_NOT_DEBUG struct lrecord_implementation lrecord_##c_name = \ + { name, marker, printer, nuker, equal, hash, desc, \ + getprop, putprop, remprop, props, size, sizer, \ + &(lrecord_##c_name##_lrecord_type_index), basic_p } \ #define LRECORDP(a) (XTYPE ((a)) == Lisp_Type_Record) #define XRECORD_LHEADER(a) ((struct lrecord_header *) XPNTR (a)) -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION -# define RECORD_TYPEP(x, ty) \ +#define RECORD_TYPEP(x, ty) \ (LRECORDP (x) && \ lrecord_implementations_table[XRECORD_LHEADER (x)->type] == (ty)) -#else -# define RECORD_TYPEP(x, ty) \ - (LRECORDP (x) && XRECORD_LHEADER (x)->implementation == (ty)) -#endif /* NOTE: the DECLARE_LRECORD() must come before the associated DEFINE_LRECORD_*() or you will get compile errors. @@ -325,13 +365,12 @@ CONST_IF_NOT_DEBUG struct lrecord_implementation lrecord_##c_name[2] = \ # define DECLARE_LRECORD(c_name, structtype) \ extern CONST_IF_NOT_DEBUG struct lrecord_implementation \ - lrecord_##c_name[]; \ + 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) || \ + assert (RECORD_TYPEP (obj, &lrecord_##c_name) || \ MARKED_RECORD_P (obj)); \ return (structtype *) XPNTR (obj); \ } \ @@ -342,7 +381,6 @@ 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); \ } \ @@ -354,7 +392,7 @@ extern Lisp_Object Q##c_name##p # define XSETRECORD(var, p, c_name) do \ { \ XSETOBJ (var, Lisp_Type_Record, p); \ - assert (RECORD_TYPEP (var, lrecord_##c_name) || \ + assert (RECORD_TYPEP (var, &lrecord_##c_name) || \ MARKED_RECORD_P (var)); \ } while (0) @@ -363,7 +401,7 @@ extern Lisp_Object Q##c_name##p # define DECLARE_LRECORD(c_name, structtype) \ extern Lisp_Object Q##c_name##p; \ extern CONST_IF_NOT_DEBUG struct lrecord_implementation \ - lrecord_##c_name[] + lrecord_##c_name # define DECLARE_NONRECORD(c_name, type_enum, structtype) \ extern Lisp_Object Q##c_name##p # define XRECORD(x, c_name, structtype) ((structtype *) XPNTR (x)) @@ -373,8 +411,8 @@ extern Lisp_Object Q##c_name##p #endif /* not ERROR_CHECK_TYPECHECK */ -#define RECORDP(x, c_name) RECORD_TYPEP (x, lrecord_##c_name) -#define GC_RECORDP(x, c_name) gc_record_type_p (x, lrecord_##c_name) +#define RECORDP(x, c_name) RECORD_TYPEP (x, &lrecord_##c_name) +#define GC_RECORDP(x, c_name) gc_record_type_p (x, &lrecord_##c_name) /* Note: we now have two different kinds of type-checking macros. The "old" kind has now been renamed CONCHECK_foo. The reason for @@ -400,7 +438,7 @@ extern Lisp_Object Q##c_name##p way out and disabled returning from a signal entirely. */ #define CONCHECK_RECORD(x, c_name) do { \ - if (!RECORD_TYPEP (x, lrecord_##c_name)) \ + 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 {\ @@ -408,7 +446,7 @@ extern Lisp_Object Q##c_name##p x = wrong_type_argument (predicate, x); \ } while (0) #define CHECK_RECORD(x, c_name) do { \ - if (!RECORD_TYPEP (x, lrecord_##c_name)) \ + 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 { \