xemacs-beta: src/elhash.c comparison

comparison src/elhash.c @ 272:c5d627a313b1 r21-0b34

Import from CVS: tag r21-0b34

author	cvs
date	Mon, 13 Aug 2007 10:28:48 +0200
parents	677f6a0ee643
children	8626e4521993

comparison

equal deleted inserted replaced

-:c7b7086b0a39
+:c5d627a313b1
 #include <config.h>
 #include "lisp.h"
 #include "hash.h"
 #include "elhash.h"
 #include "bytecode.h"
+EXFUN (Fmake_weak_hashtable, 2);
+EXFUN (Fmake_key_weak_hashtable, 2);
+EXFUN (Fmake_value_weak_hashtable, 2);
 Lisp_Object Qhashtablep, Qhashtable;
 Lisp_Object Qweak, Qkey_weak, Qvalue_weak, Qnon_weak;
 #define LISP_OBJECTS_PER_HENTRY (sizeof (hentry) / sizeof (Lisp_Object))/* 2 */
 Lisp_Object next_weak;    /* Used to chain together all of the weak
 			       hashtables.  Don't mark through this. */
 };
 static Lisp_Object Vall_weak_hashtables;
-static Lisp_Object mark_hashtable (Lisp_Object, void (*) (Lisp_Object));
-static void print_hashtable (Lisp_Object, Lisp_Object, int);
-static int hashtable_equal (Lisp_Object t1, Lisp_Object t2, int depth);
-DEFINE_LRECORD_IMPLEMENTATION ("hashtable", hashtable,
-mark_hashtable, print_hashtable, 0,
-			       /* #### Implement hashtable_hash()! */
-			       hashtable_equal, 0,
-			       struct hashtable);
 static Lisp_Object
 mark_hashtable (Lisp_Object obj, void (*markobj) (Lisp_Object))
 {
 struct hashtable *table = XHASHTABLE (obj);
 sprintf (buf, " 0x%x>", table->header.uid);
 write_c_string (buf, printcharfun);
 }
 }
+DEFINE_LRECORD_IMPLEMENTATION ("hashtable", hashtable,
+mark_hashtable, print_hashtable, 0,
+			       /* #### Implement hashtable_hash()! */
+			       hashtable_equal, 0,
+			       struct hashtable);
 /* Pretty reading of hashtables.
 Here we use the existing structures mechanism (which is,
 unfortunately, pretty cumbersome) for validating and instantiating
 hashtable_instantiate (Lisp_Object plist)
 {
 /* I'm not sure whether this can GC, but better safe than sorry.  */
 Lisp_Object hashtab = Qnil;
 Lisp_Object type = Qnil, test = Qnil, size = Qnil, data = Qnil;
-Lisp_Object key, value;
 struct gcpro gcpro1;
 GCPRO1 (hashtab);
 while (!NILP (plist))
 {
-key = XCAR (plist);
+Lisp_Object key, value;
-plist = XCDR (plist);
+key   = XCAR (plist); plist = XCDR (plist);
-value = XCAR (plist);
+value = XCAR (plist); plist = XCDR (plist);
-plist = XCDR (plist);
-if (EQ (key, Qtype))
+if      (EQ (key, Qtype)) type = value;
-	type = value;
+else if (EQ (key, Qtest)) test = value;
-else if (EQ (key, Qtest))
+else if (EQ (key, Qsize)) size = value;
-	test = value;
+else if (EQ (key, Qdata)) data = value;
-else if (EQ (key, Qsize))
-	size = value;
-else if (EQ (key, Qdata))
-	data = value;
 else
 	abort ();
 }
 if (NILP (type))
 type = Qnon_weak;
 if (NILP (size))
