procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix hash tables not being purified correctly.

Browse source 
* src/alloc.c
(purecopy_hash_table) New function, makes a copy of the given hash
table in pure storage.
Add new struct `pinned_object' and `pinned_objects' linked list for
pinning objects.
(Fpurecopy) Allow purifying hash tables
(purecopy) Pin hash tables that are either weak or not declared with
`:purecopy t`, use purecopy_hash_table otherwise.
(marked_pinned_objects) New function, marks all objects in pinned_objects.
(garbage_collect_1) Use it. Mark all pinned objects before sweeping.
* src/lisp.h Add new field `pure' to struct `Lisp_Hash_Table'.
* src/fns.c: Add `purecopy' parameter to hash tables.
(Fmake_hash_table): Check for a `:purecopy PURECOPY' argument, pass it
to make_hash_table.
(make_hash_table): Add `pure' parameter, set h->pure to it.
(Fclrhash, Fremhash, Fputhash): Enforce that the table is impure with
CHECK_IMPURE.
* src/lread.c: (read1) Parse for `purecopy' parameter while reading
  hash tables.
* src/print.c: (print_object) add the `purecopy' parameter while
  printing hash tables.
* src/category.c, src/emacs-module.c, src/image.c, src/profiler.c,
  src/xterm.c: Use new (make_hash_table).
This commit is contained in:
Vibhav Pant 2017-01-30 12:03:23 +05:30
parent 8ba236e772
commit 9c4dfdd1af
10 changed files with 123 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

76
src/alloc.c
View file

@ -5434,6 +5434,37 @@ make_pure_vector (ptrdiff_t len)
return new;
}
/* Copy all contents and parameters of TABLE to a new table allocated
from pure space, return the purified table. */
static struct Lisp_Hash_Table *
purecopy_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 +5473,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 +5516,27 @@ 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 purify hash tables which haven't been defined with
:purecopy as non-nil or are weak - they aren't guaranteed to
not change. */
if (!NILP (table->weak) || 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; /* Don't hash cons it. */
}
struct Lisp_Hash_Table *h = purecopy_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);
@ -5693,6 +5752,16 @@ compact_undo_list (Lisp_Object list)
return 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)
{
@ -5813,6 +5882,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 ();

2
src/category.c
View file

@ -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)

2
src/emacs-module.c
View file

@ -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");

33
src/fns.c
View file

@ -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;
@ -3796,6 +3802,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 +4467,15 @@ 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. Any further changes to purified tables will result
in an error.
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 +4509,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 +4553,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 +4633,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 +4659,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 +4678,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 +5049,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");

2
src/image.c
View file

@ -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

6
src/lisp.h
View file

@ -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);

8
src/lread.c
View file

@ -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");

6
src/print.c
View file

@ -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. */

2
src/profiler.c
View file

@ -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

2
src/xterm.c
View file

@ -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,