/* Declare the malloc initialization hook, which runs before 'main' starts.
EXTERNALLY_VISIBLE works around Bug#22522. */
+typedef void (*voidfuncptr) (void);
# ifndef __MALLOC_HOOK_VOLATILE
# define __MALLOC_HOOK_VOLATILE
# endif
return val;
}
-/* Free a Lisp_Misc object. */
-
-void
-free_misc (Lisp_Object misc)
-{
- XMISCANY (misc)->type = Lisp_Misc_Free;
- XMISC (misc)->u_free.chain = misc_free_list;
- misc_free_list = XMISC (misc);
- consing_since_gc -= sizeof (union Lisp_Misc);
- total_free_markers++;
-}
-
-/* Verify properties of Lisp_Save_Value's representation
- that are assumed here and elsewhere. */
-
-verify (SAVE_UNUSED == 0);
-verify (((SAVE_INTEGER | SAVE_POINTER | SAVE_FUNCPOINTER | SAVE_OBJECT)
- >> SAVE_SLOT_BITS)
- == 0);
-
-/* Return Lisp_Save_Value objects for the various combinations
- that callers need. */
-
-Lisp_Object
-make_save_int_int_int (ptrdiff_t a, ptrdiff_t b, ptrdiff_t c)
-{
- Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
- struct Lisp_Save_Value *p = XSAVE_VALUE (val);
- p->save_type = SAVE_TYPE_INT_INT_INT;
- p->data[0].integer = a;
- p->data[1].integer = b;
- p->data[2].integer = c;
- return val;
-}
-
-Lisp_Object
-make_save_obj_obj_obj_obj (Lisp_Object a, Lisp_Object b, Lisp_Object c,
- Lisp_Object d)
-{
- Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
- struct Lisp_Save_Value *p = XSAVE_VALUE (val);
- p->save_type = SAVE_TYPE_OBJ_OBJ_OBJ_OBJ;
- p->data[0].object = a;
- p->data[1].object = b;
- p->data[2].object = c;
- p->data[3].object = d;
- return val;
-}
-
-Lisp_Object
-make_save_ptr (void *a)
-{
- Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
- struct Lisp_Save_Value *p = XSAVE_VALUE (val);
- p->save_type = SAVE_POINTER;
- p->data[0].pointer = a;
- return val;
-}
-
-Lisp_Object
-make_save_ptr_int (void *a, ptrdiff_t b)
-{
- Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
- struct Lisp_Save_Value *p = XSAVE_VALUE (val);
- p->save_type = SAVE_TYPE_PTR_INT;
- p->data[0].pointer = a;
- p->data[1].integer = b;
- return val;
-}
-
-Lisp_Object
-make_save_ptr_ptr (void *a, void *b)
-{
- Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
- struct Lisp_Save_Value *p = XSAVE_VALUE (val);
- p->save_type = SAVE_TYPE_PTR_PTR;
- p->data[0].pointer = a;
- p->data[1].pointer = b;
- return val;
-}
-
-Lisp_Object
-make_save_funcptr_ptr_obj (void (*a) (void), void *b, Lisp_Object c)
-{
- Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
- struct Lisp_Save_Value *p = XSAVE_VALUE (val);
- p->save_type = SAVE_TYPE_FUNCPTR_PTR_OBJ;
- p->data[0].funcpointer = a;
- p->data[1].pointer = b;
- p->data[2].object = c;
- return val;
-}
-
-/* Return a Lisp_Save_Value object that represents an array A
- of N Lisp objects. */
-
-Lisp_Object
-make_save_memory (Lisp_Object *a, ptrdiff_t n)
-{
- Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
- struct Lisp_Save_Value *p = XSAVE_VALUE (val);
- p->save_type = SAVE_TYPE_MEMORY;
- p->data[0].pointer = a;
- p->data[1].integer = n;
- return val;
-}
-
-/* Free a Lisp_Save_Value object. Do not use this function
- if SAVE contains pointer other than returned by xmalloc. */
-
-void
-free_save_value (Lisp_Object save)
-{
- xfree (XSAVE_POINTER (save, 0));
- free_misc (save);
-}
-
Lisp_Object
make_misc_ptr (void *a)
{
/* Return 2 if OBJ is a killed or special buffer object, 1 if OBJ is a
valid lisp object, 0 if OBJ is NOT a valid lisp object, or -1 if we
- cannot validate OBJ. This function can be quite slow, so its primary
- use is the manual debugging. The only exception is print_object, where
- we use it to check whether the memory referenced by the pointer of
- Lisp_Save_Value object contains valid objects. */
+ cannot validate OBJ. This function can be quite slow, and is used
+ only in debugging. */
int
valid_lisp_object_p (Lisp_Object obj)
mark_object (blv->defcell);
}
-NO_INLINE /* To reduce stack depth in mark_object. */
-static void
-mark_save_value (struct Lisp_Save_Value *ptr)
-{
- /* If `save_type' is zero, `data[0].pointer' is the address
- of a memory area containing `data[1].integer' potential
- Lisp_Objects. */
- if (ptr->save_type == SAVE_TYPE_MEMORY)
- {
- Lisp_Object *p = ptr->data[0].pointer;
- ptrdiff_t nelt;
- for (nelt = ptr->data[1].integer; nelt > 0; nelt--, p++)
- mark_maybe_object (*p);
- }
- else
- {
- /* Find Lisp_Objects in `data[N]' slots and mark them. */
- int i;
- for (i = 0; i < SAVE_VALUE_SLOTS; i++)
- if (save_type (ptr, i) == SAVE_OBJECT)
- mark_object (ptr->data[i].object);
- }
-}
-
/* Remove killed buffers or items whose car is a killed buffer from
LIST, and mark other items. Return changed LIST, which is marked. */
XMISCANY (obj)->gcmarkbit = 1;
break;
- case Lisp_Misc_Save_Value:
- XMISCANY (obj)->gcmarkbit = 1;
- mark_save_value (XSAVE_VALUE (obj));
- break;
-
case Lisp_Misc_Ptr:
XMISCANY (obj)->gcmarkbit = true;
break;
Lisp_Misc_Free = 0x5eab,
Lisp_Misc_Marker,
Lisp_Misc_Overlay,
- Lisp_Misc_Save_Value,
Lisp_Misc_Finalizer,
Lisp_Misc_Ptr,
#ifdef HAVE_MODULES
members that are accessible only from C. A Lisp_Misc object is a
wrapper for a C struct that can contain anything you like.
- Explicit freeing is discouraged for Lisp objects in general. But if
- you really need to exploit this, use Lisp_Misc (check free_misc in
- alloc.c to see why). There is no way to free a vectorlike object.
+ There is no way to explicitly free a Lisp Object; only the garbage
+ collector frees them.
To add a new pseudovector type, extend the pvec_type enumeration;
to add a new Lisp_Misc, extend the Lisp_Misc_Type enumeration.
Lisp_Object plist;
};
-/* Number of bits needed to store one of the values
- SAVE_UNUSED..SAVE_OBJECT. */
-enum { SAVE_SLOT_BITS = 3 };
-
-/* Number of slots in a save value where save_type is nonzero. */
-enum { SAVE_VALUE_SLOTS = 4 };
-
-/* Bit-width and values for struct Lisp_Save_Value's save_type member. */
-
-enum { SAVE_TYPE_BITS = SAVE_VALUE_SLOTS * SAVE_SLOT_BITS + 1 };
-
-/* Types of data which may be saved in a Lisp_Save_Value. */
-
-enum Lisp_Save_Type
- {
- SAVE_UNUSED,
- SAVE_INTEGER,
- SAVE_FUNCPOINTER,
- SAVE_POINTER,
- SAVE_OBJECT,
- SAVE_TYPE_INT_INT = SAVE_INTEGER + (SAVE_INTEGER << SAVE_SLOT_BITS),
- SAVE_TYPE_INT_INT_INT
- = (SAVE_INTEGER + (SAVE_TYPE_INT_INT << SAVE_SLOT_BITS)),
- SAVE_TYPE_OBJ_OBJ = SAVE_OBJECT + (SAVE_OBJECT << SAVE_SLOT_BITS),
- SAVE_TYPE_OBJ_OBJ_OBJ = SAVE_OBJECT + (SAVE_TYPE_OBJ_OBJ << SAVE_SLOT_BITS),
- SAVE_TYPE_OBJ_OBJ_OBJ_OBJ
- = SAVE_OBJECT + (SAVE_TYPE_OBJ_OBJ_OBJ << SAVE_SLOT_BITS),
- SAVE_TYPE_PTR_INT = SAVE_POINTER + (SAVE_INTEGER << SAVE_SLOT_BITS),
- SAVE_TYPE_PTR_OBJ = SAVE_POINTER + (SAVE_OBJECT << SAVE_SLOT_BITS),
- SAVE_TYPE_PTR_PTR = SAVE_POINTER + (SAVE_POINTER << SAVE_SLOT_BITS),
- SAVE_TYPE_FUNCPTR_PTR_OBJ
- = SAVE_FUNCPOINTER + (SAVE_TYPE_PTR_OBJ << SAVE_SLOT_BITS),
-
- /* This has an extra bit indicating it's raw memory. */
- SAVE_TYPE_MEMORY = SAVE_TYPE_PTR_INT + (1 << (SAVE_TYPE_BITS - 1))
- };
-
-/* SAVE_SLOT_BITS must be large enough to represent these values. */
-verify (((SAVE_UNUSED | SAVE_INTEGER | SAVE_FUNCPOINTER
- | SAVE_POINTER | SAVE_OBJECT)
- >> SAVE_SLOT_BITS)
- == 0);
-
-/* Special object used to hold a different values for later use.
-
- This is mostly used to package C integers and pointers to call
- record_unwind_protect when two or more values need to be saved.
- For example:
-
- ...
- struct my_data *md = get_my_data ();
- ptrdiff_t mi = get_my_integer ();
- record_unwind_protect (my_unwind, make_save_ptr_int (md, mi));
- ...
-
- Lisp_Object my_unwind (Lisp_Object arg)
- {
- struct my_data *md = XSAVE_POINTER (arg, 0);
- ptrdiff_t mi = XSAVE_INTEGER (arg, 1);
- ...
- }
-
- If ENABLE_CHECKING is in effect, XSAVE_xxx macros do type checking of the
- saved objects and raise eassert if type of the saved object doesn't match
- the type which is extracted. In the example above, XSAVE_INTEGER (arg, 2)
- and XSAVE_OBJECT (arg, 0) are wrong because nothing was saved in slot 2 and
- slot 0 is a pointer. */
-
-typedef void (*voidfuncptr) (void);
-
-struct Lisp_Save_Value
- {
- ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Save_Value */
- bool_bf gcmarkbit : 1;
- unsigned spacer : 32 - (16 + 1 + SAVE_TYPE_BITS);
-
- /* V->data may hold up to SAVE_VALUE_SLOTS entries. The type of
- V's data entries are determined by V->save_type. E.g., if
- V->save_type == SAVE_TYPE_PTR_OBJ, V->data[0] is a pointer,
- V->data[1] is an integer, and V's other data entries are unused.
-
- If V->save_type == SAVE_TYPE_MEMORY, V->data[0].pointer is the address of
- a memory area containing V->data[1].integer potential Lisp_Objects. */
- ENUM_BF (Lisp_Save_Type) save_type : SAVE_TYPE_BITS;
- union {
- void *pointer;
- voidfuncptr funcpointer;
- ptrdiff_t integer;
- Lisp_Object object;
- } data[SAVE_VALUE_SLOTS];
- };
-
-INLINE bool
-SAVE_VALUEP (Lisp_Object x)
-{
- return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value;
-}
-
-INLINE struct Lisp_Save_Value *
-XSAVE_VALUE (Lisp_Object a)
-{
- eassert (SAVE_VALUEP (a));
- return XUNTAG (a, Lisp_Misc, struct Lisp_Save_Value);
-}
-
-/* Return the type of V's Nth saved value. */
-INLINE int
-save_type (struct Lisp_Save_Value *v, int n)
-{
- eassert (0 <= n && n < SAVE_VALUE_SLOTS);
- return (v->save_type >> (SAVE_SLOT_BITS * n) & ((1 << SAVE_SLOT_BITS) - 1));
-}
-
-/* Get and set the Nth saved pointer. */
-
-INLINE void *
-XSAVE_POINTER (Lisp_Object obj, int n)
-{
- eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER);
- return XSAVE_VALUE (obj)->data[n].pointer;
-}
-INLINE void
-set_save_pointer (Lisp_Object obj, int n, void *val)
-{
- eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER);
- XSAVE_VALUE (obj)->data[n].pointer = val;
-}
-INLINE voidfuncptr
-XSAVE_FUNCPOINTER (Lisp_Object obj, int n)
-{
- eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_FUNCPOINTER);
- return XSAVE_VALUE (obj)->data[n].funcpointer;
-}
-
struct Lisp_Misc_Ptr
{
ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Ptr */
return XUNTAG (a, Lisp_Misc, struct Lisp_Misc_Ptr)->pointer;
}
-/* Get and set the Nth saved integer. */
-
-INLINE ptrdiff_t
-XSAVE_INTEGER (Lisp_Object obj, int n)
-{
- eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER);
- return XSAVE_VALUE (obj)->data[n].integer;
-}
-INLINE void
-set_save_integer (Lisp_Object obj, int n, ptrdiff_t val)
-{
- eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER);
- XSAVE_VALUE (obj)->data[n].integer = val;
-}
-
-/* Extract Nth saved object. */
-
-INLINE Lisp_Object
-XSAVE_OBJECT (Lisp_Object obj, int n)
-{
- eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_OBJECT);
- return XSAVE_VALUE (obj)->data[n].object;
-}
-
#ifdef HAVE_MODULES
struct Lisp_User_Ptr
{
struct Lisp_Free u_free;
struct Lisp_Marker u_marker;
struct Lisp_Overlay u_overlay;
- struct Lisp_Save_Value u_save_value;
struct Lisp_Finalizer u_finalizer;
struct Lisp_Misc_Ptr u_misc_ptr;
#ifdef HAVE_MODULES
/* Defined in alloc.c. */
extern void *my_heap_start (void);
extern void check_pure_size (void);
-extern void free_misc (Lisp_Object);
extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT);
extern void malloc_warning (const char *);
extern _Noreturn void memory_full (size_t);
extern Lisp_Object make_float (double);
extern void display_malloc_warning (void);
extern ptrdiff_t inhibit_garbage_collection (void);
-extern Lisp_Object make_save_int_int_int (ptrdiff_t, ptrdiff_t, ptrdiff_t);
-extern Lisp_Object make_save_obj_obj_obj_obj (Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object);
-extern Lisp_Object make_save_ptr (void *);
-extern Lisp_Object make_save_ptr_int (void *, ptrdiff_t);
-extern Lisp_Object make_save_ptr_ptr (void *, void *);
-extern Lisp_Object make_save_funcptr_ptr_obj (void (*) (void), void *,
- Lisp_Object);
-extern Lisp_Object make_save_memory (Lisp_Object *, ptrdiff_t);
-extern void free_save_value (Lisp_Object);
extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object);
extern void free_cons (struct Lisp_Cons *);
extern void init_alloc_once (void);
}
break;
- case Lisp_Misc_Save_Value:
- {
- int i;
- struct Lisp_Save_Value *v = XSAVE_VALUE (obj);
-
- print_c_string ("#<save-value ", printcharfun);
-
- if (v->save_type == SAVE_TYPE_MEMORY)
- {
- ptrdiff_t amount = v->data[1].integer;
-
- /* valid_lisp_object_p is reliable, so try to print up
- to 8 saved objects. This code is rarely used, so
- it's OK that valid_lisp_object_p is slow. */
-
- int limit = min (amount, 8);
- Lisp_Object *area = v->data[0].pointer;
-
- i = sprintf (buf, "with %"pD"d objects", amount);
- strout (buf, i, i, printcharfun);
-
- for (i = 0; i < limit; i++)
- {
- Lisp_Object maybe = area[i];
- int valid = valid_lisp_object_p (maybe);
-
- printchar (' ', printcharfun);
- if (0 < valid)
- print_object (maybe, printcharfun, escapeflag);
- else
- print_c_string (valid < 0 ? "<some>" : "<invalid>",
- printcharfun);
- }
- if (i == limit && i < amount)
- print_c_string (" ...", printcharfun);
- }
- else
- {
- /* Print each slot according to its type. */
- int index;
- for (index = 0; index < SAVE_VALUE_SLOTS; index++)
- {
- if (index)
- printchar (' ', printcharfun);
-
- switch (save_type (v, index))
- {
- case SAVE_UNUSED:
- i = sprintf (buf, "<unused>");
- break;
-
- case SAVE_POINTER:
- i = sprintf (buf, "<pointer %p>",
- v->data[index].pointer);
- break;
-
- case SAVE_FUNCPOINTER:
- i = sprintf (buf, "<funcpointer %p>",
- ((void *) (intptr_t)
- v->data[index].funcpointer));
- break;
-
- case SAVE_INTEGER:
- i = sprintf (buf, "<integer %"pD"d>",
- v->data[index].integer);
- break;
-
- case SAVE_OBJECT:
- print_object (v->data[index].object, printcharfun,
- escapeflag);
- continue;
-
- default:
- emacs_abort ();
- }
-
- strout (buf, i, i, printcharfun);
- }
- }
- printchar ('>', printcharfun);
- }
- break;
-
default:
goto badtype;
}
projects / emacs.git / commitdiff