Re: master d02c2f7 4/4: Speed up maybe_gc when GC is inhibited

Re: master d02c2f7 4/4: Speed up maybe_gc when GC is inhibited

[Pip Cet]

On Sun, Jul 21, 2019 at 6:24 PM Paul Eggert <eggert@cs.ucla.edu> wrote:
>  static void
> -allow_garbage_collection (void)
> +allow_garbage_collection (void *ptr)
>  {
> +  object_ct *p = ptr;
> +  consing_until_gc = *p;
>    garbage_collection_inhibited--;
>  }
>
> @@ -5513,9 +5516,10 @@ ptrdiff_t
>  inhibit_garbage_collection (void)
>  {
>    ptrdiff_t count = SPECPDL_INDEX ();
> -
> -  record_unwind_protect_void (allow_garbage_collection);
> +  object_ct consing = consing_until_gc;
> +  record_unwind_protect_ptr (allow_garbage_collection, &consing);
>    garbage_collection_inhibited++;
> +  consing_until_gc = OBJECT_CT_MAX;
>    return count;
>  }

This looks unsafe to me. `consing' goes out of scope when
inhibit_garbage_collection returns, at which point the stack space for
`consing' will be reused for something else.
`allow_garbage_collection' is called later, and accesses what's
essentially random stack data.

Or am I missing something?

_______________________________________________
Emacs-diffs mailing list
Emacs-diffs@gnu.org
https://lists.gnu.org/mailman/listinfo/emacs-diffs

Re: [Emacs-diffs] master d02c2f7 4/4: Speed up maybe_gc when GC is inhibited

[Paul Eggert]

[-- Attachment #1: Type: text/plain, Size: 122 bytes --]

Pip Cet wrote:

> This looks unsafe to me.

Right you are, of course; thanks for checking that. I installed the attached.

[-- Attachment #2: 0001-Fix-lifetime-error-in-previous-patch.patch --]
[-- Type: text/x-patch, Size: 5103 bytes --]

From 5d4dd552c29279b8a9e6ed269a2dc3afc36f73b9 Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Sun, 21 Jul 2019 12:31:51 -0700
Subject: [PATCH] Fix lifetime error in previous patch

Problem reported by Pip Cet in:
https://lists.gnu.org/r/emacs-devel/2019-07/msg00520.html
* src/alloc.c (inhibit_garbage_collection): Use new function.
(allow_garbage_collection): Accept intmax_t, not pointer.
* src/eval.c (default_toplevel_binding, do_one_unbind)
(backtrace_eval_unrewind, Fbacktrace__locals, mark_specpdl):
Support SPECPDL_UNWIND_INTMAX.
(record_unwind_protect_excursion): New function.
* src/lisp.h (enum specbind_tag): New constant SPECPDL_UNWIND_INTMAX.
(union specbinding): New member unwind_intmax.
---
 src/alloc.c |  8 +++-----
 src/eval.c  | 16 ++++++++++++++++
 src/lisp.h  |  7 +++++++
 3 files changed, 26 insertions(+), 5 deletions(-)

diff --git a/src/alloc.c b/src/alloc.c
index 50015808e5..aa9200f2eb 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -5505,10 +5505,9 @@ staticpro (Lisp_Object const *varaddress)
    consing_until_gc to speed up maybe_gc when GC is inhibited.  */
 
 static void
-allow_garbage_collection (void *ptr)
+allow_garbage_collection (intmax_t consing)
 {
-  object_ct *p = ptr;
-  consing_until_gc = *p;
+  consing_until_gc = consing;
   garbage_collection_inhibited--;
 }
 
@@ -5516,8 +5515,7 @@ ptrdiff_t
 inhibit_garbage_collection (void)
 {
   ptrdiff_t count = SPECPDL_INDEX ();
-  object_ct consing = consing_until_gc;
-  record_unwind_protect_ptr (allow_garbage_collection, &consing);
+  record_unwind_protect_intmax (allow_garbage_collection, consing_until_gc);
   garbage_collection_inhibited++;
   consing_until_gc = OBJECT_CT_MAX;
   return count;
diff --git a/src/eval.c b/src/eval.c
index 02a6c3555a..b890aa6f7f 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -674,6 +674,7 @@ default_toplevel_binding (Lisp_Object symbol)
 	case SPECPDL_UNWIND_ARRAY:
 	case SPECPDL_UNWIND_PTR:
 	case SPECPDL_UNWIND_INT:
+	case SPECPDL_UNWIND_INTMAX:
 	case SPECPDL_UNWIND_EXCURSION:
 	case SPECPDL_UNWIND_VOID:
 	case SPECPDL_BACKTRACE:
@@ -3394,6 +3395,15 @@ record_unwind_protect_int (void (*function) (int), int arg)
   grow_specpdl ();
 }
 
+void
+record_unwind_protect_intmax (void (*function) (intmax_t), intmax_t arg)
+{
+  specpdl_ptr->unwind_intmax.kind = SPECPDL_UNWIND_INTMAX;
+  specpdl_ptr->unwind_intmax.func = function;
+  specpdl_ptr->unwind_intmax.arg = arg;
+  grow_specpdl ();
+}
+
 void
 record_unwind_protect_excursion (void)
 {
@@ -3448,6 +3458,9 @@ do_one_unbind (union specbinding *this_binding, bool unwinding,
     case SPECPDL_UNWIND_INT:
       this_binding->unwind_int.func (this_binding->unwind_int.arg);
       break;
+    case SPECPDL_UNWIND_INTMAX:
+      this_binding->unwind_intmax.func (this_binding->unwind_intmax.arg);
+      break;
     case SPECPDL_UNWIND_VOID:
       this_binding->unwind_void.func ();
       break;
@@ -3784,6 +3797,7 @@ backtrace_eval_unrewind (int distance)
 	case SPECPDL_UNWIND_ARRAY:
 	case SPECPDL_UNWIND_PTR:
 	case SPECPDL_UNWIND_INT:
+	case SPECPDL_UNWIND_INTMAX:
 	case SPECPDL_UNWIND_VOID:
 	case SPECPDL_BACKTRACE:
 	  break;
@@ -3917,6 +3931,7 @@ NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'.
 	  case SPECPDL_UNWIND_ARRAY:
 	  case SPECPDL_UNWIND_PTR:
 	  case SPECPDL_UNWIND_INT:
+	  case SPECPDL_UNWIND_INTMAX:
 	  case SPECPDL_UNWIND_EXCURSION:
 	  case SPECPDL_UNWIND_VOID:
 	  case SPECPDL_BACKTRACE:
@@ -3979,6 +3994,7 @@ mark_specpdl (union specbinding *first, union specbinding *ptr)
 
 	case SPECPDL_UNWIND_PTR:
 	case SPECPDL_UNWIND_INT:
+	case SPECPDL_UNWIND_INTMAX:
         case SPECPDL_UNWIND_VOID:
 	  break;
 
diff --git a/src/lisp.h b/src/lisp.h
index 6d101fed90..9d37629bc4 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3156,6 +3156,7 @@ enum specbind_tag {
 				   Its elements are potential Lisp_Objects.  */
   SPECPDL_UNWIND_PTR,		/* Likewise, on void *.  */
   SPECPDL_UNWIND_INT,		/* Likewise, on int.  */
+  SPECPDL_UNWIND_INTMAX,	/* Likewise, on intmax_t.  */
   SPECPDL_UNWIND_EXCURSION,	/* Likewise, on an execursion.  */
   SPECPDL_UNWIND_VOID,		/* Likewise, with no arg.  */
   SPECPDL_BACKTRACE,		/* An element of the backtrace.  */
@@ -3191,6 +3192,11 @@ union specbinding
       void (*func) (int);
       int arg;
     } unwind_int;
+    struct {
+      ENUM_BF (specbind_tag) kind : CHAR_BIT;
+      void (*func) (intmax_t);
+      intmax_t arg;
+    } unwind_intmax;
     struct {
       ENUM_BF (specbind_tag) kind : CHAR_BIT;
       Lisp_Object marker, window;
@@ -4118,6 +4124,7 @@ 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_intmax (void (*) (intmax_t), intmax_t);
 extern void record_unwind_protect_void (void (*) (void));
 extern void record_unwind_protect_excursion (void);
 extern void record_unwind_protect_nothing (void);
-- 
2.17.1

Re: [Emacs-diffs] master cf28594 2/4: Improve doc for hash tables

[Stefan Monnier]

>     * src/fns.c (Fsxhash_eq, Fsxhash_eql, Fsxhash_equal):
>     Say that hashes are fixnums.

[ Related to discussions we had about the need for fixnump and such
  things.  ]

I think we should try to try and avoid exposing the notion of "fixnum",
so here for instance, we should likely just accept any integer plus
document that only the lowest N bits are used where N is
platform-dependent (and it could even be different from the number of
bits in fixnums, in case we want to use the full 32bit/64bit range of
ints for hashes).


        Stefan

Re: [Emacs-diffs] master cf28594 2/4: Improve doc for hash tables

[Paul Eggert]

[-- Attachment #1: Type: text/plain, Size: 801 bytes --]

Stefan Monnier wrote:
> [ Related to discussions we had about the need for fixnump and such
>    things.  ]
> 
> I think we should try to try and avoid exposing the notion of "fixnum",

Oh, right. Sorry, I forgot those discussions when I made those doc changes. I 
installed the attached to revert most of them, and to change the code to do a 
right thing with user-defined hash functions that return bignums. The revised 
documentation is now slightly vague about what Emacs does with hash codes when 
using them as indexes: it now says it "can reduce them" rather than it "reduces 
them" modulo the length of the array. The changes to the code are in 
hashfn_user_defined (which now reduces bignums to fixnums) and in exec_byte_code 
(which no longer attempts to optimize hash tests other than eq).

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Avoid-overexposing-fixnums-for-hash-codes.patch --]
[-- Type: text/x-patch; name="0001-Avoid-overexposing-fixnums-for-hash-codes.patch", Size: 7775 bytes --]

From 823e887aef0b300e87d6e05bdb5784da8c79d3cf Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Mon, 22 Jul 2019 21:27:33 -0700
Subject: [PATCH] Avoid overexposing fixnums for hash codes
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Following a suggestion by Stefan Monnier in:
https://lists.gnu.org/r/emacs-devel/2019-07/msg00530.html
* doc/lispref/hash.texi (Creating Hash, Defining Hash):
* src/fns.c (Fsxhash_eq, Fsxhash_eql, Fsxhash_equal, Fmake_hash_table):
Don’t insist that hash codes be fixnums, reverting
the recent doc changes to the contrary.
* src/bytecode.c (exec_byte_code): Special-case only the eq case,
as the others aren’t worth tuning now that we treat bignum hashes
like fixnums.
* src/fns.c (hashfn_user_defined): If the hash code is a bignum,
reduce its hash down to a fixnum.
---
 doc/lispref/hash.texi | 16 ++++++++--------
 src/bytecode.c        | 14 ++++----------
 src/fns.c             | 12 +++++++-----
 3 files changed, 19 insertions(+), 23 deletions(-)

diff --git a/doc/lispref/hash.texi b/doc/lispref/hash.texi
index 051531491c..50d4c5742c 100644
--- a/doc/lispref/hash.texi
+++ b/doc/lispref/hash.texi
@@ -132,7 +132,7 @@ Creating Hash
 it grows automatically.  This value specifies how to make the hash table
 larger, at that time.
 
-If @var{rehash-size} is a fixnum, it should be positive and the hash
+If @var{rehash-size} is an integer, it should be positive, and the hash
 table grows by adding approximately that much to the nominal size.  If
 @var{rehash-size} is floating point, it had better be greater
 than 1, and the hash table grows by multiplying the old size by
@@ -239,8 +239,8 @@ Defining Hash
 
   You can think of a hash table conceptually as a large array of many
 slots, each capable of holding one association.  To look up a key,
-@code{gethash} first computes a fixnum, the hash code, from the key.
-It reduces this fixnum modulo the length of the array, to produce an
+@code{gethash} first computes an integer, the hash code, from the key.
+It can reduce this integer modulo the length of the array, to produce an
 index in the array.  Then it looks in that slot, and if necessary in
 other nearby slots, to see if it has found the key being sought.
 
@@ -265,7 +265,7 @@ Defining Hash
 return non-@code{nil} if they are considered the same.
 
 The function @var{hash-fn} should accept one argument, a key, and return
-a fixnum that is the hash code of that key.  For good results, the
+an integer that is the hash code of that key.  For good results, the
 function should use the whole range of fixnums for hash codes,
 including negative fixnums.
 
@@ -276,12 +276,12 @@ Defining Hash
 
 @defun sxhash-equal obj
 This function returns a hash code for Lisp object @var{obj}.
-This is a fixnum that reflects the contents of @var{obj}
+This is an integer that reflects the contents of @var{obj}
 and the other Lisp objects it points to.
 
 If two objects @var{obj1} and @var{obj2} are @code{equal}, then
 @code{(sxhash-equal @var{obj1})} and @code{(sxhash-equal @var{obj2})}
-are the same fixnum.
+are the same integer.
 
 If the two objects are not @code{equal}, the values returned by
 @code{sxhash-equal} are usually different, but not always; once in a
@@ -299,7 +299,7 @@ Defining Hash
 
 If two objects @var{obj1} and @var{obj2} are @code{eq}, then
 @code{(sxhash-eq @var{obj1})} and @code{(sxhash-eq @var{obj2})} are
-the same fixnum.
+the same integer.
 @end defun
 
 @defun sxhash-eql obj
@@ -310,7 +310,7 @@ Defining Hash
 
 If two objects @var{obj1} and @var{obj2} are @code{eql}, then
 @code{(sxhash-eql @var{obj1})} and @code{(sxhash-eql @var{obj2})} are
-the same fixnum.
+the same integer.
 @end defun
 
   This example creates a hash table whose keys are strings that are
diff --git a/src/bytecode.c b/src/bytecode.c
index d668a9a6a1..9aad1eb642 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -1406,18 +1406,12 @@ #define DEFINE(name, value) LABEL (name) ,
 
             /* h->count is a faster approximation for HASH_TABLE_SIZE (h)
                here. */
-            if (h->count <= 5)
+            if (h->count <= 5 && !h->test.cmpfn)
               { /* Do a linear search if there are not many cases
                    FIXME: 5 is arbitrarily chosen.  */
-		Lisp_Object hash_code
-		  = h->test.cmpfn ? h->test.hashfn (v1, h) : Qnil;
-
-                for (i = h->count; 0 <= --i; )
-                  if (EQ (v1, HASH_KEY (h, i))
-                      || (h->test.cmpfn
-                          && EQ (hash_code, HASH_HASH (h, i))
-			  && !NILP (h->test.cmpfn (v1, HASH_KEY (h, i), h))))
-                    break;
+		for (i = h->count; 0 <= --i; )
+		  if (EQ (v1, HASH_KEY (h, i)))
+		    break;
               }
             else
               i = hash_lookup (h, v1, NULL);
diff --git a/src/fns.c b/src/fns.c
index 734a2e253c..d28d437df9 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -47,6 +47,7 @@ Copyright (C) 1985-1987, 1993-1995, 1997-2019 Free Software Foundation,
 enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES };
 static bool internal_equal (Lisp_Object, Lisp_Object,
 			    enum equal_kind, int, Lisp_Object);
+static EMACS_UINT sxhash_bignum (struct Lisp_Bignum *);
 
 DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
        doc: /* Return the argument unchanged.  */
@@ -4021,7 +4022,8 @@ hashfn_eql (Lisp_Object key, struct Lisp_Hash_Table *h)
 hashfn_user_defined (Lisp_Object key, struct Lisp_Hash_Table *h)
 {
   Lisp_Object args[] = { h->test.user_hash_function, key };
-  return hash_table_user_defined_call (ARRAYELTS (args), args, h);
+  Lisp_Object hash = hash_table_user_defined_call (ARRAYELTS (args), args, h);
+  return BIGNUMP (hash) ? make_fixnum (sxhash_bignum (XBIGNUM (hash))) : hash;
 }
 
 struct hash_table_test const
@@ -4707,7 +4709,7 @@ sxhash (Lisp_Object obj, int depth)
  ***********************************************************************/
 
 DEFUN ("sxhash-eq", Fsxhash_eq, Ssxhash_eq, 1, 1, 0,
-       doc: /* Return a fixnum hash code for OBJ suitable for `eq'.
+       doc: /* Return an integer hash code for OBJ suitable for `eq'.
 If (eq A B), then (= (sxhash-eq A) (sxhash-eq B)).
 
 Hash codes are not guaranteed to be preserved across Emacs sessions.  */)
