if (STRING_MULTIBYTE (string))
{
ptrdiff_t chars = SCHARS (string);
- unsigned char *str = xmalloc (chars);
+ unsigned char *str = xmalloc_atomic (chars);
ptrdiff_t converted = str_to_unibyte (SDATA (string), str, chars);
if (converted < chars)
Floating-point numbers of equal value are `eql', but they may not be `eq'. */)
(Lisp_Object obj1, Lisp_Object obj2)
{
- if (FLOATP (obj1))
- return internal_equal (obj1, obj2, 0, 0, Qnil) ? Qt : Qnil;
- else
- return EQ (obj1, obj2) ? Qt : Qnil;
+ return scm_is_true (scm_eqv_p (obj1, obj2)) ? Qt : Qnil;
}
DEFUN ("equal", Fequal, Sequal, 2, 2, 0,
key_and_value vector of the hash table. This could be done
if a `:linear-search t' argument is given to make-hash-table. */
-
-/* The list of all weak hash tables. Don't staticpro this one. */
-
-static struct Lisp_Hash_Table *weak_hash_tables;
-
/* Various symbols. */
static Lisp_Object Qhash_table_p;
eassert (HASH_TABLE_P (table));
eassert (XHASH_TABLE (table) == h);
- /* Maybe add this hash table to the list of all weak hash tables. */
- if (NILP (h->weak))
- h->next_weak = NULL;
- else
- {
- h->next_weak = weak_hash_tables;
- weak_hash_tables = h;
- }
-
return table;
}
h2->index = Fcopy_sequence (h1->index);
XSET_HASH_TABLE (table, h2);
- /* Maybe add this hash table to the list of all weak hash tables. */
- if (!NILP (h2->weak))
- {
- h2->next_weak = weak_hash_tables;
- weak_hash_tables = h2;
- }
-
return table;
}
\f
-/************************************************************************
- Weak Hash Tables
- ************************************************************************/
-
-/* Sweep weak hash table H. REMOVE_ENTRIES_P means remove
- entries from the table that don't survive the current GC.
- !REMOVE_ENTRIES_P means mark entries that are in use. Value is
- true if anything was marked. */
-
-static bool
-sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p)
-{
- ptrdiff_t bucket, n;
- bool marked;
-
- n = ASIZE (h->index) & ~ARRAY_MARK_FLAG;
- marked = 0;
-
- for (bucket = 0; bucket < n; ++bucket)
- {
- Lisp_Object idx, next, prev;
-
- /* Follow collision chain, removing entries that
- don't survive this garbage collection. */
- prev = Qnil;
- for (idx = HASH_INDEX (h, bucket); !NILP (idx); idx = next)
- {
- ptrdiff_t i = XFASTINT (idx);
- bool key_known_to_survive_p = survives_gc_p (HASH_KEY (h, i));
- bool value_known_to_survive_p = survives_gc_p (HASH_VALUE (h, i));
- bool remove_p;
-
- if (EQ (h->weak, Qkey))
- remove_p = !key_known_to_survive_p;
- else if (EQ (h->weak, Qvalue))
- remove_p = !value_known_to_survive_p;
- else if (EQ (h->weak, Qkey_or_value))
- remove_p = !(key_known_to_survive_p || value_known_to_survive_p);
- else if (EQ (h->weak, Qkey_and_value))
- remove_p = !(key_known_to_survive_p && value_known_to_survive_p);
- else
- emacs_abort ();
-
- next = HASH_NEXT (h, i);
-
- if (remove_entries_p)
- {
- if (remove_p)
- {
- /* Take out of collision chain. */
- if (NILP (prev))
- set_hash_index_slot (h, bucket, next);
- else
- set_hash_next_slot (h, XFASTINT (prev), next);
-
- /* Add to free list. */
- set_hash_next_slot (h, i, h->next_free);
- h->next_free = idx;
-
- /* Clear key, value, and hash. */
- set_hash_key_slot (h, i, Qnil);
- set_hash_value_slot (h, i, Qnil);
- set_hash_hash_slot (h, i, Qnil);
-
- h->count--;
- }
- else
- {
- prev = idx;
- }
- }
- else
- {
- if (!remove_p)
- {
- /* Make sure key and value survive. */
- if (!key_known_to_survive_p)
- {
- mark_object (HASH_KEY (h, i));
- marked = 1;
- }
-
- if (!value_known_to_survive_p)
- {
- mark_object (HASH_VALUE (h, i));
- marked = 1;
- }
- }
- }
- }
- }
-
- return marked;
-}
-
-/* Remove elements from weak hash tables that don't survive the
- current garbage collection. Remove weak tables that don't survive
- from Vweak_hash_tables. Called from gc_sweep. */
-
-NO_INLINE /* For better stack traces */
-void
-sweep_weak_hash_tables (void)
-{
- struct Lisp_Hash_Table *h, *used, *next;
- bool marked;
-
- /* Mark all keys and values that are in use. Keep on marking until
- there is no more change. This is necessary for cases like
- value-weak table A containing an entry X -> Y, where Y is used in a
- key-weak table B, Z -> Y. If B comes after A in the list of weak
- tables, X -> Y might be removed from A, although when looking at B
- one finds that it shouldn't. */
- do
- {
- marked = 0;
- for (h = weak_hash_tables; h; h = h->next_weak)
- {
- if (h->header.size & ARRAY_MARK_FLAG)
- marked |= sweep_weak_table (h, 0);
- }
- }
- while (marked);
-
- /* Remove tables and entries that aren't used. */
- for (h = weak_hash_tables, used = NULL; h; h = next)
- {
- next = h->next_weak;
-
- if (h->header.size & ARRAY_MARK_FLAG)
- {
- /* TABLE is marked as used. Sweep its contents. */
- if (h->count > 0)
- sweep_weak_table (h, 1);
-
- /* Add table to the list of used weak hash tables. */
- h->next_weak = used;
- used = h;
- }
- }
-
- weak_hash_tables = used;
-}
-
-
-\f
/***********************************************************************
Hash Code Computation
***********************************************************************/
void
syms_of_fns (void)
{
+#include "fns.x"
+
DEFSYM (Qmd5, "md5");
DEFSYM (Qsha1, "sha1");
DEFSYM (Qsha224, "sha224");
DEFSYM (Qkey_or_value, "key-or-value");
DEFSYM (Qkey_and_value, "key-and-value");
- defsubr (&Ssxhash);
- defsubr (&Smake_hash_table);
- defsubr (&Scopy_hash_table);
- defsubr (&Shash_table_count);
- defsubr (&Shash_table_rehash_size);
- defsubr (&Shash_table_rehash_threshold);
- defsubr (&Shash_table_size);
- defsubr (&Shash_table_test);
- defsubr (&Shash_table_weakness);
- defsubr (&Shash_table_p);
- defsubr (&Sclrhash);
- defsubr (&Sgethash);
- defsubr (&Sputhash);
- defsubr (&Sremhash);
- defsubr (&Smaphash);
- defsubr (&Sdefine_hash_table_test);
-
DEFSYM (Qstring_lessp, "string-lessp");
DEFSYM (Qprovide, "provide");
DEFSYM (Qrequire, "require");
this variable. */);
use_file_dialog = 1;
- defsubr (&Sidentity);
- defsubr (&Srandom);
- defsubr (&Slength);
- defsubr (&Ssafe_length);
- defsubr (&Sstring_bytes);
- defsubr (&Sstring_equal);
- defsubr (&Scompare_strings);
- defsubr (&Sstring_lessp);
- defsubr (&Sappend);
- defsubr (&Sconcat);
- defsubr (&Svconcat);
- defsubr (&Scopy_sequence);
- defsubr (&Sstring_make_multibyte);
- defsubr (&Sstring_make_unibyte);
- defsubr (&Sstring_as_multibyte);
- defsubr (&Sstring_as_unibyte);
- defsubr (&Sstring_to_multibyte);
- defsubr (&Sstring_to_unibyte);
- defsubr (&Scopy_alist);
- defsubr (&Ssubstring);
- defsubr (&Ssubstring_no_properties);
- defsubr (&Snthcdr);
- defsubr (&Snth);
- defsubr (&Selt);
- defsubr (&Smember);
- defsubr (&Smemq);
- defsubr (&Smemql);
- defsubr (&Sassq);
- defsubr (&Sassoc);
- defsubr (&Srassq);
- defsubr (&Srassoc);
- defsubr (&Sdelq);
- defsubr (&Sdelete);
- defsubr (&Snreverse);
- defsubr (&Sreverse);
- defsubr (&Ssort);
- defsubr (&Splist_get);
- defsubr (&Sget);
- defsubr (&Splist_put);
- defsubr (&Sput);
- defsubr (&Slax_plist_get);
- defsubr (&Slax_plist_put);
- defsubr (&Seql);
- defsubr (&Sequal);
- defsubr (&Sequal_including_properties);
- defsubr (&Sfillarray);
- defsubr (&Sclear_string);
- defsubr (&Snconc);
- defsubr (&Smapcar);
- defsubr (&Smapc);
- defsubr (&Smapconcat);
- defsubr (&Syes_or_no_p);
- defsubr (&Sload_average);
- defsubr (&Sfeaturep);
- defsubr (&Srequire);
- defsubr (&Sprovide);
- defsubr (&Splist_member);
- defsubr (&Swidget_put);
- defsubr (&Swidget_get);
- defsubr (&Swidget_apply);
- defsubr (&Sbase64_encode_region);
- defsubr (&Sbase64_decode_region);
- defsubr (&Sbase64_encode_string);
- defsubr (&Sbase64_decode_string);
- defsubr (&Smd5);
- defsubr (&Ssecure_hash);
- defsubr (&Slocale_info);
-
hashtest_eq.name = Qeq;
hashtest_eq.user_hash_function = Qnil;
hashtest_eq.user_cmp_function = Qnil;
HCoop / bpt / emacs.git / blobdiff