[PATCH] Make purecopy create hash tables properly

[PATCH] Make purecopy create hash tables properly

[Vibhav Pant]

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

As of now, hash tables are purecopied by getting XVECTOR(table),
and copying the contents to pure-alloced memory[0]. This resulted
in purecopy returning a vector consisting of mostly nil and random numbers[1].

As the current lisp code doesn't use printed hash tables anywhere, this
never caused a problem while dumping emacs. However, using printed
hash tables in any code thats loaded in temacs causes the keys and values
of the table to change [2], or segfaults temacs altogether [3].

The following patch attempts to fix this, by adding a make_pure_hash_table
function that returns a copy of the provided Lisp_Hash_Table* value allocated
in pure space. From my testing, this both the issues with printed hash tables
in temacs, although I am not sure about the repercussions of blindly copying
the header (vectorlike_header) from one Lisp_Hash_Table to another. Any
feedback on this would be appreciated, as I would like to get this into master
to continue work on byte-switch [4], which makes use of printed hash tables
in the constant vector of bytecode functions.

I'm not well versed with Emacs internals, apologies if anything above was
incorrect.

[0] http://git.savannah.gnu.org/cgit/emacs.git/tree/src/alloc.c#n5480
[1] http://ix.io/1ReZ
[2] https://lists.gnu.org/archive/html/emacs-devel/2017-01/msg00568.html
[3] https://lists.gnu.org/archive/html/emacs-devel/2017-01/msg00597.html
[4] http://git.savannah.gnu.org/cgit/emacs.git/tree/etc/TODO#n38
---
diff --git a/src/alloc.c b/src/alloc.c
index f7b6515f4e..b64f2de224 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -5434,6 +5434,33 @@ make_pure_vector (ptrdiff_t len)
   return new;
 }

+static struct Lisp_Hash_Table * make_pure_hash_table(struct
Lisp_Hash_Table *table);
+
+/* Return a hash table with the same parameters and values as that of TABLE
+   allocated from pure space.  */
+static struct Lisp_Hash_Table *
+make_pure_hash_table(struct Lisp_Hash_Table *table)
+{
+  struct Lisp_Hash_Table *pure = pure_alloc (sizeof *pure, Lisp_Vectorlike);
+  pure->header = table->header;
+  pure->weak = purecopy (table->weak);
+  pure->rehash_size = purecopy (table->rehash_size);
+  pure->rehash_threshold = purecopy(table->rehash_threshold);
+  pure->hash = purecopy (table->hash);
+  pure->next = purecopy (table->next);
+  pure->next_free = purecopy (table->next_free);
+  pure->index = purecopy (table->index);
+  pure->count = table->count;
+  pure->key_and_value = purecopy (table->key_and_value);
+  pure->test = table->test;
+
+  if (table->next_weak) {
+    pure->next_weak = make_pure_hash_table (table->next_weak);
+  }
+
+  return pure;
+}
+
 DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0,
        doc: /* Make a copy of object OBJ in pure storage.
 Recursively copies contents of vectors and cons cells.
@@ -5477,7 +5504,11 @@ purecopy (Lisp_Object obj)
     obj = make_pure_string (SSDATA (obj), SCHARS (obj),
     SBYTES (obj),
     STRING_MULTIBYTE (obj));
-  else if (COMPILEDP (obj) || VECTORP (obj) || HASH_TABLE_P (obj))
+  else if (HASH_TABLE_P (obj)) {
+    struct Lisp_Hash_Table *h = make_pure_hash_table(XHASH_TABLE(obj));
+    XSET_HASH_TABLE(obj, h);
+  }
+  else if (COMPILEDP (obj) || VECTORP (obj))
     {
       struct Lisp_Vector *objp = XVECTOR (obj);
       ptrdiff_t nbytes = vector_nbytes (objp);


-- 
Vibhav Pant
vibhavp@gmail.com

[-- Attachment #2: purecopy_hash_table.patch --]
[-- Type: text/x-patch, Size: 1843 bytes --]

diff --git a/src/alloc.c b/src/alloc.c
index f7b6515f4e..b64f2de224 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -5434,6 +5434,33 @@ make_pure_vector (ptrdiff_t len)
   return new;
 }
 
+static struct Lisp_Hash_Table * make_pure_hash_table(struct Lisp_Hash_Table *table);
+
+/* Return a hash table with the same parameters and values as that of TABLE
+   allocated from pure space.  */
+static struct Lisp_Hash_Table *
+make_pure_hash_table(struct Lisp_Hash_Table *table)
+{
+  struct Lisp_Hash_Table *pure = pure_alloc (sizeof *pure, Lisp_Vectorlike);
+  pure->header = table->header;
+  pure->weak = purecopy (table->weak);
+  pure->rehash_size = purecopy (table->rehash_size);
+  pure->rehash_threshold = purecopy(table->rehash_threshold);
+  pure->hash = purecopy (table->hash);
+  pure->next = purecopy (table->next);
+  pure->next_free = purecopy (table->next_free);
+  pure->index = purecopy (table->index);
+  pure->count = table->count;
+  pure->key_and_value = purecopy (table->key_and_value);
+  pure->test = table->test;
+
+  if (table->next_weak) {
+    pure->next_weak = make_pure_hash_table (table->next_weak);
+  }
+
+  return pure;
+}
+
 DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0,
        doc: /* Make a copy of object OBJ in pure storage.
 Recursively copies contents of vectors and cons cells.
@@ -5477,7 +5504,11 @@ purecopy (Lisp_Object obj)
     obj = make_pure_string (SSDATA (obj), SCHARS (obj),
 			    SBYTES (obj),
 			    STRING_MULTIBYTE (obj));
-  else if (COMPILEDP (obj) || VECTORP (obj) || HASH_TABLE_P (obj))
+  else if (HASH_TABLE_P (obj)) {
+    struct Lisp_Hash_Table *h = make_pure_hash_table(XHASH_TABLE(obj));
+    XSET_HASH_TABLE(obj, h);
+  }
+  else if (COMPILEDP (obj) || VECTORP (obj))
     {
       struct Lisp_Vector *objp = XVECTOR (obj);
       ptrdiff_t nbytes = vector_nbytes (objp);

Re: [PATCH] Make purecopy create hash tables properly

[Paul Eggert]

Thanks for the patch. It looks like the right thing to do. Could you please fix 
it up on the following minor ways?

* Use GNU style for C code: space between function and paren, braces nested GNU 
style, etc. Look in neighboring code for examples.

* Rewrite make_pure_hash_table so that it uses a loop rather than recursion, 
when it follows the next_weak link.

* Create a proper ChangeLog-style commit message.

* Send bug-gnu-emacs email containing the patch in 'git format-patch' format, 
e.g., by using the command 'git send-email'. Please see the "Commit messages" 
section in CONTRIBUTE for details about the commit message style.

Thanks again.

Re: [PATCH] Make purecopy create hash tables properly

[Stefan Monnier]

> -  else if (COMPILEDP (obj) || VECTORP (obj) || HASH_TABLE_P (obj))
> +  else if (HASH_TABLE_P (obj)) {
> +    struct Lisp_Hash_Table *h = make_pure_hash_table(XHASH_TABLE(obj));
> +    XSET_HASH_TABLE(obj, h);
> +  }
> +  else if (COMPILEDP (obj) || VECTORP (obj))
>      {
>        struct Lisp_Vector *objp = XVECTOR (obj);
>        ptrdiff_t nbytes = vector_nbytes (objp);

Oh, indeed, I see what was the problem:
We relied on the generic vector-copy code for the hash-tables, whereas
those do not only contain Lisp_Object fields (and they also contain some
Lisp_Object fields which are beyond the part copied by the generic
code).

So another way to fix the code would something like the patch below
(100% untested).

Whichever option you take, please pay attention to `next_weak` because
in your patch, you'll end up purecopying some of the other weak
hash-tables but you won't register this one as a weak hash table, so it
will lead to serious problems.


        Stefan


diff --git a/src/alloc.c b/src/alloc.c
index 1a6d4e2d56..c15bbf3a2f 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -5519,6 +5519,18 @@ purecopy (Lisp_Object obj)
       memcpy (vec, objp, nbytes);
       for (i = 0; i < size; i++)
 	vec->contents[i] = purecopy (vec->contents[i]);
+      if (HASH_TABLE_P (obj))
+        {
+          struct Lisp_Hash_Table *old = (struct Lisp_Hash_Table *) objp;
+          struct Lisp_Hash_Table *new = (struct Lisp_Hash_Table *) vec;
+          new->count = new->count;
+          new->key_and_value = purecopy (old->key_and_value);
+          new->test = old->test;
+          new->next_weak = old->next_weak
+          if (!NILP (old->weak))
+            /* Insert ourselves in the list of weak hash tables.  */
+            old->next_weak = new;
+        }
       XSETVECTOR (obj, vec);
     }
   else if (SYMBOLP (obj))

