From f69cd6bfa114ea02f3d10ddb2fe809a26eafb9a4 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Aur=C3=A9lien=20Aptel?= Date: Mon, 16 Nov 2015 00:42:14 +0100 Subject: [PATCH] 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. --- src/alloc.c | 32 +++++++++++++++++++++++++++++++- src/data.c | 24 ++++++++++++++++++++++++ src/lisp.h | 47 +++++++++++++++++++++++++++++++++++++++++++++++ src/print.c | 13 +++++++++++++ 4 files changed, 115 insertions(+), 1 deletion(-) diff --git a/src/alloc.c b/src/alloc.c index bee7cd1758..48ce3f120f 100644 --- a/src/alloc.c +++ b/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. */ diff --git a/src/data.c b/src/data.c index 51546044c6..1e9cc814f0 100644 --- a/src/data.c +++ b/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); diff --git a/src/lisp.h b/src/lisp.h index cab912e740..02c19690ad 100644 --- a/src/lisp.h +++ b/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); diff --git a/src/print.c b/src/print.c index 6f868ceff8..420e6f55b4 100644 --- a/src/print.c +++ b/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 ("#p, + XUSER_PTR (obj)->finalizer); + strout (buf, i, i, printcharfun); + printchar ('>', printcharfun); + break; + } +#endif + case Lisp_Misc_Finalizer: print_c_string ("#function)) -- 2.39.2