From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Paul Eggert Newsgroups: gmane.emacs.bugs Subject: bug#31750: simplify and tune Emacs stack-related allocation Date: Thu, 7 Jun 2018 19:27:52 -0700 Organization: UCLA Computer Science Department Message-ID: <9aeda5fe-dc7c-30d5-39df-2942410a672b@cs.ucla.edu> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------B40C27BDEAB1819D77DB6E41" X-Trace: blaine.gmane.org 1528424841 8300 195.159.176.226 (8 Jun 2018 02:27:21 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Fri, 8 Jun 2018 02:27:21 +0000 (UTC) User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:52.0) Gecko/20100101 Thunderbird/52.8.0 To: 31750@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Fri Jun 08 04:27:16 2018 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fR77S-000209-TZ for geb-bug-gnu-emacs@m.gmane.org; Fri, 08 Jun 2018 04:27:16 +0200 Original-Received: from localhost ([::1]:60966 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fR79Y-0006QN-9a for geb-bug-gnu-emacs@m.gmane.org; Thu, 07 Jun 2018 22:29:24 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:40117) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fR79K-0006QC-7u for bug-gnu-emacs@gnu.org; Thu, 07 Jun 2018 22:29:17 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fR79C-0000sz-Kc for bug-gnu-emacs@gnu.org; Thu, 07 Jun 2018 22:29:10 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:58903) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1fR79C-0000sG-7a for bug-gnu-emacs@gnu.org; Thu, 07 Jun 2018 22:29:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1fR79B-0005OI-Uv for bug-gnu-emacs@gnu.org; Thu, 07 Jun 2018 22:29:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Paul Eggert Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 08 Jun 2018 02:29:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 31750 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: X-Debbugs-Original-To: Emacs bugs Original-Received: via spool by submit@debbugs.gnu.org id=B.152842491320685 (code B ref -1); Fri, 08 Jun 2018 02:29:01 +0000 Original-Received: (at submit) by debbugs.gnu.org; 8 Jun 2018 02:28:33 +0000 Original-Received: from localhost ([127.0.0.1]:38567 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fR78h-0005NX-Ea for submit@debbugs.gnu.org; Thu, 07 Jun 2018 22:28:33 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:48749) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fR78d-0005NF-1R for submit@debbugs.gnu.org; Thu, 07 Jun 2018 22:28:29 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fR78Q-0008A4-V5 for submit@debbugs.gnu.org; Thu, 07 Jun 2018 22:28:21 -0400 Original-Received: from lists.gnu.org ([2001:4830:134:3::11]:33183) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1fR78Q-00089A-EU for submit@debbugs.gnu.org; Thu, 07 Jun 2018 22:28:14 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:39596) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fR78I-0006NR-TH for bug-gnu-emacs@gnu.org; Thu, 07 Jun 2018 22:28:14 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fR78C-0007jO-Lg for bug-gnu-emacs@gnu.org; Thu, 07 Jun 2018 22:28:06 -0400 Original-Received: from zimbra.cs.ucla.edu ([131.179.128.68]:32892) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1fR78B-0007fZ-7Z for bug-gnu-emacs@gnu.org; Thu, 07 Jun 2018 22:28:00 -0400 Original-Received: from localhost (localhost [127.0.0.1]) by zimbra.cs.ucla.edu (Postfix) with ESMTP id 24BD3160612 for ; Thu, 7 Jun 2018 19:27:57 -0700 (PDT) Original-Received: from zimbra.cs.ucla.edu ([127.0.0.1]) by localhost (zimbra.cs.ucla.edu [127.0.0.1]) (amavisd-new, port 10032) with ESMTP id f72tN5S3H-JD for ; Thu, 7 Jun 2018 19:27:52 -0700 (PDT) Original-Received: from localhost (localhost [127.0.0.1]) by zimbra.cs.ucla.edu (Postfix) with ESMTP id 8B04E160632 for ; Thu, 7 Jun 2018 19:27:52 -0700 (PDT) X-Virus-Scanned: amavisd-new at zimbra.cs.ucla.edu Original-Received: from zimbra.cs.ucla.edu ([127.0.0.1]) by localhost (zimbra.cs.ucla.edu [127.0.0.1]) (amavisd-new, port 10026) with ESMTP id 3C_flWVsLfzJ for ; Thu, 7 Jun 2018 19:27:52 -0700 (PDT) Original-Received: from Penguin.CS.UCLA.EDU (Penguin.CS.UCLA.EDU [131.179.64.200]) by zimbra.cs.ucla.edu (Postfix) with ESMTPSA id 4BAEB160612 for ; Thu, 7 Jun 2018 19:27:52 -0700 (PDT) Openpgp: preference=signencrypt Autocrypt: addr=eggert@cs.ucla.edu; prefer-encrypt=mutual; keydata= xsFNBEyAcmQBEADAAyH2xoTu7ppG5D3a8FMZEon74dCvc4+q1XA2J2tBy2pwaTqfhpxxdGA9 Jj50UJ3PD4bSUEgN8tLZ0san47l5XTAFLi2456ciSl5m8sKaHlGdt9XmAAtmXqeZVIYX/UFS 96fDzf4xhEmm/y7LbYEPQdUdxu47xA5KhTYp5bltF3WYDz1Ygd7gx07Auwp7iw7eNvnoDTAl KAl8KYDZzbDNCQGEbpY3efZIvPdeI+FWQN4W+kghy+P6au6PrIIhYraeua7XDdb2LS1en3Ss mE3QjqfRqI/A2ue8JMwsvXe/WK38Ezs6x74iTaqI3AFH6ilAhDqpMnd/msSESNFt76DiO1ZK QMr9amVPknjfPmJISqdhgB1DlEdw34sROf6V8mZw0xfqT6PKE46LcFefzs0kbg4GORf8vjG2 Sf1tk5eU8MBiyN/bZ03bKNjNYMpODDQQwuP84kYLkX2wBxxMAhBxwbDVZudzxDZJ1C2VXujC OJVxq2kljBM9ETYuUGqd75AW2LXrLw6+MuIsHFAYAgRr7+KcwDgBAfwhPBYX34nSSiHlmLC+ KaHLeCLF5ZI2vKm3HEeCTtlOg7xZEONgwzL+fdKo+D6SoC8RRxJKs8a3sVfI4t6CnrQzvJbB n6gxdgCu5i29J1QCYrCYvql2UyFPAK+do99/1jOXT4m2836j1wARAQABzSBQYXVsIEVnZ2Vy dCA8ZWdnZXJ0QGNzLnVjbGEuZWR1PsLBfgQTAQIAKAUCTIByZAIbAwUJEswDAAYLCQgHAwIG FQgCCQoLBBYCAwECH Content-Language: en-US X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x [fuzzy] X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:147157 Archived-At: This is a multi-part message in MIME format. --------------B40C27BDEAB1819D77DB6E41 Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit While looking into the Emacs garbage collector's stack-overflow problems I noticed several opportunities for improving performance and simplifying the code in minor ways. I plan to install the attached patches to take advantage of these opportunities; although they don't address stack overflow, they can be thought of as a first, cleanup step toward addressing stack overflow. Overall these patches trim about 250 lines from the C source code, and should improve efficiency by not creating objects on the heap to handle stack-related events such as implementing save-excursion. This patch also removes primitives like 'free_misc' that ask for trouble by second-guessing the garbage collector. I'm filing this as a bug report in order to give the patches a bit of time to cool before installing. Comments welcome, as usual. --------------B40C27BDEAB1819D77DB6E41 Content-Type: text/x-patch; name="0001-New-mint_ptr-representation-for-C-pointers.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="0001-New-mint_ptr-representation-for-C-pointers.patch" >From 20fa8fafae0ca11d0811d452b7b7df7781c7a6b7 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 7 Jun 2018 19:12:27 -0700 Subject: [PATCH 01/10] 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 | 36 ++++++++++++++++++++++++++++++++++-- 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, 71 insertions(+), 39 deletions(-) diff --git a/src/dbusbind.c b/src/dbusbind.c index ec3707d18f..71272d37d7 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -944,7 +944,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, @@ -1187,7 +1187,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 956706cf9f..9c2de13d53 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 305bb14576..743036fd4d 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 10012b29db..25ddea7bb7 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2502,7 +2502,40 @@ 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 pointer P. OBJ is preferably a + Lisp integer I such that XINTPTR (i) == P, as this is more efficient. + 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. C code should never blindly accept a mint_ptr + object from Lisp code, as that would allow Lisp code to coin + pointers from integers and could lead to crashes. */ + +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) @@ -3809,7 +3842,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 817071fa44..3b14a89c5c 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -943,8 +943,8 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char, { 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 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char, { 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 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char, 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 a99b517fd5..23460abc65 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 c0d2d91fde..f0e6790e99 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -4819,7 +4819,7 @@ in certain situations (rapid incoming events). 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 @@ in certain situations (rapid incoming events). 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 5d1c3c84c6..0dabd747a2 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 eb299c3675..86d6068539 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 5f2651214e..2a53966ef4 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); } } -- 2.17.1 --------------B40C27BDEAB1819D77DB6E41 Content-Type: text/x-patch; name="0002-Simplify-init_module_assertions.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="0002-Simplify-init_module_assertions.patch" >From dc732f73d02c0dc7fdf1e6c2e23993699c2e0b57 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 7 Jun 2018 19:12:27 -0700 Subject: [PATCH 02/10] Simplify init_module_assertions * src/emacs-module.c (init_module_assertions): Just use NULL instead of allocating a dummy on the stack and then using eassert. Practical platforms check for null pointer dereferencing nowadays, so this is good enough. --- src/emacs-module.c | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/emacs-module.c b/src/emacs-module.c index 9c2de13d53..9ecc08e54b 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -1172,9 +1172,7 @@ init_module_assertions (bool enable) { /* We use a hidden environment for storing the globals. This environment is never freed. */ - emacs_env env; - global_env = initialize_environment (&env, &global_env_private); - eassert (global_env != &env); + global_env = initialize_environment (NULL, &global_env_private); } } -- 2.17.1 --------------B40C27BDEAB1819D77DB6E41 Content-Type: text/x-patch; name="0003-Avoid-Lisp_Misc-allocation-if-C-stack-suffices.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename*0="0003-Avoid-Lisp_Misc-allocation-if-C-stack-suffices.patch" >From f9e3085864ac6ebc799dd37b36097cb83bc9fd05 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 7 Jun 2018 19:12:27 -0700 Subject: [PATCH 03/10] Avoid Lisp_Misc allocation if C stack suffices * src/fileio.c (union read_non_regular): New type. (read_non_regular, Finsert_file_contents): Use it to avoid allocating a Lisp_Misc. * src/keymap.c (union map_keymap): New type. (map_keymap_char_table_item, map_keymap_internal): Use it to avoid allocating a Lisp_Misc. --- src/fileio.c | 28 +++++++++++++++++----------- src/keymap.c | 25 ++++++++++++++++++------- 2 files changed, 35 insertions(+), 18 deletions(-) diff --git a/src/fileio.c b/src/fileio.c index e8d966e163..89c5a14547 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -3365,20 +3365,26 @@ decide_coding_unwind (Lisp_Object unwind_data) bset_undo_list (current_buffer, undo_list); } -/* Read from a non-regular file. STATE is a Lisp_Save_Value - object where slot 0 is the file descriptor, slot 1 specifies - an offset to put the read bytes, and slot 2 is the maximum - amount of bytes to read. Value is the number of bytes read. */ +/* Read from a non-regular file. Return the number of bytes read. */ + +union read_non_regular +{ + struct + { + int fd; + ptrdiff_t inserted, trytry; + } s; + GCALIGNED_UNION +}; static Lisp_Object read_non_regular (Lisp_Object state) { - int nbytes = emacs_read_quit (XSAVE_INTEGER (state, 0), + union read_non_regular *data = XINTPTR (state); + int nbytes = emacs_read_quit (data->s.fd, ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE - + XSAVE_INTEGER (state, 1)), - XSAVE_INTEGER (state, 2)); - /* Fast recycle this object for the likely next call. */ - free_misc (state); + + data->s.inserted), + data->s.trytry); return make_number (nbytes); } @@ -4233,9 +4239,9 @@ by calling `format-decode', which see. */) /* Read from the file, capturing `quit'. When an error occurs, end the loop, and arrange for a quit to be signaled after decoding the text we read. */ + union read_non_regular data = {{fd, inserted, trytry}}; nbytes = internal_condition_case_1 - (read_non_regular, - make_save_int_int_int (fd, inserted, trytry), + (read_non_regular, make_pointer_integer (&data), Qerror, read_non_regular_quit); if (NILP (nbytes)) diff --git a/src/keymap.c b/src/keymap.c index c8cc933e78..32ee22759d 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -546,19 +546,28 @@ map_keymap_item (map_keymap_function_t fun, Lisp_Object args, Lisp_Object key, L (*fun) (key, val, args, data); } +union map_keymap +{ + struct + { + map_keymap_function_t fun; + Lisp_Object args; + void *data; + } s; + GCALIGNED_UNION +}; + static void map_keymap_char_table_item (Lisp_Object args, Lisp_Object key, Lisp_Object val) { if (!NILP (val)) { - map_keymap_function_t fun - = (map_keymap_function_t) XSAVE_FUNCPOINTER (args, 0); /* If the key is a range, make a copy since map_char_table modifies it in place. */ if (CONSP (key)) key = Fcons (XCAR (key), XCDR (key)); - map_keymap_item (fun, XSAVE_OBJECT (args, 2), key, - val, XSAVE_POINTER (args, 1)); + union map_keymap *md = XINTPTR (args); + map_keymap_item (md->s.fun, md->s.args, key, val, md->s.data); } } @@ -594,9 +603,11 @@ map_keymap_internal (Lisp_Object map, } } else if (CHAR_TABLE_P (binding)) - map_char_table (map_keymap_char_table_item, Qnil, binding, - make_save_funcptr_ptr_obj ((voidfuncptr) fun, data, - args)); + { + union map_keymap mapdata = {{fun, args, data}}; + map_char_table (map_keymap_char_table_item, Qnil, binding, + make_pointer_integer (&mapdata)); + } } return tail; -- 2.17.1 --------------B40C27BDEAB1819D77DB6E41 Content-Type: text/x-patch; name="0004-Use-record_unwind_protect_ptr-to-avoid-allocation.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename*0="0004-Use-record_unwind_protect_ptr-to-avoid-allocation.patch" >From 664c3ebe3a5b056840691c35f17273945400a4b6 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 7 Jun 2018 19:12:27 -0700 Subject: [PATCH 04/10] Use record_unwind_protect_ptr to avoid allocation * src/term.c (struct tty_pop_down_menu): New type. (tty_pop_down_menu, tty_menu_show): Use it, along with record_unwind_protect_ptr, to avoid allocating a Lisp_Misc. * src/xmenu.c (struct pop_down_menu): New type. (pop_down_menu, x_menu_show): Use it, likewise. * src/xterm.c (x_cr_destroy, x_cr_export_frames): Use record_unwind_protect_pointer to avoid possibly allocating a Lisp_Misc. --- src/term.c | 20 +++++++++++++------- src/xmenu.c | 16 ++++++++++++---- src/xterm.c | 6 ++---- 3 files changed, 27 insertions(+), 15 deletions(-) diff --git a/src/term.c b/src/term.c index 08d483f4fa..8c5085f016 100644 --- a/src/term.c +++ b/src/term.c @@ -3408,15 +3408,20 @@ tty_menu_help_callback (char const *help_string, int pane, int item) Qnil, menu_object, make_number (item)); } +struct tty_pop_down_menu +{ + tty_menu *menu; + struct buffer *buffer; +}; + static void -tty_pop_down_menu (Lisp_Object arg) +tty_pop_down_menu (void *arg) { - tty_menu *menu = XSAVE_POINTER (arg, 0); - struct buffer *orig_buffer = XSAVE_POINTER (arg, 1); + struct tty_pop_down_menu *data = arg; block_input (); - tty_menu_destroy (menu); - set_buffer_internal (orig_buffer); + tty_menu_destroy (data->menu); + set_buffer_internal (data->buffer); unblock_input (); } @@ -3697,8 +3702,9 @@ tty_menu_show (struct frame *f, int x, int y, int menuflags, /* We save and restore the current buffer because tty_menu_activate triggers redisplay, which switches buffers at will. */ - record_unwind_protect (tty_pop_down_menu, - make_save_ptr_ptr (menu, current_buffer)); + record_unwind_protect_ptr (tty_pop_down_menu, + &((struct tty_pop_down_menu) + {menu, current_buffer})); specbind (Qoverriding_terminal_local_map, Fsymbol_value (Qtty_menu_navigation_map)); diff --git a/src/xmenu.c b/src/xmenu.c index a5865a6ec2..2fbf9e8bf6 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -2033,11 +2033,18 @@ menu_help_callback (char const *help_string, int pane, int item) Qnil, menu_object, make_number (item)); } +struct pop_down_menu +{ + struct frame *frame; + XMenu *menu; +}; + static void -pop_down_menu (Lisp_Object arg) +pop_down_menu (void *arg) { - struct frame *f = XSAVE_POINTER (arg, 0); - XMenu *menu = XSAVE_POINTER (arg, 1); + union pop_down_menu *data = arg; + struct frame *f = data->frame; + XMenu *menu = data->menu; block_input (); #ifndef MSDOS @@ -2283,7 +2290,8 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, XMenuActivateSetWaitFunction (x_menu_wait_for_event, FRAME_X_DISPLAY (f)); #endif - record_unwind_protect (pop_down_menu, make_save_ptr_ptr (f, menu)); + record_unwind_protect_pointer (pop_down_menu, + &(struct pop_down_menu) {f, menu}); /* Help display under X won't work because XMenuActivate contains a loop that doesn't give Emacs a chance to process it. */ diff --git a/src/xterm.c b/src/xterm.c index 86d6068539..0efced3313 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -544,10 +544,8 @@ x_cr_accumulate_data (void *closure, const unsigned char *data, } static void -x_cr_destroy (Lisp_Object arg) +x_cr_destroy (void *cr); { - cairo_t *cr = xmint_pointer (arg); - block_input (); cairo_destroy (cr); unblock_input (); @@ -606,7 +604,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_mint_ptr (cr)); + record_unwind_protect_pointer (x_cr_destroy, cr); while (1) { -- 2.17.1 --------------B40C27BDEAB1819D77DB6E41 Content-Type: text/x-patch; name="0005-Avoid-allocating-a-Lisp_Save_Value-in-ftfont.c.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename*0="0005-Avoid-allocating-a-Lisp_Save_Value-in-ftfont.c.patch" >From da5f1e7113ee4143c40050232c618c89b8873dc7 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 7 Jun 2018 19:12:28 -0700 Subject: [PATCH 05/10] Avoid allocating a Lisp_Save_Value in ftfont.c * src/ftfont.c (struct ftfont_cache_data): New member face_refcount. (ftfont_lookup_cache): Clear it when initializing. Use make_mint_ptr, since this typically avoids the need to allocate a Lisp_Save_Value as refcount is now stored elsewhere. (ftfont_open2, ftfont_close): Manipulate the reference count in the struct, not in the save object. --- src/ftfont.c | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/src/ftfont.c b/src/ftfont.c index a53467000f..d50fa39fa7 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -345,6 +345,7 @@ struct ftfont_cache_data { FT_Face ft_face; FcCharSet *fc_charset; + intptr_t face_refcount; }; static Lisp_Object @@ -371,17 +372,15 @@ ftfont_lookup_cache (Lisp_Object key, enum ftfont_cache_for cache_for) { if (NILP (ft_face_cache)) ft_face_cache = CALLN (Fmake_hash_table, QCtest, Qequal); - cache_data = xmalloc (sizeof *cache_data); - cache_data->ft_face = NULL; - cache_data->fc_charset = NULL; - val = make_save_ptr_int (cache_data, 0); + cache_data = xzalloc (sizeof *cache_data); + val = make_mint_ptr (cache_data); cache = Fcons (Qnil, val); Fputhash (key, cache, ft_face_cache); } else { val = XCDR (cache); - cache_data = XSAVE_POINTER (val, 0); + cache_data = xmint_pointer (val); } if (cache_for == FTFONT_CACHE_FOR_ENTITY) @@ -447,7 +446,7 @@ ftfont_get_fc_charset (Lisp_Object entity) cache = ftfont_lookup_cache (entity, FTFONT_CACHE_FOR_CHARSET); val = XCDR (cache); - cache_data = XSAVE_POINTER (val, 0); + cache_data = xmint_pointer (val); return cache_data->fc_charset; } @@ -1118,9 +1117,9 @@ ftfont_open2 (struct frame *f, filename = XCAR (val); idx = XCDR (val); val = XCDR (cache); - cache_data = XSAVE_POINTER (XCDR (cache), 0); + cache_data = xmint_pointer (XCDR (cache)); ft_face = cache_data->ft_face; - if (XSAVE_INTEGER (val, 1) > 0) + if (cache_data->face_refcount > 0) { /* FT_Face in this cache is already used by the different size. */ if (FT_New_Size (ft_face, &ft_size) != 0) @@ -1136,14 +1135,14 @@ ftfont_open2 (struct frame *f, size = pixel_size; if (FT_Set_Pixel_Sizes (ft_face, size, size) != 0) { - if (XSAVE_INTEGER (val, 1) == 0) + if (cache_data->face_refcount == 0) { FT_Done_Face (ft_face); cache_data->ft_face = NULL; } return Qnil; } - set_save_integer (val, 1, XSAVE_INTEGER (val, 1) + 1); + cache_data->face_refcount++; ASET (font_object, FONT_FILE_INDEX, filename); font = XFONT_OBJECT (font_object); @@ -1255,11 +1254,10 @@ ftfont_close (struct font *font) cache = ftfont_lookup_cache (val, FTFONT_CACHE_FOR_FACE); eassert (CONSP (cache)); val = XCDR (cache); - set_save_integer (val, 1, XSAVE_INTEGER (val, 1) - 1); - if (XSAVE_INTEGER (val, 1) == 0) + struct ftfont_cache_data *cache_data = xmint_pointer (val); + cache_data->face_refcount--; + if (cache_data->face_refcount == 0) { - struct ftfont_cache_data *cache_data = XSAVE_POINTER (val, 0); - FT_Done_Face (cache_data->ft_face); #ifdef HAVE_LIBOTF if (ftfont_info->otf) -- 2.17.1 --------------B40C27BDEAB1819D77DB6E41 Content-Type: text/x-patch; name="0006-Just-use-cons-in-macfont_descriptor_entity.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="0006-Just-use-cons-in-macfont_descriptor_entity.patch" >From f74afa9af7121de49145dcc2d4d338cad2d5013f Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 7 Jun 2018 19:12:28 -0700 Subject: [PATCH 06/10] Just use cons in macfont_descriptor_entity * src/macfont.m (macfont_descriptor_entity): Use cons instead of make_save_ptr_int, as this avoids the need for a special type and function for this one-off. --- src/macfont.m | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/src/macfont.m b/src/macfont.m index 3b14a89c5c..8abe203644 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -908,7 +908,7 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char, ASET (entity, FONT_EXTRA_INDEX, Fcopy_sequence (extra)); name = CTFontDescriptorCopyAttribute (desc, kCTFontNameAttribute); font_put_extra (entity, QCfont_entity, - make_save_ptr_int ((void *) name, sym_traits)); + Fcons (make_mint_ptr (name), make_number (traits))); if (synth_sym_traits & kCTFontTraitItalic) FONT_SET_STYLE (entity, FONT_SLANT_INDEX, make_number (FONT_SLANT_SYNTHETIC_ITALIC)); @@ -2505,7 +2505,7 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no { Lisp_Object val = assq_no_quit (QCfont_entity, AREF (entity, FONT_EXTRA_INDEX)); - CFStringRef name = XSAVE_POINTER (XCDR (val), 0); + CFStringRef name = xmint_pointer (XCAR (XCDR (val))); block_input (); CFRelease (name); @@ -2528,11 +2528,10 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no val = assq_no_quit (QCfont_entity, AREF (entity, FONT_EXTRA_INDEX)); if (! CONSP (val) - || XTYPE (XCDR (val)) != Lisp_Misc - || XMISCTYPE (XCDR (val)) != Lisp_Misc_Save_Value) + || ! CONSP (XCDR (val))) return Qnil; - font_name = XSAVE_POINTER (XCDR (val), 0); - sym_traits = XSAVE_INTEGER (XCDR (val), 1); + font_name = xmint_pointer (XCAR (XCDR (val))); + sym_traits = XINT (XCDR (XCDR (val))); size = XINT (AREF (entity, FONT_SIZE_INDEX)); if (size == 0) @@ -2711,7 +2710,7 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no val = assq_no_quit (QCfont_entity, AREF (font, FONT_EXTRA_INDEX)); val = XCDR (val); - name = XSAVE_POINTER (val, 0); + name = xmint_pointer (XCAR (val)); charset = macfont_get_cf_charset_for_name (name); } else -- 2.17.1 --------------B40C27BDEAB1819D77DB6E41 Content-Type: text/x-patch; name="0007-Avoid-allocating-Lisp_Save_Value-for-excursions.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename*0="0007-Avoid-allocating-Lisp_Save_Value-for-excursions.patch" >From 9c6aeca1e58e2664cf8ebde86379d367e4bcdd92 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 7 Jun 2018 19:12:28 -0700 Subject: [PATCH 07/10] Avoid allocating Lisp_Save_Value for excursions * src/editfns.c (save_excursion_save): New arg PDL, specifying where to save the state. All uses changed. (save_excursion_restore): Args are now the marker and info rather than a pointer to a Lisp_Save_Value containing them. All uses changed. * src/eval.c (default_toplevel_binding, Fbacktrace__locals): Treat excursions like other miscellaneous pdl types. (record_unwind_protect_excursion): Save data directly into the pdl rather than creating an object on the heap. This avoids the need to allocate and free an object. (do_one_unbind, backtrace_eval_unrewind): Unwind excursions directly. (mark_specpdl): Mark excursions directly. * src/lisp.h (SPECPDL_UNWIND_EXCURSION): New constant. (union specbinding): New member unwind_excursion. --- src/editfns.c | 27 +++++++++++---------------- src/eval.c | 38 +++++++++++++++++++++++++++----------- src/lisp.h | 9 +++++++-- 3 files changed, 45 insertions(+), 29 deletions(-) diff --git a/src/editfns.c b/src/editfns.c index e672c0eb74..3147f9d146 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -995,30 +995,24 @@ This function does not move point. */) Qnil, Qt, Qnil); } -/* Save current buffer state for `save-excursion' special form. - We (ab)use Lisp_Misc_Save_Value to allow explicit free and so - offload some work from GC. */ +/* Save current buffer state for save-excursion special form. */ -Lisp_Object -save_excursion_save (void) +void +save_excursion_save (union specbinding *pdl) { - return make_save_obj_obj_obj_obj - (Fpoint_marker (), - Qnil, - /* Selected window if current buffer is shown in it, nil otherwise. */ - (EQ (XWINDOW (selected_window)->contents, Fcurrent_buffer ()) - ? selected_window : Qnil), - Qnil); + eassert (pdl->unwind_excursion.kind == SPECPDL_UNWIND_EXCURSION); + pdl->unwind_excursion.marker = Fpoint_marker (); + /* Selected window if current buffer is shown in it, nil otherwise. */ + pdl->unwind_excursion.window + = (EQ (XWINDOW (selected_window)->contents, Fcurrent_buffer ()) + ? selected_window : Qnil); } /* Restore saved buffer before leaving `save-excursion' special form. */ void -save_excursion_restore (Lisp_Object info) +save_excursion_restore (Lisp_Object marker, Lisp_Object window) { - Lisp_Object marker = XSAVE_OBJECT (info, 0); - Lisp_Object window = XSAVE_OBJECT (info, 2); - free_misc (info); Lisp_Object buffer = Fmarker_buffer (marker); /* If we're unwinding to top level, saved buffer may be deleted. This means that all of its markers are unchained and so BUFFER is nil. */ @@ -1027,6 +1021,7 @@ save_excursion_restore (Lisp_Object info) Fset_buffer (buffer); + /* Point marker. */ Fgoto_char (marker); unchain_marker (XMARKER (marker)); diff --git a/src/eval.c b/src/eval.c index 86011a234c..63bddc475e 100644 --- a/src/eval.c +++ b/src/eval.c @@ -665,6 +665,7 @@ default_toplevel_binding (Lisp_Object symbol) case SPECPDL_UNWIND: case SPECPDL_UNWIND_PTR: case SPECPDL_UNWIND_INT: + case SPECPDL_UNWIND_EXCURSION: case SPECPDL_UNWIND_VOID: case SPECPDL_BACKTRACE: case SPECPDL_LET_LOCAL: @@ -3417,7 +3418,9 @@ record_unwind_protect_int (void (*function) (int), int arg) void record_unwind_protect_excursion (void) { - record_unwind_protect (save_excursion_restore, save_excursion_save ()); + specpdl_ptr->unwind_excursion.kind = SPECPDL_UNWIND_EXCURSION; + save_excursion_save (specpdl_ptr); + grow_specpdl (); } void @@ -3465,6 +3468,10 @@ do_one_unbind (union specbinding *this_binding, bool unwinding, case SPECPDL_UNWIND_VOID: this_binding->unwind_void.func (); break; + case SPECPDL_UNWIND_EXCURSION: + save_excursion_restore (this_binding->unwind_excursion.marker, + this_binding->unwind_excursion.window); + break; case SPECPDL_BACKTRACE: break; case SPECPDL_LET: @@ -3739,18 +3746,21 @@ backtrace_eval_unrewind (int distance) unwind_protect, but the problem is that we don't know how to rewind them afterwards. */ case SPECPDL_UNWIND: - { - Lisp_Object oldarg = tmp->unwind.arg; - if (tmp->unwind.func == set_buffer_if_live) + if (tmp->unwind.func == set_buffer_if_live) + { + Lisp_Object oldarg = tmp->unwind.arg; tmp->unwind.arg = Fcurrent_buffer (); - else if (tmp->unwind.func == save_excursion_restore) - tmp->unwind.arg = save_excursion_save (); - else - break; - tmp->unwind.func (oldarg); - break; + set_buffer_if_live (oldarg); + } + break; + case SPECPDL_UNWIND_EXCURSION: + { + Lisp_Object marker = tmp->unwind_excursion.marker; + Lisp_Object window = tmp->unwind_excursion.window; + save_excursion_save (tmp); + save_excursion_restore (marker, window); } - + break; case SPECPDL_UNWIND_PTR: case SPECPDL_UNWIND_INT: case SPECPDL_UNWIND_VOID: @@ -3885,6 +3895,7 @@ NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. case SPECPDL_UNWIND: case SPECPDL_UNWIND_PTR: case SPECPDL_UNWIND_INT: + case SPECPDL_UNWIND_EXCURSION: case SPECPDL_UNWIND_VOID: case SPECPDL_BACKTRACE: break; @@ -3914,6 +3925,11 @@ mark_specpdl (union specbinding *first, union specbinding *ptr) mark_object (specpdl_arg (pdl)); break; + case SPECPDL_UNWIND_EXCURSION: + mark_object (pdl->unwind_excursion.marker); + mark_object (pdl->unwind_excursion.window); + break; + case SPECPDL_BACKTRACE: { ptrdiff_t nargs = backtrace_nargs (pdl); diff --git a/src/lisp.h b/src/lisp.h index 25ddea7bb7..1da34a25fa 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3189,6 +3189,7 @@ enum specbind_tag { SPECPDL_UNWIND, /* An unwind_protect function on Lisp_Object. */ SPECPDL_UNWIND_PTR, /* Likewise, on void *. */ SPECPDL_UNWIND_INT, /* Likewise, on int. */ + SPECPDL_UNWIND_EXCURSION, /* Likewise, on an execursion. */ SPECPDL_UNWIND_VOID, /* Likewise, with no arg. */ SPECPDL_BACKTRACE, /* An element of the backtrace. */ SPECPDL_LET, /* A plain and simple dynamic let-binding. */ @@ -3215,6 +3216,10 @@ union specbinding void (*func) (int); int arg; } unwind_int; + struct { + ENUM_BF (specbind_tag) kind : CHAR_BIT; + Lisp_Object marker, window; + } unwind_excursion; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; void (*func) (void); @@ -4107,9 +4112,9 @@ extern void mark_threads (void); /* Defined in editfns.c. */ extern void insert1 (Lisp_Object); -extern Lisp_Object save_excursion_save (void); +extern void save_excursion_save (union specbinding *); +extern void save_excursion_restore (Lisp_Object, Lisp_Object); extern Lisp_Object save_restriction_save (void); -extern void save_excursion_restore (Lisp_Object); extern void save_restriction_restore (Lisp_Object); extern _Noreturn void time_overflow (void); extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool); -- 2.17.1 --------------B40C27BDEAB1819D77DB6E41 Content-Type: text/x-patch; name="0008-Avoid-allocating-Lisp_Save_Value-for-arrays.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="0008-Avoid-allocating-Lisp_Save_Value-for-arrays.patch" >From 834105816586831a11d5313f512f64364d4966b8 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 7 Jun 2018 19:12:28 -0700 Subject: [PATCH 08/10] Avoid allocating Lisp_Save_Value for arrays * src/alloc.c (mark_maybe_objects): New function. * src/eval.c (default_toplevel_binding) (backtrace_eval_unrewind, Fbacktrace__locals): Treat array unwindings like other miscellaneous pdl types. (record_unwind_protect_array): New function. (do_one_unbind): Free the array while unwinding. (mark_specpdl): Mark arrays directly. * src/lisp.h (SPECPDL_UNWIND_ARRAY): New constant. (union specbinding): New member unwind_array. (SAFE_ALLOCA_LISP_EXTRA): Use record_unwind_protect_array instead of make_save_memory + record_unwind_protect. --- src/alloc.c | 7 +++++++ src/eval.c | 19 +++++++++++++++++++ src/lisp.h | 14 +++++++++++--- 3 files changed, 37 insertions(+), 3 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index 4186347440..a68759feb5 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4852,6 +4852,13 @@ mark_maybe_object (Lisp_Object obj) } } +void +mark_maybe_objects (Lisp_Object *array, ptrdiff_t nelts) +{ + for (Lisp_Object *lim = array + nelts; array < lim; array++) + mark_maybe_object (*array); +} + /* Return true if P can point to Lisp data, and false otherwise. Symbols are implemented via offsets not pointers, but the offsets are also multiples of GCALIGNMENT. */ diff --git a/src/eval.c b/src/eval.c index 63bddc475e..6a7a72465a 100644 --- a/src/eval.c +++ b/src/eval.c @@ -663,6 +663,7 @@ default_toplevel_binding (Lisp_Object symbol) break; case SPECPDL_UNWIND: + case SPECPDL_UNWIND_ARRAY: case SPECPDL_UNWIND_PTR: case SPECPDL_UNWIND_INT: case SPECPDL_UNWIND_EXCURSION: @@ -3397,6 +3398,15 @@ record_unwind_protect (void (*function) (Lisp_Object), Lisp_Object arg) grow_specpdl (); } +void +record_unwind_protect_array (Lisp_Object *array, ptrdiff_t nelts) +{ + specpdl_ptr->unwind_array.kind = SPECPDL_UNWIND_ARRAY; + specpdl_ptr->unwind_array.array = array; + specpdl_ptr->unwind_array.nelts = nelts; + grow_specpdl (); +} + void record_unwind_protect_ptr (void (*function) (void *), void *arg) { @@ -3459,6 +3469,9 @@ do_one_unbind (union specbinding *this_binding, bool unwinding, case SPECPDL_UNWIND: this_binding->unwind.func (this_binding->unwind.arg); break; + case SPECPDL_UNWIND_ARRAY: + xfree (this_binding->unwind_array.array); + break; case SPECPDL_UNWIND_PTR: this_binding->unwind_ptr.func (this_binding->unwind_ptr.arg); break; @@ -3761,6 +3774,7 @@ backtrace_eval_unrewind (int distance) save_excursion_restore (marker, window); } break; + case SPECPDL_UNWIND_ARRAY: case SPECPDL_UNWIND_PTR: case SPECPDL_UNWIND_INT: case SPECPDL_UNWIND_VOID: @@ -3893,6 +3907,7 @@ NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. break; case SPECPDL_UNWIND: + case SPECPDL_UNWIND_ARRAY: case SPECPDL_UNWIND_PTR: case SPECPDL_UNWIND_INT: case SPECPDL_UNWIND_EXCURSION: @@ -3925,6 +3940,10 @@ mark_specpdl (union specbinding *first, union specbinding *ptr) mark_object (specpdl_arg (pdl)); break; + case SPECPDL_UNWIND_ARRAY: + mark_maybe_objects (pdl->unwind_array.array, pdl->unwind_array.nelts); + break; + case SPECPDL_UNWIND_EXCURSION: mark_object (pdl->unwind_excursion.marker); mark_object (pdl->unwind_excursion.window); diff --git a/src/lisp.h b/src/lisp.h index 1da34a25fa..a0211966f7 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3187,6 +3187,8 @@ extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int); enum specbind_tag { SPECPDL_UNWIND, /* An unwind_protect function on Lisp_Object. */ + SPECPDL_UNWIND_ARRAY, /* Likewise, on an array that needs freeing. + Its elements are potential Lisp_Objects. */ SPECPDL_UNWIND_PTR, /* Likewise, on void *. */ SPECPDL_UNWIND_INT, /* Likewise, on int. */ SPECPDL_UNWIND_EXCURSION, /* Likewise, on an execursion. */ @@ -3206,6 +3208,12 @@ union specbinding void (*func) (Lisp_Object); Lisp_Object arg; } unwind; + struct { + ENUM_BF (specbind_tag) kind : CHAR_BIT; + void (*func) (Lisp_Object); + Lisp_Object *array; + ptrdiff_t nelts; + } unwind_array; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; void (*func) (void *); @@ -3703,6 +3711,7 @@ extern void refill_memory_reserve (void); #endif extern void alloc_unexec_pre (void); extern void alloc_unexec_post (void); +extern void mark_maybe_objects (Lisp_Object *, ptrdiff_t); extern void mark_stack (char *, char *); extern void flush_stack_call_func (void (*func) (void *arg), void *arg); extern const char *pending_malloc_warning; @@ -4017,6 +4026,7 @@ extern struct handler *push_handler (Lisp_Object, enum handlertype); extern struct handler *push_handler_nosignal (Lisp_Object, enum handlertype); extern void specbind (Lisp_Object, Lisp_Object); extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object); +extern void record_unwind_protect_array (Lisp_Object *, ptrdiff_t); extern void record_unwind_protect_ptr (void (*) (void *), void *); extern void record_unwind_protect_int (void (*) (int), int); extern void record_unwind_protect_void (void (*) (void)); @@ -4711,11 +4721,9 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); (buf) = AVAIL_ALLOCA (alloca_nbytes); \ else \ { \ - Lisp_Object arg_; \ (buf) = xmalloc (alloca_nbytes); \ - arg_ = make_save_memory (buf, nelt); \ + record_unwind_protect_array (buf, nelt); \ sa_must_free = true; \ - record_unwind_protect (free_save_value, arg_); \ } \ } while (false) -- 2.17.1 --------------B40C27BDEAB1819D77DB6E41 Content-Type: text/x-patch; name="0009-New-type-Lisp_Misc_Ptr.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="0009-New-type-Lisp_Misc_Ptr.patch" >From a527e5ddab0a54ada101eac9ffbf35bd0a80539e Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 7 Jun 2018 19:12:28 -0700 Subject: [PATCH 09/10] New type Lisp_Misc_Ptr This is a streamlined version of Lisp_Save_Value, which contains just a pointer, as that is all Lisp_Save_Values are used for any more. With the previous changes, these objects are not primarily used as save values, so just call them "Misc" rather than "Save". * src/alloc.c (make_misc_ptr): New function. (mark_object): Mark Lisp_Misc_Ptr too. * src/lisp.h (Lisp_Misc_Ptr): New constant. (struct Lisp_Misc_Ptr): New type. (make_mint_ptr, mint_ptrp, xmint_pointer): Use Lisp_Misc_Ptr, not Lisp_Save_Value. (union Lisp_Misc): Add Lisp_Misc_Ptr. * src/print.c (print_object): Print Lisp_Misc_Ptr. --- src/alloc.c | 13 +++++++++++++ src/font.h | 2 +- src/lisp.h | 30 +++++++++++++++++++++--------- src/print.c | 7 +++++++ src/w32font.c | 2 +- 5 files changed, 43 insertions(+), 11 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index a68759feb5..62a3a1a09f 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3834,6 +3834,15 @@ free_save_value (Lisp_Object save) free_misc (save); } +Lisp_Object +make_misc_ptr (void *a) +{ + Lisp_Object val = allocate_misc (Lisp_Misc_Ptr); + struct Lisp_Misc_Ptr *p = XUNTAG (val, Lisp_Misc); + p->pointer = a; + return val; +} + /* Return a Lisp_Misc_Overlay object with specified START, END and PLIST. */ Lisp_Object @@ -6697,6 +6706,10 @@ mark_object (Lisp_Object arg) mark_save_value (XSAVE_VALUE (obj)); break; + case Lisp_Misc_Ptr: + XMISCANY (obj)->gcmarkbit = true; + break; + case Lisp_Misc_Overlay: mark_overlay (XOVERLAY (obj)); break; diff --git a/src/font.h b/src/font.h index 469431fee6..8c8eb9582a 100644 --- a/src/font.h +++ b/src/font.h @@ -613,7 +613,7 @@ struct font_driver (symbols). */ Lisp_Object (*list_family) (struct frame *f); - /* Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value). + /* Optional. Free FONT_EXTRA_INDEX field of FONT_ENTITY. */ void (*free_entity) (Lisp_Object font_entity); diff --git a/src/lisp.h b/src/lisp.h index a0211966f7..625d6f13f3 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -514,6 +514,7 @@ enum Lisp_Misc_Type Lisp_Misc_Overlay, Lisp_Misc_Save_Value, Lisp_Misc_Finalizer, + Lisp_Misc_Ptr, #ifdef HAVE_MODULES Lisp_Misc_User_Ptr, #endif @@ -540,10 +541,11 @@ enum Lisp_Fwd_Type First, there are already a couple of Lisp types that can be used if your new type does not need to be exposed to Lisp programs nor - displayed to users. These are Lisp_Save_Value, a Lisp_Misc + displayed to users. These are Lisp_Misc_Ptr, a Lisp_Misc subtype; and PVEC_OTHER, a kind of vectorlike object. The former - is suitable for temporarily stashing away pointers and integers in - a Lisp object. The latter is useful for vector-like Lisp objects + is suitable for stashing a pointer in a Lisp object; the pointer + might be to some low-level C object that contains auxiliary + information. The latter is useful for vector-like Lisp objects that need to be used as part of other objects, but which are never shown to users or Lisp code (search for PVEC_OTHER in xterm.c for an example). @@ -2502,12 +2504,20 @@ XSAVE_FUNCPOINTER (Lisp_Object obj, int n) return XSAVE_VALUE (obj)->data[n].funcpointer; } -extern Lisp_Object make_save_ptr (void *); +struct Lisp_Misc_Ptr + { + ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Ptr */ + bool_bf gcmarkbit : 1; + unsigned spacer : 15; + void *pointer; + }; + +extern Lisp_Object make_misc_ptr (void *); /* A mint_ptr object OBJ represents a pointer P. OBJ is preferably a Lisp integer I such that XINTPTR (i) == P, as this is more efficient. 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 + then untagged via XINTPTR, then OBJ is a Lisp_Misc_Ptr with pointer component P. C code should never blindly accept a mint_ptr object from Lisp code, as that would allow Lisp code to coin pointers from integers and could lead to crashes. */ @@ -2516,14 +2526,13 @@ 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); + return INTEGERP (val) && XINTPTR (val) == a ? val : make_misc_ptr (a); } INLINE bool mint_ptrp (Lisp_Object x) { - return (INTEGERP (x) - || (SAVE_VALUEP (x) && XSAVE_VALUE (x)->save_type == SAVE_POINTER)); + return INTEGERP (x) || (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Ptr); } INLINE void * @@ -2532,7 +2541,8 @@ xmint_pointer (Lisp_Object a) eassert (mint_ptrp (a)); if (INTEGERP (a)) return XINTPTR (a); - return XSAVE_POINTER (a, 0); + struct Lisp_Misc_Ptr *p = XUNTAG (a, Lisp_Misc); + return p->pointer; } /* Get and set the Nth saved integer. */ @@ -2619,6 +2629,7 @@ union Lisp_Misc struct Lisp_Overlay u_overlay; struct Lisp_Save_Value u_save_value; struct Lisp_Finalizer u_finalizer; + struct Lisp_Misc_Ptr u_misc_ptr; #ifdef HAVE_MODULES struct Lisp_User_Ptr u_user_ptr; #endif @@ -3856,6 +3867,7 @@ 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/print.c b/src/print.c index 8394375220..a991f3ffa3 100644 --- a/src/print.c +++ b/src/print.c @@ -2167,6 +2167,13 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) print_c_string ("#", printcharfun); break; + case Lisp_Misc_Ptr: + { + int i = sprintf (buf, "#", xmint_pointer (obj)); + strout (buf, i, i, printcharfun); + } + break; + case Lisp_Misc_Save_Value: { int i; diff --git a/src/w32font.c b/src/w32font.c index 9cbc3ee14b..65409b92d2 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -718,7 +718,7 @@ w32font_draw (struct glyph_string *s, int from, int to, } /* w32 implementation of free_entity for font backend. - Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value). + Optional. Free FONT_EXTRA_INDEX field of FONT_ENTITY. static void w32font_free_entity (Lisp_Object entity); -- 2.17.1 --------------B40C27BDEAB1819D77DB6E41 Content-Type: text/x-patch; name="0010-Remove-Lisp_Misc_Save_Value.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="0010-Remove-Lisp_Misc_Save_Value.patch" >From 8924f58c6d39258855d47d832fab89b041becb45 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 7 Jun 2018 19:12:29 -0700 Subject: [PATCH 10/10] Remove Lisp_Misc_Save_Value This type and its associated routines are no longer used. * src/alloc.c (voidfuncptr): Move here from src/lisp.h. (free_misc, make_save_int_int_int) (make_save_obj_obj_obj_obj, make_save_ptr) (make_save_ptr_int, make_save_ptr_ptr) (make_save_funcptr_ptr_obj, make_save_memory) (free_save_value, mark_save_value): Remove. (mark_object): Remove mention of Lisp_Misc_Save_Value. * src/lisp.h (Lisp_Misc_Save_Value, SAVE_SLOT_BITS) (SAVE_VALUE_SLOTS, SAVE_TYPE_BITS, enum Lisp_Save_Type) (struct Lisp_Save_Value, SAVE_VALUEP, XSAVE_VALUE) (save_type, XSAVE_POINTER, set_save_pointer) (XSAVE_FUNCPOINTER, XSAVE_INTEGER, set_save_integer) (XSAVE_OBJECT): Remove. (union Lisp_Misc): Remove u_save_value. (voidfuncptr): Move from here to src/alloc.c. * src/print.c (print_object): Remove support for printing Lisp_Misc_Save_Value. --- src/alloc.c | 153 +-------------------------------------------- src/lisp.h | 176 +--------------------------------------------------- src/print.c | 83 ------------------------- 3 files changed, 5 insertions(+), 407 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index 62a3a1a09f..c99eabd5ec 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -172,6 +172,7 @@ malloc_initialize_hook (void) /* Declare the malloc initialization hook, which runs before 'main' starts. EXTERNALLY_VISIBLE works around Bug#22522. */ +typedef void (*voidfuncptr) (void); # ifndef __MALLOC_HOOK_VOLATILE # define __MALLOC_HOOK_VOLATILE # endif @@ -3717,123 +3718,6 @@ allocate_misc (enum Lisp_Misc_Type type) return val; } -/* Free a Lisp_Misc object. */ - -void -free_misc (Lisp_Object misc) -{ - XMISCANY (misc)->type = Lisp_Misc_Free; - XMISC (misc)->u_free.chain = misc_free_list; - misc_free_list = XMISC (misc); - consing_since_gc -= sizeof (union Lisp_Misc); - total_free_markers++; -} - -/* Verify properties of Lisp_Save_Value's representation - that are assumed here and elsewhere. */ - -verify (SAVE_UNUSED == 0); -verify (((SAVE_INTEGER | SAVE_POINTER | SAVE_FUNCPOINTER | SAVE_OBJECT) - >> SAVE_SLOT_BITS) - == 0); - -/* Return Lisp_Save_Value objects for the various combinations - that callers need. */ - -Lisp_Object -make_save_int_int_int (ptrdiff_t a, ptrdiff_t b, ptrdiff_t c) -{ - Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); - struct Lisp_Save_Value *p = XSAVE_VALUE (val); - p->save_type = SAVE_TYPE_INT_INT_INT; - p->data[0].integer = a; - p->data[1].integer = b; - p->data[2].integer = c; - return val; -} - -Lisp_Object -make_save_obj_obj_obj_obj (Lisp_Object a, Lisp_Object b, Lisp_Object c, - Lisp_Object d) -{ - Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); - struct Lisp_Save_Value *p = XSAVE_VALUE (val); - p->save_type = SAVE_TYPE_OBJ_OBJ_OBJ_OBJ; - p->data[0].object = a; - p->data[1].object = b; - p->data[2].object = c; - p->data[3].object = d; - return val; -} - -Lisp_Object -make_save_ptr (void *a) -{ - Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); - struct Lisp_Save_Value *p = XSAVE_VALUE (val); - p->save_type = SAVE_POINTER; - p->data[0].pointer = a; - return val; -} - -Lisp_Object -make_save_ptr_int (void *a, ptrdiff_t b) -{ - Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); - struct Lisp_Save_Value *p = XSAVE_VALUE (val); - p->save_type = SAVE_TYPE_PTR_INT; - p->data[0].pointer = a; - p->data[1].integer = b; - return val; -} - -Lisp_Object -make_save_ptr_ptr (void *a, void *b) -{ - Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); - struct Lisp_Save_Value *p = XSAVE_VALUE (val); - p->save_type = SAVE_TYPE_PTR_PTR; - p->data[0].pointer = a; - p->data[1].pointer = b; - return val; -} - -Lisp_Object -make_save_funcptr_ptr_obj (void (*a) (void), void *b, Lisp_Object c) -{ - Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); - struct Lisp_Save_Value *p = XSAVE_VALUE (val); - p->save_type = SAVE_TYPE_FUNCPTR_PTR_OBJ; - p->data[0].funcpointer = a; - p->data[1].pointer = b; - p->data[2].object = c; - return val; -} - -/* Return a Lisp_Save_Value object that represents an array A - of N Lisp objects. */ - -Lisp_Object -make_save_memory (Lisp_Object *a, ptrdiff_t n) -{ - Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); - struct Lisp_Save_Value *p = XSAVE_VALUE (val); - p->save_type = SAVE_TYPE_MEMORY; - p->data[0].pointer = a; - p->data[1].integer = n; - return val; -} - -/* Free a Lisp_Save_Value object. Do not use this function - if SAVE contains pointer other than returned by xmalloc. */ - -void -free_save_value (Lisp_Object save) -{ - xfree (XSAVE_POINTER (save, 0)); - free_misc (save); -} - Lisp_Object make_misc_ptr (void *a) { @@ -5287,10 +5171,8 @@ valid_pointer_p (void *p) /* Return 2 if OBJ is a killed or special buffer object, 1 if OBJ is a valid lisp object, 0 if OBJ is NOT a valid lisp object, or -1 if we - cannot validate OBJ. This function can be quite slow, so its primary - use is the manual debugging. The only exception is print_object, where - we use it to check whether the memory referenced by the pointer of - Lisp_Save_Value object contains valid objects. */ + cannot validate OBJ. This function can be quite slow, and is used + only in debugging. */ int valid_lisp_object_p (Lisp_Object obj) @@ -6369,30 +6251,6 @@ mark_localized_symbol (struct Lisp_Symbol *ptr) mark_object (blv->defcell); } -NO_INLINE /* To reduce stack depth in mark_object. */ -static void -mark_save_value (struct Lisp_Save_Value *ptr) -{ - /* If `save_type' is zero, `data[0].pointer' is the address - of a memory area containing `data[1].integer' potential - Lisp_Objects. */ - if (ptr->save_type == SAVE_TYPE_MEMORY) - { - Lisp_Object *p = ptr->data[0].pointer; - ptrdiff_t nelt; - for (nelt = ptr->data[1].integer; nelt > 0; nelt--, p++) - mark_maybe_object (*p); - } - else - { - /* Find Lisp_Objects in `data[N]' slots and mark them. */ - int i; - for (i = 0; i < SAVE_VALUE_SLOTS; i++) - if (save_type (ptr, i) == SAVE_OBJECT) - mark_object (ptr->data[i].object); - } -} - /* Remove killed buffers or items whose car is a killed buffer from LIST, and mark other items. Return changed LIST, which is marked. */ @@ -6701,11 +6559,6 @@ mark_object (Lisp_Object arg) XMISCANY (obj)->gcmarkbit = 1; break; - case Lisp_Misc_Save_Value: - XMISCANY (obj)->gcmarkbit = 1; - mark_save_value (XSAVE_VALUE (obj)); - break; - case Lisp_Misc_Ptr: XMISCANY (obj)->gcmarkbit = true; break; diff --git a/src/lisp.h b/src/lisp.h index 625d6f13f3..04f9e393d6 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -512,7 +512,6 @@ enum Lisp_Misc_Type Lisp_Misc_Free = 0x5eab, Lisp_Misc_Marker, Lisp_Misc_Overlay, - Lisp_Misc_Save_Value, Lisp_Misc_Finalizer, Lisp_Misc_Ptr, #ifdef HAVE_MODULES @@ -561,9 +560,8 @@ enum Lisp_Fwd_Type members that are accessible only from C. A Lisp_Misc object is a wrapper for a C struct that can contain anything you like. - Explicit freeing is discouraged for Lisp objects in general. But if - you really need to exploit this, use Lisp_Misc (check free_misc in - alloc.c to see why). There is no way to free a vectorlike object. + There is no way to explicitly free a Lisp Object; only the garbage + collector frees them. To add a new pseudovector type, extend the pvec_type enumeration; to add a new Lisp_Misc, extend the Lisp_Misc_Type enumeration. @@ -2370,140 +2368,6 @@ struct Lisp_Overlay Lisp_Object plist; }; -/* Number of bits needed to store one of the values - SAVE_UNUSED..SAVE_OBJECT. */ -enum { SAVE_SLOT_BITS = 3 }; - -/* Number of slots in a save value where save_type is nonzero. */ -enum { SAVE_VALUE_SLOTS = 4 }; - -/* Bit-width and values for struct Lisp_Save_Value's save_type member. */ - -enum { SAVE_TYPE_BITS = SAVE_VALUE_SLOTS * SAVE_SLOT_BITS + 1 }; - -/* Types of data which may be saved in a Lisp_Save_Value. */ - -enum Lisp_Save_Type - { - SAVE_UNUSED, - SAVE_INTEGER, - SAVE_FUNCPOINTER, - SAVE_POINTER, - SAVE_OBJECT, - SAVE_TYPE_INT_INT = SAVE_INTEGER + (SAVE_INTEGER << SAVE_SLOT_BITS), - SAVE_TYPE_INT_INT_INT - = (SAVE_INTEGER + (SAVE_TYPE_INT_INT << SAVE_SLOT_BITS)), - SAVE_TYPE_OBJ_OBJ = SAVE_OBJECT + (SAVE_OBJECT << SAVE_SLOT_BITS), - SAVE_TYPE_OBJ_OBJ_OBJ = SAVE_OBJECT + (SAVE_TYPE_OBJ_OBJ << SAVE_SLOT_BITS), - SAVE_TYPE_OBJ_OBJ_OBJ_OBJ - = SAVE_OBJECT + (SAVE_TYPE_OBJ_OBJ_OBJ << SAVE_SLOT_BITS), - SAVE_TYPE_PTR_INT = SAVE_POINTER + (SAVE_INTEGER << SAVE_SLOT_BITS), - SAVE_TYPE_PTR_OBJ = SAVE_POINTER + (SAVE_OBJECT << SAVE_SLOT_BITS), - SAVE_TYPE_PTR_PTR = SAVE_POINTER + (SAVE_POINTER << SAVE_SLOT_BITS), - SAVE_TYPE_FUNCPTR_PTR_OBJ - = SAVE_FUNCPOINTER + (SAVE_TYPE_PTR_OBJ << SAVE_SLOT_BITS), - - /* This has an extra bit indicating it's raw memory. */ - SAVE_TYPE_MEMORY = SAVE_TYPE_PTR_INT + (1 << (SAVE_TYPE_BITS - 1)) - }; - -/* SAVE_SLOT_BITS must be large enough to represent these values. */ -verify (((SAVE_UNUSED | SAVE_INTEGER | SAVE_FUNCPOINTER - | SAVE_POINTER | SAVE_OBJECT) - >> SAVE_SLOT_BITS) - == 0); - -/* Special object used to hold a different values for later use. - - This is mostly used to package C integers and pointers to call - record_unwind_protect when two or more values need to be saved. - For example: - - ... - struct my_data *md = get_my_data (); - ptrdiff_t mi = get_my_integer (); - record_unwind_protect (my_unwind, make_save_ptr_int (md, mi)); - ... - - Lisp_Object my_unwind (Lisp_Object arg) - { - struct my_data *md = XSAVE_POINTER (arg, 0); - ptrdiff_t mi = XSAVE_INTEGER (arg, 1); - ... - } - - If ENABLE_CHECKING is in effect, XSAVE_xxx macros do type checking of the - saved objects and raise eassert if type of the saved object doesn't match - the type which is extracted. In the example above, XSAVE_INTEGER (arg, 2) - and XSAVE_OBJECT (arg, 0) are wrong because nothing was saved in slot 2 and - slot 0 is a pointer. */ - -typedef void (*voidfuncptr) (void); - -struct Lisp_Save_Value - { - ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Save_Value */ - bool_bf gcmarkbit : 1; - unsigned spacer : 32 - (16 + 1 + SAVE_TYPE_BITS); - - /* V->data may hold up to SAVE_VALUE_SLOTS entries. The type of - V's data entries are determined by V->save_type. E.g., if - V->save_type == SAVE_TYPE_PTR_OBJ, V->data[0] is a pointer, - V->data[1] is an integer, and V's other data entries are unused. - - If V->save_type == SAVE_TYPE_MEMORY, V->data[0].pointer is the address of - a memory area containing V->data[1].integer potential Lisp_Objects. */ - ENUM_BF (Lisp_Save_Type) save_type : SAVE_TYPE_BITS; - union { - void *pointer; - voidfuncptr funcpointer; - ptrdiff_t integer; - Lisp_Object object; - } data[SAVE_VALUE_SLOTS]; - }; - -INLINE bool -SAVE_VALUEP (Lisp_Object x) -{ - return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value; -} - -INLINE struct Lisp_Save_Value * -XSAVE_VALUE (Lisp_Object a) -{ - eassert (SAVE_VALUEP (a)); - return XUNTAG (a, Lisp_Misc); -} - -/* Return the type of V's Nth saved value. */ -INLINE int -save_type (struct Lisp_Save_Value *v, int n) -{ - eassert (0 <= n && n < SAVE_VALUE_SLOTS); - return (v->save_type >> (SAVE_SLOT_BITS * n) & ((1 << SAVE_SLOT_BITS) - 1)); -} - -/* Get and set the Nth saved pointer. */ - -INLINE void * -XSAVE_POINTER (Lisp_Object obj, int n) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); - return XSAVE_VALUE (obj)->data[n].pointer; -} -INLINE void -set_save_pointer (Lisp_Object obj, int n, void *val) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); - XSAVE_VALUE (obj)->data[n].pointer = val; -} -INLINE voidfuncptr -XSAVE_FUNCPOINTER (Lisp_Object obj, int n) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_FUNCPOINTER); - return XSAVE_VALUE (obj)->data[n].funcpointer; -} - struct Lisp_Misc_Ptr { ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Ptr */ @@ -2545,30 +2409,6 @@ xmint_pointer (Lisp_Object a) return p->pointer; } -/* Get and set the Nth saved integer. */ - -INLINE ptrdiff_t -XSAVE_INTEGER (Lisp_Object obj, int n) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); - return XSAVE_VALUE (obj)->data[n].integer; -} -INLINE void -set_save_integer (Lisp_Object obj, int n, ptrdiff_t val) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); - XSAVE_VALUE (obj)->data[n].integer = val; -} - -/* Extract Nth saved object. */ - -INLINE Lisp_Object -XSAVE_OBJECT (Lisp_Object obj, int n) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_OBJECT); - return XSAVE_VALUE (obj)->data[n].object; -} - #ifdef HAVE_MODULES struct Lisp_User_Ptr { @@ -2627,7 +2467,6 @@ union Lisp_Misc struct Lisp_Free u_free; struct Lisp_Marker u_marker; struct Lisp_Overlay u_overlay; - struct Lisp_Save_Value u_save_value; struct Lisp_Finalizer u_finalizer; struct Lisp_Misc_Ptr u_misc_ptr; #ifdef HAVE_MODULES @@ -3710,7 +3549,6 @@ extern void parse_str_as_multibyte (const unsigned char *, ptrdiff_t, /* Defined in alloc.c. */ extern void *my_heap_start (void); extern void check_pure_size (void); -extern void free_misc (Lisp_Object); extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT); extern void malloc_warning (const char *); extern _Noreturn void memory_full (size_t); @@ -3864,16 +3702,6 @@ extern bool gc_in_progress; extern Lisp_Object make_float (double); extern void display_malloc_warning (void); 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 *, - Lisp_Object); -extern Lisp_Object make_save_memory (Lisp_Object *, ptrdiff_t); -extern void free_save_value (Lisp_Object); extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object); extern void free_cons (struct Lisp_Cons *); extern void init_alloc_once (void); diff --git a/src/print.c b/src/print.c index a991f3ffa3..b8af2ca87b 100644 --- a/src/print.c +++ b/src/print.c @@ -2174,89 +2174,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) } break; - case Lisp_Misc_Save_Value: - { - int i; - struct Lisp_Save_Value *v = XSAVE_VALUE (obj); - - print_c_string ("#save_type == SAVE_TYPE_MEMORY) - { - ptrdiff_t amount = v->data[1].integer; - - /* valid_lisp_object_p is reliable, so try to print up - to 8 saved objects. This code is rarely used, so - it's OK that valid_lisp_object_p is slow. */ - - int limit = min (amount, 8); - Lisp_Object *area = v->data[0].pointer; - - i = sprintf (buf, "with %"pD"d objects", amount); - strout (buf, i, i, printcharfun); - - for (i = 0; i < limit; i++) - { - Lisp_Object maybe = area[i]; - int valid = valid_lisp_object_p (maybe); - - printchar (' ', printcharfun); - if (0 < valid) - print_object (maybe, printcharfun, escapeflag); - else - print_c_string (valid < 0 ? "" : "", - printcharfun); - } - if (i == limit && i < amount) - print_c_string (" ...", printcharfun); - } - else - { - /* Print each slot according to its type. */ - int index; - for (index = 0; index < SAVE_VALUE_SLOTS; index++) - { - if (index) - printchar (' ', printcharfun); - - switch (save_type (v, index)) - { - case SAVE_UNUSED: - i = sprintf (buf, ""); - break; - - case SAVE_POINTER: - i = sprintf (buf, "", - v->data[index].pointer); - break; - - case SAVE_FUNCPOINTER: - i = sprintf (buf, "", - ((void *) (intptr_t) - v->data[index].funcpointer)); - break; - - case SAVE_INTEGER: - i = sprintf (buf, "", - v->data[index].integer); - break; - - case SAVE_OBJECT: - print_object (v->data[index].object, printcharfun, - escapeflag); - continue; - - default: - emacs_abort (); - } - - strout (buf, i, i, printcharfun); - } - } - printchar ('>', printcharfun); - } - break; - default: goto badtype; } -- 2.17.1 --------------B40C27BDEAB1819D77DB6E41--