[Emacs-diffs] master 30d393f 01/10: New mint_ptr representation for C pointers

[Paul Eggert]

branch: master
commit 30d393f9118035ec5d12917252bc4339c771a539
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>

    New mint_ptr representation for C pointers
    
    * src/lisp.h (make_mint_ptr, mint_ptrp, xmint_pointer): New functions.
    * src/dbusbind.c (xd_lisp_dbus_to_dbus, Fdbus__init_bus):
    * src/emacs-module.c (module_free_global_ref, Fmodule_load)
    (module_assert_runtime, module_assert_env, value_to_lisp)
    (lisp_to_value, initialize_environment)
    (finalize_environment, finalize_runtime_unwind)
    (mark_modules):
    * src/font.c (otf_open, font_put_frame_data)
    (font_get_frame_data):
    * src/macfont.m (macfont_invalidate_family_cache)
    (macfont_get_family_cache_if_present)
    (macfont_set_family_cache):
    * src/nsterm.h (XNS_SCROLL_BAR):
    * src/nsterm.m (ns_set_vertical_scroll_bar)
    (ns_set_horizontal_scroll_bar):
    * src/w32fns.c (w32_monitor_enum)
    (w32_display_monitor_attributes_list):
    * src/xterm.c (x_cr_destroy, x_cr_export_frames):
    * src/xwidget.c (webkit_javascript_finished_cb)
    (save_script_callback, Fxwidget_webkit_execute_script)
    (kill_buffer_xwidgets):
    Use mint pointers instead of merely save pointers.
---
 src/dbusbind.c     |  4 ++--
 src/emacs-module.c | 24 ++++++++++++------------
 src/font.c         | 10 +++++-----
 src/lisp.h         | 43 +++++++++++++++++++++++++++++++++++++++++--
 src/macfont.m      | 12 ++++++------
 src/nsterm.h       |  4 ++--
 src/nsterm.m       |  4 ++--
 src/w32fns.c       |  4 ++--
 src/xterm.c        |  4 ++--
 src/xwidget.c      |  8 ++++----
 10 files changed, 78 insertions(+), 39 deletions(-)

diff --git a/src/dbusbind.c b/src/dbusbind.c
index 4e0b99b..4ebea57 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -946,7 +946,7 @@ xd_get_connection_references (DBusConnection *connection)
 static DBusConnection *
 xd_lisp_dbus_to_dbus (Lisp_Object bus)
 {
-  return (DBusConnection *) XSAVE_POINTER (bus, 0);
+  return xmint_pointer (bus);
 }
 
 /* Return D-Bus connection address.  BUS is either a Lisp symbol,
@@ -1189,7 +1189,7 @@ this connection to those buses.  */)
        XD_SIGNAL1 (build_string ("Cannot add watch functions"));
 
       /* Add bus to list of registered buses.  */
-      val = make_save_ptr (connection);
+      val = make_mint_ptr (connection);
       xd_registered_buses = Fcons (Fcons (bus, val), xd_registered_buses);
 
       /* Cleanup.  */