Re: [PATCH] Make purecopy create hash tables properly

[Vibhav Pant]

On Sat, Jan 28, 2017 at 4:40 AM, Stefan Monnier
<monnier@iro.umontreal.ca> wrote:
> Whichever option you take, please pay attention to `next_weak` because
> in your patch, you'll end up purecopying some of the other weak
> hash-tables but you won't register this one as a weak hash table, so it
> will lead to serious problems.

Not sure if I'm correct here, but shouldn't we be *not* purecopying weak hash
tables? Otherwise, GC will result in potentially writing over/freeing pure
memory, something that we don't want to happen. Plus, I think that this opens
another can of worms for code like this:

(let ((h #s(hash-table data ())))
  (puthash 'foo 'bar h))

or

(defun a ()
 #s(hash-table data ())) ;; the returned table might be purecopied
                                     ;; and the callee might write to it

Which also writes to pure storage if the code is purecopied during
dumping emacs.
I'd recommend skipping purecopy for hash tables altogether, and add an
internal :read-only flag to (make-hash-table) for hash tables we know aren't
going to be be written to, and are thus safe to be purecopied (this would
obviously only be useful for hash tables that are defined using printed syntax).

-- 
Vibhav Pant
vibhavp@gmail.com

Re: [PATCH] Make purecopy create hash tables properly

[Vibhav Pant]

On Sat, Jan 28, 2017 at 3:55 PM, Vibhav Pant <vibhavp@gmail.com> wrote:

>  #s(hash-table data ())) ;; the returned table might be purecopied
>                                      ;; and the callee might write to it

s/callee/caller/

-- 
Vibhav Pant
vibhavp@gmail.com

Re: [PATCH] Make purecopy create hash tables properly

[Stefan Monnier]

> Not sure if I'm correct here, but shouldn't we be *not* purecopying weak hash
> tables?

Good point.  So we should check NILP (old->weak) and signal an
error if set.  And thus old->next_weak should always be NULL and is
trivial to copy.

> I'd recommend skipping purecopy for hash tables altogether, and add an

That would imply we can't purecopy any object which ends up referencing
a hash-table.  Unless we arrange to keep track of those hash-tables
which are referenced from purespace.  We already do that for symbols, so
maybe we can extend/generalize that mechanism (probably a good idea).

> internal :read-only flag to (make-hash-table) for hash tables we know
> aren't going to be be written to, and are thus safe to be purecopied
> (this would obviously only be useful for hash tables that are defined
> using printed syntax).

For cons cells we do:

  CHECK_IMPURE (cell, XCONS (cell));

in `setcar', so we can do the same for hash-tables.  Since purespace is
contiguous, CHECK_IMPURE is pretty efficient, and since it only relies
on the pointer value, the CPU can compute it in parallel with the access to
the object (and the test itself is trivial to predict), so it should
have a negligible impact on performance.


        Stefan

Re: [PATCH] Make purecopy create hash tables properly

[Vibhav Pant]

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

On Sat 28 Jan, 2017, 8:28 PM Stefan Monnier, <monnier@iro.umontreal.ca>
wrote:

> Unless we arrange to keep track of those hash-tables
> which are referenced from purespace.  We already do that for symbols, so
> maybe we can extend/generalize that mechanism (probably a good idea).
>

Where is this implemented? I could use this to do the same for hash tables.

>

[-- Attachment #2: Type: text/html, Size: 824 bytes --]

Re: [PATCH] Make purecopy create hash tables properly

[Stefan Monnier]

>> Unless we arrange to keep track of those hash-tables
>> which are referenced from purespace.  We already do that for symbols, so
>> maybe we can extend/generalize that mechanism (probably a good idea).
> Where is this implemented? I could use this to do the same for hash tables.

Currently, it's implemented via the `pinned` bit in the symbol objects,
plus the mark_pinned_symbols function.  You could introduce
a `pinned_objects` array instead.


        Stefan

Re: [PATCH] Make purecopy create hash tables properly

[Vibhav Pant]

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

On Sat, Jan 28, 2017 at 8:28 PM, Stefan Monnier
<monnier@iro.umontreal.ca> wrote:
> Good point.  So we should check NILP (old->weak) and signal an
> error if set.  And thus old->next_weak should always be NULL and is
> trivial to copy.

> That would imply we can't purecopy any object which ends up referencing
> a hash-table.  Unless we arrange to keep track of those hash-tables
> which are referenced from purespace.  We already do that for symbols, so
> maybe we can extend/generalize that mechanism (probably a good idea).
>
> For cons cells we do:
>
>   CHECK_IMPURE (cell, XCONS (cell));
>
> in `setcar', so we can do the same for hash-tables.  Since purespace is
> contiguous, CHECK_IMPURE is pretty efficient, and since it only relies
> on the pointer value, the CPU can compute it in parallel with the access to
> the object (and the test itself is trivial to predict), so it should
> have a negligible impact on performance.

Based on these suggestions, I have made a few more modifications to the code:

* `gethash' now takes an additional :purecopy argument. If non-nil, the table
will/can be copied to pure storage when the Emacs binary is being dumped.
Since objects in pure storage are read only, gethash enforces that :weak and
:purecopy aren't non-nil at the same time, erroring out when the latter is true.

* All functions that modify hash tables (`puthash', `clrhash' and `remhash')
make sure that the table is not in pure storage (with CHECK_IMPURE).

* `make_pure_hash_table' now also purecopies the hash table test, and enforces
the checks above with `eassert'.

* A new struct, `pinned_object' is used as a linked list to store objects that
should be marked before every GC cycle. For now, this is only used when
a hash table with the :purecopy property set to nil is passed to purecopy (but
should be usable for other objects in the future).

Should this work, or is there anything else I need to do?

Thanks,
Vibhav
-- 
Vibhav Pant
vibhavp@gmail.com

diff --git a/src/alloc.c b/src/alloc.c
index f7b6515f4e..7d1132c953 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -5434,6 +5434,35 @@ make_pure_vector (ptrdiff_t len)
   return new;
 }

+static struct Lisp_Hash_Table *
+make_pure_hash_table (struct Lisp_Hash_Table *table) {
+  eassert (NILP (table->weak));
+  eassert (!NILP (table->pure));
+
+  struct Lisp_Hash_Table *pure = pure_alloc (sizeof *pure, Lisp_Vectorlike);
+  struct hash_table_test pure_test = table->test;
+
+  /* Purecopy the hash table test.  */
+  pure_test.name = purecopy (table->test.name);
+  pure_test.user_hash_function = purecopy (table->test.user_hash_function);
+  pure_test.user_cmp_function = purecopy (table->test.user_cmp_function);
+
+  pure->test = pure_test;
+  pure->header = table->header;
+  pure->weak = purecopy (Qnil);
+  pure->rehash_size = purecopy (table->rehash_size);
+  pure->rehash_threshold = purecopy (table->rehash_threshold);
+  pure->hash = purecopy (table->hash);
+  pure->next = purecopy (table->next);
+  pure->next_free = purecopy (table->next_free);
+  pure->index = purecopy (table->index);
+  pure->count = table->count;
+  pure->key_and_value = purecopy (table->key_and_value);
+  pure->pure = purecopy (table->pure);
+
+  return pure;
+}
+
 DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0,
        doc: /* Make a copy of object OBJ in pure storage.
 Recursively copies contents of vectors and cons cells.
@@ -5442,14 +5471,22 @@ Does not copy symbols.  Copies strings without
text properties.  */)
 {
   if (NILP (Vpurify_flag))
     return obj;
-  else if (MARKERP (obj) || OVERLAYP (obj)
-   || HASH_TABLE_P (obj) || SYMBOLP (obj))
+  else if (MARKERP (obj) || OVERLAYP (obj) || SYMBOLP (obj))
     /* Can't purify those.  */
     return obj;
   else
     return purecopy (obj);
 }

+struct pinned_object
+{
+  Lisp_Object object;
+  struct pinned_object *next;
+};
+
+/* Pinned objects are marked before every GC cycle.  */
+static struct pinned_object *pinned_objects;
+
 static Lisp_Object
 purecopy (Lisp_Object obj)
 {
@@ -5477,7 +5514,26 @@ purecopy (Lisp_Object obj)
     obj = make_pure_string (SSDATA (obj), SCHARS (obj),
     SBYTES (obj),
     STRING_MULTIBYTE (obj));
-  else if (COMPILEDP (obj) || VECTORP (obj) || HASH_TABLE_P (obj))
+  else if (HASH_TABLE_P (obj))
+    {
+      struct Lisp_Hash_Table *table = XHASH_TABLE (obj);
+      /* We cannot purecopy hash tables which haven't been defined with
+         :purecopy as non-nil, they aren't guaranteed to not change.  */
+      if (NILP (table->pure))
+        {
+          /* Instead, the hash table is added to the list of pinned objects,
+             and is marked before GC.  */
+          struct pinned_object *o = xmalloc (sizeof *o);
+          o->object = obj;
+          o->next = pinned_objects;
+          pinned_objects = o;
+          return obj;
+        }
+
+      struct Lisp_Hash_Table *h = make_pure_hash_table (table);
+      XSET_HASH_TABLE (obj, h);
+    }
+  else if (COMPILEDP (obj) || VECTORP (obj))
     {
       struct Lisp_Vector *objp = XVECTOR (obj);
       ptrdiff_t nbytes = vector_nbytes (objp);
@@ -5694,6 +5750,16 @@ compact_undo_list (Lisp_Object list)
 }

 static void
+mark_pinned_objects (void)
+{
+  struct pinned_object *pobj;
+  for (pobj = pinned_objects; pobj; pobj = pobj->next)
+    {
+      mark_object (pobj->object);
+    }
+}
+
+static void
 mark_pinned_symbols (void)
 {
   struct symbol_block *sblk;
@@ -5813,6 +5879,7 @@ garbage_collect_1 (void *end)
   for (i = 0; i < staticidx; i++)
     mark_object (*staticvec[i]);

+  mark_pinned_objects ();
   mark_pinned_symbols ();
   mark_terminals ();
   mark_kboards ();
diff --git a/src/category.c b/src/category.c
index e5d261c1cf..ff287a4af3 100644
--- a/src/category.c
+++ b/src/category.c
@@ -67,7 +67,7 @@ hash_get_category_set (Lisp_Object table,
Lisp_Object category_set)
        make_hash_table (hashtest_equal, make_number (DEFAULT_HASH_SIZE),
  make_float (DEFAULT_REHASH_SIZE),
  make_float (DEFAULT_REHASH_THRESHOLD),
- Qnil));
+ Qnil, Qnil));
   h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]);
   i = hash_lookup (h, category_set, &hash);
   if (i >= 0)
