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.

1 files changed, 47 insertions, 0 deletions

diff --git a/src/lisp.h b/src/lisp.h
index cab912e7401..02c19690adf 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);