diff --git a/src/emacs-module.c b/src/emacs-module.c
index c18c7ab..ff575ff 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -347,7 +347,7 @@ module_free_global_ref (emacs_env *env, emacs_value ref)
       for (Lisp_Object tail = global_env_private.values; CONSP (tail);
            tail = XCDR (tail))
         {
-          emacs_value global = XSAVE_POINTER (XCAR (globals), 0);
+          emacs_value global = xmint_pointer (XCAR (globals));
           if (global == ref)
             {
               if (NILP (prev))
@@ -735,7 +735,7 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
   rt->private_members = &rt_priv;
   rt->get_environment = module_get_environment;
 
-  Vmodule_runtimes = Fcons (make_save_ptr (rt), Vmodule_runtimes);
+  Vmodule_runtimes = Fcons (make_mint_ptr (rt), Vmodule_runtimes);
   ptrdiff_t count = SPECPDL_INDEX ();
   record_unwind_protect_ptr (finalize_runtime_unwind, rt);
 
@@ -830,7 +830,7 @@ module_assert_runtime (struct emacs_runtime *ert)
   ptrdiff_t count = 0;
   for (Lisp_Object tail = Vmodule_runtimes; CONSP (tail); tail = XCDR (tail))
     {
-      if (XSAVE_POINTER (XCAR (tail), 0) == ert)
+      if (xmint_pointer (XCAR (tail)) == ert)
         return;
       ++count;
     }
@@ -847,7 +847,7 @@ module_assert_env (emacs_env *env)
   for (Lisp_Object tail = Vmodule_environments; CONSP (tail);
        tail = XCDR (tail))
     {
-      if (XSAVE_POINTER (XCAR (tail), 0) == env)
+      if (xmint_pointer (XCAR (tail)) == env)
         return;
       ++count;
     }
@@ -959,11 +959,11 @@ value_to_lisp (emacs_value v)
       for (Lisp_Object environments = Vmodule_environments;
            CONSP (environments); environments = XCDR (environments))
         {
-          emacs_env *env = XSAVE_POINTER (XCAR (environments), 0);
+          emacs_env *env = xmint_pointer (XCAR (environments));
           for (Lisp_Object values = env->private_members->values;
                CONSP (values); values = XCDR (values))
             {
-              Lisp_Object *p = XSAVE_POINTER (XCAR (values), 0);
+              Lisp_Object *p = xmint_pointer (XCAR (values));
               if (p == optr)
                 return *p;
               ++num_values;
@@ -1021,7 +1021,7 @@ lisp_to_value (emacs_env *env, Lisp_Object o)
       void *vptr = optr;
       ATTRIBUTE_MAY_ALIAS emacs_value ret = vptr;
       struct emacs_env_private *priv = env->private_members;
-      priv->values = Fcons (make_save_ptr (ret), priv->values);
+      priv->values = Fcons (make_mint_ptr (ret), priv->values);
       return ret;
     }
 
@@ -1086,7 +1086,7 @@ initialize_environment (emacs_env *env, struct 
emacs_env_private *priv)
   env->vec_get = module_vec_get;
   env->vec_size = module_vec_size;
   env->should_quit = module_should_quit;
-  Vmodule_environments = Fcons (make_save_ptr (env), Vmodule_environments);
+  Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments);
   return env;
 }
 
@@ -1095,7 +1095,7 @@ initialize_environment (emacs_env *env, struct 
emacs_env_private *priv)
 static void
 finalize_environment (emacs_env *env)
 {
-  eassert (XSAVE_POINTER (XCAR (Vmodule_environments), 0) == env);
+  eassert (xmint_pointer (XCAR (Vmodule_environments)) == env);
   Vmodule_environments = XCDR (Vmodule_environments);
   if (module_assertions)
     /* There is always at least the global environment.  */
@@ -1109,10 +1109,10 @@ finalize_environment_unwind (void *env)
 }
 
 static void
-finalize_runtime_unwind (void* raw_ert)
+finalize_runtime_unwind (void *raw_ert)
 {
   struct emacs_runtime *ert = raw_ert;
-  eassert (XSAVE_POINTER (XCAR (Vmodule_runtimes), 0) == ert);
+  eassert (xmint_pointer (XCAR (Vmodule_runtimes)) == ert);
   Vmodule_runtimes = XCDR (Vmodule_runtimes);
   finalize_environment (ert->private_members->env);
 }
@@ -1123,7 +1123,7 @@ mark_modules (void)
   for (Lisp_Object tail = Vmodule_environments; CONSP (tail);
        tail = XCDR (tail))
     {
-      emacs_env *env = XSAVE_POINTER (XCAR (tail), 0);
+      emacs_env *env = xmint_pointer (XCAR (tail));
       struct emacs_env_private *priv = env->private_members;
       mark_object (priv->non_local_exit_symbol);
       mark_object (priv->non_local_exit_data);
diff --git a/src/font.c b/src/font.c
index 3800869..3a82e50 100644
--- a/src/font.c
+++ b/src/font.c
@@ -1897,11 +1897,11 @@ otf_open (Lisp_Object file)
   OTF *otf;
 
   if (! NILP (val))
-    otf = XSAVE_POINTER (XCDR (val), 0);
+    otf = xmint_pointer (XCDR (val));
   else
     {
       otf = STRINGP (file) ? OTF_open (SSDATA (file)) : NULL;
-      val = make_save_ptr (otf);
+      val = make_mint_ptr (otf);
       otf_list = Fcons (Fcons (file, val), otf_list);
     }
   return otf;
@@ -3632,10 +3632,10 @@ font_put_frame_data (struct frame *f, Lisp_Object 
driver, void *data)
   else
     {
       if (NILP (val))
-       fset_font_data (f, Fcons (Fcons (driver, make_save_ptr (data)),
+       fset_font_data (f, Fcons (Fcons (driver, make_mint_ptr (data)),
                                  f->font_data));
       else
-       XSETCDR (val, make_save_ptr (data));
+       XSETCDR (val, make_mint_ptr (data));
     }
 }
 
@@ -3644,7 +3644,7 @@ font_get_frame_data (struct frame *f, Lisp_Object driver)
 {
   Lisp_Object val = assq_no_quit (driver, f->font_data);
 
-  return NILP (val) ? NULL : XSAVE_POINTER (XCDR (val), 0);
+  return NILP (val) ? NULL : xmint_pointer (XCDR (val));
 }
 
 #endif /* HAVE_XFT || HAVE_FREETYPE */
diff --git a/src/lisp.h b/src/lisp.h
index aaad90b..b7e5d9e 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2494,7 +2494,47 @@ XSAVE_FUNCPOINTER (Lisp_Object obj, int n)
   return XSAVE_VALUE (obj)->data[n].funcpointer;
 }
 
-/* Likewise for the saved integer.  */
+extern Lisp_Object make_save_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.
+
+   mint_ptr objects are efficiency hacks intended for C code.
+   Although xmint_ptr can be given any mint_ptr generated by non-buggy
+   C code, it should not be given a mint_ptr generated from Lisp code
+   as that would allow Lisp code to coin pointers from integers and
+   could lead to crashes.  To package a C pointer into a Lisp-visible
+   object you can put the pointer into a Lisp_Misc object instead; see
+   Lisp_User_Ptr for an example.  */
+
+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);
+}
+
+INLINE bool
+mint_ptrp (Lisp_Object x)
+{
+  return (INTEGERP (x)
+         || (SAVE_VALUEP (x) && XSAVE_VALUE (x)->save_type == SAVE_POINTER));
+}
+
+INLINE void *
+xmint_pointer (Lisp_Object a)
+{
+  eassert (mint_ptrp (a));
+  if (INTEGERP (a))
+    return XINTPTR (a);
+  return XSAVE_POINTER (a, 0);
+}
+
+/* Get and set the Nth saved integer.  */
 
 INLINE ptrdiff_t
 XSAVE_INTEGER (Lisp_Object obj, int n)