diff --git a/src/emacs-module.c b/src/emacs-module.c
index e22c7dc5b7..69fa5c8e64 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -1016,7 +1016,7 @@ syms_of_module (void)
     = make_hash_table (hashtest_eq, make_number (DEFAULT_HASH_SIZE),
        make_float (DEFAULT_REHASH_SIZE),
        make_float (DEFAULT_REHASH_THRESHOLD),
-       Qnil);
+       Qnil, Qnil);
   Funintern (Qmodule_refs_hash, Qnil);

   DEFSYM (Qmodule_environments, "module-environments");
diff --git a/src/fns.c b/src/fns.c
index b8ebfe5b2e..420bf6c1ee 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -34,6 +34,7 @@ along with GNU Emacs.  If not, see
<http://www.gnu.org/licenses/>.  */
 #include "buffer.h"
 #include "intervals.h"
 #include "window.h"
+#include "puresize.h"

 static void sort_vector_copy (Lisp_Object, ptrdiff_t,
       Lisp_Object *restrict, Lisp_Object *restrict);
@@ -3750,12 +3751,17 @@ allocate_hash_table (void)
    (table size) is >= REHASH_THRESHOLD.

    WEAK specifies the weakness of the table.  If non-nil, it must be
-   one of the symbols `key', `value', `key-or-value', or `key-and-value'.  */
+   one of the symbols `key', `value', `key-or-value', or `key-and-value'.
+
+   If PURECOPY is non-nil, the table can be copied to pure storage via
+   `purecopy' when Emacs is being dumped. Such tables can no longer be
+   changed after purecopy.  */

 Lisp_Object
 make_hash_table (struct hash_table_test test,
  Lisp_Object size, Lisp_Object rehash_size,
- Lisp_Object rehash_threshold, Lisp_Object weak)
+ Lisp_Object rehash_threshold, Lisp_Object weak,
+                 Lisp_Object pure)
 {
   struct Lisp_Hash_Table *h;
   Lisp_Object table;
@@ -3774,6 +3780,8 @@ make_hash_table (struct hash_table_test test,

   if (XFASTINT (size) == 0)
     size = make_number (1);
+  if (!NILP (weak) && !NILP (pure))
+    error ("Weak hash tables cannot be purecopied");

   sz = XFASTINT (size);
   index_float = sz / XFLOAT_DATA (rehash_threshold);
@@ -3796,6 +3804,7 @@ make_hash_table (struct hash_table_test test,
   h->hash = Fmake_vector (size, Qnil);
   h->next = Fmake_vector (size, Qnil);
   h->index = Fmake_vector (make_number (index_size), Qnil);
+  h->pure = pure;

   /* Set up the free list.  */
   for (i = 0; i < sz - 1; ++i)
@@ -4460,10 +4469,14 @@ key, value, one of key or value, or both key
and value, depending on
 WEAK.  WEAK t is equivalent to `key-and-value'.  Default value of WEAK
 is nil.

