Add new User Pointer (User_Ptr) type
* src/lisp.h: Add new Lisp_Misc_User_Ptr type. (XUSER_PTR): New User_Ptr accessor. * src/alloc.c (make_user_ptr): New function. (mark_object, sweep_misc): Handle Lisp_Misc_User_Ptr. * src/data.c (Ftype_of): Return 'user-ptr' for user pointer. (Fuser-ptrp): New user pointer type predicate function. (syms_of_data): New 'user-ptrp', 'user-ptr' symbol. New 'user-ptrp' subr. * src/print.c (print_object): Add printer for User_Ptr type.
This commit is contained in:
parent
435cf35bcc
commit
f69cd6bfa1
4 changed files with 115 additions and 1 deletions
32
src/alloc.c
32
src/alloc.c
|
@ -3711,6 +3711,23 @@ make_event_array (ptrdiff_t nargs, Lisp_Object *args)
|
|||
}
|
||||
}
|
||||
|
||||
#ifdef HAVE_MODULES
|
||||
/* Create a new module user ptr object. */
|
||||
Lisp_Object
|
||||
make_user_ptr (void (*finalizer) (void*), void *p)
|
||||
{
|
||||
Lisp_Object obj;
|
||||
struct Lisp_User_Ptr *uptr;
|
||||
|
||||
obj = allocate_misc (Lisp_Misc_User_Ptr);
|
||||
uptr = XUSER_PTR (obj);
|
||||
uptr->finalizer = finalizer;
|
||||
uptr->p = p;
|
||||
return obj;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
static void
|
||||
init_finalizer_list (struct Lisp_Finalizer *head)
|
||||
{
|
||||
|
@ -6301,6 +6318,12 @@ mark_object (Lisp_Object arg)
|
|||
mark_object (XFINALIZER (obj)->function);
|
||||
break;
|
||||
|
||||
#ifdef HAVE_MODULES
|
||||
case Lisp_Misc_User_Ptr:
|
||||
XMISCANY (obj)->gcmarkbit = true;
|
||||
break;
|
||||
#endif
|
||||
|
||||
default:
|
||||
emacs_abort ();
|
||||
}
|
||||
|
@ -6677,8 +6700,15 @@ sweep_misc (void)
|
|||
{
|
||||
if (mblk->markers[i].m.u_any.type == Lisp_Misc_Marker)
|
||||
unchain_marker (&mblk->markers[i].m.u_marker);
|
||||
if (mblk->markers[i].m.u_any.type == Lisp_Misc_Finalizer)
|
||||
else if (mblk->markers[i].m.u_any.type == Lisp_Misc_Finalizer)
|
||||
unchain_finalizer (&mblk->markers[i].m.u_finalizer);
|
||||
#ifdef HAVE_MODULES
|
||||
else if (mblk->markers[i].m.u_any.type == Lisp_Misc_User_Ptr)
|
||||
{
|
||||
struct Lisp_User_Ptr *uptr = &mblk->markers[i].m.u_user_ptr;
|
||||
uptr->finalizer (uptr->p);
|
||||
}
|
||||
#endif
|
||||
/* Set the type of the freed object to Lisp_Misc_Free.
|
||||
We could leave the type alone, since nobody checks it,
|
||||
but this might catch bugs faster. */
|
||||
|
|
24
src/data.c
24
src/data.c
|
@ -223,6 +223,10 @@ for example, (type-of 1) returns `integer'. */)
|
|||
return Qfloat;
|
||||
case Lisp_Misc_Finalizer:
|
||||
return Qfinalizer;
|
||||
#ifdef HAVE_MODULES
|
||||
case Lisp_Misc_User_Ptr:
|
||||
return Quser_ptr;
|
||||
#endif
|
||||
default:
|
||||
emacs_abort ();
|
||||
}
|
||||
|
@ -424,6 +428,17 @@ DEFUN ("markerp", Fmarkerp, Smarkerp, 1, 1, 0,
|
|||
return Qnil;
|
||||
}
|
||||
|
||||
#ifdef HAVE_MODULES
|
||||
DEFUN ("user-ptrp", Fuser_ptrp, Suser_ptrp, 1, 1, 0,
|
||||
doc: /* Return t if OBJECT is a module user pointer. */)
|
||||
(Lisp_Object object)
|
||||
{
|
||||
if (USER_PTRP (object))
|
||||
return Qt;
|
||||
return Qnil;
|
||||
}
|
||||
#endif
|
||||
|
||||
DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0,
|
||||
doc: /* Return t if OBJECT is a built-in function. */)
|
||||
(Lisp_Object object)
|
||||
|
@ -3478,6 +3493,9 @@ syms_of_data (void)
|
|||
DEFSYM (Qbool_vector_p, "bool-vector-p");
|
||||
DEFSYM (Qchar_or_string_p, "char-or-string-p");
|
||||
DEFSYM (Qmarkerp, "markerp");
|
||||
#ifdef HAVE_MODULES
|
||||
DEFSYM (Quser_ptrp, "user-ptrp");
|
||||
#endif
|
||||
DEFSYM (Qbuffer_or_string_p, "buffer-or-string-p");
|
||||
DEFSYM (Qinteger_or_marker_p, "integer-or-marker-p");
|
||||
DEFSYM (Qfboundp, "fboundp");
|
||||
|
@ -3569,6 +3587,9 @@ syms_of_data (void)
|
|||
DEFSYM (Qmarker, "marker");
|
||||
DEFSYM (Qoverlay, "overlay");
|
||||
DEFSYM (Qfinalizer, "finalizer");
|
||||
#ifdef HAVE_MODULES
|
||||
DEFSYM (Quser_ptr, "user-ptr");
|
||||
#endif
|
||||
DEFSYM (Qfloat, "float");
|
||||
DEFSYM (Qwindow_configuration, "window-configuration");
|
||||
DEFSYM (Qprocess, "process");
|
||||
|
@ -3683,6 +3704,9 @@ syms_of_data (void)
|
|||
defsubr (&Sbyteorder);
|
||||
defsubr (&Ssubr_arity);
|
||||
defsubr (&Ssubr_name);
|
||||
#ifdef HAVE_MODULES
|
||||
defsubr (&Suser_ptrp);
|
||||
#endif
|
||||
|
||||
defsubr (&Sbool_vector_exclusive_or);
|
||||
defsubr (&Sbool_vector_union);
|
||||
|
|
47
src/lisp.h
47
src/lisp.h
|
@ -468,6 +468,9 @@ enum Lisp_Misc_Type
|
|||
Lisp_Misc_Overlay,
|
||||
Lisp_Misc_Save_Value,
|
||||
Lisp_Misc_Finalizer,
|
||||
#ifdef HAVE_MODULES
|
||||
Lisp_Misc_User_Ptr,
|
||||
#endif
|
||||
/* Currently floats are not a misc type,
|
||||
but let's define this in case we want to change that. */
|
||||
Lisp_Misc_Float,
|
||||
|
@ -581,6 +584,12 @@ INLINE bool PROCESSP (Lisp_Object);
|
|||
INLINE bool PSEUDOVECTORP (Lisp_Object, int);
|
||||
INLINE bool SAVE_VALUEP (Lisp_Object);
|
||||
INLINE bool FINALIZERP (Lisp_Object);
|
||||
|
||||
#ifdef HAVE_MODULES
|
||||
INLINE bool USER_PTRP (Lisp_Object);
|
||||
INLINE struct Lisp_User_Ptr *(XUSER_PTR) (Lisp_Object);
|
||||
#endif
|
||||
|
||||
INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t,
|
||||
Lisp_Object);
|
||||
INLINE bool STRINGP (Lisp_Object);
|
||||
|
@ -2230,6 +2239,18 @@ XSAVE_OBJECT (Lisp_Object obj, int n)
|
|||
return XSAVE_VALUE (obj)->data[n].object;
|
||||
}
|
||||
|
||||
#ifdef HAVE_MODULES
|
||||
struct Lisp_User_Ptr
|
||||
{
|
||||
ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_User_Ptr */
|
||||
bool_bf gcmarkbit : 1;
|
||||
unsigned spacer : 15;
|
||||
|
||||
void (*finalizer) (void*);
|
||||
void *p;
|
||||
};
|
||||
#endif
|
||||
|
||||
/* A finalizer sentinel. */
|
||||
struct Lisp_Finalizer
|
||||
{
|
||||
|
@ -2265,6 +2286,9 @@ union Lisp_Misc
|
|||
struct Lisp_Overlay u_overlay;
|
||||
struct Lisp_Save_Value u_save_value;
|
||||
struct Lisp_Finalizer u_finalizer;
|
||||
#ifdef HAVE_MODULES
|
||||
struct Lisp_User_Ptr u_user_ptr;
|
||||
#endif
|
||||
};
|
||||
|
||||
INLINE union Lisp_Misc *
|
||||
|
@ -2314,6 +2338,16 @@ XFINALIZER (Lisp_Object a)
|
|||
return & XMISC (a)->u_finalizer;
|
||||
}
|
||||
|
||||
#ifdef HAVE_MODULES
|
||||
INLINE struct Lisp_User_Ptr *
|
||||
XUSER_PTR (Lisp_Object a)
|
||||
{
|
||||
eassert (USER_PTRP (a));
|
||||
return & XMISC (a)->u_user_ptr;
|
||||
}
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
/* Forwarding pointer to an int variable.
|
||||
This is allowed only in the value cell of a symbol,
|
||||
|
@ -2598,6 +2632,14 @@ FINALIZERP (Lisp_Object x)
|
|||
return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Finalizer;
|
||||
}
|
||||
|
||||
#ifdef HAVE_MODULES
|
||||
INLINE bool
|
||||
USER_PTRP (Lisp_Object x)
|
||||
{
|
||||
return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_User_Ptr;
|
||||
}
|
||||
#endif
|
||||
|
||||
INLINE bool
|
||||
AUTOLOADP (Lisp_Object x)
|
||||
{
|
||||
|
@ -3870,6 +3912,11 @@ Lisp_Object backtrace_top_function (void);
|
|||
extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol);
|
||||
extern bool let_shadows_global_binding_p (Lisp_Object symbol);
|
||||
|
||||
#ifdef HAVE_MODULES
|
||||
/* Defined in alloc.c. */
|
||||
extern Lisp_Object make_user_ptr (void (*finalizer) (void*), void *p);
|
||||
|
||||
#endif
|
||||
|
||||
/* Defined in editfns.c. */
|
||||
extern void insert1 (Lisp_Object);
|
||||
|
|
13
src/print.c
13
src/print.c
|
@ -1990,6 +1990,19 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
|
|||
printchar ('>', printcharfun);
|
||||
break;
|
||||
|
||||
#ifdef HAVE_MODULES
|
||||
case Lisp_Misc_User_Ptr:
|
||||
{
|
||||
print_c_string ("#<user-ptr ", printcharfun);
|
||||
int i = sprintf (buf, "ptr=%p finalizer=%p",
|
||||
XUSER_PTR (obj)->p,
|
||||
XUSER_PTR (obj)->finalizer);
|
||||
strout (buf, i, i, printcharfun);
|
||||
printchar ('>', printcharfun);
|
||||
break;
|
||||
}
|
||||
#endif
|
||||
|
||||
case Lisp_Misc_Finalizer:
|
||||
print_c_string ("#<finalizer", printcharfun);
|
||||
if (NILP (XFINALIZER (obj)->function))
|
||||
|
|
Loading…
Add table
Reference in a new issue