@@ -4717,7 +4719,7 @@ If (eq A B), then (= (sxhash-eq A) (sxhash-eq B)).
 }
 
 DEFUN ("sxhash-eql", Fsxhash_eql, Ssxhash_eql, 1, 1, 0,
-       doc: /* Return a fixnum hash code for OBJ suitable for `eql'.
+       doc: /* Return an integer hash code for OBJ suitable for `eql'.
 If (eql A B), then (= (sxhash-eql A) (sxhash-eql B)).
 
 Hash codes are not guaranteed to be preserved across Emacs sessions.  */)
@@ -4727,7 +4729,7 @@ If (eql A B), then (= (sxhash-eql A) (sxhash-eql B)).
 }
 
 DEFUN ("sxhash-equal", Fsxhash_equal, Ssxhash_equal, 1, 1, 0,
-       doc: /* Return a fixnum hash code for OBJ suitable for `equal'.
+       doc: /* Return an integer hash code for OBJ suitable for `equal'.
 If (equal A B), then (= (sxhash-equal A) (sxhash-equal B)).
 
 Hash codes are not guaranteed to be preserved across Emacs sessions.  */)
@@ -4751,7 +4753,7 @@ DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0,
 Default is 65.
 
 :rehash-size REHASH-SIZE - Indicates how to expand the table when it
-fills up.  If REHASH-SIZE is a fixnum, increase the size by that
+fills up.  If REHASH-SIZE is an integer, increase the size by that
 amount.  If it is a float, it must be > 1.0, and the new size is the
 old size multiplied by that factor.  Default is 1.5.
 
-- 
2.17.1