+:purecopy PURECOPY -- If PURECOPY is non-nil, the table can be copied
+to pure storage when Emacs is being dumped, making the contents of the
+table read only. WEAK should be nil for such tables.
+
 usage: (make-hash-table &rest KEYWORD-ARGS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
-  Lisp_Object test, size, rehash_size, rehash_threshold, weak;
+  Lisp_Object test, size, rehash_size, rehash_threshold, weak, pure;
   struct hash_table_test testdesc;
   ptrdiff_t i;
   USE_SAFE_ALLOCA;
@@ -4497,6 +4510,9 @@ usage: (make-hash-table &rest KEYWORD-ARGS)  */)
       testdesc.cmpfn = cmpfn_user_defined;
     }

+  /* See if there's a `:purecopy PURECOPY' argument.  */
+  i = get_key_arg (QCpurecopy, nargs, args, used);
+  pure = i ? args[i] : Qnil;
   /* See if there's a `:size SIZE' argument.  */
   i = get_key_arg (QCsize, nargs, args, used);
   size = i ? args[i] : Qnil;
@@ -4538,7 +4554,8 @@ usage: (make-hash-table &rest KEYWORD-ARGS)  */)
       signal_error ("Invalid argument list", args[i]);

   SAFE_FREE ();
-  return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak);
+  return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak,
+                          pure);
 }


@@ -4617,7 +4634,9 @@ DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0,
        doc: /* Clear hash table TABLE and return it.  */)
   (Lisp_Object table)
 {
-  hash_clear (check_hash_table (table));
+  struct Lisp_Hash_Table *h = check_hash_table (table);
+  CHECK_IMPURE (table, h);
+  hash_clear (h);
   /* Be compatible with XEmacs.  */
   return table;
 }
