xemacs-beta: src/elhash.c annotate

annotate src/elhash.c @ 5313:5ed261fd2bd9

Unrool a load-time loop at macro expansion time, cl-macs.el 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (inline-side-effect-free-compiler-macros): Unroll a loop here at macro-expansion time, so these compiler macros are compiled. Use #'eql instead of #'eq in a couple of places for better style.

author	Aidan Kehoe <kehoea@parhasard.net>
date	Wed, 29 Dec 2010 23:43:10 +0000
parents	c096d8051f89
children	31be2a3d121d 8d29f1c4bb98

rev	line source
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1 /* Implementation of the hash table lisp object type.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2 Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5125 diff changeset	3 Copyright (C) 1995, 1996, 2002, 2004, 2010 Ben Wing.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4 Copyright (C) 1997 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	6 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	7
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	8 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	9 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	10 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	11 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	12
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
5232 33899241a6a8 Fix typo in permission notice of elhash.c. Stephen J. Turnbull <stephen@xemacs.org> parents: 5222 diff changeset	14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	16 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	17
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	18 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	19 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	21 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	22
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	23 /* Synched up with: Not in FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	24
1292 f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	25 /* Author: Lost in the mists of history. At least back to Lucid 19.3,
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	26 circa Sep 1992. Early hash table implementation allowed only `eq' as a
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	27 test -- other tests possible only when these objects were created from
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	28 the C code.
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	29
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	30 Expansion to allow general `equal'-test Lisp-creatable tables, and hash
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	31 methods for the various Lisp objects in existence at the time, added
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	32 during 19.12 I think (early 1995?), by Ben Wing.
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	33
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	34 Weak hash tables added by Jamie (maybe?) early on, perhaps around 19.6,
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	35 maybe earlier; again, only possible through the C code, and only
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	36 supported fully weak hash tables. Expansion to other kinds of weakness,
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	37 and exporting of the interface to Lisp, by Ben Wing during 19.12
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	38 (early-mid 1995) or maybe 19.13 cycle (mid 1995).
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	39
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	40 Expansion to full Common Lisp spec and interface, redoing of the
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	41 implementation, by Martin Buchholz, 1997? (Former hash table
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	42 implementation used "double hashing", I'm pretty sure, and was weirdly
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	43 tied into the generic hash.c code. Martin completely separated them.)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	44 */
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	45
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	46 /* This file implements the hash table lisp object type.
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	47
504 bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	48 This implementation was mostly written by Martin Buchholz in 1997.
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	49
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	50 The Lisp-level API (derived from Common Lisp) is almost completely
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	51 compatible with GNU Emacs 21, even though the implementations are
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	52 totally independent.
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	53
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	54 The hash table technique used is "linear probing". Collisions are
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	55 resolved by putting the item in the next empty place in the array
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	56 following the collision. Finding a hash entry performs a linear
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	57 search in the cluster starting at the hash value.
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	58
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	59 On deletions from the hash table, the entries immediately following
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	60 the deleted entry are re-entered in the hash table. We do not have
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	61 a special way to mark deleted entries (known as "tombstones").
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	62
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	63 At the end of the hash entries ("hentries"), we leave room for an
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	64 entry that is always empty (the "sentinel").
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	65
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	66 The traditional literature on hash table implementation
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	67 (e.g. Knuth) suggests that too much "primary clustering" occurs
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	68 with linear probing. However, this literature was written when
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	69 locality of reference was not a factor. The discrepancy between
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	70 CPU speeds and memory speeds is increasing, and the speed of access
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	71 to memory is highly dependent on memory caches which work best when
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	72 there is high locality of data reference. Random access to memory
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	73 is up to 20 times as expensive as access to the nearest address
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	74 (and getting worse). So linear probing makes sense.
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	75
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	76 But the representation doesn't actually matter that much with the
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	77 current elisp engine. Funcall is sufficiently slow that the choice
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	78 of hash table implementation is noise. */
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	79
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	80 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	81 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	82 #include "bytecode.h"
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	83 #include "elhash.h"
5169 6c6d78781d59 cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup Ben Wing <ben@xemacs.org> parents: 5158 diff changeset	84 #include "gc.h"
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	85 #include "opaque.h"
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	86 #include "buffer.h"
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	87
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	88 Lisp_Object Qhash_tablep;
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	89 Lisp_Object Qeq, Qeql, Qequal, Qequalp;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	90 Lisp_Object Qeq_hash, Qeql_hash, Qequal_hash, Qequalp_hash;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	91
5084 6afe991b8135 Add a PARSE_KEYWORDS macro, use it in #'make-hash-table. Aidan Kehoe <kehoea@parhasard.net> parents: 4976 diff changeset	92 static Lisp_Object Qhashtable, Qhash_table, Qmake_hash_table;
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	93 static Lisp_Object Qweakness, Qvalue, Qkey_or_value, Qkey_and_value;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	94 static Lisp_Object Vall_weak_hash_tables;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	95 static Lisp_Object Qrehash_size, Qrehash_threshold;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	96 static Lisp_Object Q_size, Q_test, Q_weakness, Q_rehash_size, Q_rehash_threshold;
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	97 static Lisp_Object Vhash_table_test_eq, Vhash_table_test_eql;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	98 static Lisp_Object Vhash_table_test_weak_list;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	99
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	100 /* obsolete as of 19990901 in xemacs-21.2 */
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	101 static Lisp_Object Qweak, Qkey_weak, Qvalue_weak, Qkey_or_value_weak;
5222 18c0b5909d16 Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1 Aidan Kehoe <kehoea@parhasard.net> parents: 5193 diff changeset	102 static Lisp_Object Qnon_weak;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	103
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	104 /* A hash table test, with its associated hash function. equal_function may
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	105 call lisp_equal_function, and hash_function similarly may call
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	106 lisp_hash_function. */
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	107 struct Hash_Table_Test
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	108 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	109 NORMAL_LISP_OBJECT_HEADER header;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	110 Lisp_Object name;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	111 hash_table_equal_function_t equal_function;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	112 hash_table_hash_function_t hash_function;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	113 Lisp_Object lisp_equal_function;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	114 Lisp_Object lisp_hash_function;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	115 };
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	116
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	117 static Lisp_Object
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	118 mark_hash_table_test (Lisp_Object obj)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	119 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	120 Hash_Table_Test *http = XHASH_TABLE_TEST (obj);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	121
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	122 mark_object (http->name);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	123 mark_object (http->lisp_equal_function);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	124 mark_object (http->lisp_hash_function);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	125
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	126 return Qnil;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	127 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	128
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	129 static const struct memory_description hash_table_test_description_1[] =
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	130 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	131 { XD_LISP_OBJECT, offsetof (struct Hash_Table_Test, name) },
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	132 { XD_LISP_OBJECT, offsetof (struct Hash_Table_Test, lisp_equal_function) },
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	133 { XD_LISP_OBJECT, offsetof (struct Hash_Table_Test, lisp_hash_function) },
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	134 { XD_END }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	135 };
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	136
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	137 static const struct sized_memory_description hash_table_test_description =
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	138 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	139 sizeof (struct Hash_Table_Test),
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	140 hash_table_test_description_1
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	141 };
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	142
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	143 DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("hash-table-test", hash_table_test,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	144 mark_hash_table_test,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	145 hash_table_test_description_1,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	146 Hash_Table_Test);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	147 /* A hash table. */
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	148
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	149 struct Lisp_Hash_Table
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	150 {
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5125 diff changeset	151 NORMAL_LISP_OBJECT_HEADER header;
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	152 Elemcount size;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	153 Elemcount count;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	154 Elemcount rehash_count;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	155 double rehash_size;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	156 double rehash_threshold;
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	157 Elemcount golden_ratio;
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	158 htentry *hentries;
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	159 Lisp_Object test;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	160 enum hash_table_weakness weakness;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	161 Lisp_Object next_weak; /* Used to chain together all of the weak
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	162 hash tables. Don't mark through this. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	163 };
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	164
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	165 #define CLEAR_HTENTRY(htentry) \
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	166 (((EMACS_UINT)(&((htentry)->key))) = 0, \
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	167 ((EMACS_UINT)(&((htentry)->value))) = 0)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	168
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	169 #define HASH_TABLE_DEFAULT_SIZE 16
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	170 #define HASH_TABLE_DEFAULT_REHASH_SIZE 1.3
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	171 #define HASH_TABLE_MIN_SIZE 10
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	172 #define HASH_TABLE_DEFAULT_REHASH_THRESHOLD(size, test) \
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	173 (((size) > 4096 && EQ (Vhash_table_test_eq, test)) ? 0.7 : 0.6)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	174
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	175 #define HASHCODE(key, ht, http) \
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	176 ((((!EQ (Vhash_table_test_eq, ht->test)) ? \
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	177 (http)->hash_function (http, key) : \
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	178 LISP_HASH (key)) * (ht)->golden_ratio) % (ht)->size)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	179
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	180 #define KEYS_EQUAL_P(key1, key2, test, http) \
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	181 (EQ (key1, key2) \|\| ((!EQ (Vhash_table_test_eq, test) && \
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	182 (http->equal_function) (http, key1, key2))))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	183
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	184 #define LINEAR_PROBING_LOOP(probe, entries, size) \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	185 for (; \
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	186 !HTENTRY_CLEAR_P (probe) \|\| \
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	187 (probe == entries + size ? \
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	188 (probe = entries, !HTENTRY_CLEAR_P (probe)) : 0); \
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	189 probe++)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	190
800 a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben] ben parents: 793 diff changeset	191 #ifdef ERROR_CHECK_STRUCTURES
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	192 static void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	193 check_hash_table_invariants (Lisp_Hash_Table *ht)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	194 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	195 assert (ht->count < ht->size);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	196 assert (ht->count <= ht->rehash_count);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	197 assert (ht->rehash_count < ht->size);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	198 assert ((double) ht->count * ht->rehash_threshold - 1 <= (double) ht->rehash_count);
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	199 assert (HTENTRY_CLEAR_P (ht->hentries + ht->size));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	200 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	201 #else
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	202 #define check_hash_table_invariants(ht)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	203 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	204
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	205 /* Return a suitable size for a hash table, with at least SIZE slots. */
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	206 static Elemcount
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	207 hash_table_size (Elemcount requested_size)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	208 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	209 /* Return some prime near, but greater than or equal to, SIZE.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	210 Decades from the time of writing, someone will have a system large
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	211 enough that the list below will be too short... */
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	212 static const Elemcount primes [] =
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	213 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	214 19, 29, 41, 59, 79, 107, 149, 197, 263, 347, 457, 599, 787, 1031,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	215 1361, 1777, 2333, 3037, 3967, 5167, 6719, 8737, 11369, 14783,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	216 19219, 24989, 32491, 42257, 54941, 71429, 92861, 120721, 156941,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	217 204047, 265271, 344857, 448321, 582821, 757693, 985003, 1280519,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	218 1664681, 2164111, 2813353, 3657361, 4754591, 6180989, 8035301,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	219 10445899, 13579681, 17653589, 22949669, 29834603, 38784989,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	220 50420551, 65546729, 85210757, 110774011, 144006217, 187208107,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	221 243370577, 316381771, 411296309, 534685237, 695090819, 903618083,
647 b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben] ben parents: 617 diff changeset	222 1174703521, 1527114613, 1985248999 /* , 2580823717UL, 3355070839UL */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	223 };
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	224 /* We've heard of binary search. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	225 int low, high;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	226 for (low = 0, high = countof (primes) - 1; high - low > 1;)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	227 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	228 /* Loop Invariant: size < primes [high] */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	229 int mid = (low + high) / 2;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	230 if (primes [mid] < requested_size)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	231 low = mid;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	232 else
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	233 high = mid;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	234 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	235 return primes [high];
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	236 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	237
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	238
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	239
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	240 static int
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	241 lisp_object_eql_equal (const Hash_Table_Test *UNUSED (http), Lisp_Object obj1,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	242 Lisp_Object obj2)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	243 {
4885 6772ce4d982b Fix hash tables, #'member, #'assoc, #'eql compiler macros if bignums Aidan Kehoe <kehoea@parhasard.net> parents: 4820 diff changeset	244 return EQ (obj1, obj2) \|\|
6772ce4d982b Fix hash tables, #'member, #'assoc, #'eql compiler macros if bignums Aidan Kehoe <kehoea@parhasard.net> parents: 4820 diff changeset	245 (NON_FIXNUM_NUMBER_P (obj1) && internal_equal (obj1, obj2, 0));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	246 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	247
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	248 static Hashcode
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	249 lisp_object_eql_hash (const Hash_Table_Test *UNUSED (http), Lisp_Object obj)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	250 {
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	251 return NON_FIXNUM_NUMBER_P (obj) ?
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	252 internal_hash (obj, 0, 0) : LISP_HASH (obj);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	253 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	254
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	255 static int
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	256 lisp_object_equal_equal (const Hash_Table_Test *UNUSED (http),
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	257 Lisp_Object obj1, Lisp_Object obj2)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	258 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	259 return internal_equal (obj1, obj2, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	260 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	261
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	262 static Hashcode
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	263 lisp_object_equal_hash (const Hash_Table_Test *UNUSED (http), Lisp_Object obj)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	264 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	265 return internal_hash (obj, 0, 0);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	266 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	267
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	268 static Hashcode
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	269 lisp_object_equalp_hash (const Hash_Table_Test *UNUSED (http), Lisp_Object obj)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	270 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	271 return internal_hash (obj, 0, 1);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	272 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	273
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	274 static int
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	275 lisp_object_equalp_equal (const Hash_Table_Test *UNUSED (http),
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	276 Lisp_Object obj1, Lisp_Object obj2)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	277 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	278 return internal_equalp (obj1, obj2, 0);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	279 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	280
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	281 static Hashcode
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	282 lisp_object_general_hash (const Hash_Table_Test *http, Lisp_Object obj)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	283 {
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	284 struct gcpro gcpro1;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	285 Lisp_Object args[2] = { http->lisp_hash_function, obj }, res;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	286
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	287 /* Make sure any weakly referenced objects don't get collected before the
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	288 funcall: */
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	289 GCPRO1 (args[0]);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	290 gcpro1.nvars = countof (args);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	291 res = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	292 UNGCPRO;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	293
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	294 if (INTP (res))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	295 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	296 return (Hashcode) (XINT (res));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	297 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	298
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	299 #ifdef HAVE_BIGNUM
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	300 if (BIGNUMP (res))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	301 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	302 if (bignum_fits_emacs_int_p (XBIGNUM_DATA (res)))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	303 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	304 return (Hashcode) bignum_to_emacs_int (XBIGNUM_DATA (res));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	305 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	306
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	307 signal_error (Qrange_error, "Not a valid hash code", res);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	308 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	309 #endif
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	310
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	311 dead_wrong_type_argument (Qintegerp, res);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	312 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	313
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	314 static int
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	315 lisp_object_general_equal (const Hash_Table_Test *http, Lisp_Object obj1,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	316 Lisp_Object obj2)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	317 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	318 struct gcpro gcpro1;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	319 Lisp_Object args[] = { http->lisp_equal_function, obj1, obj2 }, res;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	320
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	321 GCPRO1 (args[0]);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	322 gcpro1.nvars = countof (args);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	323 res = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	324 UNGCPRO;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	325
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	326 return !(NILP (res));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	327 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	328
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	329
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	330 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	331 mark_hash_table (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	332 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	333 Lisp_Hash_Table *ht = XHASH_TABLE (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	334
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	335 /* If the hash table is weak, we don't want to mark the keys and
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	336 values (we scan over them after everything else has been marked,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	337 and mark or remove them as necessary). */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	338 if (ht->weakness == HASH_TABLE_NON_WEAK)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	339 {
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	340 htentry e, sentinel;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	341
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	342 for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++)
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	343 if (!HTENTRY_CLEAR_P (e))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	344 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	345 mark_object (e->key);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	346 mark_object (e->value);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	347 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	348 }
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	349
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	350 mark_object (ht->test);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	351
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	352 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	353 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	354
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	355 /* Equality of hash tables. Two hash tables are equal when they are of
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	356 the same weakness and test function, they have the same number of
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	357 elements, and for each key in the hash table, the values are `equal'.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	358
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	359 This is similar to Common Lisp `equalp' of hash tables, with the
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	360 difference that CL requires the keys to be compared with the test
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	361 function, which we don't do. Doing that would require consing, and
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	362 consing is a bad idea in `equal'. Anyway, our method should provide
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	363 the same result -- if the keys are not equal according to the test
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	364 function, then Fgethash() in hash_table_equal_mapper() will fail. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	365 static int
4906 6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4885 diff changeset	366 hash_table_equal (Lisp_Object hash_table1, Lisp_Object hash_table2, int depth,
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4885 diff changeset	367 int foldcase)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	368 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	369 Lisp_Hash_Table *ht1 = XHASH_TABLE (hash_table1);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	370 Lisp_Hash_Table *ht2 = XHASH_TABLE (hash_table2);
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	371 htentry e, sentinel;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	372
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	373 if (!(EQ (ht1->test, ht2->test)) \|\|
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	374 (ht1->weakness != ht2->weakness) \|\|
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	375 (ht1->count != ht2->count))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	376 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	377
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	378 depth++;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	379
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	380 for (e = ht1->hentries, sentinel = e + ht1->size; e < sentinel; e++)
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	381 if (!HTENTRY_CLEAR_P (e))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	382 /* Look up the key in the other hash table, and compare the values. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	383 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	384 Lisp_Object value_in_other = Fgethash (e->key, hash_table2, Qunbound);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	385 if (UNBOUNDP (value_in_other) \|\|
4906 6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps Ben Wing <ben@xemacs.org> parents: 4885 diff changeset	386 !internal_equal_0 (e->value, value_in_other, depth, foldcase))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	387 return 0; /* Give up */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	388 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	389
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	390 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	391 }
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	392
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	393 /* This is not a great hash function, but it _is_ correct and fast.
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	394 Examining all entries is too expensive, and examining a random
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	395 subset does not yield a correct hash function. */
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	396 static Hashcode
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	397 hash_table_hash (Lisp_Object hash_table, int UNUSED (depth),
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	398 int UNUSED (equalp))
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	399 {
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	400 return XHASH_TABLE (hash_table)->count;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	401 }
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	402
5158 9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	403 #ifdef MEMORY_USAGE_STATS
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	404
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	405 struct hash_table_stats
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	406 {
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	407 struct usage_stats u;
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	408 Bytecount hentries;
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	409 };
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	410
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	411 static void
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	412 hash_table_memory_usage (Lisp_Object hashtab,
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	413 struct generic_usage_stats *gustats)
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	414 {
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	415 Lisp_Hash_Table *ht = XHASH_TABLE (hashtab);
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	416 struct hash_table_stats stats = (struct hash_table_stats ) gustats;
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	417 stats->hentries +=
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	418 malloced_storage_size (ht->hentries,
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	419 sizeof (htentry) * (ht->size + 1),
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	420 &stats->u);
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	421 }
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	422
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	423 #endif /* MEMORY_USAGE_STATS */
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	424
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	425
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	426 /* Printing hash tables.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	427
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	428 This is non-trivial, because we use a readable structure-style
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	429 syntax for hash tables. This means that a typical hash table will be
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	430 readably printed in the form of:
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	431
4820 e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	432 #s(hash-table :size 2 :data (key1 value1 key2 value2))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	433
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	434 The supported hash table structure keywords and their values are:
4820 e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	435 `:test' (eql (or nil), eq or equal)
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	436 `:size' (a natnum or nil)
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	437 `:rehash-size' (a float)
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	438 `:rehash-threshold' (a float)
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	439 `:weakness' (nil, key, value, key-and-value, or key-or-value)
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	440 `:data' (a list)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	441
430 a5df635868b2 Import from CVS: tag r21-2-23 cvs parents: 428 diff changeset	442 If `print-readably' is nil, then a simpler syntax is used, for example
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	443
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	444 #<hash-table size 2/13 data (key1 value1 key2 value2) 0x874d>
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	445
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	446 The data is truncated to four pairs, and the rest is shown with
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	447 `...'. This printer does not cons. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	448
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	449
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	450 /* Print the data of the hash table. This maps through a Lisp
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	451 hash table and prints key/value pairs using PRINTCHARFUN. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	452 static void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	453 print_hash_table_data (Lisp_Hash_Table *ht, Lisp_Object printcharfun)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	454 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	455 int count = 0;
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	456 htentry e, sentinel;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	457
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4820 diff changeset	458 write_ascstring (printcharfun, " :data (");
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	459
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	460 for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++)
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	461 if (!HTENTRY_CLEAR_P (e))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	462 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	463 if (count > 0)
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4820 diff changeset	464 write_ascstring (printcharfun, " ");
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	465 if (!print_readably && count > 3)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	466 {
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4820 diff changeset	467 write_ascstring (printcharfun, "...");
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	468 break;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	469 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	470 print_internal (e->key, printcharfun, 1);
800 a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben] ben parents: 793 diff changeset	471 write_fmt_string_lisp (printcharfun, " %S", 1, e->value);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	472 count++;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	473 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	474
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4820 diff changeset	475 write_ascstring (printcharfun, ")");
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	476 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	477
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	478 static void
2286 04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james] james parents: 1726 diff changeset	479 print_hash_table (Lisp_Object obj, Lisp_Object printcharfun,
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james] james parents: 1726 diff changeset	480 int UNUSED (escapeflag))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	481 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	482 Lisp_Hash_Table *ht = XHASH_TABLE (obj);
4777 c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this. Aidan Kehoe <kehoea@parhasard.net> parents: 4693 diff changeset	483 Ascbyte pigbuf[350];
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	484
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4820 diff changeset	485 write_ascstring (printcharfun,
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 801 diff changeset	486 print_readably ? "#s(hash-table" : "#<hash-table");
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	487
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	488 if (!(EQ (ht->test, Vhash_table_test_eql)))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	489 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	490 write_fmt_string_lisp (printcharfun, " :test %S",
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	491 1, XHASH_TABLE_TEST (ht->test)->name);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	492 }
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	493
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	494 if (ht->count \|\| !print_readably)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	495 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	496 if (print_readably)
4820 e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	497 write_fmt_string (printcharfun, " :size %ld", (long) ht->count);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	498 else
4820 e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	499 write_fmt_string (printcharfun, " :size %ld/%ld", (long) ht->count,
800 a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben] ben parents: 793 diff changeset	500 (long) ht->size);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	501 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	502
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	503 if (ht->weakness != HASH_TABLE_NON_WEAK)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	504 {
800 a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben] ben parents: 793 diff changeset	505 write_fmt_string
4820 e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	506 (printcharfun, " :weakness %s",
800 a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben] ben parents: 793 diff changeset	507 (ht->weakness == HASH_TABLE_WEAK ? "key-and-value" :
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben] ben parents: 793 diff changeset	508 ht->weakness == HASH_TABLE_KEY_WEAK ? "key" :
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben] ben parents: 793 diff changeset	509 ht->weakness == HASH_TABLE_VALUE_WEAK ? "value" :
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben] ben parents: 793 diff changeset	510 ht->weakness == HASH_TABLE_KEY_VALUE_WEAK ? "key-or-value" :
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben] ben parents: 793 diff changeset	511 "you-d-better-not-see-this"));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	512 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	513
4777 c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this. Aidan Kehoe <kehoea@parhasard.net> parents: 4693 diff changeset	514 if (ht->rehash_size != HASH_TABLE_DEFAULT_REHASH_SIZE)
c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this. Aidan Kehoe <kehoea@parhasard.net> parents: 4693 diff changeset	515 {
c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this. Aidan Kehoe <kehoea@parhasard.net> parents: 4693 diff changeset	516 float_to_string (pigbuf, ht->rehash_size);
4820 e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	517 write_fmt_string (printcharfun, " :rehash-size %s", pigbuf);
4777 c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this. Aidan Kehoe <kehoea@parhasard.net> parents: 4693 diff changeset	518 }
c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this. Aidan Kehoe <kehoea@parhasard.net> parents: 4693 diff changeset	519
c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this. Aidan Kehoe <kehoea@parhasard.net> parents: 4693 diff changeset	520 if (ht->rehash_threshold
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	521 != HASH_TABLE_DEFAULT_REHASH_THRESHOLD (ht->size, ht->test))
4777 c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this. Aidan Kehoe <kehoea@parhasard.net> parents: 4693 diff changeset	522 {
c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this. Aidan Kehoe <kehoea@parhasard.net> parents: 4693 diff changeset	523 float_to_string (pigbuf, ht->rehash_threshold);
4820 e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	524 write_fmt_string (printcharfun, " :rehash-threshold %s", pigbuf);
4777 c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this. Aidan Kehoe <kehoea@parhasard.net> parents: 4693 diff changeset	525 }
c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this. Aidan Kehoe <kehoea@parhasard.net> parents: 4693 diff changeset	526
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	527 if (ht->count)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	528 print_hash_table_data (ht, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	529
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	530 if (print_readably)
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4820 diff changeset	531 write_ascstring (printcharfun, ")");
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	532 else
5146 88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	533 write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	534 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	535
5169 6c6d78781d59 cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup Ben Wing <ben@xemacs.org> parents: 5158 diff changeset	536 #ifdef ERROR_CHECK_STRUCTURES
6c6d78781d59 cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup Ben Wing <ben@xemacs.org> parents: 5158 diff changeset	537 #define USED_IF_ERROR_CHECK_STRUCTURES(x) x
6c6d78781d59 cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup Ben Wing <ben@xemacs.org> parents: 5158 diff changeset	538 #else
6c6d78781d59 cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup Ben Wing <ben@xemacs.org> parents: 5158 diff changeset	539 #define USED_IF_ERROR_CHECK_STRUCTURES(x) UNUSED (x)
6c6d78781d59 cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup Ben Wing <ben@xemacs.org> parents: 5158 diff changeset	540 #endif
6c6d78781d59 cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup Ben Wing <ben@xemacs.org> parents: 5158 diff changeset	541
4117 229bd619740a [xemacs-hg @ 2007-08-15 11:06:02 by crestani] crestani parents: 4072 diff changeset	542 #ifndef NEW_GC
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	543 static void
4117 229bd619740a [xemacs-hg @ 2007-08-15 11:06:02 by crestani] crestani parents: 4072 diff changeset	544 free_hentries (htentry *hentries,
5169 6c6d78781d59 cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup Ben Wing <ben@xemacs.org> parents: 5158 diff changeset	545 Elemcount USED_IF_ERROR_CHECK_STRUCTURES (size))
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	546 {
800 a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben] ben parents: 793 diff changeset	547 #ifdef ERROR_CHECK_STRUCTURES
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	548 /* Ensure a crash if other code uses the discarded entries afterwards. */
5146 88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	549 deadbeef_memory (hentries,
88bd4f3ef8e4 make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c Ben Wing <ben@xemacs.org> parents: 5142 diff changeset	550 (Rawbyte ) (hentries + size) - (Rawbyte ) hentries);
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	551 #endif
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	552
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	553 if (!DUMPEDP (hentries))
4976 16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO) Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	554 xfree (hentries);
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	555 }
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	556
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	557 static void
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5125 diff changeset	558 finalize_hash_table (Lisp_Object obj)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	559 {
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5125 diff changeset	560 Lisp_Hash_Table *ht = XHASH_TABLE (obj);
5124 623d57b7fbe8 separate regular and disksave finalization, print method fixes. Ben Wing <ben@xemacs.org> parents: 5120 diff changeset	561 free_hentries (ht->hentries, ht->size);
623d57b7fbe8 separate regular and disksave finalization, print method fixes. Ben Wing <ben@xemacs.org> parents: 5120 diff changeset	562 ht->hentries = 0;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	563 }
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3092 diff changeset	564 #endif /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	565
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	566 static const struct memory_description htentry_description_1[] = {
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	567 { XD_LISP_OBJECT, offsetof (htentry, key) },
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	568 { XD_LISP_OBJECT, offsetof (htentry, value) },
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	569 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	570 };
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	571
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	572 static const struct sized_memory_description htentry_description = {
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	573 sizeof (htentry),
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	574 htentry_description_1
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	575 };
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	576
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	577 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	578 static const struct memory_description htentry_weak_description_1[] = {
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	579 { XD_LISP_OBJECT, offsetof (htentry, key), 0, { 0 }, XD_FLAG_NO_KKCC},
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	580 { XD_LISP_OBJECT, offsetof (htentry, value), 0, { 0 }, XD_FLAG_NO_KKCC},
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	581 { XD_END }
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	582 };
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	583
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	584 static const struct sized_memory_description htentry_weak_description = {
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	585 sizeof (htentry),
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	586 htentry_weak_description_1
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	587 };
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	588
5118 e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	589 DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("hash-table-entry", hash_table_entry,
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	590 0, htentry_description_1,
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	591 Lisp_Hash_Table_Entry);
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	592 #endif /* NEW_GC */
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	593
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	594 static const struct memory_description htentry_union_description_1[] = {
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	595 /* Note: XD_INDIRECT in this table refers to the surrounding table,
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	596 and so this will work. */
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	597 #ifdef NEW_GC
5169 6c6d78781d59 cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup Ben Wing <ben@xemacs.org> parents: 5158 diff changeset	598 { XD_INLINE_LISP_OBJECT_BLOCK_PTR, HASH_TABLE_NON_WEAK,
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	599 XD_INDIRECT (0, 1), { &htentry_description } },
5169 6c6d78781d59 cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup Ben Wing <ben@xemacs.org> parents: 5158 diff changeset	600 { XD_INLINE_LISP_OBJECT_BLOCK_PTR, 0, XD_INDIRECT (0, 1),
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	601 { &htentry_weak_description }, XD_FLAG_UNION_DEFAULT_ENTRY },
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	602 #else /* not NEW_GC */
2367 ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2333 diff changeset	603 { XD_BLOCK_PTR, HASH_TABLE_NON_WEAK, XD_INDIRECT (0, 1),
2551 9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james] james parents: 2500 diff changeset	604 { &htentry_description } },
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james] james parents: 2500 diff changeset	605 { XD_BLOCK_PTR, 0, XD_INDIRECT (0, 1), { &htentry_description },
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	606 XD_FLAG_UNION_DEFAULT_ENTRY \| XD_FLAG_NO_KKCC },
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	607 #endif /* not NEW_GC */
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	608 { XD_END }
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	609 };
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	610
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	611 static const struct sized_memory_description htentry_union_description = {
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	612 sizeof (htentry *),
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	613 htentry_union_description_1
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	614 };
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	615
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	616 const struct memory_description hash_table_description[] = {
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	617 { XD_ELEMCOUNT, offsetof (Lisp_Hash_Table, size) },
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	618 { XD_INT, offsetof (Lisp_Hash_Table, weakness) },
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	619 { XD_UNION, offsetof (Lisp_Hash_Table, hentries), XD_INDIRECT (1, 0),
2551 9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james] james parents: 2500 diff changeset	620 { &htentry_union_description } },
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	621 { XD_LO_LINK, offsetof (Lisp_Hash_Table, next_weak) },
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	622 { XD_LISP_OBJECT,offsetof (Lisp_Hash_Table, test) },
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	623 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	624 };
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	625
5118 e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	626 DEFINE_DUMPABLE_LISP_OBJECT ("hash-table", hash_table,
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	627 mark_hash_table, print_hash_table,
5169 6c6d78781d59 cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup Ben Wing <ben@xemacs.org> parents: 5158 diff changeset	628 IF_OLD_GC (finalize_hash_table),
5118 e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	629 hash_table_equal, hash_table_hash,
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	630 hash_table_description,
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	631 Lisp_Hash_Table);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	632
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	633 static Lisp_Hash_Table *
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	634 xhash_table (Lisp_Object hash_table)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	635 {
1123 37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben] ben parents: 934 diff changeset	636 /* #### What's going on here? Why the gc_in_progress check? */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	637 if (!gc_in_progress)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	638 CHECK_HASH_TABLE (hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	639 check_hash_table_invariants (XHASH_TABLE (hash_table));
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	640 return XHASH_TABLE (hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	641 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	642
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	643
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	644 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	645 /* Creation of Hash Tables */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	646 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	647
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	648 /* Creation of hash tables, without error-checking. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	649 static void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	650 compute_hash_table_derived_values (Lisp_Hash_Table *ht)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	651 {
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	652 ht->rehash_count = (Elemcount)
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 434 diff changeset	653 ((double) ht->size * ht->rehash_threshold);
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	654 ht->golden_ratio = (Elemcount)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	655 ((double) ht->size * (.6180339887 / (double) sizeof (Lisp_Object)));
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	656 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	657
5118 e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	658 static htentry *
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	659 allocate_hash_table_entries (Elemcount size)
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	660 {
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	661 #ifdef NEW_GC
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	662 return XHASH_TABLE_ENTRY (alloc_lrecord_array
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	663 (size, &lrecord_hash_table_entry));
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	664 #else /* not NEW_GC */
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	665 return xnew_array_and_zero (htentry, size);
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	666 #endif /* not NEW_GC */
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	667 }
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	668
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	669 static Lisp_Object decode_hash_table_test (Lisp_Object obj);
450 98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	670
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	671 Lisp_Object
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	672 make_general_lisp_hash_table (Lisp_Object test,
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	673 Elemcount size,
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	674 double rehash_size,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	675 double rehash_threshold,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	676 enum hash_table_weakness weakness)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	677 {
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5125 diff changeset	678 Lisp_Object hash_table = ALLOC_NORMAL_LISP_OBJECT (hash_table);
5117 3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3017 diff changeset	679 Lisp_Hash_Table *ht = XHASH_TABLE (hash_table);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	680
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	681 assert (HASH_TABLE_TESTP (test));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	682
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	683 ht->test = test;
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 434 diff changeset	684 ht->weakness = weakness;
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 434 diff changeset	685
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 434 diff changeset	686 ht->rehash_size =
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 434 diff changeset	687 rehash_size > 1.0 ? rehash_size : HASH_TABLE_DEFAULT_REHASH_SIZE;
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 434 diff changeset	688
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 434 diff changeset	689 ht->rehash_threshold =
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 434 diff changeset	690 rehash_threshold > 0.0 ? rehash_threshold :
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	691 HASH_TABLE_DEFAULT_REHASH_THRESHOLD (size, ht->test);
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 434 diff changeset	692
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	693 if (size < HASH_TABLE_MIN_SIZE)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	694 size = HASH_TABLE_MIN_SIZE;
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	695 ht->size = hash_table_size ((Elemcount) (((double) size / ht->rehash_threshold)
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 434 diff changeset	696 + 1.0));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	697 ht->count = 0;
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 434 diff changeset	698
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	699 compute_hash_table_derived_values (ht);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	700
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	701 /* We leave room for one never-occupied sentinel htentry at the end. */
5118 e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	702 ht->hentries = allocate_hash_table_entries (ht->size + 1);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	703
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	704 if (weakness == HASH_TABLE_NON_WEAK)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	705 ht->next_weak = Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	706 else
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	707 ht->next_weak = Vall_weak_hash_tables, Vall_weak_hash_tables = hash_table;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	708
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	709 return hash_table;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	710 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	711
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	712 Lisp_Object
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	713 make_lisp_hash_table (Elemcount size, enum hash_table_weakness weakness,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	714 Lisp_Object test)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	715 {
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	716 test = decode_hash_table_test (test);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	717 return make_general_lisp_hash_table (test, size, -1.0, -1.0, weakness);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	718 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	719
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	720 /* Pretty reading of hash tables.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	721
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	722 Here we use the existing structures mechanism (which is,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	723 unfortunately, pretty cumbersome) for validating and instantiating
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	724 the hash tables. The idea is that the side-effect of reading a
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	725 #s(hash-table PLIST) object is creation of a hash table with desired
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	726 properties, and that the hash table is returned. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	727
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	728 /* Validation functions: each keyword provides its own validation
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	729 function. The errors should maybe be continuable, but it is
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	730 unclear how this would cope with ERRB. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	731 static int
2286 04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james] james parents: 1726 diff changeset	732 hash_table_size_validate (Lisp_Object UNUSED (keyword), Lisp_Object value,
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james] james parents: 1726 diff changeset	733 Error_Behavior errb)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	734 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	735 if (NATNUMP (value))
5307 c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	736 {
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	737 if (BIGNUMP (value))
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	738 {
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	739 /* hash_table_size() can't handle excessively large sizes. */
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	740 maybe_signal_error_1 (Qargs_out_of_range,
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	741 list3 (value, Qzero,
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	742 make_integer (EMACS_INT_MAX)),
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	743 Qhash_table, errb);
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	744 return 0;
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	745 }
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	746 else
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	747 {
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	748 return 1;
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	749 }
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	750 }
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	751 else
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	752 {
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	753 maybe_signal_error_1 (Qwrong_type_argument, list2 (Qnatnump, value),
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	754 Qhash_table, errb);
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	755 }
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	756
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	757 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	758 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	759
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	760 static Elemcount
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	761 decode_hash_table_size (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	762 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	763 return NILP (obj) ? HASH_TABLE_DEFAULT_SIZE : XINT (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	764 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	765
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	766 static int
2286 04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james] james parents: 1726 diff changeset	767 hash_table_weakness_validate (Lisp_Object UNUSED (keyword), Lisp_Object value,
578 190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben] ben parents: 563 diff changeset	768 Error_Behavior errb)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	769 {
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	770 if (EQ (value, Qnil)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	771 if (EQ (value, Qt)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	772 if (EQ (value, Qkey)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	773 if (EQ (value, Qkey_and_value)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	774 if (EQ (value, Qkey_or_value)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	775 if (EQ (value, Qvalue)) return 1;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	776
5222 18c0b5909d16 Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1 Aidan Kehoe <kehoea@parhasard.net> parents: 5193 diff changeset	777 #ifdef NEED_TO_HANDLE_21_4_CODE
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	778 /* Following values are obsolete as of 19990901 in xemacs-21.2 */
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	779 if (EQ (value, Qnon_weak)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	780 if (EQ (value, Qweak)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	781 if (EQ (value, Qkey_weak)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	782 if (EQ (value, Qkey_or_value_weak)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	783 if (EQ (value, Qvalue_weak)) return 1;
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	784 #endif
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	785
563 183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	786 maybe_invalid_constant ("Invalid hash table weakness",
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	787 value, Qhash_table, errb);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	788 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	789 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	790
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	791 static enum hash_table_weakness
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	792 decode_hash_table_weakness (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	793 {
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	794 if (EQ (obj, Qnil)) return HASH_TABLE_NON_WEAK;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	795 if (EQ (obj, Qt)) return HASH_TABLE_WEAK;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	796 if (EQ (obj, Qkey_and_value)) return HASH_TABLE_WEAK;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	797 if (EQ (obj, Qkey)) return HASH_TABLE_KEY_WEAK;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	798 if (EQ (obj, Qkey_or_value)) return HASH_TABLE_KEY_VALUE_WEAK;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	799 if (EQ (obj, Qvalue)) return HASH_TABLE_VALUE_WEAK;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	800
5222 18c0b5909d16 Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1 Aidan Kehoe <kehoea@parhasard.net> parents: 5193 diff changeset	801 #ifdef NEED_TO_HANDLE_21_4_CODE
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	802 /* Following values are obsolete as of 19990901 in xemacs-21.2 */
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	803 if (EQ (obj, Qnon_weak)) return HASH_TABLE_NON_WEAK;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	804 if (EQ (obj, Qweak)) return HASH_TABLE_WEAK;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	805 if (EQ (obj, Qkey_weak)) return HASH_TABLE_KEY_WEAK;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	806 if (EQ (obj, Qkey_or_value_weak)) return HASH_TABLE_KEY_VALUE_WEAK;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	807 if (EQ (obj, Qvalue_weak)) return HASH_TABLE_VALUE_WEAK;
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	808 #endif
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	809
563 183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	810 invalid_constant ("Invalid hash table weakness", obj);
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	811 RETURN_NOT_REACHED (HASH_TABLE_NON_WEAK);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	812 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	813
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	814 static int
2286 04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james] james parents: 1726 diff changeset	815 hash_table_test_validate (Lisp_Object UNUSED (keyword), Lisp_Object value,
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james] james parents: 1726 diff changeset	816 Error_Behavior errb)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	817 {
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	818 Lisp_Object lookup;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	819
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	820 if (NILP (value))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	821 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	822 return 1;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	823 }
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	824
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	825 lookup = Fassq (value, XWEAK_LIST_LIST (Vhash_table_test_weak_list));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	826 if (NILP (lookup))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	827 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	828 maybe_invalid_constant ("Invalid hash table test",
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	829 value, Qhash_table, errb);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	830 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	831
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	832 return 1;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	833 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	834
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	835 static Lisp_Object
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	836 decode_hash_table_test (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	837 {
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	838 Lisp_Object result;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	839
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	840 if (NILP (obj))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	841 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	842 obj = Qeql;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	843 }
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	844
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	845 result = Fassq (obj, XWEAK_LIST_LIST (Vhash_table_test_weak_list));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	846 if (NILP (result))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	847 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	848 invalid_constant ("Invalid hash table test", obj);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	849 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	850
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	851 return XCDR (result);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	852 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	853
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	854 static int
2286 04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james] james parents: 1726 diff changeset	855 hash_table_rehash_size_validate (Lisp_Object UNUSED (keyword),
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james] james parents: 1726 diff changeset	856 Lisp_Object value, Error_Behavior errb)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	857 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	858 if (!FLOATP (value))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	859 {
563 183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	860 maybe_signal_error_1 (Qwrong_type_argument, list2 (Qfloatp, value),
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	861 Qhash_table, errb);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	862 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	863 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	864
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	865 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	866 double rehash_size = XFLOAT_DATA (value);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	867 if (rehash_size <= 1.0)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	868 {
563 183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	869 maybe_invalid_argument
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	870 ("Hash table rehash size must be greater than 1.0",
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	871 value, Qhash_table, errb);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	872 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	873 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	874 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	875
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	876 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	877 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	878
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	879 static double
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	880 decode_hash_table_rehash_size (Lisp_Object rehash_size)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	881 {
4585 871eb054b34a Document non-obvious usages. Stephen J. Turnbull <stephen@xemacs.org> parents: 4410 diff changeset	882 /* -1.0 signals make_general_lisp_hash_table to use the default. */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	883 return NILP (rehash_size) ? -1.0 : XFLOAT_DATA (rehash_size);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	884 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	885
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	886 static int
2286 04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james] james parents: 1726 diff changeset	887 hash_table_rehash_threshold_validate (Lisp_Object UNUSED (keyword),
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james] james parents: 1726 diff changeset	888 Lisp_Object value, Error_Behavior errb)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	889 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	890 if (!FLOATP (value))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	891 {
563 183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	892 maybe_signal_error_1 (Qwrong_type_argument, list2 (Qfloatp, value),
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	893 Qhash_table, errb);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	894 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	895 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	896
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	897 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	898 double rehash_threshold = XFLOAT_DATA (value);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	899 if (rehash_threshold <= 0.0 \|\| rehash_threshold >= 1.0)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	900 {
563 183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	901 maybe_invalid_argument
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	902 ("Hash table rehash threshold must be between 0.0 and 1.0",
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	903 value, Qhash_table, errb);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	904 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	905 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	906 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	907
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	908 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	909 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	910
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	911 static double
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	912 decode_hash_table_rehash_threshold (Lisp_Object rehash_threshold)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	913 {
4585 871eb054b34a Document non-obvious usages. Stephen J. Turnbull <stephen@xemacs.org> parents: 4410 diff changeset	914 /* -1.0 signals make_general_lisp_hash_table to use the default. */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	915 return NILP (rehash_threshold) ? -1.0 : XFLOAT_DATA (rehash_threshold);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	916 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	917
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	918 static int
2286 04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james] james parents: 1726 diff changeset	919 hash_table_data_validate (Lisp_Object UNUSED (keyword), Lisp_Object value,
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james] james parents: 1726 diff changeset	920 Error_Behavior errb)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	921 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	922 int len;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	923
4585 871eb054b34a Document non-obvious usages. Stephen J. Turnbull <stephen@xemacs.org> parents: 4410 diff changeset	924 /* Check for improper lists while getting length. */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	925 GET_EXTERNAL_LIST_LENGTH (value, len);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	926
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	927 if (len & 1)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	928 {
563 183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	929 maybe_sferror
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	930 ("Hash table data must have alternating key/value pairs",
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	931 value, Qhash_table, errb);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	932 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	933 }
4585 871eb054b34a Document non-obvious usages. Stephen J. Turnbull <stephen@xemacs.org> parents: 4410 diff changeset	934
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	935 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	936 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	937
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	938 /* The actual instantiation of a hash table. This does practically no
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	939 error checking, because it relies on the fact that the paranoid
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	940 functions above have error-checked everything to the last details.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	941 If this assumption is wrong, we will get a crash immediately (with
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	942 error-checking compiled in), and we'll know if there is a bug in
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	943 the structure mechanism. So there. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	944 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	945 hash_table_instantiate (Lisp_Object plist)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	946 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	947 Lisp_Object hash_table;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	948 Lisp_Object test = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	949 Lisp_Object size = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	950 Lisp_Object rehash_size = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	951 Lisp_Object rehash_threshold = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	952 Lisp_Object weakness = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	953 Lisp_Object data = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	954
4820 e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	955 if (KEYWORDP (Fcar (plist)))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	956 {
4820 e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	957 PROPERTY_LIST_LOOP_3 (key, value, plist)
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	958 {
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	959 if (EQ (key, Q_test)) test = value;
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	960 else if (EQ (key, Q_size)) size = value;
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	961 else if (EQ (key, Q_rehash_size)) rehash_size = value;
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	962 else if (EQ (key, Q_rehash_threshold)) rehash_threshold = value;
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	963 else if (EQ (key, Q_weakness)) weakness = value;
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	964 else if (EQ (key, Q_data)) data = value;
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	965 else if (!KEYWORDP (key))
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	966 signal_error (Qinvalid_read_syntax,
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	967 "can't mix keyword and non-keyword hash table syntax",
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	968 key);
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	969 else ABORT();
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	970 }
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	971 }
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	972 else
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	973 {
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	974 PROPERTY_LIST_LOOP_3 (key, value, plist)
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	975 {
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	976 if (EQ (key, Qtest)) test = value;
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	977 else if (EQ (key, Qsize)) size = value;
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	978 else if (EQ (key, Qrehash_size)) rehash_size = value;
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	979 else if (EQ (key, Qrehash_threshold)) rehash_threshold = value;
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	980 else if (EQ (key, Qweakness)) weakness = value;
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	981 else if (EQ (key, Qdata)) data = value;
5277 d804e621add0 Simplify the API of PARSE_KEYWORDS for callers. Aidan Kehoe <kehoea@parhasard.net> parents: 5232 diff changeset	982 #ifdef NEED_TO_HANDLE_21_4_CODE
4820 e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	983 else if (EQ (key, Qtype))/obsolete/ weakness = value;
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	984 #endif
4820 e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	985 else if (KEYWORDP (key))
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	986 signal_error (Qinvalid_read_syntax,
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	987 "can't mix keyword and non-keyword hash table syntax",
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	988 key);
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	989 else ABORT();
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	990 }
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	991 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	992
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	993 /* Create the hash table. */
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	994 hash_table = make_general_lisp_hash_table
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	995 (decode_hash_table_test (test),
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	996 decode_hash_table_size (size),
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	997 decode_hash_table_rehash_size (rehash_size),
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	998 decode_hash_table_rehash_threshold (rehash_threshold),
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	999 decode_hash_table_weakness (weakness));
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1000
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1001 /* This can GC with a user-specified test. */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1002 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1003 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1004 GCPRO1 (hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1005
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1006 /* And fill it with data. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1007 while (!NILP (data))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1008 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1009 Lisp_Object key, value;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1010 key = XCAR (data); data = XCDR (data);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1011 value = XCAR (data); data = XCDR (data);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1012 Fputhash (key, value, hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1013 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1014 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1015 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1016
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1017 return hash_table;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1018 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1019
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1020 static void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1021 structure_type_create_hash_table_structure_name (Lisp_Object structure_name)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1022 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1023 struct structure_type *st;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1024
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1025 st = define_structure_type (structure_name, 0, hash_table_instantiate);
4820 e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	1026
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	1027 /* First the keyword syntax: */
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	1028 define_structure_type_keyword (st, Q_test, hash_table_test_validate);
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	1029 define_structure_type_keyword (st, Q_size, hash_table_size_validate);
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	1030 define_structure_type_keyword (st, Q_rehash_size, hash_table_rehash_size_validate);
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	1031 define_structure_type_keyword (st, Q_rehash_threshold, hash_table_rehash_threshold_validate);
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	1032 define_structure_type_keyword (st, Q_weakness, hash_table_weakness_validate);
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	1033 define_structure_type_keyword (st, Q_data, hash_table_data_validate);
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	1034
5222 18c0b5909d16 Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1 Aidan Kehoe <kehoea@parhasard.net> parents: 5193 diff changeset	1035 #ifdef NEED_TO_HANDLE_21_4_CODE
4820 e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	1036 /* Next the mutually exclusive, older, non-keyword syntax: */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1037 define_structure_type_keyword (st, Qtest, hash_table_test_validate);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1038 define_structure_type_keyword (st, Qsize, hash_table_size_validate);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1039 define_structure_type_keyword (st, Qrehash_size, hash_table_rehash_size_validate);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1040 define_structure_type_keyword (st, Qrehash_threshold, hash_table_rehash_threshold_validate);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1041 define_structure_type_keyword (st, Qweakness, hash_table_weakness_validate);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1042 define_structure_type_keyword (st, Qdata, hash_table_data_validate);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1043
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1044 /* obsolete as of 19990901 in xemacs-21.2 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1045 define_structure_type_keyword (st, Qtype, hash_table_weakness_validate);
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1046 #endif
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1047 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1048
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1049 /* Create a built-in Lisp structure type named `hash-table'.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1050 We make #s(hashtable ...) equivalent to #s(hash-table ...),
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1051 for backward compatibility.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1052 This is called from emacs.c. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1053 void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1054 structure_type_create_hash_table (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1055 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1056 structure_type_create_hash_table_structure_name (Qhash_table);
5222 18c0b5909d16 Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1 Aidan Kehoe <kehoea@parhasard.net> parents: 5193 diff changeset	1057 #ifdef NEED_TO_HANDLE_21_4_CODE
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1058 structure_type_create_hash_table_structure_name (Qhashtable); /* compat */
5222 18c0b5909d16 Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1 Aidan Kehoe <kehoea@parhasard.net> parents: 5193 diff changeset	1059 #endif
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1060 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1061
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1062
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1063 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1064 /* Definition of Lisp-visible methods */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1065 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1066
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1067 DEFUN ("hash-table-p", Fhash_table_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1068 Return t if OBJECT is a hash table, else nil.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1069 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1070 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1071 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1072 return HASH_TABLEP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1073 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1074
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1075 DEFUN ("make-hash-table", Fmake_hash_table, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1076 Return a new empty hash table object.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1077 Use Common Lisp style keywords to specify hash table properties.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1078
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1079 Keyword :test can be `eq', `eql' (default), `equal' or `equalp'.
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1080 Comparison between keys is done using this function. If speed is important,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1081 consider using `eq'. When storing strings in the hash table, you will
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1082 likely need to use `equal' or `equalp' (for case-insensitivity). With other
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1083 objects, consider using a test function defined with
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1084 `define-hash-table-test', an emacs extension to this Common Lisp hash table
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1085 API.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1086
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1087 Keyword :size specifies the number of keys likely to be inserted.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1088 This number of entries can be inserted without enlarging the hash table.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1089
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1090 Keyword :rehash-size must be a float greater than 1.0, and specifies
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1091 the factor by which to increase the size of the hash table when enlarging.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1092
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1093 Keyword :rehash-threshold must be a float between 0.0 and 1.0,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1094 and specifies the load factor of the hash table which triggers enlarging.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1095
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1096 Non-standard keyword :weakness can be `nil' (default), `t', `key-and-value',
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1097 `key', `value' or `key-or-value'. `t' is an alias for `key-and-value'.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1098
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1099 A key-and-value-weak hash table, also known as a fully-weak or simply
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1100 as a weak hash table, is one whose pointers do not count as GC
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1101 referents: for any key-value pair in the hash table, if the only
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1102 remaining pointer to either the key or the value is in a weak hash
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1103 table, then the pair will be removed from the hash table, and the key
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1104 and value collected. A non-weak hash table (or any other pointer)
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1105 would prevent the object from being collected.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1106
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1107 A key-weak hash table is similar to a fully-weak hash table except that
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1108 a key-value pair will be removed only if the key remains unmarked
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1109 outside of weak hash tables. The pair will remain in the hash table if
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1110 the key is pointed to by something other than a weak hash table, even
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1111 if the value is not.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1112
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1113 A value-weak hash table is similar to a fully-weak hash table except
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1114 that a key-value pair will be removed only if the value remains
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1115 unmarked outside of weak hash tables. The pair will remain in the
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1116 hash table if the value is pointed to by something other than a weak
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1117 hash table, even if the key is not.
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1118
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1119 A key-or-value-weak hash table is similar to a fully-weak hash table except
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1120 that a key-value pair will be removed only if the value and the key remain
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1121 unmarked outside of weak hash tables. The pair will remain in the
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1122 hash table if the value or key are pointed to by something other than a weak
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1123 hash table, even if the other is not.
4693 80cd90837ac5 Add argument information to remaining MANY or UNEVALLED C subrs. Aidan Kehoe <kehoea@parhasard.net> parents: 4585 diff changeset	1124
4777 c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this. Aidan Kehoe <kehoea@parhasard.net> parents: 4693 diff changeset	1125 arguments: (&key TEST SIZE REHASH-SIZE REHASH-THRESHOLD WEAKNESS)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1126 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1127 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1128 {
5277 d804e621add0 Simplify the API of PARSE_KEYWORDS for callers. Aidan Kehoe <kehoea@parhasard.net> parents: 5232 diff changeset	1129 #ifndef NEED_TO_HANDLE_21_4_CODE
d804e621add0 Simplify the API of PARSE_KEYWORDS for callers. Aidan Kehoe <kehoea@parhasard.net> parents: 5232 diff changeset	1130 PARSE_KEYWORDS (Fmake_hash_table, nargs, args, 5,
5084 6afe991b8135 Add a PARSE_KEYWORDS macro, use it in #'make-hash-table. Aidan Kehoe <kehoea@parhasard.net> parents: 4976 diff changeset	1131 (test, size, rehash_size, rehash_threshold, weakness),
5277 d804e621add0 Simplify the API of PARSE_KEYWORDS for callers. Aidan Kehoe <kehoea@parhasard.net> parents: 5232 diff changeset	1132 NULL);
5084 6afe991b8135 Add a PARSE_KEYWORDS macro, use it in #'make-hash-table. Aidan Kehoe <kehoea@parhasard.net> parents: 4976 diff changeset	1133 #else
5277 d804e621add0 Simplify the API of PARSE_KEYWORDS for callers. Aidan Kehoe <kehoea@parhasard.net> parents: 5232 diff changeset	1134 PARSE_KEYWORDS (Fmake_hash_table, nargs, args, 6,
5084 6afe991b8135 Add a PARSE_KEYWORDS macro, use it in #'make-hash-table. Aidan Kehoe <kehoea@parhasard.net> parents: 4976 diff changeset	1135 (test, size, rehash_size, rehash_threshold, weakness,
5277 d804e621add0 Simplify the API of PARSE_KEYWORDS for callers. Aidan Kehoe <kehoea@parhasard.net> parents: 5232 diff changeset	1136 type), (type = Qunbound, weakness = Qunbound));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1137
5084 6afe991b8135 Add a PARSE_KEYWORDS macro, use it in #'make-hash-table. Aidan Kehoe <kehoea@parhasard.net> parents: 4976 diff changeset	1138 if (EQ (weakness, Qunbound))
6afe991b8135 Add a PARSE_KEYWORDS macro, use it in #'make-hash-table. Aidan Kehoe <kehoea@parhasard.net> parents: 4976 diff changeset	1139 {
6afe991b8135 Add a PARSE_KEYWORDS macro, use it in #'make-hash-table. Aidan Kehoe <kehoea@parhasard.net> parents: 4976 diff changeset	1140 if (EQ (weakness, Qunbound) && !EQ (type, Qunbound))
6afe991b8135 Add a PARSE_KEYWORDS macro, use it in #'make-hash-table. Aidan Kehoe <kehoea@parhasard.net> parents: 4976 diff changeset	1141 {
6afe991b8135 Add a PARSE_KEYWORDS macro, use it in #'make-hash-table. Aidan Kehoe <kehoea@parhasard.net> parents: 4976 diff changeset	1142 weakness = type;
6afe991b8135 Add a PARSE_KEYWORDS macro, use it in #'make-hash-table. Aidan Kehoe <kehoea@parhasard.net> parents: 4976 diff changeset	1143 }
6afe991b8135 Add a PARSE_KEYWORDS macro, use it in #'make-hash-table. Aidan Kehoe <kehoea@parhasard.net> parents: 4976 diff changeset	1144 else
6afe991b8135 Add a PARSE_KEYWORDS macro, use it in #'make-hash-table. Aidan Kehoe <kehoea@parhasard.net> parents: 4976 diff changeset	1145 {
6afe991b8135 Add a PARSE_KEYWORDS macro, use it in #'make-hash-table. Aidan Kehoe <kehoea@parhasard.net> parents: 4976 diff changeset	1146 weakness = Qnil;
6afe991b8135 Add a PARSE_KEYWORDS macro, use it in #'make-hash-table. Aidan Kehoe <kehoea@parhasard.net> parents: 4976 diff changeset	1147 }
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1148 }
5084 6afe991b8135 Add a PARSE_KEYWORDS macro, use it in #'make-hash-table. Aidan Kehoe <kehoea@parhasard.net> parents: 4976 diff changeset	1149 #endif
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1150
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1151 #define VALIDATE_VAR(var) \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1152 if (!NILP (var)) hash_table_##var##_validate (Q##var, var, ERROR_ME);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1153
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1154 VALIDATE_VAR (test);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1155 VALIDATE_VAR (size);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1156 VALIDATE_VAR (rehash_size);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1157 VALIDATE_VAR (rehash_threshold);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1158 VALIDATE_VAR (weakness);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1159
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1160 return make_general_lisp_hash_table
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1161 (decode_hash_table_test (test),
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1162 decode_hash_table_size (size),
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1163 decode_hash_table_rehash_size (rehash_size),
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1164 decode_hash_table_rehash_threshold (rehash_threshold),
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1165 decode_hash_table_weakness (weakness));
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1166 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1167
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1168 DEFUN ("copy-hash-table", Fcopy_hash_table, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1169 Return a new hash table containing the same keys and values as HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1170 The keys and values will not themselves be copied.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1171 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1172 (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1173 {
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1174 const Lisp_Hash_Table *ht_old = xhash_table (hash_table);
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5125 diff changeset	1175 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (hash_table);
5117 3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3017 diff changeset	1176 Lisp_Hash_Table *ht = XHASH_TABLE (obj);
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5125 diff changeset	1177 copy_lisp_object (obj, hash_table);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1178
5118 e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	1179 /* We leave room for one never-occupied sentinel htentry at the end. */
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	1180 ht->hentries = allocate_hash_table_entries (ht_old->size + 1);
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1181 memcpy (ht->hentries, ht_old->hentries, (ht_old->size + 1) * sizeof (htentry));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1182
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1183 if (! EQ (ht->next_weak, Qunbound))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1184 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1185 ht->next_weak = Vall_weak_hash_tables;
5117 3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3017 diff changeset	1186 Vall_weak_hash_tables = obj;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1187 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1188
5117 3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3017 diff changeset	1189 return obj;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1190 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1191
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1192 static void
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1193 resize_hash_table (Lisp_Hash_Table *ht, Elemcount new_size)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1194 {
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1195 htentry old_entries, new_entries, sentinel, e;
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1196 Elemcount old_size;
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1197 Hash_Table_Test *http = XHASH_TABLE_TEST (ht->test);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1198
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1199 old_size = ht->size;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1200 ht->size = new_size;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1201
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1202 old_entries = ht->hentries;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1203
5118 e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	1204 /* We leave room for one never-occupied sentinel htentry at the end. */
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	1205 ht->hentries = allocate_hash_table_entries (new_size + 1);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1206 new_entries = ht->hentries;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1207
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1208 compute_hash_table_derived_values (ht);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1209
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1210 for (e = old_entries, sentinel = e + old_size; e < sentinel; e++)
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1211 if (!HTENTRY_CLEAR_P (e))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1212 {
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1213 htentry *probe = new_entries + HASHCODE (e->key, ht, http);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1214 LINEAR_PROBING_LOOP (probe, new_entries, new_size)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1215 ;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1216 probe = e;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1217 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1218
4117 229bd619740a [xemacs-hg @ 2007-08-15 11:06:02 by crestani] crestani parents: 4072 diff changeset	1219 #ifndef NEW_GC
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1220 free_hentries (old_entries, old_size);
4117 229bd619740a [xemacs-hg @ 2007-08-15 11:06:02 by crestani] crestani parents: 4072 diff changeset	1221 #endif /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1222 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1223
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1224 /* After a hash table has been saved to disk and later restored by the
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1225 portable dumper, it contains the same objects, but their addresses
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1226 and thus their HASHCODEs have changed. */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1227 void
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1228 pdump_reorganize_hash_table (Lisp_Object hash_table)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1229 {
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1230 const Lisp_Hash_Table *ht = xhash_table (hash_table);
5118 e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	1231 /* We leave room for one never-occupied sentinel htentry at the end. */
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	1232 htentry *new_entries = allocate_hash_table_entries (ht->size + 1);
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1233 htentry e, sentinel;
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1234 Hash_Table_Test *http = XHASH_TABLE_TEST (ht->test);
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1235
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1236 for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++)
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1237 if (!HTENTRY_CLEAR_P (e))
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1238 {
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1239 htentry *probe = new_entries + HASHCODE (e->key, ht, http);
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1240 LINEAR_PROBING_LOOP (probe, new_entries, ht->size)
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1241 ;
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1242 probe = e;
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1243 }
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1244
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1245 memcpy (ht->hentries, new_entries, ht->size * sizeof (htentry));
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1246
4117 229bd619740a [xemacs-hg @ 2007-08-15 11:06:02 by crestani] crestani parents: 4072 diff changeset	1247 #ifndef NEW_GC
4976 16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO) Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	1248 xfree (new_entries);
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	1249 #endif /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1250 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1251
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1252 static void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1253 enlarge_hash_table (Lisp_Hash_Table *ht)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1254 {
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1255 Elemcount new_size =
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1256 hash_table_size ((Elemcount) ((double) ht->size * ht->rehash_size));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1257 resize_hash_table (ht, new_size);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1258 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1259
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 3263 diff changeset	1260 htentry *
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1261 find_htentry (Lisp_Object key, const Lisp_Hash_Table *ht)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1262 {
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1263 Lisp_Object test = ht->test;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1264 Hash_Table_Test *http = XHASH_TABLE_TEST (test);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1265
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1266 htentry *entries = ht->hentries;
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1267 htentry *probe = entries + HASHCODE (key, ht, http);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1268
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1269 LINEAR_PROBING_LOOP (probe, entries, ht->size)
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1270 if (KEYS_EQUAL_P (probe->key, key, test, http))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1271 break;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1272
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1273 return probe;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1274 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1275
2421 ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1276 /* A version of Fputhash() that increments the value by the specified
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1277 amount and dispenses with all error checks. Assumes that tables does
2421 ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1278 comparison using EQ. Used by the profiling routines to avoid
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1279 overhead -- profiling overhead was being recorded at up to 15% of the
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1280 total time. */
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1281
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1282 void
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1283 inchash_eq (Lisp_Object key, Lisp_Object table, EMACS_INT offset)
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1284 {
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1285 Lisp_Hash_Table *ht = XHASH_TABLE (table);
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1286 Hash_Table_Test *http = XHASH_TABLE_TEST (ht->test);
2421 ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1287 htentry *entries = ht->hentries;
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1288 htentry *probe = entries + HASHCODE (key, ht, http);
2421 ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1289
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1290 LINEAR_PROBING_LOOP (probe, entries, ht->size)
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1291 if (EQ (probe->key, key))
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1292 break;
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1293
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1294 if (!HTENTRY_CLEAR_P (probe))
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1295 probe->value = make_int (XINT (probe->value) + offset);
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1296 else
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1297 {
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1298 probe->key = key;
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1299 probe->value = make_int (offset);
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1300
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1301 if (++ht->count >= ht->rehash_count)
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1302 enlarge_hash_table (ht);
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1303 }
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1304 }
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1305
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1306 DEFUN ("gethash", Fgethash, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1307 Find hash value for KEY in HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1308 If there is no corresponding value, return DEFAULT (which defaults to nil).
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1309 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1310 (key, hash_table, default_))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1311 {
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1312 const Lisp_Hash_Table *ht = xhash_table (hash_table);
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1313 htentry *e = find_htentry (key, ht);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1314
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1315 return HTENTRY_CLEAR_P (e) ? default_ : e->value;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1316 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1317
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1318 DEFUN ("puthash", Fputhash, 3, 3, 0, /*
4410 aae1994dfeec Document return values for #'puthash, #'clrhash. Aidan Kehoe <kehoea@parhasard.net> parents: 4398 diff changeset	1319 Hash KEY to VALUE in HASH-TABLE, and return VALUE.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1320 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1321 (key, value, hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1322 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1323 Lisp_Hash_Table *ht = xhash_table (hash_table);
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1324 htentry *e = find_htentry (key, ht);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1325
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1326 if (!HTENTRY_CLEAR_P (e))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1327 return e->value = value;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1328
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1329 e->key = key;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1330 e->value = value;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1331
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1332 if (++ht->count >= ht->rehash_count)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1333 enlarge_hash_table (ht);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1334
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1335 return value;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1336 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1337
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1338 /* Remove htentry pointed at by PROBE.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1339 Subsequent entries are removed and reinserted.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1340 We don't use tombstones - too wasteful. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1341 static void
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1342 remhash_1 (Lisp_Hash_Table ht, htentry entries, htentry *probe)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1343 {
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1344 Hash_Table_Test *http = XHASH_TABLE_TEST (ht->test);
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1345 Elemcount size = ht->size;
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1346 CLEAR_HTENTRY (probe);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1347 probe++;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1348 ht->count--;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1349
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1350 LINEAR_PROBING_LOOP (probe, entries, size)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1351 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1352 Lisp_Object key = probe->key;
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1353 htentry *probe2 = entries + HASHCODE (key, ht, http);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1354 LINEAR_PROBING_LOOP (probe2, entries, size)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1355 if (EQ (probe2->key, key))
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1356 /* htentry at probe doesn't need to move. */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1357 goto continue_outer_loop;
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1358 /* Move htentry from probe to new home at probe2. */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1359 probe2 = probe;
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1360 CLEAR_HTENTRY (probe);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1361 continue_outer_loop: continue;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1362 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1363 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1364
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1365 DEFUN ("remhash", Fremhash, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1366 Remove the entry for KEY from HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1367 Do nothing if there is no entry for KEY in HASH-TABLE.
617 af57a77cbc92 [xemacs-hg @ 2001-06-18 07:09:50 by ben] ben parents: 578 diff changeset	1368 Return non-nil if an entry was removed.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1369 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1370 (key, hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1371 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1372 Lisp_Hash_Table *ht = xhash_table (hash_table);
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1373 htentry *e = find_htentry (key, ht);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1374
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1375 if (HTENTRY_CLEAR_P (e))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1376 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1377
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1378 remhash_1 (ht, ht->hentries, e);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1379 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1380 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1381
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1382 DEFUN ("clrhash", Fclrhash, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1383 Remove all entries from HASH-TABLE, leaving it empty.
4410 aae1994dfeec Document return values for #'puthash, #'clrhash. Aidan Kehoe <kehoea@parhasard.net> parents: 4398 diff changeset	1384 Return HASH-TABLE.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1385 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1386 (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1387 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1388 Lisp_Hash_Table *ht = xhash_table (hash_table);
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1389 htentry e, sentinel;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1390
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1391 for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++)
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1392 CLEAR_HTENTRY (e);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1393 ht->count = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1394
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1395 return hash_table;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1396 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1397
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1398 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1399 /* Accessor Functions */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1400 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1401
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1402 DEFUN ("hash-table-count", Fhash_table_count, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1403 Return the number of entries in HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1404 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1405 (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1406 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1407 return make_int (xhash_table (hash_table)->count);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1408 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1409
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1410 DEFUN ("hash-table-test", Fhash_table_test, 1, 1, 0, /*
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1411 Return HASH-TABLE's test.
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1412
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1413 This can be one of `eq', `eql', `equal', `equalp', or some symbol supplied
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1414 as the NAME argument to `define-hash-table-test', which see.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1415 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1416 (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1417 {
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1418 CHECK_HASH_TABLE (hash_table);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1419 return XHASH_TABLE_TEST (XHASH_TABLE (hash_table)->test)->name;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1420 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1421
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1422 DEFUN ("hash-table-size", Fhash_table_size, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1423 Return the size of HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1424 This is the current number of slots in HASH-TABLE, whether occupied or not.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1425 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1426 (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1427 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1428 return make_int (xhash_table (hash_table)->size);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1429 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1430
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1431 DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1432 Return the current rehash size of HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1433 This is a float greater than 1.0; the factor by which HASH-TABLE
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1434 is enlarged when the rehash threshold is exceeded.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1435 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1436 (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1437 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1438 return make_float (xhash_table (hash_table)->rehash_size);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1439 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1440
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1441 DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1442 Return the current rehash threshold of HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1443 This is a float between 0.0 and 1.0; the maximum `load factor' of HASH-TABLE,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1444 beyond which the HASH-TABLE is enlarged by rehashing.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1445 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1446 (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1447 {
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 434 diff changeset	1448 return make_float (xhash_table (hash_table)->rehash_threshold);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1449 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1450
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1451 DEFUN ("hash-table-weakness", Fhash_table_weakness, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1452 Return the weakness of HASH-TABLE.
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1453 This can be one of `nil', `key-and-value', `key-or-value', `key' or `value'.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1454 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1455 (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1456 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1457 switch (xhash_table (hash_table)->weakness)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1458 {
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1459 case HASH_TABLE_WEAK: return Qkey_and_value;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1460 case HASH_TABLE_KEY_WEAK: return Qkey;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1461 case HASH_TABLE_KEY_VALUE_WEAK: return Qkey_or_value;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1462 case HASH_TABLE_VALUE_WEAK: return Qvalue;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1463 default: return Qnil;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1464 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1465 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1466
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1467 /* obsolete as of 19990901 in xemacs-21.2 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1468 DEFUN ("hash-table-type", Fhash_table_type, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1469 Return the type of HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1470 This can be one of `non-weak', `weak', `key-weak' or `value-weak'.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1471 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1472 (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1473 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1474 switch (xhash_table (hash_table)->weakness)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1475 {
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1476 case HASH_TABLE_WEAK: return Qweak;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1477 case HASH_TABLE_KEY_WEAK: return Qkey_weak;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1478 case HASH_TABLE_KEY_VALUE_WEAK: return Qkey_or_value_weak;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1479 case HASH_TABLE_VALUE_WEAK: return Qvalue_weak;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1480 default: return Qnon_weak;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1481 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1482 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1483
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1484 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1485 /* Mapping Functions */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1486 /************************************************************************/
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1487
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1488 /* We need to be careful when mapping over hash tables because the
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1489 hash table might be modified during the mapping operation:
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1490 - by the mapping function
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1491 - by gc (if the hash table is weak)
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1492
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1493 So we make a copy of the hentries at the beginning of the mapping
497 11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1494 operation, and iterate over the copy. Naturally, this is
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1495 expensive, but not as expensive as you might think, because no
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1496 actual memory has to be collected by our notoriously inefficient
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1497 GC; we use an unwind-protect instead to free the memory directly.
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1498
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1499 We could avoid the copying by having the hash table modifiers
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1500 puthash and remhash check for currently active mapping functions.
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1501 Disadvantages: it's hard to get right, and IMO hash mapping
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1502 functions are basically rare, and no extra space in the hash table
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1503 object and no extra cpu in puthash or remhash should be wasted to
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1504 make maphash 3% faster. From a design point of view, the basic
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1505 functions gethash, puthash and remhash should be implementable
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1506 without having to think about maphash.
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1507
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1508 Note: We don't (yet) have Common Lisp's with-hash-table-iterator.
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1509 If you implement this naively, you cannot have more than one
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1510 concurrently active iterator over the same hash table. The `each'
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1511 function in perl has this limitation.
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1512
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1513 Note: We GCPRO memory on the heap, not on the stack. There is no
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1514 obvious reason why this is bad, but as of this writing this is the
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1515 only known occurrence of this technique in the code.
504 bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1516
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1517 -- Martin
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1518 */
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1519
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1520 /* Ben disagrees with the "copying hentries" design, and says:
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1521
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1522 Another solution is the same as I've already proposed -- when
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1523 mapping, mark the table as "change-unsafe", and in this case, use a
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1524 secondary table to maintain changes. this could be basically a
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1525 standard hash table, but with entries only for added or deleted
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1526 entries in the primary table, and a marker like Qunbound to
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1527 indicate a deleted entry. puthash, gethash and remhash need a
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1528 single extra check for this secondary table -- totally
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1529 insignificant speedwise. if you really cared about making
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1530 recursive maphashes completely correct, you'd have to do a bit of
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1531 extra work here -- when maphashing, if the secondary table exists,
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1532 make a copy of it, and use the copy in conjunction with the primary
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1533 table when mapping. the advantages of this are
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1534
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1535 [a] easy to demonstrate correct, even with weak hashtables.
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1536
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1537 [b] no extra overhead in the general maphash case -- only when you
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1538 modify the table while maphashing, and even then the overhead is
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1539 very small.
497 11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1540 */
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1541
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1542 static Lisp_Object
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1543 maphash_unwind (Lisp_Object unwind_obj)
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1544 {
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1545 void ptr = (void ) get_opaque_ptr (unwind_obj);
4976 16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO) Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	1546 xfree (ptr);
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1547 free_opaque_ptr (unwind_obj);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1548 return Qnil;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1549 }
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1550
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1551 /* Return a malloced array of alternating key/value pairs from HT. */
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1552 static Lisp_Object *
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1553 copy_compress_hentries (const Lisp_Hash_Table *ht)
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1554 {
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1555 Lisp_Object * const objs =
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1556 /* If the hash table is empty, ht->count could be 0. */
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1557 xnew_array (Lisp_Object, 2 * (ht->count > 0 ? ht->count : 1));
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1558 const htentry e, sentinel;
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1559 Lisp_Object *pobj;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1560
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1561 for (e = ht->hentries, sentinel = e + ht->size, pobj = objs; e < sentinel; e++)
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1562 if (!HTENTRY_CLEAR_P (e))
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1563 {
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1564 *(pobj++) = e->key;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1565 *(pobj++) = e->value;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1566 }
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1567
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1568 type_checking_assert (pobj == objs + 2 * ht->count);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1569
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1570 return objs;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1571 }
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1572
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1573 DEFUN ("maphash", Fmaphash, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1574 Map FUNCTION over entries in HASH-TABLE, calling it with two args,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1575 each key and value in HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1576
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1577 FUNCTION must not modify HASH-TABLE, with the one exception that FUNCTION
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1578 may remhash or puthash the entry currently being processed by FUNCTION.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1579 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1580 (function, hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1581 {
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1582 const Lisp_Hash_Table * const ht = xhash_table (hash_table);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1583 Lisp_Object * const objs = copy_compress_hentries (ht);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1584 Lisp_Object args[3];
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1585 const Lisp_Object pobj, end;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1586 int speccount = specpdl_depth ();
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1587 struct gcpro gcpro1;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1588
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1589 record_unwind_protect (maphash_unwind, make_opaque_ptr ((void *)objs));
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1590 GCPRO1 (objs[0]);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1591 gcpro1.nvars = 2 * ht->count;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1592
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1593 args[0] = function;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1594
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1595 for (pobj = objs, end = pobj + 2 * ht->count; pobj < end; pobj += 2)
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1596 {
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1597 args[1] = pobj[0];
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1598 args[2] = pobj[1];
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1599 Ffuncall (countof (args), args);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1600 }
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1601
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 665 diff changeset	1602 unbind_to (speccount);
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1603 UNGCPRO;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1604
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1605 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1606 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1607
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1608 /* Map C function FUNCTION over the elements of a non-weak lisp hash table.
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1609 FUNCTION must not modify HASH-TABLE, with the one exception that FUNCTION
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1610 may puthash the entry currently being processed by FUNCTION.
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1611 Mapping terminates if FUNCTION returns something other than 0. */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1612 void
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1613 elisp_maphash_unsafe (maphash_function_t function,
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1614 Lisp_Object hash_table, void *extra_arg)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1615 {
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1616 const Lisp_Hash_Table *ht = XHASH_TABLE (hash_table);
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1617 const htentry e, sentinel;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1618
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1619 for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++)
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1620 if (!HTENTRY_CLEAR_P (e))
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1621 if (function (e->key, e->value, extra_arg))
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1622 return;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1623 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1624
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1625 /* Map C function FUNCTION over the elements of a lisp hash table.
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1626 It is safe for FUNCTION to modify HASH-TABLE.
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1627 Mapping terminates if FUNCTION returns something other than 0. */
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1628 void
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1629 elisp_maphash (maphash_function_t function,
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1630 Lisp_Object hash_table, void *extra_arg)
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1631 {
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1632 const Lisp_Hash_Table * const ht = xhash_table (hash_table);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1633 Lisp_Object * const objs = copy_compress_hentries (ht);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1634 const Lisp_Object pobj, end;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1635 int speccount = specpdl_depth ();
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1636 struct gcpro gcpro1;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1637
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1638 record_unwind_protect (maphash_unwind, make_opaque_ptr ((void *)objs));
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1639 GCPRO1 (objs[0]);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1640 gcpro1.nvars = 2 * ht->count;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1641
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1642 for (pobj = objs, end = pobj + 2 * ht->count; pobj < end; pobj += 2)
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1643 if (function (pobj[0], pobj[1], extra_arg))
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1644 break;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1645
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 665 diff changeset	1646 unbind_to (speccount);
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1647 UNGCPRO;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1648 }
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1649
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1650 /* Remove all elements of a lisp hash table satisfying C predicate PREDICATE.
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1651 PREDICATE must not modify HASH-TABLE. */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1652 void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1653 elisp_map_remhash (maphash_function_t predicate,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1654 Lisp_Object hash_table, void *extra_arg)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1655 {
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1656 const Lisp_Hash_Table * const ht = xhash_table (hash_table);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1657 Lisp_Object * const objs = copy_compress_hentries (ht);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1658 const Lisp_Object pobj, end;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1659 int speccount = specpdl_depth ();
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1660 struct gcpro gcpro1;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1661
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1662 record_unwind_protect (maphash_unwind, make_opaque_ptr ((void *)objs));
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1663 GCPRO1 (objs[0]);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1664 gcpro1.nvars = 2 * ht->count;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1665
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1666 for (pobj = objs, end = pobj + 2 * ht->count; pobj < end; pobj += 2)
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1667 if (predicate (pobj[0], pobj[1], extra_arg))
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1668 Fremhash (pobj[0], hash_table);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1669
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 665 diff changeset	1670 unbind_to (speccount);
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1671 UNGCPRO;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1672 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1673
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1674
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1675 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1676 /* garbage collecting weak hash tables */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1677 /************************************************************************/
1598 ac1be85b4a5f [xemacs-hg @ 2003-07-31 13:32:24 by crestani] crestani parents: 1292 diff changeset	1678 #ifdef USE_KKCC
2645 e6854ec89f8e [xemacs-hg @ 2005-03-10 09:12:36 by crestani] crestani parents: 2551 diff changeset	1679 #define MARK_OBJ(obj) do { \
e6854ec89f8e [xemacs-hg @ 2005-03-10 09:12:36 by crestani] crestani parents: 2551 diff changeset	1680 Lisp_Object mo_obj = (obj); \
e6854ec89f8e [xemacs-hg @ 2005-03-10 09:12:36 by crestani] crestani parents: 2551 diff changeset	1681 if (!marked_p (mo_obj)) \
e6854ec89f8e [xemacs-hg @ 2005-03-10 09:12:36 by crestani] crestani parents: 2551 diff changeset	1682 { \
5169 6c6d78781d59 cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup Ben Wing <ben@xemacs.org> parents: 5158 diff changeset	1683 kkcc_gc_stack_push_lisp_object_0 (mo_obj); \
2645 e6854ec89f8e [xemacs-hg @ 2005-03-10 09:12:36 by crestani] crestani parents: 2551 diff changeset	1684 did_mark = 1; \
e6854ec89f8e [xemacs-hg @ 2005-03-10 09:12:36 by crestani] crestani parents: 2551 diff changeset	1685 } \
1598 ac1be85b4a5f [xemacs-hg @ 2003-07-31 13:32:24 by crestani] crestani parents: 1292 diff changeset	1686 } while (0)
ac1be85b4a5f [xemacs-hg @ 2003-07-31 13:32:24 by crestani] crestani parents: 1292 diff changeset	1687
ac1be85b4a5f [xemacs-hg @ 2003-07-31 13:32:24 by crestani] crestani parents: 1292 diff changeset	1688 #else /* NO USE_KKCC */
ac1be85b4a5f [xemacs-hg @ 2003-07-31 13:32:24 by crestani] crestani parents: 1292 diff changeset	1689
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1690 #define MARK_OBJ(obj) do { \
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1691 Lisp_Object mo_obj = (obj); \
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1692 if (!marked_p (mo_obj)) \
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1693 { \
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1694 mark_object (mo_obj); \
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1695 did_mark = 1; \
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1696 } \
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1697 } while (0)
1598 ac1be85b4a5f [xemacs-hg @ 2003-07-31 13:32:24 by crestani] crestani parents: 1292 diff changeset	1698 #endif /NO USE_KKCC /
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1699
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1700
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1701 /* Complete the marking for semi-weak hash tables. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1702 int
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1703 finish_marking_weak_hash_tables (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1704 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1705 Lisp_Object hash_table;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1706 int did_mark = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1707
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1708 for (hash_table = Vall_weak_hash_tables;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1709 !NILP (hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1710 hash_table = XHASH_TABLE (hash_table)->next_weak)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1711 {
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1712 const Lisp_Hash_Table *ht = XHASH_TABLE (hash_table);
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1713 const htentry *e = ht->hentries;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1714 const htentry *sentinel = e + ht->size;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1715
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1716 if (! marked_p (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1717 /* The hash table is probably garbage. Ignore it. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1718 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1719
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1720 /* Now, scan over all the pairs. For all pairs that are
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1721 half-marked, we may need to mark the other half if we're
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1722 keeping this pair. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1723 switch (ht->weakness)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1724 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1725 case HASH_TABLE_KEY_WEAK:
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1726 for (; e < sentinel; e++)
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1727 if (!HTENTRY_CLEAR_P (e))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1728 if (marked_p (e->key))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1729 MARK_OBJ (e->value);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1730 break;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1731
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1732 case HASH_TABLE_VALUE_WEAK:
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1733 for (; e < sentinel; e++)
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1734 if (!HTENTRY_CLEAR_P (e))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1735 if (marked_p (e->value))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1736 MARK_OBJ (e->key);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1737 break;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1738
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1739 case HASH_TABLE_KEY_VALUE_WEAK:
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1740 for (; e < sentinel; e++)
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1741 if (!HTENTRY_CLEAR_P (e))
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1742 {
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1743 if (marked_p (e->value))
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1744 MARK_OBJ (e->key);
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1745 else if (marked_p (e->key))
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1746 MARK_OBJ (e->value);
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1747 }
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1748 break;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1749
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1750 case HASH_TABLE_KEY_CAR_WEAK:
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1751 for (; e < sentinel; e++)
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1752 if (!HTENTRY_CLEAR_P (e))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1753 if (!CONSP (e->key) \|\| marked_p (XCAR (e->key)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1754 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1755 MARK_OBJ (e->key);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1756 MARK_OBJ (e->value);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1757 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1758 break;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1759
450 98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1760 /* We seem to be sprouting new weakness types at an alarming
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1761 rate. At least this is not externally visible - and in
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1762 fact all of these KEY_CAR_* types are only used by the
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1763 glyph code. */
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1764 case HASH_TABLE_KEY_CAR_VALUE_WEAK:
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1765 for (; e < sentinel; e++)
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1766 if (!HTENTRY_CLEAR_P (e))
450 98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1767 {
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1768 if (!CONSP (e->key) \|\| marked_p (XCAR (e->key)))
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1769 {
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1770 MARK_OBJ (e->key);
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1771 MARK_OBJ (e->value);
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1772 }
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1773 else if (marked_p (e->value))
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1774 MARK_OBJ (e->key);
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1775 }
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1776 break;
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1777
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1778 case HASH_TABLE_VALUE_CAR_WEAK:
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1779 for (; e < sentinel; e++)
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1780 if (!HTENTRY_CLEAR_P (e))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1781 if (!CONSP (e->value) \|\| marked_p (XCAR (e->value)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1782 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1783 MARK_OBJ (e->key);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1784 MARK_OBJ (e->value);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1785 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1786 break;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1787
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1788 default:
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1789 break;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1790 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1791 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1792
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1793 return did_mark;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1794 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1795
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1796 void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1797 prune_weak_hash_tables (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1798 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1799 Lisp_Object hash_table, prev = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1800 for (hash_table = Vall_weak_hash_tables;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1801 !NILP (hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1802 hash_table = XHASH_TABLE (hash_table)->next_weak)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1803 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1804 if (! marked_p (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1805 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1806 /* This hash table itself is garbage. Remove it from the list. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1807 if (NILP (prev))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1808 Vall_weak_hash_tables = XHASH_TABLE (hash_table)->next_weak;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1809 else
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1810 XHASH_TABLE (prev)->next_weak = XHASH_TABLE (hash_table)->next_weak;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1811 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1812 else
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1813 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1814 /* Now, scan over all the pairs. Remove all of the pairs
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1815 in which the key or value, or both, is unmarked
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1816 (depending on the weakness of the hash table). */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1817 Lisp_Hash_Table *ht = XHASH_TABLE (hash_table);
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1818 htentry *entries = ht->hentries;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1819 htentry *sentinel = entries + ht->size;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1820 htentry *e;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1821
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1822 for (e = entries; e < sentinel; e++)
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1823 if (!HTENTRY_CLEAR_P (e))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1824 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1825 again:
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1826 if (!marked_p (e->key) \|\| !marked_p (e->value))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1827 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1828 remhash_1 (ht, entries, e);
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1829 if (!HTENTRY_CLEAR_P (e))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1830 goto again;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1831 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1832 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1833
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1834 prev = hash_table;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1835 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1836 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1837 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1838
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1839 /* Return a hash value for an array of Lisp_Objects of size SIZE. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1840
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1841 Hashcode
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1842 internal_array_hash (Lisp_Object *arr, int size, int depth, Boolint equalp)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1843 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1844 int i;
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1845 Hashcode hash = 0;
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1846 depth++;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1847
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1848 if (size <= 5)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1849 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1850 for (i = 0; i < size; i++)
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1851 hash = HASH2 (hash, internal_hash (arr[i], depth, equalp));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1852 return hash;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1853 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1854
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1855 /* just pick five elements scattered throughout the array.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1856 A slightly better approach would be to offset by some
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1857 noise factor from the points chosen below. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1858 for (i = 0; i < 5; i++)
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1859 hash = HASH2 (hash, internal_hash (arr[i*size/5], depth, equalp));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1860
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1861 return hash;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1862 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1863
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1864 /* This needs to be algorithmically the same as
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1865 internal_array_hash(). Unfortunately, for strings with non-ASCII content,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1866 it has to be O(2N), I don't see a reasonable alternative to hashing
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1867 sequence relying on their length. It is O(1) for pure ASCII strings,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1868 though. */
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1869
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1870 static Hashcode
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1871 string_equalp_hash (Lisp_Object string)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1872 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1873 Bytecount len = XSTRING_LENGTH (string),
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1874 ascii_begin = (Bytecount) XSTRING_ASCII_BEGIN (string);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1875 const Ibyte ptr = XSTRING_DATA (string), pend = ptr + len;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1876 Charcount clen;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1877 Hashcode hash = 0;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1878
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1879 if (len == ascii_begin)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1880 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1881 clen = len;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1882 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1883 else
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1884 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1885 clen = string_char_length (string);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1886 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1887
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1888 if (clen <= 5)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1889 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1890 while (ptr < pend)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1891 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1892 hash = HASH2 (hash,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1893 LISP_HASH (make_char (CANONCASE (NULL,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1894 itext_ichar (ptr)))));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1895 INC_IBYTEPTR (ptr);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1896 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1897 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1898 else
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1899 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1900 int ii;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1901
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1902 if (clen == len)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1903 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1904 for (ii = 0; ii < 5; ii++)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1905 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1906 hash = HASH2 (hash,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1907 LISP_HASH (make_char
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1908 (CANONCASE (NULL,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1909 ptr[ii * clen / 5]))));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1910 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1911 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1912 else
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1913 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1914 Charcount this_char = 0, last_char = 0;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1915 for (ii = 0; ii < 5; ii++)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1916 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1917 this_char = ii * clen / 5;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1918 ptr = itext_n_addr (ptr, this_char - last_char);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1919 last_char = this_char;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1920
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1921 hash = HASH2 (hash,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1922 LISP_HASH (make_char
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1923 (CANONCASE (NULL, itext_ichar (ptr)))));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1924 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1925 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1926 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1927
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1928 return HASH2 (clen, hash);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1929 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1930
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1931 /* Return a hash value for a Lisp_Object. This is for use when hashing
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1932 objects with the comparison being `equal' (for `eq', you can just
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1933 use the Lisp_Object itself as the hash value). You need to make a
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1934 tradeoff between the speed of the hash function and how good the
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1935 hashing is. In particular, the hash function needs to be FAST,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1936 so you can't just traipse down the whole tree hashing everything
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1937 together. Most of the time, objects will differ in the first
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1938 few elements you hash. Thus, we only go to a short depth (5)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1939 and only hash at most 5 elements out of a vector. Theoretically
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1940 we could still take 5^5 time (a big big number) to compute a
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1941 hash, but practically this won't ever happen. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1942
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1943 Hashcode
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1944 internal_hash (Lisp_Object obj, int depth, Boolint equalp)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1945 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1946 if (depth > 5)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1947 return 0;
4398 479443c0f95a Have list hashes depend on the order of the contents, as is the case for vectors. Aidan Kehoe <kehoea@parhasard.net> parents: 4117 diff changeset	1948
5193 41ac827cb71b fix cygwin compile, fix warning and style in elhash.c Ben Wing <ben@xemacs.org> parents: 5191 diff changeset	1949 if (CONSP (obj))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1950 {
4398 479443c0f95a Have list hashes depend on the order of the contents, as is the case for vectors. Aidan Kehoe <kehoea@parhasard.net> parents: 4117 diff changeset	1951 Hashcode hash, h;
479443c0f95a Have list hashes depend on the order of the contents, as is the case for vectors. Aidan Kehoe <kehoea@parhasard.net> parents: 4117 diff changeset	1952 int s;
479443c0f95a Have list hashes depend on the order of the contents, as is the case for vectors. Aidan Kehoe <kehoea@parhasard.net> parents: 4117 diff changeset	1953
479443c0f95a Have list hashes depend on the order of the contents, as is the case for vectors. Aidan Kehoe <kehoea@parhasard.net> parents: 4117 diff changeset	1954 depth += 1;
479443c0f95a Have list hashes depend on the order of the contents, as is the case for vectors. Aidan Kehoe <kehoea@parhasard.net> parents: 4117 diff changeset	1955
5193 41ac827cb71b fix cygwin compile, fix warning and style in elhash.c Ben Wing <ben@xemacs.org> parents: 5191 diff changeset	1956 if (!CONSP (XCDR (obj)))
4398 479443c0f95a Have list hashes depend on the order of the contents, as is the case for vectors. Aidan Kehoe <kehoea@parhasard.net> parents: 4117 diff changeset	1957 {
479443c0f95a Have list hashes depend on the order of the contents, as is the case for vectors. Aidan Kehoe <kehoea@parhasard.net> parents: 4117 diff changeset	1958 /* special case for '(a . b) conses */
5193 41ac827cb71b fix cygwin compile, fix warning and style in elhash.c Ben Wing <ben@xemacs.org> parents: 5191 diff changeset	1959 return HASH2 (internal_hash (XCAR(obj), depth, equalp),
41ac827cb71b fix cygwin compile, fix warning and style in elhash.c Ben Wing <ben@xemacs.org> parents: 5191 diff changeset	1960 internal_hash (XCDR (obj), depth, equalp));
4398 479443c0f95a Have list hashes depend on the order of the contents, as is the case for vectors. Aidan Kehoe <kehoea@parhasard.net> parents: 4117 diff changeset	1961 }
479443c0f95a Have list hashes depend on the order of the contents, as is the case for vectors. Aidan Kehoe <kehoea@parhasard.net> parents: 4117 diff changeset	1962
479443c0f95a Have list hashes depend on the order of the contents, as is the case for vectors. Aidan Kehoe <kehoea@parhasard.net> parents: 4117 diff changeset	1963 /* Don't simply tail recurse; we want to hash lists with the
479443c0f95a Have list hashes depend on the order of the contents, as is the case for vectors. Aidan Kehoe <kehoea@parhasard.net> parents: 4117 diff changeset	1964 same contents in distinct orders differently. */
5193 41ac827cb71b fix cygwin compile, fix warning and style in elhash.c Ben Wing <ben@xemacs.org> parents: 5191 diff changeset	1965 hash = internal_hash (XCAR (obj), depth, equalp);
4398 479443c0f95a Have list hashes depend on the order of the contents, as is the case for vectors. Aidan Kehoe <kehoea@parhasard.net> parents: 4117 diff changeset	1966
5193 41ac827cb71b fix cygwin compile, fix warning and style in elhash.c Ben Wing <ben@xemacs.org> parents: 5191 diff changeset	1967 obj = XCDR (obj);
41ac827cb71b fix cygwin compile, fix warning and style in elhash.c Ben Wing <ben@xemacs.org> parents: 5191 diff changeset	1968 for (s = 1; s < 6 && CONSP (obj); obj = XCDR (obj), s++)
4398 479443c0f95a Have list hashes depend on the order of the contents, as is the case for vectors. Aidan Kehoe <kehoea@parhasard.net> parents: 4117 diff changeset	1969 {
5193 41ac827cb71b fix cygwin compile, fix warning and style in elhash.c Ben Wing <ben@xemacs.org> parents: 5191 diff changeset	1970 h = internal_hash (XCAR (obj), depth, equalp);
41ac827cb71b fix cygwin compile, fix warning and style in elhash.c Ben Wing <ben@xemacs.org> parents: 5191 diff changeset	1971 hash = HASH3 (hash, h, s);
4398 479443c0f95a Have list hashes depend on the order of the contents, as is the case for vectors. Aidan Kehoe <kehoea@parhasard.net> parents: 4117 diff changeset	1972 }
479443c0f95a Have list hashes depend on the order of the contents, as is the case for vectors. Aidan Kehoe <kehoea@parhasard.net> parents: 4117 diff changeset	1973
479443c0f95a Have list hashes depend on the order of the contents, as is the case for vectors. Aidan Kehoe <kehoea@parhasard.net> parents: 4117 diff changeset	1974 return hash;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1975 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1976 if (STRINGP (obj))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1977 {
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1978 if (equalp)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1979 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1980 return string_equalp_hash (obj);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1981 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1982
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1983 return hash_string (XSTRING_DATA (obj), XSTRING_LENGTH (obj));
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1984 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1985 if (LRECORDP (obj))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1986 {
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1987 const struct lrecord_implementation
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1988 *imp = XRECORD_LHEADER_IMPLEMENTATION (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1989 if (imp->hash)
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1990 return imp->hash (obj, depth, equalp);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1991 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1992
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1993 if (equalp)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1994 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1995 if (CHARP (obj))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1996 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1997 /* Characters and numbers of the same numeric value hash
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1998 differently, which is fine, they're not equalp. */
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	1999 return LISP_HASH (make_char (CANONCASE (NULL, XCHAR (obj))));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2000 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2001
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2002 if (INTP (obj))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2003 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2004 return FLOAT_HASHCODE_FROM_DOUBLE ((double) (XINT (obj)));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2005 }
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2006 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2007
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2008 return LISP_HASH (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2009 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2010
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2011 DEFUN ("eq-hash", Feq_hash, 1, 1, 0, /*
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2012 Return a hash value for OBJECT appropriate for use with `eq.'
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2013 */
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2014 (object))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2015 {
5193 41ac827cb71b fix cygwin compile, fix warning and style in elhash.c Ben Wing <ben@xemacs.org> parents: 5191 diff changeset	2016 return make_integer ((EMACS_INT) XPNTRVAL (object));
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2017 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2018
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2019 DEFUN ("eql-hash", Feql_hash, 1, 1, 0, /*
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2020 Return a hash value for OBJECT appropriate for use with `eql.'
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2021 */
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2022 (object))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2023 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2024 EMACS_INT hashed = lisp_object_eql_hash (NULL, object);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2025 return make_integer (hashed);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2026 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2027
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2028 DEFUN ("equal-hash", Fequal_hash, 1, 1, 0, /*
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2029 Return a hash value for OBJECT appropriate for use with `equal.'
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2030 \(equal obj1 obj2) implies (= (equal-hash obj1) (equal-hash obj2)).
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2031 */
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2032 (object))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2033 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2034 EMACS_INT hashed = internal_hash (object, 0, 0);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2035 return make_integer (hashed);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2036 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2037
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2038 DEFUN ("equalp-hash", Fequalp_hash, 1, 1, 0, /*
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2039 Return a hash value for OBJECT appropriate for use with `equalp.'
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2040 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2041 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2042 {
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2043 EMACS_INT hashed = internal_hash (object, 0, 1);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2044 return make_integer (hashed);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2045 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2046
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2047 static Lisp_Object
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2048 make_hash_table_test (Lisp_Object name,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2049 hash_table_equal_function_t equal_function,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2050 hash_table_hash_function_t hash_function,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2051 Lisp_Object lisp_equal_function,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2052 Lisp_Object lisp_hash_function)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2053 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2054 Lisp_Object result = ALLOC_NORMAL_LISP_OBJECT (hash_table_test);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2055 Hash_Table_Test *http = XHASH_TABLE_TEST (result);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2056
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2057 http->name = name;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2058 http->equal_function = equal_function;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2059 http->hash_function = hash_function;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2060 http->lisp_equal_function = lisp_equal_function;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2061 http->lisp_hash_function = lisp_hash_function;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2062
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2063 return result;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2064 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2065
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2066 Lisp_Object
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2067 define_hash_table_test (Lisp_Object name,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2068 hash_table_equal_function_t equal_function,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2069 hash_table_hash_function_t hash_function,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2070 Lisp_Object lisp_equal_function,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2071 Lisp_Object lisp_hash_function)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2072 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2073 Lisp_Object result = make_hash_table_test (name, equal_function,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2074 hash_function,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2075 lisp_equal_function,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2076 lisp_hash_function);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2077 XWEAK_LIST_LIST (Vhash_table_test_weak_list)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2078 = Fcons (Fcons (name, result),
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2079 XWEAK_LIST_LIST (Vhash_table_test_weak_list));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2080
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2081 return result;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2082 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2083
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2084 DEFUN ("define-hash-table-test", Fdefine_hash_table_test, 3, 3, 0, /*
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2085 Define a new hash table test with name NAME, a symbol.
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2086
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2087 In a hash table created with NAME as its test, use EQUAL-FUNCTION to compare
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2088 keys, and HASH-FUNCTION for computing hash codes of keys.
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2089
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2090 EQUAL-FUNCTION must be a function taking two arguments and returning non-nil
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2091 if both arguments are the same. HASH-FUNCTION must be a function taking one
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2092 argument and returning an integer that is the hash code of the argument.
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2093
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2094 Computation should use the whole value range of the underlying machine long
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2095 type. In XEmacs this will necessitate bignums for values above
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2096 `most-positive-fixnum' but below (1+ (* most-positive-fixnum 2)) and
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2097 analagous values below `most-negative-fixnum'. Relatively poor hashing
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2098 performance is guaranteed in a build without bignums.
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2099
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2100 This function returns t if successful, and errors if NAME
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2101 cannot be defined as a hash table test.
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2102 */
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2103 (name, equal_function, hash_function))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2104 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2105 Lisp_Object min, max, lookup;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2106
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2107 CHECK_SYMBOL (name);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2108
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2109 lookup = Fassq (name, XWEAK_LIST_LIST (Vhash_table_test_weak_list));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2110
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2111 if (!NILP (lookup))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2112 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2113 invalid_change ("Cannot redefine existing hash table test", name);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2114 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2115
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2116 min = Ffunction_min_args (equal_function);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2117 max = Ffunction_max_args (equal_function);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2118
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2119 if (!((XINT (min) <= 2) && (NILP (max) \|\| 2 <= XINT (max))))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2120 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2121 signal_wrong_number_of_arguments_error (equal_function, 2);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2122 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2123
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2124 min = Ffunction_min_args (hash_function);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2125 max = Ffunction_max_args (hash_function);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2126
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2127 if (!((XINT (min) <= 1) && (NILP (max) \|\| 1 <= XINT (max))))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2128 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2129 signal_wrong_number_of_arguments_error (hash_function, 1);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2130 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2131
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2132 define_hash_table_test (name, lisp_object_general_equal,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2133 lisp_object_general_hash, equal_function,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2134 hash_function);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2135 return Qt;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2136 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2137
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2138 DEFUN ("valid-hash-table-test-p", Fvalid_hash_table_test_p, 1, 1, 0, /*
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2139 Return t if OBJECT names a hash table test, nil otherwise.
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2140
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2141 A valid hash table test is one of the symbols `eq', `eql', `equal',
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2142 `equalp', or some symbol passed as the NAME argument to
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2143 `define-hash-table-test'. As a special case, `nil' is regarded as
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2144 equivalent to `eql'.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2145 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2146 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2147 {
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2148 Lisp_Object lookup;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2149
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2150 if (NILP (object))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2151 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2152 return Qt;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2153 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2154
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2155 lookup = Fassq (object, XWEAK_LIST_LIST (Vhash_table_test_weak_list));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2156
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2157 if (!NILP (lookup))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2158 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2159 return Qt;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2160 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2161
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2162 return Qnil;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2163 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2164
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2165 DEFUN ("hash-table-test-list", Fhash_table_test_list, 0, 0, 0, /*
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2166 Return a list of symbols naming valid hash table tests.
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2167 These can be passed as the value of the TEST keyword to `make-hash-table'.
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2168 This list does not include nil, regarded as equivalent to `eql' by
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2169 `make-hash-table'.
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2170 */
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2171 ())
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2172 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2173 Lisp_Object result = Qnil;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2174
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2175 LIST_LOOP_2 (test, XWEAK_LIST_LIST (Vhash_table_test_weak_list))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2176 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2177 if (!UNBOUNDP (XCAR (test)))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2178 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2179 result = Fcons (XCAR (test), result);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2180 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2181 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2182
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2183 return result;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2184 }
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2185
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2186 DEFUN ("hash-table-test-equal-function",
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2187 Fhash_table_test_equal_function, 1, 1, 0, /*
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2188 Return the comparison function used for hash table test TEST.
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2189 See `define-hash-table-test' and `make-hash-table'.
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2190 */
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2191 (test))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2192 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2193 Lisp_Object lookup;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2194
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2195 if (NILP (test))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2196 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2197 test = Qeql;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2198 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2199
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2200 lookup = Fassq (test, XWEAK_LIST_LIST (Vhash_table_test_weak_list));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2201 if (NILP (lookup))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2202 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2203 invalid_argument ("Not a defined hash table test", test);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2204 }
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2205
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2206 return XHASH_TABLE_TEST (XCDR (lookup))->lisp_equal_function;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2207 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2208
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2209 DEFUN ("hash-table-test-hash-function",
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2210 Fhash_table_test_hash_function, 1, 1, 0, /*
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2211 Return the hash function used for hash table test TEST.
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2212 See `define-hash-table-test' and `make-hash-table'.
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2213 */
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2214 (test))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2215 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2216 Lisp_Object lookup;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2217
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2218 if (NILP (test))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2219 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2220 test = Qeql;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2221 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2222
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2223 lookup = Fassq (test, XWEAK_LIST_LIST (Vhash_table_test_weak_list));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2224 if (NILP (lookup))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2225 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2226 invalid_argument ("Not a defined hash table test", test);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2227 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2228
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2229 return XHASH_TABLE_TEST (XCDR (lookup))->lisp_hash_function;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2230 }
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2231
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2232 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2233 /* initialization */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2234 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2235
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2236 void
5158 9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2237 hash_table_objects_create (void)
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2238 {
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2239 #ifdef MEMORY_USAGE_STATS
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2240 OBJECT_HAS_METHOD (hash_table, memory_usage);
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2241 #endif
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2242 }
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2243
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2244 void
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2245 syms_of_elhash (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2246 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2247 DEFSUBR (Fhash_table_p);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2248 DEFSUBR (Fmake_hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2249 DEFSUBR (Fcopy_hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2250 DEFSUBR (Fgethash);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2251 DEFSUBR (Fremhash);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2252 DEFSUBR (Fputhash);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2253 DEFSUBR (Fclrhash);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2254 DEFSUBR (Fmaphash);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2255 DEFSUBR (Fhash_table_count);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2256 DEFSUBR (Fhash_table_test);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2257 DEFSUBR (Fhash_table_size);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2258 DEFSUBR (Fhash_table_rehash_size);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2259 DEFSUBR (Fhash_table_rehash_threshold);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2260 DEFSUBR (Fhash_table_weakness);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2261 DEFSUBR (Fhash_table_type); /* obsolete */
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2262
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2263 DEFSUBR (Feq_hash);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2264 DEFSUBR (Feql_hash);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2265 DEFSUBR (Fequal_hash);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2266 Ffset (intern ("sxhash"), intern ("equal-hash"));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2267 DEFSUBR (Fequalp_hash);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2268
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2269 DEFSUBR (Fdefine_hash_table_test);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2270 DEFSUBR (Fvalid_hash_table_test_p);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2271 DEFSUBR (Fhash_table_test_list);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2272 DEFSUBR (Fhash_table_test_equal_function);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2273 DEFSUBR (Fhash_table_test_hash_function);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2274
563 183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2275 DEFSYMBOL_MULTIWORD_PREDICATE (Qhash_tablep);
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2276
563 183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2277 DEFSYMBOL (Qhash_table);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2278 DEFSYMBOL (Qhashtable);
5084 6afe991b8135 Add a PARSE_KEYWORDS macro, use it in #'make-hash-table. Aidan Kehoe <kehoea@parhasard.net> parents: 4976 diff changeset	2279 DEFSYMBOL (Qmake_hash_table);
563 183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2280 DEFSYMBOL (Qweakness);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2281 DEFSYMBOL (Qvalue);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2282 DEFSYMBOL (Qkey_or_value);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2283 DEFSYMBOL (Qkey_and_value);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2284 DEFSYMBOL (Qrehash_size);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2285 DEFSYMBOL (Qrehash_threshold);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2286
563 183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2287 DEFSYMBOL (Qweak); /* obsolete */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2288 DEFSYMBOL (Qkey_weak); /* obsolete */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2289 DEFSYMBOL (Qkey_or_value_weak); /* obsolete */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2290 DEFSYMBOL (Qvalue_weak); /* obsolete */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2291 DEFSYMBOL (Qnon_weak); /* obsolete */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2292
4820 e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	2293 DEFKEYWORD (Q_data);
563 183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2294 DEFKEYWORD (Q_test);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2295 DEFKEYWORD (Q_size);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2296 DEFKEYWORD (Q_rehash_size);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2297 DEFKEYWORD (Q_rehash_threshold);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2298 DEFKEYWORD (Q_weakness);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2299 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2300
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2301 void
5158 9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2302 vars_of_elhash (void)
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2303 {
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2304 Lisp_Object weak_list_list = XWEAK_LIST_LIST (Vhash_table_test_weak_list);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2305
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2306 /* This var was staticpro'd and initialised in
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2307 init_elhash_once_early, but its Vall_weak_lists isn't sane, since
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2308 that was done before vars_of_data() was called. Create a sane
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2309 weak list object now, set its list appropriately, assert that our
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2310 data haven't been garbage collected. */
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2311 assert (!NILP (Fassq (Qeq, weak_list_list)));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2312 assert (!NILP (Fassq (Qeql, weak_list_list)));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2313 assert (!NILP (Fassq (Qequal, weak_list_list)));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2314 assert (!NILP (Fassq (Qequalp, weak_list_list)));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2315 assert (4 == XINT (Flength (weak_list_list)));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2316
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2317 Vhash_table_test_weak_list = make_weak_list (WEAK_LIST_KEY_ASSOC);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2318 XWEAK_LIST_LIST (Vhash_table_test_weak_list) = weak_list_list;
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2319
5158 9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2320 #ifdef MEMORY_USAGE_STATS
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2321 OBJECT_HAS_PROPERTY
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2322 (hash_table, memusage_stats_list, list1 (intern ("hash-entries")));
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2323 #endif /* MEMORY_USAGE_STATS */
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2324 }
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2325
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2326 void
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 665 diff changeset	2327 init_elhash_once_early (void)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2328 {
5117 3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3017 diff changeset	2329 INIT_LISP_OBJECT (hash_table);
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2330 INIT_LISP_OBJECT (hash_table_test);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2331
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	2332 #ifdef NEW_GC
5118 e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	2333 INIT_LISP_OBJECT (hash_table_entry);
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	2334 #endif /* NEW_GC */
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 665 diff changeset	2335
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2336 /* init_elhash_once_early() is called very early, we can't have these
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2337 DEFSYMBOLs in syms_of_elhash(), unfortunately. */
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2338
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2339 DEFSYMBOL (Qeq);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2340 DEFSYMBOL (Qeql);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2341 DEFSYMBOL (Qequal);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2342 DEFSYMBOL (Qequalp);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2343
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2344 DEFSYMBOL (Qeq_hash);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2345 DEFSYMBOL (Qeql_hash);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2346 DEFSYMBOL (Qequal_hash);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2347 DEFSYMBOL (Qequalp_hash);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2348
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2349 /* This must NOT be staticpro'd */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2350 Vall_weak_hash_tables = Qnil;
452 3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	2351 dump_add_weak_object_chain (&Vall_weak_hash_tables);
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2352
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2353 staticpro (&Vhash_table_test_weak_list);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2354 Vhash_table_test_weak_list = make_weak_list (WEAK_LIST_KEY_ASSOC);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2355
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2356 staticpro (&Vhash_table_test_eq);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2357 Vhash_table_test_eq = define_hash_table_test (Qeq, NULL, NULL, Qeq, Qeq_hash);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2358 staticpro (&Vhash_table_test_eql);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2359 Vhash_table_test_eql
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2360 = define_hash_table_test (Qeql, lisp_object_eql_equal,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2361 lisp_object_eql_hash, Qeql, Qeql_hash);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2362 (void) define_hash_table_test (Qequal, lisp_object_equal_equal,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2363 lisp_object_equal_hash, Qequal, Qequal_hash);
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2364 (void) define_hash_table_test (Qequalp, lisp_object_equalp_equal,
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2365 lisp_object_equalp_hash, Qequalp, Qequalp_hash);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2366 }

Mercurial > hg > xemacs-beta

annotate src/elhash.c @ 5313:5ed261fd2bd9