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.
{
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)
{
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);
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)
{
for (i = 0; i < staticidx; i++)
mark_object (*staticvec[i]);
+ mark_pinned_objects ();
mark_pinned_symbols ();
mark_terminals ();
mark_kboards ();
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)
= 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");
#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);
(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;
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)
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;
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;
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);
}
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;
}
(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);
(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;
}
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");
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
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). */
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);
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;
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);
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");
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. */
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
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,
projects / emacs.git / commitdiff