@@ -4641,9 +4660,10 @@ VALUE.  In any case, return VALUE.  */)
   (Lisp_Object key, Lisp_Object value, Lisp_Object table)
 {
   struct Lisp_Hash_Table *h = check_hash_table (table);
+  CHECK_IMPURE (table, h);
+
   ptrdiff_t i;
   EMACS_UINT hash;
-
   i = hash_lookup (h, key, &hash);
   if (i >= 0)
     set_hash_value_slot (h, i, value);
@@ -4659,6 +4679,7 @@ DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0,
   (Lisp_Object key, Lisp_Object table)
 {
   struct Lisp_Hash_Table *h = check_hash_table (table);
+  CHECK_IMPURE (table, h);
   hash_remove_from_table (h, key);
   return Qnil;
 }
@@ -5029,6 +5050,7 @@ syms_of_fns (void)
   DEFSYM (Qequal, "equal");
   DEFSYM (QCtest, ":test");
   DEFSYM (QCsize, ":size");
+  DEFSYM (QCpurecopy, ":purecopy");
   DEFSYM (QCrehash_size, ":rehash-size");
   DEFSYM (QCrehash_threshold, ":rehash-threshold");
   DEFSYM (QCweakness, ":weakness");
diff --git a/src/image.c b/src/image.c
index 39677d2add..ad0143be48 100644
--- a/src/image.c
+++ b/src/image.c
@@ -4020,7 +4020,7 @@ xpm_make_color_table_h (void (**put_func)
(Lisp_Object, const char *, int,
   return make_hash_table (hashtest_equal, make_number (DEFAULT_HASH_SIZE),
   make_float (DEFAULT_REHASH_SIZE),
   make_float (DEFAULT_REHASH_THRESHOLD),
-  Qnil);
+  Qnil, Qnil);
 }

 static void
diff --git a/src/lisp.h b/src/lisp.h
index 84d53bb1ee..91c430fe98 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1995,6 +1995,10 @@ struct Lisp_Hash_Table
      hash table size to reduce collisions.  */
   Lisp_Object index;

+  /* Non-nil if the table can be purecopied. Any changes the table after
+     purecopy will result in an error.  */
+  Lisp_Object pure;
+
   /* Only the fields above are traced normally by the GC.  The ones below
      `count' are special and are either ignored by the GC or traced in
      a special way (e.g. because of weakness).  */
@@ -3364,7 +3368,7 @@ extern void sweep_weak_hash_tables (void);
 EMACS_UINT hash_string (char const *, ptrdiff_t);
 EMACS_UINT sxhash (Lisp_Object, int);
 Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object,
-                             Lisp_Object, Lisp_Object);
+                             Lisp_Object, Lisp_Object, Lisp_Object);
 ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *);
 ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
     EMACS_UINT);
diff --git a/src/lread.c b/src/lread.c
index ea2a1d1d85..17806922a8 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -2599,7 +2599,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool
first_in_list)
       Lisp_Object val = Qnil;
       /* The size is 2 * number of allowed keywords to
  make-hash-table.  */
-      Lisp_Object params[10];
+      Lisp_Object params[12];
       Lisp_Object ht;
       Lisp_Object key = Qnil;
       int param_count = 0;
@@ -2636,6 +2636,11 @@ read1 (Lisp_Object readcharfun, int *pch, bool
first_in_list)
       if (!NILP (params[param_count + 1]))
  param_count += 2;

+              params[param_count] = QCpurecopy;
+              params[param_count + 1] = Fplist_get (tmp, Qpurecopy);
+              if (!NILP (params[param_count + 1]))
+                param_count += 2;
+
       /* This is the hash table data.  */
       data = Fplist_get (tmp, Qdata);

@@ -4849,6 +4854,7 @@ that are loaded before your customizations are read!  */);
   DEFSYM (Qdata, "data");
   DEFSYM (Qtest, "test");
   DEFSYM (Qsize, "size");
+  DEFSYM (Qpurecopy, "purecopy");
   DEFSYM (Qweakness, "weakness");
   DEFSYM (Qrehash_size, "rehash-size");
   DEFSYM (Qrehash_threshold, "rehash-threshold");
diff --git a/src/print.c b/src/print.c
index 36d68a452e..db3d00f51f 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1818,6 +1818,12 @@ print_object (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag)
       print_object (h->rehash_threshold, printcharfun, escapeflag);
     }

+          if (!NILP (h->pure))
+            {
+              print_c_string (" purecopy ", printcharfun);
+      print_object (h->pure, printcharfun, escapeflag);
+            }
+
   print_c_string (" data ", printcharfun);

   /* Print the data here as a plist. */
diff --git a/src/profiler.c b/src/profiler.c
index 88825bebdb..a223a7e7c0 100644
--- a/src/profiler.c
+++ b/src/profiler.c
@@ -48,7 +48,7 @@ make_log (EMACS_INT heap_size, EMACS_INT max_stack_depth)
      make_number (heap_size),
      make_float (DEFAULT_REHASH_SIZE),
      make_float (DEFAULT_REHASH_THRESHOLD),
