a `next' pointer, and are allocated using alloc_lcrecord().
Creating a new lcrecord type is fairly easy; just follow the
- lead of some existing type (e.g. hash tables). Note that you
+ lead of some existing type (e.g. hashtables). Note that you
do not need to supply all the methods (see below); reasonable
defaults are provided for many of them. Alternatively, if you're
just looking for a way of encapsulating data (which possibly
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 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;
+ unsigned type:8;
+ /* 1 if the object is marked during GC, 0 otherwise. */
+ unsigned mark:1;
+ /* 1 if the object resides in pure (read-only) space */
+ unsigned pure:1;
+#else
+ CONST struct lrecord_implementation *implementation;
+#endif
};
struct lrecord_implementation;
int lrecord_type_index (CONST struct lrecord_implementation *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)->c_readonly = 0; \
- (SLI_header)->lisp_readonly = 0; \
+#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
+# define set_lheader_implementation(header,imp) do \
+{ \
+ (header)->type = lrecord_type_index (imp); \
+ (header)->mark = 0; \
+ (header)->pure = 0; \
} while (0)
+#else
+# define set_lheader_implementation(header,imp) \
+ ((void) ((header)->implementation = (imp)))
+#endif
struct lcrecord_header
{
struct lrecord_header lheader;
-
- /* The `next' field is normally used to chain all lrecords together
+ /* 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.
+ "alloc_lcrecord" threads records together.
- For example, the event and marker object types allocate members
- out of memory chunks, and are able to find all unmarked members
- by sweeping through the elements of the list of chunks. */
+ 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;
-
- /* The `uid' field is just for debugging/printing convenience.
- Having this slot doesn't hurt us much spacewise, since an
- lcrecord already has the above slots plus malloc overhead. */
+ /* 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;
-
- /* The `free' field is 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. */
+ /* 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;
};
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));
`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);
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])
+# 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
extern int gc_in_progress;
-#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 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 UNMARKABLE_RECORD_HEADER_P(lheader) \
- (LHEADER_IMPLEMENTATION (lheader)->marker == this_one_is_unmarkable)
-
-#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
-};
+#ifdef 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)->mark
+# define MARK_RECORD_HEADER(lheader) (lheader)->mark = 1
+# define UNMARK_RECORD_HEADER(lheader) (lheader)->mark = 0
-struct struct_description {
- size_t size;
- const struct lrecord_description *description;
-};
+#else /* ! USE_INDEXED_LRECORD_IMPLEMENTATION */
+
+# define MARKED_RECORD_HEADER_P(lheader) \
+ (((lheader)->implementation->finalizer) == this_marks_a_marked_record)
+# define MARK_RECORD_HEADER(lheader) \
+ do { (((lheader)->implementation)++); } while (0)
+# define UNMARK_RECORD_HEADER(lheader) \
+ do { (((lheader)->implementation)--); } while (0)
-#define XD_INDIRECT(count) (-1-(count))
-#define XD_PARENT_INDIRECT(count) (-1000-(count))
+#endif /* ! USE_INDEXED_LRECORD_IMPLEMENTATION */
-#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) }
+#define UNMARKABLE_RECORD_HEADER_P(lheader) \
+ ((LHEADER_IMPLEMENTATION (lheader)->marker) \
+ == this_one_is_unmarkable)
/* Declaring the following structures as const puts them in the
text (read-only) segment, which makes debugging inconvenient
# define DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype)
#endif
-#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(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_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_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_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(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_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_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_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(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_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 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 MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,props,size,sizer,basic_p,structtype) \
+#define MAKE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,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 = \
- { name, marker, printer, nuker, equal, hash, desc, \
- getprop, putprop, remprop, props, size, sizer, \
- &(lrecord_##c_name##_lrecord_type_index), basic_p } \
+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 } }
#define LRECORDP(a) (XTYPE ((a)) == Lisp_Type_Record)
#define XRECORD_LHEADER(a) ((struct lrecord_header *) XPNTR (a))
-#define RECORD_TYPEP(x, ty) \
+#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
+# 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.
# 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); \
+ lrecord_##c_name[]; \
+INLINE structtype *error_check_##c_name (Lisp_Object _obj); \
INLINE structtype * \
-error_check_##c_name (Lisp_Object obj) \
+error_check_##c_name (Lisp_Object _obj) \
{ \
- assert (RECORD_TYPEP (obj, &lrecord_##c_name) || \
- MARKED_RECORD_P (obj)); \
- return (structtype *) XPNTR (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); \
INLINE structtype * \
-error_check_##c_name (Lisp_Object obj) \
+error_check_##c_name (Lisp_Object _obj) \
{ \
- assert (XGCTYPE (obj) == type_enum); \
- return (structtype *) XPNTR (obj); \
+ XUNMARK (_obj); \
+ assert (XGCTYPE (_obj) == type_enum); \
+ return (structtype *) XPNTR (_obj); \
} \
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)
# 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))
#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
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 {\
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 { \
projects / chise / xemacs-chise.git.1 / blobdiff