This is lrecord.h in view mode; [Download] [Up]
/* The "lrecord" structure (header of a compound lisp object).
Copyright (C) 1993, 1994 Free Software Foundation, Inc.
This file is part of XEmacs.
XEmacs is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 2, or (at your option) any
later version.
XEmacs is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
for more details.
You should have received a copy of the GNU General Public License
along with XEmacs; see the file COPYING. If not, write to the Free
Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
/* Synched up with: Not in FSF. */
#ifndef _XEMACS_LRECORD_H_
#define _XEMACS_LRECORD_H_
/* The "lrecord" type of Lisp object is used for all object types
other than a few simple ones. This allows many types to be
implemented but only a few bits required in a Lisp object for
type information. (The tradeoff is that each object has its
type marked in it, thereby increasing its size.) The first
four bytes of all lrecords is a pointer to a struct
lrecord_implementation, which contains methods describing
how to process this object.
lrecords are of two types: straight lrecords, and lcrecords.
Straight lrecords are used for those types of objects that
have their own allocation routines (typically allocated out
of 2K chunks of memory). These objects have a
`struct lrecord_header' at the top, containing only the
implementation pointer. There are special routines in alloc.c
to deal with each such object type.
Lcrecords are used for less common sorts of objects that don't
do their own allocation. Each such object is malloc()ed
individually, and the objects are chained together through
a `next' pointer. Lcrecords have a `struct lcrecord_header'
at the top, which contains an implementation pointer and
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. 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
could contain Lisp_Objects in it), you may well be able to use
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;
};
#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;
};
/* This as the value of lheader->implementation->finalizer
* means that this record is already marked */
extern void this_marks_a_marked_record (void *, int);
/* see alloc.c for an explanation */
extern Lisp_Object this_one_is_unmarkable (Lisp_Object obj,
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.
WARNING: The finalizer will be called multiple times if there are
multiple pointers to the object. Therefore, your routine *must*
ensure that it doesn't mess up (e.g. free a memory block twice) if
called twice on the same object. Also 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);
int (*getprop) (Lisp_Object obj, Lisp_Object prop, Lisp_Object *value_out);
int (*putprop) (Lisp_Object obj, Lisp_Object prop, Lisp_Object val);
int (*remprop) (Lisp_Object obj, Lisp_Object prop);
Lisp_Object (*props) (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;
};
#define MARKED_RECORD_P(obj) (gc_in_progress && \
XRECORD_LHEADER (obj)->implementation->finalizer == \
this_marks_a_marked_record)
/* Declaring the following structures as const puts them in the
text (read-only) segment, which makes debugging inconvenient
because this segment is not mapped when processing a core-
dump file */
#ifdef DEBUG_XEMACS
#define CONST_IF_NOT_DEBUG
#else
#define CONST_IF_NOT_DEBUG CONST
#endif
/* DEFINE_LRECORD_IMPLEMENTATION is for objects with constant size.
DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION is for objects whose size varies.
*/
/* This uses macros instead of a separate function call to verify
the type of the Lisp_Object deferenced in XRECORD().
For as yet unknown reasons, this makes things break in a spectacular
fashion using the Dec CC compiler on the Alphas. Yet another
compiler bug, no doubt. */
#ifndef BROKEN_MACROIZE_ERROR_CHECKING
# define MACROIZE_ERROR_CHECKING
#endif
#if defined (ERROR_CHECK_TYPECHECK) && !defined (MACROIZE_ERROR_CHECKING)
# define DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype) \
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); \
}
#else
# define DECLARE_ERROR_CHECK_TYPECHECK(c_name, structtype)
#endif
#define DEFINE_LRECORD_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,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, \
0, 0, 0, 0, sizeof (structtype), 0, \
&(lrecord_##c_name##_lrecord_type_index) }, \
{ 0, 0, 0, this_marks_a_marked_record, 0, 0, 0, 0, 0, 0, 0, 0, 0 } }
#define DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,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, sizeof (structtype), 0, \
&(lrecord_##c_name##_lrecord_type_index) }, \
{ 0, 0, 0, this_marks_a_marked_record, 0, 0, 0, 0, 0, 0, 0, 0, 0 } }
#define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,marker,printer,nuker,equal,hash,sizer,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, \
0, 0, 0, 0, 0, sizer, \
&(lrecord_##c_name##_lrecord_type_index) }, \
{ 0, 0, 0, this_marks_a_marked_record, 0, 0, 0, 0, 0, 0, 0, 0, 0 } }
#define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,marker,printer,nuker,equal,hash,getprop,putprop,remprop,props,sizer,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, 0, sizer, \
&(lrecord_##c_name##_lrecord_type_index) }, \
{ 0, 0, 0, this_marks_a_marked_record, 0, 0, 0, 0, 0, 0, 0, 0, 0 } }
#define LRECORDP(a) (XTYPE ((a)) == Lisp_Record)
#define XRECORD_LHEADER(a) ((struct lrecord_header *) XPNTR (a))
#define RECORD_TYPEP(x, ty) \
(LRECORDP (x) && XRECORD_LHEADER (x)->implementation == (ty))
/* NOTE: the DECLARE_LRECORD() must come before the associated
DEFINE_LRECORD_*() or you will get compile errors. */
#ifdef ERROR_CHECK_TYPECHECK
# define DECLARE_LRECORD(c_name, structtype) \
extern Lisp_Object Q##c_name##p; \
extern structtype *error_check_##c_name (Lisp_Object _obj); \
extern CONST_IF_NOT_DEBUG struct lrecord_implementation \
lrecord_##c_name[]
# define DECLARE_NONRECORD(c_name, structtype) \
extern Lisp_Object Q##c_name##p; \
extern structtype *error_check_##c_name (Lisp_Object _obj)
# ifdef MACROIZE_ERROR_CHECKING
MAC_DECLARE_EXTERN (Lisp_Object, mactemp_xrecord)
# define XRECORD(x, c_name, structtype) \
MAC_BEGIN \
MAC_DECLARE (Lisp_Object, mactemp_xrecord, x) \
XUNMARK (mactemp_xrecord) \
MAC_SEP \
assert (RECORD_TYPEP (mactemp_xrecord, lrecord_##c_name) || \
MARKED_RECORD_P (mactemp_xrecord)) \
MAC_SEP \
(structtype *) XPNTR (mactemp_xrecord) \
MAC_END
# define XNONRECORD(x, c_name, type_enum, structtype) \
MAC_BEGIN \
MAC_DECLARE (Lisp_Object, mactemp_xrecord, x) \
XUNMARK (mactemp_xrecord) \
MAC_SEP \
assert (XTYPE (mactemp_xrecord) == type_enum || \
MARKED_RECORD_P (mactemp_xrecord)) \
MAC_SEP \
(structtype *) XPNTR (mactemp_xrecord) \
MAC_END
# else /* not MACROIZE_ERROR_CHECKING */
# define XRECORD(x, c_name, structtype) error_check_##c_name (x)
# define XNONRECORD(x, c_name, type_enum, structtype) \
error_check_##c_name (x)
# endif /* not MACROIZE_ERROR_CHECKING */
# 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 \
lrecord_##c_name[]
# define DECLARE_NONRECORD(c_name, 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) \
((structtype *) XPNTR (x))
# define XSETRECORD(var, p, c_name) XSETOBJ (var, Lisp_Record, p)
#endif /* not ERROR_CHECK_TYPECHECK */
#define RECORDP(x, c_name) RECORD_TYPEP (x, lrecord_##c_name)
#define CHECK_RECORD(x, c_name) do \
{ if (!RECORD_TYPEP (x, lrecord_##c_name)) \
x = wrong_type_argument (Q##c_name##p, x); } \
while (0)
extern void *alloc_lcrecord (int size, CONST struct lrecord_implementation *);
extern int gc_record_type_p (Lisp_Object frob,
CONST struct lrecord_implementation *type);
/* 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), \
sizeof (*dst) - sizeof (struct lcrecord_header))
#define zero_lcrecord(lcr) \
memset ((char *) lcr + sizeof (struct lcrecord_header), 0, \
sizeof (*lcr) - sizeof (struct lcrecord_header))
#endif /* _XEMACS_LRECORD_H_ */
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.