-     Qnil);
+     Qnil, Qnil);
   struct Lisp_Hash_Table *h = XHASH_TABLE (log);

   /* What is special about our hash-tables is that the keys are pre-filled
diff --git a/src/xterm.c b/src/xterm.c
index 80cf8ce191..38229a5f31 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -12877,7 +12877,7 @@ keysyms.  The default is nil, which is the
same as `super'.  */);
   Vx_keysym_table = make_hash_table (hashtest_eql, make_number (900),
      make_float (DEFAULT_REHASH_SIZE),
      make_float (DEFAULT_REHASH_THRESHOLD),
-     Qnil);
+     Qnil, Qnil);

   DEFVAR_BOOL ("x-frame-normalize-before-maximize",
        x_frame_normalize_before_maximize,

[-- Attachment #2: purecopy_hash_table.patch --]
[-- Type: text/x-patch, Size: 13415 bytes --]

diff --git a/src/alloc.c b/src/alloc.c
index f7b6515f4e..7d1132c953 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -5434,6 +5434,35 @@ make_pure_vector (ptrdiff_t len)
   return new;
 }
 
+static struct Lisp_Hash_Table *
+make_pure_hash_table (struct Lisp_Hash_Table *table) {
+  eassert (NILP (table->weak));
+  eassert (!NILP (table->pure));
+
+  struct Lisp_Hash_Table *pure = pure_alloc (sizeof *pure, Lisp_Vectorlike);
+  struct hash_table_test pure_test = table->test;
+
+  /* Purecopy the hash table test.  */
+  pure_test.name = purecopy (table->test.name);
+  pure_test.user_hash_function = purecopy (table->test.user_hash_function);
+  pure_test.user_cmp_function = purecopy (table->test.user_cmp_function);
+
+  pure->test = pure_test;
+  pure->header = table->header;
+  pure->weak = purecopy (Qnil);
+  pure->rehash_size = purecopy (table->rehash_size);
+  pure->rehash_threshold = purecopy (table->rehash_threshold);
+  pure->hash = purecopy (table->hash);
+  pure->next = purecopy (table->next);
+  pure->next_free = purecopy (table->next_free);
+  pure->index = purecopy (table->index);
+  pure->count = table->count;
+  pure->key_and_value = purecopy (table->key_and_value);
+  pure->pure = purecopy (table->pure);
+
+  return pure;
+}
+
 DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0,
        doc: /* Make a copy of object OBJ in pure storage.
 Recursively copies contents of vectors and cons cells.
@@ -5442,14 +5471,22 @@ Does not copy symbols.  Copies strings without text properties.  */)
 {
   if (NILP (Vpurify_flag))
     return obj;
-  else if (MARKERP (obj) || OVERLAYP (obj)
-	   || HASH_TABLE_P (obj) || SYMBOLP (obj))
+  else if (MARKERP (obj) || OVERLAYP (obj) || SYMBOLP (obj))
     /* Can't purify those.  */
     return obj;
   else
     return purecopy (obj);
 }
 
+struct pinned_object
+{
+  Lisp_Object object;
+  struct pinned_object *next;
+};
+
+/* Pinned objects are marked before every GC cycle.  */
+static struct pinned_object *pinned_objects;
+
 static Lisp_Object
 purecopy (Lisp_Object obj)
 {
@@ -5477,7 +5514,26 @@ purecopy (Lisp_Object obj)
     obj = make_pure_string (SSDATA (obj), SCHARS (obj),
 			    SBYTES (obj),
 			    STRING_MULTIBYTE (obj));
-  else if (COMPILEDP (obj) || VECTORP (obj) || HASH_TABLE_P (obj))
+  else if (HASH_TABLE_P (obj))
+    {
+      struct Lisp_Hash_Table *table = XHASH_TABLE (obj);
+      /* We cannot purecopy hash tables which haven't been defined with
+         :purecopy as non-nil, they aren't guaranteed to not change.  */
+      if (NILP (table->pure))
+        {
+          /* Instead, the hash table is added to the list of pinned objects,
+             and is marked before GC.  */
+          struct pinned_object *o = xmalloc (sizeof *o);
+          o->object = obj;
+          o->next = pinned_objects;
+          pinned_objects = o;
+          return obj;
+        }
+
+      struct Lisp_Hash_Table *h = make_pure_hash_table (table);
+      XSET_HASH_TABLE (obj, h);
+    }
+  else if (COMPILEDP (obj) || VECTORP (obj))
     {
       struct Lisp_Vector *objp = XVECTOR (obj);
       ptrdiff_t nbytes = vector_nbytes (objp);
@@ -5694,6 +5750,16 @@ compact_undo_list (Lisp_Object list)
 }
 
 static void
+mark_pinned_objects (void)
+{
+  struct pinned_object *pobj;
+  for (pobj = pinned_objects; pobj; pobj = pobj->next)
+    {
+      mark_object (pobj->object);
+    }
+}
+
+static void
 mark_pinned_symbols (void)
 {
   struct symbol_block *sblk;
@@ -5813,6 +5879,7 @@ garbage_collect_1 (void *end)
   for (i = 0; i < staticidx; i++)
     mark_object (*staticvec[i]);
 
+  mark_pinned_objects ();
   mark_pinned_symbols ();
   mark_terminals ();
   mark_kboards ();
diff --git a/src/category.c b/src/category.c
index e5d261c1cf..ff287a4af3 100644
--- a/src/category.c
+++ b/src/category.c
@@ -67,7 +67,7 @@ hash_get_category_set (Lisp_Object table, Lisp_Object category_set)
        make_hash_table (hashtest_equal, make_number (DEFAULT_HASH_SIZE),
 			make_float (DEFAULT_REHASH_SIZE),
 			make_float (DEFAULT_REHASH_THRESHOLD),
-			Qnil));
+			Qnil, Qnil));
   h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]);
   i = hash_lookup (h, category_set, &hash);
   if (i >= 0)
diff --git a/src/emacs-module.c b/src/emacs-module.c
index e22c7dc5b7..69fa5c8e64 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -1016,7 +1016,7 @@ syms_of_module (void)
     = make_hash_table (hashtest_eq, make_number (DEFAULT_HASH_SIZE),
 		       make_float (DEFAULT_REHASH_SIZE),
 		       make_float (DEFAULT_REHASH_THRESHOLD),
-		       Qnil);
+		       Qnil, Qnil);
   Funintern (Qmodule_refs_hash, Qnil);
 
   DEFSYM (Qmodule_environments, "module-environments");
diff --git a/src/fns.c b/src/fns.c
index b8ebfe5b2e..420bf6c1ee 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -34,6 +34,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "buffer.h"
 #include "intervals.h"
 #include "window.h"
+#include "puresize.h"
 
 static void sort_vector_copy (Lisp_Object, ptrdiff_t,
 			      Lisp_Object *restrict, Lisp_Object *restrict);
@@ -3750,12 +3751,17 @@ allocate_hash_table (void)
    (table size) is >= REHASH_THRESHOLD.
 
    WEAK specifies the weakness of the table.  If non-nil, it must be