-{
+/* Divide by two, because data is a plist. */
-/* Divide by two, because data is a plist. */
+size = make_int (XINT (Flength (data)) / 2);
-XSETINT (size, XINT (Flength (data)) / 2);
-}
 /* Create the hashtable.  */
 if (EQ (type, Qnon_weak))
 hashtab = Fmake_hashtable (size, test);
 else if (EQ (type, Qweak))
 abort ();
 /* And fill it with data.  */
 while (!NILP (data))
 {
-key = XCAR (data);
+Lisp_Object key, value;
-data = XCDR (data);
+key   = XCAR (data); data = XCDR (data);
-value = XCAR (data);
+value = XCAR (data); data = XCDR (data);
-data = XCDR (data);
 Fputhash (key, value, hashtab);
 }
 UNGCPRO;
 return hashtab;
 signal_simple_error ("Invalid hashtable test function", sym);
 return HASHTABLE_EQ; /* not reached */
 }
 DEFUN ("make-hashtable", Fmake_hashtable, 1, 2, 0, /*
-Make a hashtable of initial size SIZE.
+Return a new hashtable object of initial size SIZE.
 Comparison between keys is done with TEST-FUN, which must be one of
 `eq', `eql', or `equal'.  The default is `eql'; i.e. two keys must
 be the same object (or have the same floating-point value, for floats)
 to be considered equivalent.
 return make_lisp_hashtable (XINT (size), HASHTABLE_NONWEAK,
 			      decode_hashtable_test_fun (test_fun));
 }
 DEFUN ("copy-hashtable", Fcopy_hashtable, 1, 1, 0, /*
-Make a new hashtable which contains the same keys and values
+Return a new hashtable containing the same keys and values as HASHTABLE.
-as the given table.  The keys and values will not themselves be copied.
+The keys and values will not themselves be copied.
 */
-(old_table))
+(hashtable))
 {
 struct _C_hashtable old_htbl;
 struct _C_hashtable new_htbl;
 struct hashtable *old_ht;
 struct hashtable *new_ht;
 Lisp_Object result;
-CHECK_HASHTABLE (old_table);
+CHECK_HASHTABLE (hashtable);
-old_ht = XHASHTABLE (old_table);
+old_ht = XHASHTABLE (hashtable);
 ht_copy_to_c (old_ht, &old_htbl);
 /* we can't just call Fmake_hashtable() here because that will make a
 table that is slightly larger than the one we're trying to copy,
 which will make copy_hash() blow up. */
 {
 CHECK_HASHTABLE (hashtable);
 switch (XHASHTABLE (hashtable)->type)
 {
-case HASHTABLE_WEAK:
+case HASHTABLE_WEAK:	return Qweak;
-return Qweak;
+case HASHTABLE_KEY_WEAK:	return Qkey_weak;
-break;
+case HASHTABLE_VALUE_WEAK:	return Qvalue_weak;
-case HASHTABLE_KEY_WEAK:
+default:			return Qnon_weak;
-return Qkey_weak;
-break;
-case HASHTABLE_VALUE_WEAK:
-return Qvalue_weak;
-break;
-default:
-return Qnon_weak;
 }
 }
 DEFUN ("hashtable-test-function", Fhashtable_test_function, 1, 1, 0, /*
 Return test function of HASHTABLE.
 static void
 verify_function (Lisp_Object function, CONST char *description)
 {
 /* #### Unused DESCRIPTION?  */
 if (SYMBOLP (function))
 {
 if (NILP (function))
-return;
+	return;
 else
-function = indirect_function (function, 1);
+	function = indirect_function (function, 1);
 }
 if (SUBRP (function) || COMPILED_FUNCTIONP (function))
 return;
 else if (CONSP (function))
 {
 Lisp_Object funcar = XCAR (function);
 if ((SYMBOLP (funcar)) && (EQ (funcar, Qlambda) ||
-			       EQ (funcar, Qautoload)))
+				 EQ (funcar, Qautoload)))
-return;
+	return;
 }
 signal_error (Qinvalid_function, list1 (function));
 }
 static int
 lisp_maphash_function (CONST void *void_key,
 ht_copy_to_c (XHASHTABLE (hashtable), &htbl);
 maphash (function, &htbl, closure);
 }
 void
-elisp_map_remhash (int (*function) (CONST void *key,
+elisp_map_remhash (remhash_predicate function, Lisp_Object hashtable,
-				    CONST void *contents,
-				    void *extra_arg),
-		   Lisp_Object hashtable,
 		   void *closure)
 {
 struct _C_hashtable htbl;
 if (!gc_in_progress) CHECK_HASHTABLE (hashtable);
 #endif /* 0 */
 DEFUN ("make-weak-hashtable", Fmake_weak_hashtable, 1, 2, 0, /*
-Make a fully weak hashtable of initial size SIZE.
+Return a new fully weak hashtable object of initial size SIZE.
 A weak hashtable is one whose pointers do not count as GC referents:
 for any key-value pair in the hashtable, if the only remaining pointer
 to either the key or the value is in a weak hash table, then the pair
 will be removed from the table, and the key and value collected.  A
 non-weak hash table (or any other pointer) would prevent the object
 return make_lisp_hashtable (XINT (size), HASHTABLE_WEAK,
 			      decode_hashtable_test_fun (test_fun));
 }
 DEFUN ("make-key-weak-hashtable", Fmake_key_weak_hashtable, 1, 2, 0, /*
-Make a key-weak hashtable of initial size SIZE.
+Return a new key-weak hashtable object of initial size SIZE.
 A key-weak hashtable is similar to a fully-weak hashtable (see
 `make-weak-hashtable') except that a key-value pair will be removed
 only if the key remains unmarked outside of weak hashtables.  The pair
 will remain in the hashtable if the key is pointed to by something other
 than a weak hashtable, even if the value is not.
 return make_lisp_hashtable (XINT (size), HASHTABLE_KEY_WEAK,
 			      decode_hashtable_test_fun (test_fun));
 }
 DEFUN ("make-value-weak-hashtable", Fmake_value_weak_hashtable, 1, 2, 0, /*
-Make a value-weak hashtable of initial size SIZE.
+Return a new value-weak hashtable object of initial size SIZE.
 A value-weak hashtable is similar to a fully-weak hashtable (see
 `make-weak-hashtable') except that a key-value pair will be removed only
 if the value remains unmarked outside of weak hashtables.  The pair will
 remain in the hashtable if the value is pointed to by something other
 than a weak hashtable, even if the key is not.

Mercurial > hg > xemacs-beta

comparison src/elhash.c @ 272:c5d627a313b1 r21-0b34