@@ -3801,7 +3841,6 @@ 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 *,
diff --git a/src/macfont.m b/src/macfont.m
index 817071f..3b14a89 100644
--- a/src/macfont.m
+++ b/src/macfont.m
@@ -943,8 +943,8 @@ macfont_invalidate_family_cache (void)
          {
            Lisp_Object value = HASH_VALUE (h, i);
 
-           if (SAVE_VALUEP (value))
-             CFRelease (XSAVE_POINTER (value, 0));
+           if (mint_ptrp (value))
+             CFRelease (xmint_pointer (value));
          }
       macfont_family_cache = Qnil;
     }
@@ -962,7 +962,7 @@ macfont_get_family_cache_if_present (Lisp_Object symbol, 
CFStringRef *string)
        {
          Lisp_Object value = HASH_VALUE (h, i);
 
-         *string = SAVE_VALUEP (value) ? XSAVE_POINTER (value, 0) : NULL;
+         *string = mint_ptrp (value) ? xmint_pointer (value) : NULL;
 
          return true;
        }
@@ -984,13 +984,13 @@ macfont_set_family_cache (Lisp_Object symbol, CFStringRef 
string)
 
   h = XHASH_TABLE (macfont_family_cache);
   i = hash_lookup (h, symbol, &hash);
-  value = string ? make_save_ptr ((void *) CFRetain (string)) : Qnil;
+  value = string ? make_mint_ptr (CFRetain (string)) : Qnil;
   if (i >= 0)
     {
       Lisp_Object old_value = HASH_VALUE (h, i);
 
-      if (SAVE_VALUEP (old_value))
-       CFRelease (XSAVE_POINTER (old_value, 0));
+      if (mint_ptrp (old_value))
+       CFRelease (xmint_pointer (old_value));
       set_hash_value_slot (h, i, value);
     }
   else
diff --git a/src/nsterm.h b/src/nsterm.h
index a99b517..23460ab 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -1019,9 +1019,9 @@ struct x_output
 #define FRAME_FONT(f) ((f)->output_data.ns->font)
 
 #ifdef __OBJC__
-#define XNS_SCROLL_BAR(vec) ((id) XSAVE_POINTER (vec, 0))
+#define XNS_SCROLL_BAR(vec) ((id) xmint_pointer (vec))
 #else
-#define XNS_SCROLL_BAR(vec) XSAVE_POINTER (vec, 0)
+#define XNS_SCROLL_BAR(vec) xmint_pointer (vec)
 #endif
 
 /* Compute pixel height of the frame's titlebar.  */