-   one of the symbols `key', `value', `key-or-value', or `key-and-value'.  */
+   one of the symbols `key', `value', `key-or-value', or `key-and-value'.
+
+   If PURECOPY is non-nil, the table can be copied to pure storage via
+   `purecopy' when Emacs is being dumped. Such tables can no longer be
+   changed after purecopy.  */
 
 Lisp_Object
 make_hash_table (struct hash_table_test test,
 		 Lisp_Object size, Lisp_Object rehash_size,
-		 Lisp_Object rehash_threshold, Lisp_Object weak)
+		 Lisp_Object rehash_threshold, Lisp_Object weak,
+                 Lisp_Object pure)
 {
   struct Lisp_Hash_Table *h;
   Lisp_Object table;
@@ -3774,6 +3780,8 @@ make_hash_table (struct hash_table_test test,
 
   if (XFASTINT (size) == 0)
     size = make_number (1);
+  if (!NILP (weak) && !NILP (pure))
+    error ("Weak hash tables cannot be purecopied");
 
   sz = XFASTINT (size);
   index_float = sz / XFLOAT_DATA (rehash_threshold);
@@ -3796,6 +3804,7 @@ make_hash_table (struct hash_table_test test,
   h->hash = Fmake_vector (size, Qnil);
   h->next = Fmake_vector (size, Qnil);
   h->index = Fmake_vector (make_number (index_size), Qnil);
+  h->pure = pure;
 
   /* Set up the free list.  */
   for (i = 0; i < sz - 1; ++i)
@@ -4460,10 +4469,14 @@ key, value, one of key or value, or both key and value, depending on
 WEAK.  WEAK t is equivalent to `key-and-value'.  Default value of WEAK
 is nil.
 
+:purecopy PURECOPY -- If PURECOPY is non-nil, the table can be copied
+to pure storage when Emacs is being dumped, making the contents of the
+table read only. WEAK should be nil for such tables.
+
 usage: (make-hash-table &rest KEYWORD-ARGS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
-  Lisp_Object test, size, rehash_size, rehash_threshold, weak;
+  Lisp_Object test, size, rehash_size, rehash_threshold, weak, pure;
   struct hash_table_test testdesc;
   ptrdiff_t i;
   USE_SAFE_ALLOCA;
@@ -4497,6 +4510,9 @@ usage: (make-hash-table &rest KEYWORD-ARGS)  */)
       testdesc.cmpfn = cmpfn_user_defined;
     }
 
+  /* See if there's a `:purecopy PURECOPY' argument.  */
+  i = get_key_arg (QCpurecopy, nargs, args, used);
+  pure = i ? args[i] : Qnil;
   /* See if there's a `:size SIZE' argument.  */
   i = get_key_arg (QCsize, nargs, args, used);
   size = i ? args[i] : Qnil;
@@ -4538,7 +4554,8 @@ usage: (make-hash-table &rest KEYWORD-ARGS)  */)
       signal_error ("Invalid argument list", args[i]);
 
   SAFE_FREE ();
-  return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak);
+  return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak,
+                          pure);
 }
 
 
@@ -4617,7 +4634,9 @@ DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0,
        doc: /* Clear hash table TABLE and return it.  */)
   (Lisp_Object table)
 {
-  hash_clear (check_hash_table (table));
+  struct Lisp_Hash_Table *h = check_hash_table (table);
+  CHECK_IMPURE (table, h);
+  hash_clear (h);
   /* Be compatible with XEmacs.  */
   return table;
 }
@@ -4641,9 +4660,10 @@ VALUE.  In any case, return VALUE.  */)
   (Lisp_Object key, Lisp_Object value, Lisp_Object table)
 {
   struct Lisp_Hash_Table *h = check_hash_table (table);
+  CHECK_IMPURE (table, h);
+
   ptrdiff_t i;
   EMACS_UINT hash;
-
   i = hash_lookup (h, key, &hash);
   if (i >= 0)
     set_hash_value_slot (h, i, value);
@@ -4659,6 +4679,7 @@ DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0,
   (Lisp_Object key, Lisp_Object table)
 {
   struct Lisp_Hash_Table *h = check_hash_table (table);
+  CHECK_IMPURE (table, h);
   hash_remove_from_table (h, key);
   return Qnil;
 }
@@ -5029,6 +5050,7 @@ syms_of_fns (void)
   DEFSYM (Qequal, "equal");
   DEFSYM (QCtest, ":test");
   DEFSYM (QCsize, ":size");
+  DEFSYM (QCpurecopy, ":purecopy");
   DEFSYM (QCrehash_size, ":rehash-size");
   DEFSYM (QCrehash_threshold, ":rehash-threshold");
   DEFSYM (QCweakness, ":weakness");
diff --git a/src/image.c b/src/image.c
index 39677d2add..ad0143be48 100644
--- a/src/image.c
+++ b/src/image.c
@@ -4020,7 +4020,7 @@ xpm_make_color_table_h (void (**put_func) (Lisp_Object, const char *, int,
   return make_hash_table (hashtest_equal, make_number (DEFAULT_HASH_SIZE),
 			  make_float (DEFAULT_REHASH_SIZE),
 			  make_float (DEFAULT_REHASH_THRESHOLD),
-			  Qnil);
+			  Qnil, Qnil);
 }
 
 static void
diff --git a/src/lisp.h b/src/lisp.h
index 84d53bb1ee..91c430fe98 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1995,6 +1995,10 @@ struct Lisp_Hash_Table
      hash table size to reduce collisions.  */
   Lisp_Object index;
 
+  /* Non-nil if the table can be purecopied. Any changes the table after
+     purecopy will result in an error.  */
+  Lisp_Object pure;
+
   /* Only the fields above are traced normally by the GC.  The ones below
      `count' are special and are either ignored by the GC or traced in
      a special way (e.g. because of weakness).  */
@@ -3364,7 +3368,7 @@ extern void sweep_weak_hash_tables (void);
 EMACS_UINT hash_string (char const *, ptrdiff_t);
 EMACS_UINT sxhash (Lisp_Object, int);
 Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object,
-                             Lisp_Object, Lisp_Object);
+                             Lisp_Object, Lisp_Object, Lisp_Object);
 ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *);
 ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
 		    EMACS_UINT);
diff --git a/src/lread.c b/src/lread.c
index ea2a1d1d85..17806922a8 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -2599,7 +2599,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
 	      Lisp_Object val = Qnil;
 	      /* The size is 2 * number of allowed keywords to
 		 make-hash-table.  */
