From: Paul Eggert Date: Thu, 14 Jun 2018 22:59:08 +0000 (-0700) Subject: New mint_ptr representation for C pointers X-Git-Tag: emacs-27.0.90~4862 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=30d393f9118035ec5d12917252bc4339c771a539;p=emacs.git 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. --- diff --git a/src/dbusbind.c b/src/dbusbind.c index 4e0b99bea9d..4ebea5712a8 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 c18c7ab308b..ff575ff44df 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 3800869c5b3..3a82e501a84 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 aaad90b2dad..b7e5d9e3761 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 817071fa44f..3b14a89c5cc 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 a99b517fd5e..23460abc659 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 c0d2d91fde8..f0e6790e99e 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 2cb715a356d..3bd320928dd 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 decaa33670b..00ca18c2a96 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 5f2651214e3..2a53966ef43 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); } }