diff --git a/src/nsterm.m b/src/nsterm.m
index c0d2d91..f0e6790 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -4819,7 +4819,7 @@ ns_set_vertical_scroll_bar (struct window *window,
        ns_clear_frame_area (f, left, top, width, height);
 
       bar = [[EmacsScroller alloc] initFrame: r window: win];
-      wset_vertical_scroll_bar (window, make_save_ptr (bar));
+      wset_vertical_scroll_bar (window, make_mint_ptr (bar));
       update_p = YES;
     }
   else
@@ -4898,7 +4898,7 @@ ns_set_horizontal_scroll_bar (struct window *window,
        ns_clear_frame_area (f, left, top, width, height);
 
       bar = [[EmacsScroller alloc] initFrame: r window: win];
-      wset_horizontal_scroll_bar (window, make_save_ptr (bar));
+      wset_horizontal_scroll_bar (window, make_mint_ptr (bar));
       update_p = YES;
     }
   else
diff --git a/src/w32fns.c b/src/w32fns.c
index 2cb715a..3bd3209 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -6296,7 +6296,7 @@ w32_monitor_enum (HMONITOR monitor, HDC hdc, RECT 
*rcMonitor, LPARAM dwData)
 {
   Lisp_Object *monitor_list = (Lisp_Object *) dwData;
 
-  *monitor_list = Fcons (make_save_ptr (monitor), *monitor_list);
+  *monitor_list = Fcons (make_mint_ptr (monitor), *monitor_list);
 
   return TRUE;
 }
@@ -6325,7 +6325,7 @@ w32_display_monitor_attributes_list (void)
   monitors = xmalloc (n_monitors * sizeof (*monitors));
   for (i = 0; i < n_monitors; i++)
     {
-      monitors[i] = XSAVE_POINTER (XCAR (monitor_list), 0);
+      monitors[i] = xmint_pointer (XCAR (monitor_list));
       monitor_list = XCDR (monitor_list);
     }
 
diff --git a/src/xterm.c b/src/xterm.c
index decaa33..00ca18c 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -546,7 +546,7 @@ x_cr_accumulate_data (void *closure, const unsigned char 
*data,
 static void
 x_cr_destroy (Lisp_Object arg)
 {
-  cairo_t *cr = (cairo_t *) XSAVE_POINTER (arg, 0);
+  cairo_t *cr = xmint_pointer (arg);
 
   block_input ();
   cairo_destroy (cr);
@@ -606,7 +606,7 @@ x_cr_export_frames (Lisp_Object frames, 
cairo_surface_type_t surface_type)
 
   cr = cairo_create (surface);
   cairo_surface_destroy (surface);
-  record_unwind_protect (x_cr_destroy, make_save_ptr (cr));
+  record_unwind_protect (x_cr_destroy, make_mint_ptr (cr));
 
   while (1)
     {
diff --git a/src/xwidget.c b/src/xwidget.c
index 5f26512..2a53966 100644
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -374,7 +374,7 @@ webkit_javascript_finished_cb (GObject      *webview,
     Lisp_Object script_callback = AREF (xw->script_callbacks, script_idx);
     ASET (xw->script_callbacks, script_idx, Qnil);
     if (!NILP (script_callback))
-      xfree (XSAVE_POINTER (XCAR (script_callback), 0));
+      xfree (xmint_pointer (XCAR (script_callback)));
 
     js_result = webkit_web_view_run_javascript_finish
       (WEBKIT_WEB_VIEW (webview), result, &error);
@@ -724,7 +724,7 @@ save_script_callback (struct xwidget *xw, Lisp_Object 
script, Lisp_Object fun)
        break;
       }
 
-  ASET (cbs, idx, Fcons (make_save_ptr (xlispstrdup (script)), fun));
+  ASET (cbs, idx, Fcons (make_mint_ptr (xlispstrdup (script)), fun));
   return idx;
 }
 
@@ -750,7 +750,7 @@ argument procedure FUN.*/)
      callback function is provided we pass it to the C callback
      procedure that retrieves the return value.  */
   gchar *script_string
-    = XSAVE_POINTER (XCAR (AREF (xw->script_callbacks, idx)), 0);
+    = xmint_pointer (XCAR (AREF (xw->script_callbacks, idx)));
   webkit_web_view_run_javascript (WEBKIT_WEB_VIEW (xw->widget_osr),
                                  script_string,
                                   NULL, /* cancelable */
@@ -1227,7 +1227,7 @@ kill_buffer_xwidgets (Lisp_Object buffer)
            {
              Lisp_Object cb = AREF (xw->script_callbacks, idx);
              if (!NILP (cb))
-               xfree (XSAVE_POINTER (XCAR (cb), 0));
+               xfree (xmint_pointer (XCAR (cb)));
              ASET (xw->script_callbacks, idx, Qnil);
            }
       }