-	      Lisp_Object params[10];
+	      Lisp_Object params[12];
 	      Lisp_Object ht;
 	      Lisp_Object key = Qnil;
 	      int param_count = 0;
@@ -2636,6 +2636,11 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
 	      if (!NILP (params[param_count + 1]))
 		param_count += 2;
 
+              params[param_count] = QCpurecopy;
+              params[param_count + 1] = Fplist_get (tmp, Qpurecopy);
+              if (!NILP (params[param_count + 1]))
+                param_count += 2;
+
 	      /* This is the hash table data.  */
 	      data = Fplist_get (tmp, Qdata);
 
@@ -4849,6 +4854,7 @@ that are loaded before your customizations are read!  */);
   DEFSYM (Qdata, "data");
   DEFSYM (Qtest, "test");
   DEFSYM (Qsize, "size");
+  DEFSYM (Qpurecopy, "purecopy");
   DEFSYM (Qweakness, "weakness");
   DEFSYM (Qrehash_size, "rehash-size");
   DEFSYM (Qrehash_threshold, "rehash-threshold");
diff --git a/src/print.c b/src/print.c
index 36d68a452e..db3d00f51f 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1818,6 +1818,12 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 	      print_object (h->rehash_threshold, printcharfun, escapeflag);
 	    }
 
+          if (!NILP (h->pure))
+            {
+              print_c_string (" purecopy ", printcharfun);
+	      print_object (h->pure, printcharfun, escapeflag);
+            }
+
 	  print_c_string (" data ", printcharfun);
 
 	  /* Print the data here as a plist. */
diff --git a/src/profiler.c b/src/profiler.c
index 88825bebdb..a223a7e7c0 100644
--- a/src/profiler.c
+++ b/src/profiler.c
@@ -48,7 +48,7 @@ make_log (EMACS_INT heap_size, EMACS_INT max_stack_depth)
 				     make_number (heap_size),
 				     make_float (DEFAULT_REHASH_SIZE),
 				     make_float (DEFAULT_REHASH_THRESHOLD),
-				     Qnil);
+				     Qnil, Qnil);
   struct Lisp_Hash_Table *h = XHASH_TABLE (log);
 
   /* What is special about our hash-tables is that the keys are pre-filled
diff --git a/src/xterm.c b/src/xterm.c
index 80cf8ce191..38229a5f31 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -12877,7 +12877,7 @@ keysyms.  The default is nil, which is the same as `super'.  */);
   Vx_keysym_table = make_hash_table (hashtest_eql, make_number (900),
 				     make_float (DEFAULT_REHASH_SIZE),
 				     make_float (DEFAULT_REHASH_THRESHOLD),
-				     Qnil);
+				     Qnil, Qnil);
 
   DEFVAR_BOOL ("x-frame-normalize-before-maximize",
 	       x_frame_normalize_before_maximize,

Re: [PATCH] Make purecopy create hash tables properly

[Stefan Monnier]

> Based on these suggestions, I have made a few more modifications to the code:
> * `gethash' now takes an additional :purecopy argument. If non-nil, the table
> will/can be copied to pure storage when the Emacs binary is being dumped.
> Since objects in pure storage are read only, gethash enforces that :weak and
> :purecopy aren't non-nil at the same time, erroring out when the latter is true.

Hmm... why do that in gethash?  Why not just check NILP (obj->weak)
when purecopying?

> * All functions that modify hash tables (`puthash', `clrhash' and `remhash')
> make sure that the table is not in pure storage (with CHECK_IMPURE).

Good.

> * `make_pure_hash_table' now also purecopies the hash table test, and enforces
> the checks above with `eassert'.

Sounds good.

> * A new struct, `pinned_object' is used as a linked list to store objects that
> should be marked before every GC cycle.  For now, this is only used when
> a hash table with the :purecopy property set to nil is passed to purecopy (but
> should be usable for other objects in the future).

An array would be significantly more efficient, but that sounds good.

> Should this work, or is there anything else I need to do?

I think this should work.

> +make_pure_hash_table (struct Lisp_Hash_Table *table) {

Nitpick: I'd call it `purecopy_hash_table`.


        Stefan

Re: [PATCH] Make purecopy create hash tables properly

[Vibhav Pant]

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

On 29-Jan-2017 11:29 PM, "Stefan Monnier" <monnier@iro.umontreal.ca> wrote:

Hmm... why do that in gethash?  Why not just check NILP (obj->weak)
when purecopying?

The rationale for this was that weak tables wouldn't be purecopied, so it
might be a good idea to inform the user about that beforhand. The simple
NILP (obj->weak) check in purecopy is much easier and wouldn't generate
errors, I'll switch to that instead.

> Should this work, or is there anything else I need to do?

I think this should work.

Alright then, I'll push this to master after adding some more documentation.

> +make_pure_hash_table (struct Lisp_Hash_Table *table) {

Nitpick: I'd call it `purecopy_hash_table`.

Other functions in alloc.c that perform pure allocation for different
objects are named in the same way (make_pure_string, make_pure_vector), so
I merely followed this convention.

[-- Attachment #2: Type: text/html, Size: 1827 bytes --]

Re: [PATCH] Make purecopy create hash tables properly

[Stefan Monnier]

>  Nitpick: I'd call it `purecopy_hash_table`.
>
> Other functions in alloc.c that perform pure allocation for different
> objects are named in the same way (make_pure_string,
> make_pure_vector), so I merely followed this convention. 

But those make pure objects "out of thin air", whereas in the present
case what we do is to copy a pre-existing Lisp_Object into pure space.
But, yes, you're right that the distinction is largely irrelevant, so
either way is fine,


        Stefan

Re: [PATCH] Make purecopy create hash tables properly

[Vibhav Pant]

On Mon, Jan 30, 2017 at 1:11 AM, Stefan Monnier
<monnier@iro.umontreal.ca> wrote:
> But those make pure objects "out of thin air", whereas in the present
> case what we do is to copy a pre-existing Lisp_Object into pure space.
> But, yes, you're right that the distinction is largely irrelevant, so
> either way is fine,

Ah, that makes sense. I've renamed the function accordingly and pushed
the changes to master.

Thanks,
Vibhav

-- 
Vibhav Pant
vibhavp@gmail.com