Commit f8ad6b31 authored by Paul Eggert's avatar Paul Eggert

New type Lisp_Misc_Ptr

This is a streamlined version of Lisp_Save_Value, which contains just
a pointer, as that is all Lisp_Save_Values are used for any more.
With the previous changes, these objects are not primarily used as
save values, so just call them "Misc" rather than "Save".
* src/alloc.c (make_misc_ptr): New function.
(mark_object): Mark Lisp_Misc_Ptr too.
* src/lisp.h (Lisp_Misc_Ptr): New constant.
(struct Lisp_Misc_Ptr): New type.
(make_mint_ptr, mint_ptrp, xmint_pointer):
Use Lisp_Misc_Ptr, not Lisp_Save_Value.
(union Lisp_Misc): Add Lisp_Misc_Ptr.
* src/print.c (print_object): Print Lisp_Misc_Ptr.
parent d98670eb
......@@ -3827,6 +3827,14 @@ free_save_value (Lisp_Object save)
free_misc (save);
}
Lisp_Object
make_misc_ptr (void *a)
{
Lisp_Object val = allocate_misc (Lisp_Misc_Ptr);
XUNTAG (val, Lisp_Misc, struct Lisp_Misc_Ptr)->pointer = a;
return val;
}
/* Return a Lisp_Misc_Overlay object with specified START, END and PLIST. */
Lisp_Object
......@@ -6692,6 +6700,10 @@ mark_object (Lisp_Object arg)
mark_save_value (XSAVE_VALUE (obj));
break;
case Lisp_Misc_Ptr:
XMISCANY (obj)->gcmarkbit = true;
break;
case Lisp_Misc_Overlay:
mark_overlay (XOVERLAY (obj));
break;
......
......@@ -613,7 +613,7 @@ struct font_driver
(symbols). */
Lisp_Object (*list_family) (struct frame *f);
/* Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value).
/* Optional.
Free FONT_EXTRA_INDEX field of FONT_ENTITY. */
void (*free_entity) (Lisp_Object font_entity);
......
......@@ -513,6 +513,7 @@ enum Lisp_Misc_Type
Lisp_Misc_Overlay,
Lisp_Misc_Save_Value,
Lisp_Misc_Finalizer,
Lisp_Misc_Ptr,
#ifdef HAVE_MODULES
Lisp_Misc_User_Ptr,
#endif
......@@ -539,10 +540,11 @@ enum Lisp_Fwd_Type
First, there are already a couple of Lisp types that can be used if
your new type does not need to be exposed to Lisp programs nor
displayed to users. These are Lisp_Save_Value, a Lisp_Misc
displayed to users. These are Lisp_Misc_Ptr, a Lisp_Misc
subtype; and PVEC_OTHER, a kind of vectorlike object. The former
is suitable for temporarily stashing away pointers and integers in
a Lisp object. The latter is useful for vector-like Lisp objects
is suitable for stashing a pointer in a Lisp object; the pointer
might be to some low-level C object that contains auxiliary
information. The latter is useful for vector-like Lisp objects
that need to be used as part of other objects, but which are never
shown to users or Lisp code (search for PVEC_OTHER in xterm.c for
an example).
......@@ -2494,14 +2496,22 @@ XSAVE_FUNCPOINTER (Lisp_Object obj, int n)
return XSAVE_VALUE (obj)->data[n].funcpointer;
}
extern Lisp_Object make_save_ptr (void *);
struct Lisp_Misc_Ptr
{
ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Ptr */
bool_bf gcmarkbit : 1;
unsigned spacer : 15;
void *pointer;
};
extern Lisp_Object make_misc_ptr (void *);
/* A mint_ptr object OBJ represents a C-language pointer P efficiently.
Preferably (and typically), OBJ is a Lisp integer I such that
XINTPTR (I) == P, as this represents P within a single Lisp value
without requiring any auxiliary memory. However, if P would be
damaged by being tagged as an integer and then untagged via
XINTPTR, then OBJ is a Lisp_Save_Value with pointer component P.
XINTPTR, then OBJ is a Lisp_Misc_Ptr with pointer component P.
mint_ptr objects are efficiency hacks intended for C code.
Although xmint_ptr can be given any mint_ptr generated by non-buggy
......@@ -2515,14 +2525,13 @@ INLINE Lisp_Object
make_mint_ptr (void *a)
{
Lisp_Object val = TAG_PTR (Lisp_Int0, a);
return INTEGERP (val) && XINTPTR (val) == a ? val : make_save_ptr (a);
return INTEGERP (val) && XINTPTR (val) == a ? val : make_misc_ptr (a);
}
INLINE bool
mint_ptrp (Lisp_Object x)
{
return (INTEGERP (x)
|| (SAVE_VALUEP (x) && XSAVE_VALUE (x)->save_type == SAVE_POINTER));
return INTEGERP (x) || (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Ptr);
}
INLINE void *
......@@ -2531,7 +2540,7 @@ xmint_pointer (Lisp_Object a)
eassert (mint_ptrp (a));
if (INTEGERP (a))
return XINTPTR (a);
return XSAVE_POINTER (a, 0);
return XUNTAG (a, Lisp_Misc, struct Lisp_Misc_Ptr)->pointer;
}
/* Get and set the Nth saved integer. */
......@@ -2618,6 +2627,7 @@ union Lisp_Misc
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
struct Lisp_User_Ptr u_user_ptr;
#endif
......@@ -3855,6 +3865,7 @@ 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 *,
......
......@@ -2178,6 +2178,13 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
print_c_string ("#<misc free cell>", printcharfun);
break;
case Lisp_Misc_Ptr:
{
int i = sprintf (buf, "#<ptr %p>", xmint_pointer (obj));
strout (buf, i, i, printcharfun);
}
break;
case Lisp_Misc_Save_Value:
{
int i;
......
......@@ -718,7 +718,7 @@ w32font_draw (struct glyph_string *s, int from, int to,
}
/* w32 implementation of free_entity for font backend.
Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value).
Optional.
Free FONT_EXTRA_INDEX field of FONT_ENTITY.
static void
w32font_free_entity (Lisp_Object entity);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment