emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] emacs-25 f69cd6b 3/6: Add new User Pointer (User_Ptr) type


From: Teodor Zlatanov
Subject: [Emacs-diffs] emacs-25 f69cd6b 3/6: Add new User Pointer (User_Ptr) type
Date: Wed, 18 Nov 2015 19:25:17 +0000

branch: emacs-25
commit f69cd6bfa114ea02f3d10ddb2fe809a26eafb9a4
Author: Aurélien Aptel <address@hidden>
Commit: Ted Zlatanov <address@hidden>

    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 deletions(-)

diff --git a/src/alloc.c b/src/alloc.c
index bee7cd1..48ce3f1 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 5154604..1e9cc81 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 cab912e..02c1969 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 6f868ce..420e6f5 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 ("#<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))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]