xemacs-beta: src/elhash.c annotate

annotate src/elhash.c @ 5524:e05d98bf9644

Style and indentation corrections, behavior.el. 2011-06-19 Aidan Kehoe <kehoea@parhasard.net> * behavior.el (enable-behavior): * behavior.el (disable-behavior): Remove a couple of redundant lambdas here, and remove a cond clause that was never tripped (because nil is a list.) * behavior.el (behavior-menu-filter): Correct some indentation here.

author	Aidan Kehoe <kehoea@parhasard.net>
date	Sun, 19 Jun 2011 19:15:52 +0100
parents	05c1ad4f7a7b
children	58b38d5b32d0

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
5402 308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5277 diff changeset	8 XEmacs is free software: you can redistribute it and/or modify it
428 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
5402 308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5277 diff changeset	10 Free Software Foundation, either version 3 of the License, or (at your
308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5277 diff changeset	11 option) any later version.
428 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
5402 308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5277 diff changeset	19 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	20
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	21 /* Synched up with: Not in FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	22
1292 f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	23 /* 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	24 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	25 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	26 the C code.
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	27
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	28 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	29 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	30 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	31
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	32 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	33 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	34 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	35 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	36 (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	37
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	38 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	39 implementation, by Martin Buchholz, 1997? (Former hash table
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	40 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	41 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	42 */
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben] ben parents: 1204 diff changeset	43
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	44 /* 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	45
504 bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	46 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	47
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	48 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	49 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	50 totally independent.
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	51
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	52 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	53 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	54 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	55 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	56
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	57 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	58 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	59 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	60
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	61 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	62 entry that is always empty (the "sentinel").
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	63
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	64 The traditional literature on hash table implementation
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	65 (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	66 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	67 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	68 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	69 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	70 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	71 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	72 (and getting worse). So linear probing makes sense.
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	73
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	74 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	75 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	76 of hash table implementation is noise. */
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	77
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	78 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	79 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	80 #include "bytecode.h"
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	81 #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	82 #include "gc.h"
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	83 #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	84 #include "buffer.h"
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	85
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	86 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	87 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	88 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	89
5084 6afe991b8135 Add a PARSE_KEYWORDS macro, use it in #'make-hash-table. Aidan Kehoe <kehoea@parhasard.net> parents: 4976 diff changeset	90 static Lisp_Object Qhashtable, Qhash_table, Qmake_hash_table;
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	91 static Lisp_Object Qweakness, Qvalue, Qkey_or_value, Qkey_and_value;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	92 static Lisp_Object Vall_weak_hash_tables;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	93 static Lisp_Object Qrehash_size, Qrehash_threshold;
5320 31be2a3d121d Move Qcount, Q_default, Q_test to general-slots.h; add SYMBOL_KEYWORD_GENERAL() Aidan Kehoe <kehoea@parhasard.net> parents: 5307 diff changeset	94 static Lisp_Object Q_size, 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	95 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	96 static Lisp_Object Vhash_table_test_weak_list;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	97
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	98 /* obsolete as of 19990901 in xemacs-21.2 */
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	99 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	100 static Lisp_Object Qnon_weak;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	101
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	102 /* 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	103 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	104 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	105 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	106 {
71ee43b8a74d 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 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	108 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	109 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	110 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	111 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	112 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	113 };
71ee43b8a74d 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
71ee43b8a74d 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 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	116 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	117 {
71ee43b8a74d 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 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	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 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	121 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	122 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	123
71ee43b8a74d 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 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	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
71ee43b8a74d 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 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	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 { 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	130 { 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	131 { 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	132 { 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	133 };
71ee43b8a74d 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
71ee43b8a74d 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 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	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 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	138 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	139 };
71ee43b8a74d 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
71ee43b8a74d 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 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	142 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	143 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	144 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 /* 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	146
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	147 struct Lisp_Hash_Table
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	148 {
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5125 diff changeset	149 NORMAL_LISP_OBJECT_HEADER header;
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	150 Elemcount size;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	151 Elemcount count;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	152 Elemcount rehash_count;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	153 double rehash_size;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	154 double rehash_threshold;
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	155 Elemcount golden_ratio;
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	156 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	157 Lisp_Object test;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	158 enum hash_table_weakness weakness;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	159 Lisp_Object next_weak; /* Used to chain together all of the weak
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	160 hash tables. Don't mark through this. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	161 };
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	162
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	163 #define CLEAR_HTENTRY(htentry) \
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	164 (((EMACS_UINT)(&((htentry)->key))) = 0, \
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	165 ((EMACS_UINT)(&((htentry)->value))) = 0)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	166
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	167 #define HASH_TABLE_DEFAULT_SIZE 16
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	168 #define HASH_TABLE_DEFAULT_REHASH_SIZE 1.3
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	169 #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	170 #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	171 (((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	172
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	173 #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	174 ((((!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	175 (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	176 LISP_HASH (key)) * (ht)->golden_ratio) % (ht)->size)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	177
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	178 #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	179 (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	180 (http->equal_function) (http, key1, key2))))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	181
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	182 #define LINEAR_PROBING_LOOP(probe, entries, size) \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	183 for (; \
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	184 !HTENTRY_CLEAR_P (probe) \|\| \
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	185 (probe == entries + size ? \
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	186 (probe = entries, !HTENTRY_CLEAR_P (probe)) : 0); \
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	187 probe++)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	188
800 a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben] ben parents: 793 diff changeset	189 #ifdef ERROR_CHECK_STRUCTURES
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	190 static void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	191 check_hash_table_invariants (Lisp_Hash_Table *ht)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	192 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	193 assert (ht->count < ht->size);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	194 assert (ht->count <= ht->rehash_count);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	195 assert (ht->rehash_count < ht->size);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	196 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	197 assert (HTENTRY_CLEAR_P (ht->hentries + ht->size));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	198 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	199 #else
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	200 #define check_hash_table_invariants(ht)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	201 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	202
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	203 /* 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	204 static Elemcount
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	205 hash_table_size (Elemcount requested_size)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	206 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	207 /* Return some prime near, but greater than or equal to, SIZE.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	208 Decades from the time of writing, someone will have a system large
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	209 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	210 static const Elemcount primes [] =
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	211 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	212 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	213 1361, 1777, 2333, 3037, 3967, 5167, 6719, 8737, 11369, 14783,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	214 19219, 24989, 32491, 42257, 54941, 71429, 92861, 120721, 156941,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	215 204047, 265271, 344857, 448321, 582821, 757693, 985003, 1280519,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	216 1664681, 2164111, 2813353, 3657361, 4754591, 6180989, 8035301,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	217 10445899, 13579681, 17653589, 22949669, 29834603, 38784989,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	218 50420551, 65546729, 85210757, 110774011, 144006217, 187208107,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	219 243370577, 316381771, 411296309, 534685237, 695090819, 903618083,
647 b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben] ben parents: 617 diff changeset	220 1174703521, 1527114613, 1985248999 /* , 2580823717UL, 3355070839UL */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	221 };
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	222 /* We've heard of binary search. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	223 int low, high;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	224 for (low = 0, high = countof (primes) - 1; high - low > 1;)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	225 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	226 /* Loop Invariant: size < primes [high] */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	227 int mid = (low + high) / 2;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	228 if (primes [mid] < requested_size)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	229 low = mid;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	230 else
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	231 high = mid;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	232 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	233 return primes [high];
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
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 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	239 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	240 Lisp_Object obj2)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	241 {
4885 6772ce4d982b Fix hash tables, #'member, #'assoc, #'eql compiler macros if bignums Aidan Kehoe <kehoea@parhasard.net> parents: 4820 diff changeset	242 return EQ (obj1, obj2) \|\|
6772ce4d982b Fix hash tables, #'member, #'assoc, #'eql compiler macros if bignums Aidan Kehoe <kehoea@parhasard.net> parents: 4820 diff changeset	243 (NON_FIXNUM_NUMBER_P (obj1) && internal_equal (obj1, obj2, 0));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	244 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	245
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	246 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	247 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	248 {
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 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	250 internal_hash (obj, 0, 0) : LISP_HASH (obj);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	251 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	252
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	253 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	254 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	255 Lisp_Object obj1, Lisp_Object obj2)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	256 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	257 return internal_equal (obj1, obj2, 0);
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
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	260 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	261 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	262 {
71ee43b8a74d 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 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	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
71ee43b8a74d 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 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	267 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	268 {
71ee43b8a74d 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 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	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
71ee43b8a74d 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 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	273 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	274 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	275 {
71ee43b8a74d 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 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	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
71ee43b8a74d 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 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	280 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	281 {
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	282 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	283 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	284
71ee43b8a74d 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 /* 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	286 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	287 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	288 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	289 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	290 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	291
71ee43b8a74d 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 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	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 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	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
71ee43b8a74d 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 #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	298 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	299 {
71ee43b8a74d 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 (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	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 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	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
71ee43b8a74d 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 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	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 #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	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 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	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
71ee43b8a74d 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 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	313 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	314 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	315 {
71ee43b8a74d 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 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	317 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	318
71ee43b8a74d 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 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	320 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	321 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	322 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	323
71ee43b8a74d 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 return !(NILP (res));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	325 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	326
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	329 mark_hash_table (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	330 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	331 Lisp_Hash_Table *ht = XHASH_TABLE (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 /* 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	334 values (we scan over them after everything else has been marked,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	335 and mark or remove them as necessary). */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	336 if (ht->weakness == HASH_TABLE_NON_WEAK)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	337 {
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	338 htentry e, sentinel;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	339
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	340 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	341 if (!HTENTRY_CLEAR_P (e))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	342 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	343 mark_object (e->key);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	344 mark_object (e->value);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	345 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	346 }
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	347
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	348 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	349
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	350 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	351 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	352
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	353 /* 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	354 the same weakness and test function, they have the same number of
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	355 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	356
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	357 This is similar to Common Lisp `equalp' of hash tables, with the
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	358 difference that CL requires the keys to be compared with the test
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	359 function, which we don't do. Doing that would require consing, and
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	360 consing is a bad idea in `equal'. Anyway, our method should provide
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	361 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	362 function, then Fgethash() in hash_table_equal_mapper() will fail. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	363 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	364 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	365 int foldcase)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	366 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	367 Lisp_Hash_Table *ht1 = XHASH_TABLE (hash_table1);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	368 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	369 htentry e, sentinel;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	370
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	371 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	372 (ht1->weakness != ht2->weakness) \|\|
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	373 (ht1->count != ht2->count))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	374 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	375
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	376 depth++;
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 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	379 if (!HTENTRY_CLEAR_P (e))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	380 /* 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	381 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	382 Lisp_Object value_in_other = Fgethash (e->key, hash_table2, Qunbound);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	383 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	384 !internal_equal_0 (e->value, value_in_other, depth, foldcase))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	385 return 0; /* Give up */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	386 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	387
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	388 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	389 }
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	390
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	391 /* 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	392 Examining all entries is too expensive, and examining a random
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	393 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	394 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	395 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	396 int UNUSED (equalp))
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	397 {
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	398 return XHASH_TABLE (hash_table)->count;
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
5158 9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	401 #ifdef MEMORY_USAGE_STATS
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	402
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	403 struct hash_table_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 usage_stats u;
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	406 Bytecount hentries;
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	407 };
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	408
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	409 static void
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	410 hash_table_memory_usage (Lisp_Object hashtab,
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	411 struct generic_usage_stats *gustats)
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	412 {
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	413 Lisp_Hash_Table *ht = XHASH_TABLE (hashtab);
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	414 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	415 stats->hentries +=
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	416 malloced_storage_size (ht->hentries,
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	417 sizeof (htentry) * (ht->size + 1),
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	418 &stats->u);
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	419 }
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	420
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	421 #endif /* MEMORY_USAGE_STATS */
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	422
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	423
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	424 /* Printing hash tables.
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 This is non-trivial, because we use a readable structure-style
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	427 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	428 readably printed in the form of:
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	429
4820 e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	430 #s(hash-table :size 2 :data (key1 value1 key2 value2))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	431
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	432 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	433 `: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	434 `: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	435 `: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	436 `: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	437 `: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	438 `:data' (a list)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	439
430 a5df635868b2 Import from CVS: tag r21-2-23 cvs parents: 428 diff changeset	440 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	441
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	442 #<hash-table size 2/13 data (key1 value1 key2 value2) 0x874d>
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 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	445 `...'. This printer does not cons. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	446
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	447
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	448 /* Print the data of the hash table. This maps through a Lisp
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	449 hash table and prints key/value pairs using PRINTCHARFUN. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	450 static void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	451 print_hash_table_data (Lisp_Hash_Table *ht, Lisp_Object printcharfun)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	452 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	453 int count = 0;
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	454 htentry e, sentinel;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	455
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4820 diff changeset	456 write_ascstring (printcharfun, " :data (");
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	457
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	458 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	459 if (!HTENTRY_CLEAR_P (e))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	460 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	461 if (count > 0)
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4820 diff changeset	462 write_ascstring (printcharfun, " ");
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	463 if (!print_readably && count > 3)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	464 {
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4820 diff changeset	465 write_ascstring (printcharfun, "...");
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	466 break;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	467 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	468 print_internal (e->key, printcharfun, 1);
800 a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben] ben parents: 793 diff changeset	469 write_fmt_string_lisp (printcharfun, " %S", 1, e->value);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	470 count++;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	471 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	472
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4820 diff changeset	473 write_ascstring (printcharfun, ")");
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	474 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	475
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	476 static void
2286 04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james] james parents: 1726 diff changeset	477 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	478 int UNUSED (escapeflag))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	479 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	480 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	481 Ascbyte pigbuf[350];
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	482
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4820 diff changeset	483 write_ascstring (printcharfun,
826 6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben] ben parents: 801 diff changeset	484 print_readably ? "#s(hash-table" : "#<hash-table");
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	485
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	486 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	487 {
71ee43b8a74d 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 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	489 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	490 }
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	491
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	492 if (ht->count \|\| !print_readably)
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 (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	495 write_fmt_string (printcharfun, " :size %ld", (long) ht->count);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	496 else
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/%ld", (long) ht->count,
800 a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben] ben parents: 793 diff changeset	498 (long) ht->size);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	499 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	500
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	501 if (ht->weakness != HASH_TABLE_NON_WEAK)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	502 {
800 a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben] ben parents: 793 diff changeset	503 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	504 (printcharfun, " :weakness %s",
800 a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben] ben parents: 793 diff changeset	505 (ht->weakness == HASH_TABLE_WEAK ? "key-and-value" :
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben] ben parents: 793 diff changeset	506 ht->weakness == HASH_TABLE_KEY_WEAK ? "key" :
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben] ben parents: 793 diff changeset	507 ht->weakness == HASH_TABLE_VALUE_WEAK ? "value" :
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben] ben parents: 793 diff changeset	508 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	509 "you-d-better-not-see-this"));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	510 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	511
4777 c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this. Aidan Kehoe <kehoea@parhasard.net> parents: 4693 diff changeset	512 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	513 {
c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this. Aidan Kehoe <kehoea@parhasard.net> parents: 4693 diff changeset	514 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	515 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	516 }
c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this. Aidan Kehoe <kehoea@parhasard.net> parents: 4693 diff changeset	517
c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this. Aidan Kehoe <kehoea@parhasard.net> parents: 4693 diff changeset	518 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	519 != 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	520 {
c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this. Aidan Kehoe <kehoea@parhasard.net> parents: 4693 diff changeset	521 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	522 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	523 }
c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this. Aidan Kehoe <kehoea@parhasard.net> parents: 4693 diff changeset	524
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	525 if (ht->count)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	526 print_hash_table_data (ht, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	527
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	528 if (print_readably)
4952 19a72041c5ed Mule-izing, various fixes related to char * arguments Ben Wing <ben@xemacs.org> parents: 4820 diff changeset	529 write_ascstring (printcharfun, ")");
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	530 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	531 write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	532 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	533
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	534 #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	535 #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	536 #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	537 #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	538 #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	539
4117 229bd619740a [xemacs-hg @ 2007-08-15 11:06:02 by crestani] crestani parents: 4072 diff changeset	540 #ifndef NEW_GC
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	541 static void
4117 229bd619740a [xemacs-hg @ 2007-08-15 11:06:02 by crestani] crestani parents: 4072 diff changeset	542 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	543 Elemcount USED_IF_ERROR_CHECK_STRUCTURES (size))
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	544 {
800 a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben] ben parents: 793 diff changeset	545 #ifdef ERROR_CHECK_STRUCTURES
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	546 /* 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	547 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	548 (Rawbyte ) (hentries + size) - (Rawbyte ) hentries);
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	549 #endif
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	550
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	551 if (!DUMPEDP (hentries))
4976 16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO) Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	552 xfree (hentries);
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	553 }
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	554
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	555 static void
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5125 diff changeset	556 finalize_hash_table (Lisp_Object obj)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	557 {
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5125 diff changeset	558 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	559 free_hentries (ht->hentries, ht->size);
623d57b7fbe8 separate regular and disksave finalization, print method fixes. Ben Wing <ben@xemacs.org> parents: 5120 diff changeset	560 ht->hentries = 0;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	561 }
3263 d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani] crestani parents: 3092 diff changeset	562 #endif /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	563
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	564 static const struct memory_description htentry_description_1[] = {
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	565 { XD_LISP_OBJECT, offsetof (htentry, key) },
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	566 { XD_LISP_OBJECT, offsetof (htentry, value) },
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	567 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	568 };
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	569
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	570 static const struct sized_memory_description htentry_description = {
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	571 sizeof (htentry),
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	572 htentry_description_1
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	573 };
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	574
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	575 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	576 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	577 { 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	578 { 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	579 { XD_END }
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	580 };
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	581
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	582 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	583 sizeof (htentry),
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	584 htentry_weak_description_1
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	585 };
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	586
5118 e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	587 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	588 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	589 Lisp_Hash_Table_Entry);
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	590 #endif /* NEW_GC */
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	591
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	592 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	593 /* 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	594 and so this will work. */
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	595 #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	596 { 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	597 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	598 { 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	599 { &htentry_weak_description }, XD_FLAG_UNION_DEFAULT_ENTRY },
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	600 #else /* not NEW_GC */
2367 ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben] ben parents: 2333 diff changeset	601 { 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	602 { &htentry_description } },
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james] james parents: 2500 diff changeset	603 { 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	604 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	605 #endif /* not NEW_GC */
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	606 { XD_END }
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	607 };
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	608
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	609 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	610 sizeof (htentry *),
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	611 htentry_union_description_1
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	612 };
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	613
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	614 const struct memory_description hash_table_description[] = {
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	615 { XD_ELEMCOUNT, offsetof (Lisp_Hash_Table, size) },
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	616 { XD_INT, offsetof (Lisp_Hash_Table, weakness) },
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	617 { 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	618 { &htentry_union_description } },
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	619 { 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	620 { XD_LISP_OBJECT,offsetof (Lisp_Hash_Table, test) },
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	621 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	622 };
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	623
5118 e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	624 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	625 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	626 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	627 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	628 hash_table_description,
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	629 Lisp_Hash_Table);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	630
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	631 static Lisp_Hash_Table *
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	632 xhash_table (Lisp_Object hash_table)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	633 {
1123 37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben] ben parents: 934 diff changeset	634 /* #### What's going on here? Why the gc_in_progress check? */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	635 if (!gc_in_progress)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	636 CHECK_HASH_TABLE (hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	637 check_hash_table_invariants (XHASH_TABLE (hash_table));
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	638 return XHASH_TABLE (hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	639 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	640
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 /* Creation of Hash Tables */
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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	646 /* Creation of hash tables, without error-checking. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	647 static void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	648 compute_hash_table_derived_values (Lisp_Hash_Table *ht)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	649 {
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	650 ht->rehash_count = (Elemcount)
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 434 diff changeset	651 ((double) ht->size * ht->rehash_threshold);
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	652 ht->golden_ratio = (Elemcount)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	653 ((double) ht->size * (.6180339887 / (double) sizeof (Lisp_Object)));
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	654 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	655
5118 e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	656 static htentry *
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	657 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	658 {
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	659 #ifdef NEW_GC
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	660 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	661 (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	662 #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	663 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	664 #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	665 }
e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	666
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	667 static Lisp_Object decode_hash_table_test (Lisp_Object obj);
450 98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	668
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	669 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	670 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	671 Elemcount size,
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	672 double rehash_size,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	673 double rehash_threshold,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	674 enum hash_table_weakness weakness)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	675 {
5127 a9c41067dd88 more cleanups, terminology clarification, lots of doc work Ben Wing <ben@xemacs.org> parents: 5125 diff changeset	676 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	677 Lisp_Hash_Table *ht = XHASH_TABLE (hash_table);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	678
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	679 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	680
71ee43b8a74d 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 ht->test = test;
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 434 diff changeset	682 ht->weakness = weakness;
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 434 diff changeset	683
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 434 diff changeset	684 ht->rehash_size =
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 434 diff changeset	685 rehash_size > 1.0 ? rehash_size : HASH_TABLE_DEFAULT_REHASH_SIZE;
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 434 diff changeset	686
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 434 diff changeset	687 ht->rehash_threshold =
84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 434 diff changeset	688 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	689 HASH_TABLE_DEFAULT_REHASH_THRESHOLD (size, ht->test);
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 434 diff changeset	690
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	691 if (size < HASH_TABLE_MIN_SIZE)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	692 size = HASH_TABLE_MIN_SIZE;
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	693 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	694 + 1.0));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	695 ht->count = 0;
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 434 diff changeset	696
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	697 compute_hash_table_derived_values (ht);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	698
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	699 /* 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	700 ht->hentries = allocate_hash_table_entries (ht->size + 1);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	701
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	702 if (weakness == HASH_TABLE_NON_WEAK)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	703 ht->next_weak = Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	704 else
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	705 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	706
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	707 return 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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	710 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	711 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	712 Lisp_Object test)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	713 {
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	714 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	715 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	716 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	717
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	718 /* Pretty reading of hash tables.
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 Here we use the existing structures mechanism (which is,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	721 unfortunately, pretty cumbersome) for validating and instantiating
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	722 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	723 #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	724 properties, and that the hash table is returned. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	725
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	726 /* Validation functions: each keyword provides its own validation
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	727 function. The errors should maybe be continuable, but it is
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	728 unclear how this would cope with ERRB. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	729 static int
2286 04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james] james parents: 1726 diff changeset	730 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	731 Error_Behavior errb)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	732 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	733 if (NATNUMP (value))
5307 c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	734 {
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	735 if (BIGNUMP (value))
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 /* 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	738 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	739 list3 (value, Qzero,
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	740 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	741 Qhash_table, errb);
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	742 return 0;
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	743 }
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	744 else
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 return 1;
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 }
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	749 else
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 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	752 Qhash_table, errb);
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately. Aidan Kehoe <kehoea@parhasard.net> parents: 5277 diff changeset	753 }
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	754
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	755 return 0;
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
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	758 static Elemcount
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	759 decode_hash_table_size (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	760 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	761 return NILP (obj) ? HASH_TABLE_DEFAULT_SIZE : XINT (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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	764 static int
2286 04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james] james parents: 1726 diff changeset	765 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	766 Error_Behavior errb)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	767 {
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	768 if (EQ (value, Qnil)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	769 if (EQ (value, Qt)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	770 if (EQ (value, Qkey)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	771 if (EQ (value, Qkey_and_value)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	772 if (EQ (value, Qkey_or_value)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	773 if (EQ (value, Qvalue)) return 1;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	774
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	775 #ifdef NEED_TO_HANDLE_21_4_CODE
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	776 /* 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	777 if (EQ (value, Qnon_weak)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	778 if (EQ (value, Qweak)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	779 if (EQ (value, Qkey_weak)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	780 if (EQ (value, Qkey_or_value_weak)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	781 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	782 #endif
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	783
563 183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	784 maybe_invalid_constant ("Invalid hash table weakness",
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	785 value, Qhash_table, errb);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	786 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	787 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	788
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	789 static enum hash_table_weakness
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	790 decode_hash_table_weakness (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	791 {
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	792 if (EQ (obj, Qnil)) return HASH_TABLE_NON_WEAK;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	793 if (EQ (obj, Qt)) return HASH_TABLE_WEAK;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	794 if (EQ (obj, Qkey_and_value)) return HASH_TABLE_WEAK;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	795 if (EQ (obj, Qkey)) return HASH_TABLE_KEY_WEAK;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	796 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	797 if (EQ (obj, Qvalue)) return HASH_TABLE_VALUE_WEAK;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	798
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	799 #ifdef NEED_TO_HANDLE_21_4_CODE
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	800 /* 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	801 if (EQ (obj, Qnon_weak)) return HASH_TABLE_NON_WEAK;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	802 if (EQ (obj, Qweak)) return HASH_TABLE_WEAK;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	803 if (EQ (obj, Qkey_weak)) return HASH_TABLE_KEY_WEAK;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	804 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	805 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	806 #endif
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	807
563 183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	808 invalid_constant ("Invalid hash table weakness", obj);
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	809 RETURN_NOT_REACHED (HASH_TABLE_NON_WEAK);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	810 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	811
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	812 static int
2286 04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james] james parents: 1726 diff changeset	813 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	814 Error_Behavior errb)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	815 {
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	816 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	817
71ee43b8a74d 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 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	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 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	821 }
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	822
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	823 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	824 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	825 {
71ee43b8a74d 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 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	827 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	828 }
71ee43b8a74d 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
71ee43b8a74d 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 return 1;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	831 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	832
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	833 static Lisp_Object
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	834 decode_hash_table_test (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	835 {
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	836 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	837
71ee43b8a74d 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 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	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 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	841 }
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	842
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	843 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	844 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	845 {
71ee43b8a74d 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 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	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
71ee43b8a74d 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 return XCDR (result);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	850 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	851
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	852 static int
2286 04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james] james parents: 1726 diff changeset	853 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	854 Lisp_Object value, Error_Behavior errb)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	855 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	856 if (!FLOATP (value))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	857 {
563 183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	858 maybe_signal_error_1 (Qwrong_type_argument, list2 (Qfloatp, value),
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	859 Qhash_table, errb);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	860 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	861 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	862
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 double rehash_size = XFLOAT_DATA (value);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	865 if (rehash_size <= 1.0)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	866 {
563 183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	867 maybe_invalid_argument
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	868 ("Hash table rehash size must be greater than 1.0",
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	869 value, Qhash_table, errb);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	870 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	871 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	872 }
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 return 1;
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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	877 static double
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	878 decode_hash_table_rehash_size (Lisp_Object rehash_size)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	879 {
4585 871eb054b34a Document non-obvious usages. Stephen J. Turnbull <stephen@xemacs.org> parents: 4410 diff changeset	880 /* -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	881 return NILP (rehash_size) ? -1.0 : XFLOAT_DATA (rehash_size);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	882 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	883
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	884 static int
2286 04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james] james parents: 1726 diff changeset	885 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	886 Lisp_Object value, Error_Behavior errb)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	887 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	888 if (!FLOATP (value))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	889 {
563 183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	890 maybe_signal_error_1 (Qwrong_type_argument, list2 (Qfloatp, value),
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	891 Qhash_table, errb);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	892 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	893 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	894
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 double rehash_threshold = XFLOAT_DATA (value);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	897 if (rehash_threshold <= 0.0 \|\| rehash_threshold >= 1.0)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	898 {
563 183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	899 maybe_invalid_argument
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	900 ("Hash table rehash threshold must be between 0.0 and 1.0",
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	901 value, Qhash_table, errb);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	902 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	903 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	904 }
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 return 1;
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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	909 static double
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	910 decode_hash_table_rehash_threshold (Lisp_Object rehash_threshold)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	911 {
4585 871eb054b34a Document non-obvious usages. Stephen J. Turnbull <stephen@xemacs.org> parents: 4410 diff changeset	912 /* -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	913 return NILP (rehash_threshold) ? -1.0 : XFLOAT_DATA (rehash_threshold);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	914 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	915
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	916 static int
2286 04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james] james parents: 1726 diff changeset	917 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	918 Error_Behavior errb)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	919 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	920 int len;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	921
4585 871eb054b34a Document non-obvious usages. Stephen J. Turnbull <stephen@xemacs.org> parents: 4410 diff changeset	922 /* Check for improper lists while getting length. */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	923 GET_EXTERNAL_LIST_LENGTH (value, len);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	924
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	925 if (len & 1)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	926 {
563 183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	927 maybe_sferror
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	928 ("Hash table data must have alternating key/value pairs",
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	929 value, Qhash_table, errb);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	930 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	931 }
4585 871eb054b34a Document non-obvious usages. Stephen J. Turnbull <stephen@xemacs.org> parents: 4410 diff changeset	932
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	933 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	934 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	935
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	936 /* The actual instantiation of a hash table. This does practically no
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	937 error checking, because it relies on the fact that the paranoid
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	938 functions above have error-checked everything to the last details.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	939 If this assumption is wrong, we will get a crash immediately (with
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	940 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	941 the structure mechanism. So there. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	942 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	943 hash_table_instantiate (Lisp_Object plist)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	944 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	945 Lisp_Object hash_table;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	946 Lisp_Object test = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	947 Lisp_Object size = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	948 Lisp_Object rehash_size = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	949 Lisp_Object rehash_threshold = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	950 Lisp_Object weakness = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	951 Lisp_Object data = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	952
4820 e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	953 if (KEYWORDP (Fcar (plist)))
428 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 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	956 {
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	957 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	958 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	959 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	960 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	961 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	962 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	963 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	964 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	965 "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	966 key);
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	967 else ABORT();
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	968 }
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	969 }
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	970 else
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 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	973 {
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	974 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	975 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	976 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	977 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	978 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	979 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	980 #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	981 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	982 #endif
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 (KEYWORDP (key))
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	984 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	985 "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	986 key);
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	987 else ABORT();
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	988 }
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	989 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	990
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	991 /* 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	992 hash_table = make_general_lisp_hash_table
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	993 (decode_hash_table_test (test),
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	994 decode_hash_table_size (size),
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	995 decode_hash_table_rehash_size (rehash_size),
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	996 decode_hash_table_rehash_threshold (rehash_threshold),
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	997 decode_hash_table_weakness (weakness));
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	998
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	999 /* This can GC with a user-specified test. */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1000 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1001 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1002 GCPRO1 (hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1003
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1004 /* And fill it with data. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1005 while (!NILP (data))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1006 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1007 Lisp_Object key, value;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1008 key = XCAR (data); data = XCDR (data);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1009 value = XCAR (data); data = XCDR (data);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1010 Fputhash (key, value, hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1011 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1012 UNGCPRO;
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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1015 return hash_table;
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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1018 static void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1019 structure_type_create_hash_table_structure_name (Lisp_Object structure_name)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1020 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1021 struct structure_type *st;
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 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	1024
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	1025 /* 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	1026 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	1027 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	1028 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	1029 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	1030 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	1031 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	1032
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	1033 #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	1034 /* Next the mutually exclusive, older, non-keyword syntax: */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1035 define_structure_type_keyword (st, Qtest, hash_table_test_validate);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1036 define_structure_type_keyword (st, Qsize, hash_table_size_validate);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1037 define_structure_type_keyword (st, Qrehash_size, hash_table_rehash_size_validate);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1038 define_structure_type_keyword (st, Qrehash_threshold, hash_table_rehash_threshold_validate);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1039 define_structure_type_keyword (st, Qweakness, hash_table_weakness_validate);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1040 define_structure_type_keyword (st, Qdata, hash_table_data_validate);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1041
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1042 /* obsolete as of 19990901 in xemacs-21.2 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1043 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	1044 #endif
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1045 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1046
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1047 /* Create a built-in Lisp structure type named `hash-table'.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1048 We make #s(hashtable ...) equivalent to #s(hash-table ...),
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1049 for backward compatibility.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1050 This is called from emacs.c. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1051 void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1052 structure_type_create_hash_table (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1053 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1054 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	1055 #ifdef NEED_TO_HANDLE_21_4_CODE
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1056 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	1057 #endif
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1058 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1059
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 /* Definition of Lisp-visible methods */
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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1065 DEFUN ("hash-table-p", Fhash_table_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1066 Return t if OBJECT is a hash table, else nil.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1067 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1068 (object))
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 return HASH_TABLEP (object) ? Qt : Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1073 DEFUN ("make-hash-table", Fmake_hash_table, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1074 Return a new empty hash table object.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1075 Use Common Lisp style keywords to specify hash table properties.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1076
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	1077 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	1078 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	1079 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	1080 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	1081 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	1082 `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	1083 API.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1084
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1085 Keyword :size specifies the number of keys likely to be inserted.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1086 This number of entries can be inserted without enlarging the hash table.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1087
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1088 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	1089 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	1090
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1091 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	1092 and specifies the load factor of the hash table which triggers enlarging.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1093
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1094 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	1095 `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	1096
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1097 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	1098 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	1099 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	1100 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	1101 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	1102 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	1103 would prevent the object from being collected.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1104
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1105 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	1106 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	1107 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	1108 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	1109 if the value is not.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1110
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1111 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	1112 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	1113 unmarked outside of weak hash tables. The pair will remain in the
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1114 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	1115 hash table, even if the key is not.
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1116
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1117 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	1118 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	1119 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	1120 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	1121 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	1122
4777 c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this. Aidan Kehoe <kehoea@parhasard.net> parents: 4693 diff changeset	1123 arguments: (&key TEST SIZE REHASH-SIZE REHASH-THRESHOLD WEAKNESS)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1124 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1125 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1126 {
5277 d804e621add0 Simplify the API of PARSE_KEYWORDS for callers. Aidan Kehoe <kehoea@parhasard.net> parents: 5232 diff changeset	1127 #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	1128 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	1129 (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	1130 NULL);
5084 6afe991b8135 Add a PARSE_KEYWORDS macro, use it in #'make-hash-table. Aidan Kehoe <kehoea@parhasard.net> parents: 4976 diff changeset	1131 #else
5277 d804e621add0 Simplify the API of PARSE_KEYWORDS for callers. Aidan Kehoe <kehoea@parhasard.net> parents: 5232 diff changeset	1132 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	1133 (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	1134 type), (type = Qunbound, weakness = Qunbound));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1135
5084 6afe991b8135 Add a PARSE_KEYWORDS macro, use it in #'make-hash-table. Aidan Kehoe <kehoea@parhasard.net> parents: 4976 diff changeset	1136 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	1137 {
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) && !EQ (type, 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 weakness = type;
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 else
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 weakness = Qnil;
6afe991b8135 Add a PARSE_KEYWORDS macro, use it in #'make-hash-table. Aidan Kehoe <kehoea@parhasard.net> parents: 4976 diff changeset	1145 }
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1146 }
5084 6afe991b8135 Add a PARSE_KEYWORDS macro, use it in #'make-hash-table. Aidan Kehoe <kehoea@parhasard.net> parents: 4976 diff changeset	1147 #endif
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1148
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1149 #define VALIDATE_VAR(var) \
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1150 if (!NILP (var)) hash_table_##var##_validate (Q##var, var, ERROR_ME);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1151
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1152 VALIDATE_VAR (test);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1153 VALIDATE_VAR (size);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1154 VALIDATE_VAR (rehash_size);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1155 VALIDATE_VAR (rehash_threshold);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1156 VALIDATE_VAR (weakness);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1157
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	1158 return make_general_lisp_hash_table
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1159 (decode_hash_table_test (test),
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1160 decode_hash_table_size (size),
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1161 decode_hash_table_rehash_size (rehash_size),
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1162 decode_hash_table_rehash_threshold (rehash_threshold),
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1163 decode_hash_table_weakness (weakness));
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1164 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1165
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1166 DEFUN ("copy-hash-table", Fcopy_hash_table, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1167 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	1168 The keys and values will not themselves be copied.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1169 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1170 (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1171 {
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1172 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	1173 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	1174 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	1175 copy_lisp_object (obj, hash_table);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1176
5118 e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	1177 /* 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	1178 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	1179 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	1180
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1181 if (! EQ (ht->next_weak, Qunbound))
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 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	1184 Vall_weak_hash_tables = obj;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1185 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1186
5117 3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3017 diff changeset	1187 return obj;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1188 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1189
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1190 static void
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1191 resize_hash_table (Lisp_Hash_Table *ht, Elemcount new_size)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1192 {
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1193 htentry old_entries, new_entries, sentinel, e;
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1194 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	1195 Hash_Table_Test *http = XHASH_TABLE_TEST (ht->test);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1196
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1197 old_size = ht->size;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1198 ht->size = new_size;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1199
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1200 old_entries = ht->hentries;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1201
5118 e0db3c197671 merge up to latest default branch, doesn't compile yet Ben Wing <ben@xemacs.org> parents: 5117 4779 diff changeset	1202 /* 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	1203 ht->hentries = allocate_hash_table_entries (new_size + 1);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1204 new_entries = ht->hentries;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1205
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1206 compute_hash_table_derived_values (ht);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1207
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1208 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	1209 if (!HTENTRY_CLEAR_P (e))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1210 {
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	1211 htentry *probe = new_entries + HASHCODE (e->key, ht, http);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1212 LINEAR_PROBING_LOOP (probe, new_entries, new_size)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1213 ;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1214 probe = e;
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
4117 229bd619740a [xemacs-hg @ 2007-08-15 11:06:02 by crestani] crestani parents: 4072 diff changeset	1217 #ifndef NEW_GC
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1218 free_hentries (old_entries, old_size);
4117 229bd619740a [xemacs-hg @ 2007-08-15 11:06:02 by crestani] crestani parents: 4072 diff changeset	1219 #endif /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1220 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1221
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1222 /* 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	1223 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	1224 and thus their HASHCODEs have changed. */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1225 void
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1226 pdump_reorganize_hash_table (Lisp_Object hash_table)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1227 {
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1228 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	1229 /* 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	1230 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	1231 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	1232 Hash_Table_Test *http = XHASH_TABLE_TEST (ht->test);
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1233
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1234 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	1235 if (!HTENTRY_CLEAR_P (e))
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1236 {
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	1237 htentry *probe = new_entries + HASHCODE (e->key, ht, http);
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1238 LINEAR_PROBING_LOOP (probe, new_entries, ht->size)
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1239 ;
8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1240 probe = e;
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
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1243 memcpy (ht->hentries, new_entries, ht->size * sizeof (htentry));
440 8de8e3f6228a Import from CVS: tag r21-2-28 cvs parents: 438 diff changeset	1244
4117 229bd619740a [xemacs-hg @ 2007-08-15 11:06:02 by crestani] crestani parents: 4072 diff changeset	1245 #ifndef NEW_GC
4976 16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO) Ben Wing <ben@xemacs.org> parents: 4962 diff changeset	1246 xfree (new_entries);
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	1247 #endif /* not NEW_GC */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1248 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1249
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1250 static void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1251 enlarge_hash_table (Lisp_Hash_Table *ht)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1252 {
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1253 Elemcount new_size =
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1254 hash_table_size ((Elemcount) ((double) ht->size * ht->rehash_size));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1255 resize_hash_table (ht, new_size);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1256 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1257
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 3263 diff changeset	1258 htentry *
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1259 find_htentry (Lisp_Object key, const Lisp_Hash_Table *ht)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1260 {
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	1261 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	1262 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	1263
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1264 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	1265 htentry *probe = entries + HASHCODE (key, ht, http);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1266
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1267 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	1268 if (KEYS_EQUAL_P (probe->key, key, test, http))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1269 break;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1270
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1271 return probe;
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
2421 ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1274 /* 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	1275 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	1276 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	1277 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	1278 total time. */
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1279
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1280 void
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1281 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	1282 {
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1283 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	1284 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	1285 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	1286 htentry *probe = entries + HASHCODE (key, ht, http);
2421 ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1287
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1288 LINEAR_PROBING_LOOP (probe, entries, ht->size)
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1289 if (EQ (probe->key, key))
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1290 break;
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1291
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1292 if (!HTENTRY_CLEAR_P (probe))
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1293 probe->value = make_int (XINT (probe->value) + offset);
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1294 else
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1295 {
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1296 probe->key = key;
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1297 probe->value = make_int (offset);
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1298
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1299 if (++ht->count >= ht->rehash_count)
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1300 enlarge_hash_table (ht);
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1301 }
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1302 }
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben] ben parents: 2367 diff changeset	1303
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1304 DEFUN ("gethash", Fgethash, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1305 Find hash value for KEY in HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1306 If there is no corresponding value, return DEFAULT (which defaults to nil).
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1307 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1308 (key, hash_table, default_))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1309 {
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1310 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	1311 htentry *e = find_htentry (key, ht);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1312
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1313 return HTENTRY_CLEAR_P (e) ? default_ : e->value;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1314 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1315
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1316 DEFUN ("puthash", Fputhash, 3, 3, 0, /*
4410 aae1994dfeec Document return values for #'puthash, #'clrhash. Aidan Kehoe <kehoea@parhasard.net> parents: 4398 diff changeset	1317 Hash KEY to VALUE in HASH-TABLE, and return VALUE.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1318 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1319 (key, value, hash_table))
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 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	1322 htentry *e = find_htentry (key, ht);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1323
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1324 if (!HTENTRY_CLEAR_P (e))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1325 return e->value = value;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1326
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1327 e->key = key;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1328 e->value = value;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1329
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1330 if (++ht->count >= ht->rehash_count)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1331 enlarge_hash_table (ht);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1332
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1333 return value;
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
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1336 /* Remove htentry pointed at by PROBE.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1337 Subsequent entries are removed and reinserted.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1338 We don't use tombstones - too wasteful. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1339 static void
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1340 remhash_1 (Lisp_Hash_Table ht, htentry entries, htentry *probe)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1341 {
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	1342 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	1343 Elemcount size = ht->size;
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1344 CLEAR_HTENTRY (probe);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1345 probe++;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1346 ht->count--;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1347
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1348 LINEAR_PROBING_LOOP (probe, entries, size)
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 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	1351 htentry *probe2 = entries + HASHCODE (key, ht, http);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1352 LINEAR_PROBING_LOOP (probe2, entries, size)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1353 if (EQ (probe2->key, key))
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1354 /* htentry at probe doesn't need to move. */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1355 goto continue_outer_loop;
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1356 /* Move htentry from probe to new home at probe2. */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1357 probe2 = probe;
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1358 CLEAR_HTENTRY (probe);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1359 continue_outer_loop: continue;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1360 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1361 }
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 DEFUN ("remhash", Fremhash, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1364 Remove the entry for KEY from HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1365 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	1366 Return non-nil if an entry was removed.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1367 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1368 (key, hash_table))
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 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	1371 htentry *e = find_htentry (key, ht);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1372
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1373 if (HTENTRY_CLEAR_P (e))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1374 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1375
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1376 remhash_1 (ht, ht->hentries, e);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1377 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1378 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1379
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1380 DEFUN ("clrhash", Fclrhash, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1381 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	1382 Return HASH-TABLE.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1383 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1384 (hash_table))
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 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	1387 htentry e, sentinel;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1388
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1389 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	1390 CLEAR_HTENTRY (e);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1391 ht->count = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1392
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1393 return hash_table;
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
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 /* Accessor Functions */
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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1400 DEFUN ("hash-table-count", Fhash_table_count, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1401 Return the number of entries in HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1402 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1403 (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 return make_int (xhash_table (hash_table)->count);
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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1408 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	1409 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	1410
71ee43b8a74d 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 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	1412 as the NAME argument to `define-hash-table-test', which see.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1413 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1414 (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1415 {
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	1416 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	1417 return XHASH_TABLE_TEST (XHASH_TABLE (hash_table)->test)->name;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1418 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1419
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1420 DEFUN ("hash-table-size", Fhash_table_size, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1421 Return the size of HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1422 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	1423 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1424 (hash_table))
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 return make_int (xhash_table (hash_table)->size);
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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1429 DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1430 Return the current rehash size of HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1431 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	1432 is enlarged when the rehash threshold is exceeded.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1433 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1434 (hash_table))
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 return make_float (xhash_table (hash_table)->rehash_size);
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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1439 DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1440 Return the current rehash threshold of HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1441 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	1442 beyond which the HASH-TABLE is enlarged by rehashing.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1443 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1444 (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1445 {
438 84b14dcb0985 Import from CVS: tag r21-2-27 cvs parents: 434 diff changeset	1446 return make_float (xhash_table (hash_table)->rehash_threshold);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1447 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1448
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1449 DEFUN ("hash-table-weakness", Fhash_table_weakness, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1450 Return the weakness of HASH-TABLE.
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1451 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	1452 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1453 (hash_table))
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 switch (xhash_table (hash_table)->weakness)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1456 {
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1457 case HASH_TABLE_WEAK: return Qkey_and_value;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1458 case HASH_TABLE_KEY_WEAK: return Qkey;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1459 case HASH_TABLE_KEY_VALUE_WEAK: return Qkey_or_value;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1460 case HASH_TABLE_VALUE_WEAK: return Qvalue;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1461 default: return Qnil;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1462 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1463 }
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 /* obsolete as of 19990901 in xemacs-21.2 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1466 DEFUN ("hash-table-type", Fhash_table_type, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1467 Return the type of HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1468 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	1469 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1470 (hash_table))
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 switch (xhash_table (hash_table)->weakness)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1473 {
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1474 case HASH_TABLE_WEAK: return Qweak;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1475 case HASH_TABLE_KEY_WEAK: return Qkey_weak;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1476 case HASH_TABLE_KEY_VALUE_WEAK: return Qkey_or_value_weak;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1477 case HASH_TABLE_VALUE_WEAK: return Qvalue_weak;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1478 default: return Qnon_weak;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1479 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1480 }
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 /* Mapping Functions */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1484 /************************************************************************/
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1485
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1486 /* 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	1487 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	1488 - by the mapping function
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1489 - by gc (if the hash table is weak)
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1490
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1491 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	1492 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	1493 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	1494 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	1495 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	1496
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1497 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	1498 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	1499 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	1500 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	1501 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	1502 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	1503 functions gethash, puthash and remhash should be implementable
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1504 without having to think about maphash.
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1505
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1506 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	1507 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	1508 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	1509 function in perl has this limitation.
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1510
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1511 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	1512 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	1513 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	1514
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1515 -- Martin
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
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1518 /* 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	1519
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1520 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	1521 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	1522 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	1523 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	1524 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	1525 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	1526 single extra check for this secondary table -- totally
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1527 insignificant speedwise. if you really cared about making
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1528 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	1529 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	1530 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	1531 table when mapping. the advantages of this are
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1532
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1533 [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	1534
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb] martinb parents: 497 diff changeset	1535 [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	1536 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	1537 very small.
497 11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1538 */
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb] martinb parents: 489 diff changeset	1539
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1540 static Lisp_Object
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1541 maphash_unwind (Lisp_Object unwind_obj)
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1542 {
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1543 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	1544 xfree (ptr);
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1545 free_opaque_ptr (unwind_obj);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1546 return Qnil;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1547 }
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1548
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1549 /* 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	1550 static Lisp_Object *
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1551 copy_compress_hentries (const Lisp_Hash_Table *ht)
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1552 {
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1553 Lisp_Object * const objs =
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1554 /* 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	1555 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	1556 const htentry e, sentinel;
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1557 Lisp_Object *pobj;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1558
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1559 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	1560 if (!HTENTRY_CLEAR_P (e))
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1561 {
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1562 *(pobj++) = e->key;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1563 *(pobj++) = e->value;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1564 }
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1565
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1566 type_checking_assert (pobj == objs + 2 * ht->count);
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 return objs;
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
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1571 DEFUN ("maphash", Fmaphash, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1572 Map FUNCTION over entries in HASH-TABLE, calling it with two args,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1573 each key and value in HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1574
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1575 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	1576 may remhash or puthash the entry currently being processed by FUNCTION.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1577 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1578 (function, hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1579 {
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1580 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	1581 Lisp_Object * const objs = copy_compress_hentries (ht);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1582 Lisp_Object args[3];
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1583 const Lisp_Object pobj, end;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1584 int speccount = specpdl_depth ();
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1585 struct gcpro gcpro1;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1586
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1587 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	1588 GCPRO1 (objs[0]);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1589 gcpro1.nvars = 2 * ht->count;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1590
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1591 args[0] = function;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1592
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1593 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	1594 {
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1595 args[1] = pobj[0];
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1596 args[2] = pobj[1];
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1597 Ffuncall (countof (args), args);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1598 }
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1599
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 665 diff changeset	1600 unbind_to (speccount);
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1601 UNGCPRO;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1602
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1603 return Qnil;
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
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1606 /* 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	1607 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	1608 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	1609 Mapping terminates if FUNCTION returns something other than 0. */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1610 void
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1611 elisp_maphash_unsafe (maphash_function_t function,
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1612 Lisp_Object hash_table, void *extra_arg)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1613 {
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1614 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	1615 const htentry e, sentinel;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1616
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1617 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	1618 if (!HTENTRY_CLEAR_P (e))
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1619 if (function (e->key, e->value, extra_arg))
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1620 return;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1621 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1622
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1623 /* 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	1624 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	1625 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	1626 void
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1627 elisp_maphash (maphash_function_t function,
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1628 Lisp_Object hash_table, void *extra_arg)
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1629 {
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1630 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	1631 Lisp_Object * const objs = copy_compress_hentries (ht);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1632 const Lisp_Object pobj, end;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1633 int speccount = specpdl_depth ();
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1634 struct gcpro gcpro1;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1635
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1636 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	1637 GCPRO1 (objs[0]);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1638 gcpro1.nvars = 2 * ht->count;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1639
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1640 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	1641 if (function (pobj[0], pobj[1], extra_arg))
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1642 break;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1643
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 665 diff changeset	1644 unbind_to (speccount);
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1645 UNGCPRO;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1646 }
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1647
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1648 /* 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	1649 PREDICATE must not modify HASH-TABLE. */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1650 void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1651 elisp_map_remhash (maphash_function_t predicate,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1652 Lisp_Object hash_table, void *extra_arg)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1653 {
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1654 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	1655 Lisp_Object * const objs = copy_compress_hentries (ht);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1656 const Lisp_Object pobj, end;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1657 int speccount = specpdl_depth ();
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1658 struct gcpro gcpro1;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1659
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1660 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	1661 GCPRO1 (objs[0]);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1662 gcpro1.nvars = 2 * ht->count;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1663
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1664 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	1665 if (predicate (pobj[0], pobj[1], extra_arg))
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1666 Fremhash (pobj[0], hash_table);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1667
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 665 diff changeset	1668 unbind_to (speccount);
489 4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb] martinb parents: 464 diff changeset	1669 UNGCPRO;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1670 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1671
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 /* garbage collecting weak hash tables */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1675 /************************************************************************/
1598 ac1be85b4a5f [xemacs-hg @ 2003-07-31 13:32:24 by crestani] crestani parents: 1292 diff changeset	1676 #ifdef USE_KKCC
2645 e6854ec89f8e [xemacs-hg @ 2005-03-10 09:12:36 by crestani] crestani parents: 2551 diff changeset	1677 #define MARK_OBJ(obj) do { \
e6854ec89f8e [xemacs-hg @ 2005-03-10 09:12:36 by crestani] crestani parents: 2551 diff changeset	1678 Lisp_Object mo_obj = (obj); \
e6854ec89f8e [xemacs-hg @ 2005-03-10 09:12:36 by crestani] crestani parents: 2551 diff changeset	1679 if (!marked_p (mo_obj)) \
e6854ec89f8e [xemacs-hg @ 2005-03-10 09:12:36 by crestani] crestani parents: 2551 diff changeset	1680 { \
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	1681 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	1682 did_mark = 1; \
e6854ec89f8e [xemacs-hg @ 2005-03-10 09:12:36 by crestani] crestani parents: 2551 diff changeset	1683 } \
1598 ac1be85b4a5f [xemacs-hg @ 2003-07-31 13:32:24 by crestani] crestani parents: 1292 diff changeset	1684 } while (0)
ac1be85b4a5f [xemacs-hg @ 2003-07-31 13:32:24 by crestani] crestani parents: 1292 diff changeset	1685
ac1be85b4a5f [xemacs-hg @ 2003-07-31 13:32:24 by crestani] crestani parents: 1292 diff changeset	1686 #else /* NO USE_KKCC */
ac1be85b4a5f [xemacs-hg @ 2003-07-31 13:32:24 by crestani] crestani parents: 1292 diff changeset	1687
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1688 #define MARK_OBJ(obj) do { \
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1689 Lisp_Object mo_obj = (obj); \
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1690 if (!marked_p (mo_obj)) \
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1691 { \
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1692 mark_object (mo_obj); \
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1693 did_mark = 1; \
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1694 } \
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1695 } while (0)
1598 ac1be85b4a5f [xemacs-hg @ 2003-07-31 13:32:24 by crestani] crestani parents: 1292 diff changeset	1696 #endif /NO USE_KKCC /
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1697
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1698
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1699 /* Complete the marking for semi-weak hash tables. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1700 int
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1701 finish_marking_weak_hash_tables (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1702 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1703 Lisp_Object hash_table;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1704 int did_mark = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1705
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1706 for (hash_table = Vall_weak_hash_tables;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1707 !NILP (hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1708 hash_table = XHASH_TABLE (hash_table)->next_weak)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1709 {
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1710 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	1711 const htentry *e = ht->hentries;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1712 const htentry *sentinel = e + ht->size;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1713
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1714 if (! marked_p (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1715 /* The hash table is probably garbage. Ignore it. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1716 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1717
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1718 /* Now, scan over all the pairs. For all pairs that are
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1719 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	1720 keeping this pair. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1721 switch (ht->weakness)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1722 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1723 case HASH_TABLE_KEY_WEAK:
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1724 for (; e < sentinel; e++)
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1725 if (!HTENTRY_CLEAR_P (e))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1726 if (marked_p (e->key))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1727 MARK_OBJ (e->value);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1728 break;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1729
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1730 case HASH_TABLE_VALUE_WEAK:
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1731 for (; e < sentinel; e++)
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1732 if (!HTENTRY_CLEAR_P (e))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1733 if (marked_p (e->value))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1734 MARK_OBJ (e->key);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1735 break;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1736
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1737 case HASH_TABLE_KEY_VALUE_WEAK:
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1738 for (; e < sentinel; e++)
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1739 if (!HTENTRY_CLEAR_P (e))
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1740 {
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1741 if (marked_p (e->value))
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1742 MARK_OBJ (e->key);
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1743 else if (marked_p (e->key))
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1744 MARK_OBJ (e->value);
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1745 }
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1746 break;
abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1747
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1748 case HASH_TABLE_KEY_CAR_WEAK:
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1749 for (; e < sentinel; e++)
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1750 if (!HTENTRY_CLEAR_P (e))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1751 if (!CONSP (e->key) \|\| marked_p (XCAR (e->key)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1752 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1753 MARK_OBJ (e->key);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1754 MARK_OBJ (e->value);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1755 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1756 break;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1757
450 98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1758 /* We seem to be sprouting new weakness types at an alarming
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1759 rate. At least this is not externally visible - and in
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1760 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	1761 glyph code. */
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1762 case HASH_TABLE_KEY_CAR_VALUE_WEAK:
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1763 for (; e < sentinel; e++)
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1764 if (!HTENTRY_CLEAR_P (e))
450 98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1765 {
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1766 if (!CONSP (e->key) \|\| marked_p (XCAR (e->key)))
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 MARK_OBJ (e->key);
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1769 MARK_OBJ (e->value);
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1770 }
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1771 else if (marked_p (e->value))
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1772 MARK_OBJ (e->key);
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1773 }
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1774 break;
98528da0b7fc Import from CVS: tag r21-2-40 cvs parents: 444 diff changeset	1775
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1776 case HASH_TABLE_VALUE_CAR_WEAK:
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1777 for (; e < sentinel; e++)
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1778 if (!HTENTRY_CLEAR_P (e))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1779 if (!CONSP (e->value) \|\| marked_p (XCAR (e->value)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1780 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1781 MARK_OBJ (e->key);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1782 MARK_OBJ (e->value);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1783 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1784 break;
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 default:
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1787 break;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1788 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1789 }
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 return did_mark;
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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1794 void
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1795 prune_weak_hash_tables (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1796 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1797 Lisp_Object hash_table, prev = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1798 for (hash_table = Vall_weak_hash_tables;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1799 !NILP (hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1800 hash_table = XHASH_TABLE (hash_table)->next_weak)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1801 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1802 if (! marked_p (hash_table))
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 /* This hash table itself is garbage. Remove it from the list. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1805 if (NILP (prev))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1806 Vall_weak_hash_tables = XHASH_TABLE (hash_table)->next_weak;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1807 else
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1808 XHASH_TABLE (prev)->next_weak = XHASH_TABLE (hash_table)->next_weak;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1809 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1810 else
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 /* Now, scan over all the pairs. Remove all of the pairs
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1813 in which the key or value, or both, is unmarked
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1814 (depending on the weakness of the hash table). */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1815 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	1816 htentry *entries = ht->hentries;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1817 htentry *sentinel = entries + ht->size;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1818 htentry *e;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1819
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1820 for (e = entries; e < sentinel; e++)
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1821 if (!HTENTRY_CLEAR_P (e))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1822 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1823 again:
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1824 if (!marked_p (e->key) \|\| !marked_p (e->value))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1825 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1826 remhash_1 (ht, entries, e);
1204 e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels] michaels parents: 1123 diff changeset	1827 if (!HTENTRY_CLEAR_P (e))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1828 goto again;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1829 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1830 }
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 prev = hash_table;
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 }
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 /* 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	1838
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1839 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	1840 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	1841 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1842 int i;
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1843 Hashcode hash = 0;
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1844 depth++;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1845
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1846 if (size <= 5)
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 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	1849 hash = HASH2 (hash, internal_hash (arr[i], depth, equalp));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1850 return hash;
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1851 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1852
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1853 /* just pick five elements scattered throughout the array.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1854 A slightly better approach would be to offset by some
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1855 noise factor from the points chosen below. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1856 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	1857 hash = HASH2 (hash, internal_hash (arr[i*size/5], depth, equalp));
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1858
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1859 return hash;
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
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	1862 /* 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	1863 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	1864 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	1865 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	1866 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	1867
71ee43b8a74d 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 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	1869 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	1870 {
71ee43b8a74d 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 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	1872 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	1873 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	1874 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	1875 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	1876
71ee43b8a74d 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 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	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 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	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 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	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 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	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
71ee43b8a74d 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 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	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 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	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 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	1891 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	1892 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	1893 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	1894 }
71ee43b8a74d 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 }
71ee43b8a74d 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 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	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 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	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 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	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 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	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 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	1905 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	1906 (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	1907 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	1908 }
71ee43b8a74d 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 }
71ee43b8a74d 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 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	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 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	1913 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	1914 {
71ee43b8a74d 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 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	1916 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	1917 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	1918
71ee43b8a74d 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 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	1920 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	1921 (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	1922 }
71ee43b8a74d 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 }
71ee43b8a74d 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 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	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
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1929 /* 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	1930 objects with the comparison being `equal' (for `eq', you can just
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1931 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	1932 tradeoff between the speed of the hash function and how good the
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1933 hashing is. In particular, the hash function needs to be FAST,
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1934 so you can't just traipse down the whole tree hashing everything
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1935 together. Most of the time, objects will differ in the first
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1936 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	1937 and only hash at most 5 elements out of a vector. Theoretically
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1938 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	1939 hash, but practically this won't ever happen. */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1940
665 fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben] ben parents: 647 diff changeset	1941 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	1942 internal_hash (Lisp_Object obj, int depth, Boolint equalp)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1943 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1944 if (depth > 5)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1945 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	1946
5193 41ac827cb71b fix cygwin compile, fix warning and style in elhash.c Ben Wing <ben@xemacs.org> parents: 5191 diff changeset	1947 if (CONSP (obj))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1948 {
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	1949 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	1950 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	1951
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 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	1953
5193 41ac827cb71b fix cygwin compile, fix warning and style in elhash.c Ben Wing <ben@xemacs.org> parents: 5191 diff changeset	1954 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	1955 {
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	1956 /* 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	1957 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	1958 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	1959 }
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	1960
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 /* 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	1962 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	1963 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	1964
5193 41ac827cb71b fix cygwin compile, fix warning and style in elhash.c Ben Wing <ben@xemacs.org> parents: 5191 diff changeset	1965 obj = XCDR (obj);
41ac827cb71b fix cygwin compile, fix warning and style in elhash.c Ben Wing <ben@xemacs.org> parents: 5191 diff changeset	1966 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	1967 {
5193 41ac827cb71b fix cygwin compile, fix warning and style in elhash.c Ben Wing <ben@xemacs.org> parents: 5191 diff changeset	1968 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	1969 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	1970 }
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	1971
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 return hash;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1973 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1974 if (STRINGP (obj))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1975 {
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	1976 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	1977 {
71ee43b8a74d 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 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	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
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1981 return hash_string (XSTRING_DATA (obj), XSTRING_LENGTH (obj));
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1982 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1983 if (LRECORDP (obj))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1984 {
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 440 diff changeset	1985 const struct lrecord_implementation
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1986 *imp = XRECORD_LHEADER_IMPLEMENTATION (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1987 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	1988 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	1989 }
71ee43b8a74d 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
71ee43b8a74d 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 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	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 (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	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 /* 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	1996 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	1997 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	1998 }
71ee43b8a74d 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
71ee43b8a74d 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 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	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 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	2003 }
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2004 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2005
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2006 return LISP_HASH (obj);
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
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	2009 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	2010 Return a hash value for OBJECT appropriate for use with `eq.'
5520 05c1ad4f7a7b Expand the documentation of #'eq-hash, mention the CL PRINT-OBJECT protocol Aidan Kehoe <kehoea@parhasard.net> parents: 5474 diff changeset	2011
05c1ad4f7a7b Expand the documentation of #'eq-hash, mention the CL PRINT-OBJECT protocol Aidan Kehoe <kehoea@parhasard.net> parents: 5474 diff changeset	2012 If OBJECT is not immediate (it is not a fixnum or character) this hash value
05c1ad4f7a7b Expand the documentation of #'eq-hash, mention the CL PRINT-OBJECT protocol Aidan Kehoe <kehoea@parhasard.net> parents: 5474 diff changeset	2013 will be unique among currently-reachable objects, and is appropriate for
05c1ad4f7a7b Expand the documentation of #'eq-hash, mention the CL PRINT-OBJECT protocol Aidan Kehoe <kehoea@parhasard.net> parents: 5474 diff changeset	2014 implementing the Common Lisp PRINT-OBJECT protocol.
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	2015 */
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2016 (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	2017 {
5193 41ac827cb71b fix cygwin compile, fix warning and style in elhash.c Ben Wing <ben@xemacs.org> parents: 5191 diff changeset	2018 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	2019 }
71ee43b8a74d 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
71ee43b8a74d 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 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	2022 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	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 (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 {
71ee43b8a74d 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 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	2027 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	2028 }
71ee43b8a74d 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
71ee43b8a74d 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 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	2031 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	2032 \(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	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 (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	2035 {
71ee43b8a74d 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 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	2037 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	2038 }
71ee43b8a74d 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
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2040 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	2041 Return a hash value for OBJECT appropriate for use with `equalp.'
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2042 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2043 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2044 {
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	2045 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	2046 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	2047 }
71ee43b8a74d 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
71ee43b8a74d 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 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	2050 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	2051 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	2052 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	2053 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	2054 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	2055 {
71ee43b8a74d 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 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	2057 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	2058
71ee43b8a74d 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->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	2060 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	2061 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	2062 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	2063 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	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 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	2066 }
71ee43b8a74d 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
71ee43b8a74d 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 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	2069 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	2070 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	2071 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	2072 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	2073 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	2074 {
71ee43b8a74d 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_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	2076 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 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	2078 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	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 = 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	2081 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	2082
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2083 return result;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2084 }
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2085
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	2086 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	2087 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	2088
71ee43b8a74d 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 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	2090 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	2091
71ee43b8a74d 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 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	2093 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	2094 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	2095
71ee43b8a74d 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 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	2097 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	2098 `most-positive-fixnum' but below (1+ (* most-positive-fixnum 2)) and
5384 3889ef128488 Fix misspelled words, and some grammar, across the entire source tree. Jerry James <james@xemacs.org> parents: 5320 diff changeset	2099 analogous values below `most-negative-fixnum'. Relatively poor hashing
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	2100 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	2101
71ee43b8a74d 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 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	2103 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	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 (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	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 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	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 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	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 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	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 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	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 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	2116 }
71ee43b8a74d 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
71ee43b8a74d 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 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	2119 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	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 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	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 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	2124 }
71ee43b8a74d 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
71ee43b8a74d 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 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	2127 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	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 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	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 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	2132 }
71ee43b8a74d 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
71ee43b8a74d 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 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	2135 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	2136 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	2137 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	2138 }
71ee43b8a74d 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
71ee43b8a74d 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 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	2141 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	2142
71ee43b8a74d 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 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	2144 `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	2145 `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	2146 equivalent to `eql'.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2147 */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2148 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2149 {
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	2150 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	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 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	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 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	2155 }
71ee43b8a74d 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 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	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 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	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 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	2162 }
71ee43b8a74d 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 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	2165 }
71ee43b8a74d 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
71ee43b8a74d 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 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	2168 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	2169 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	2170 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	2171 `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	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 ())
71ee43b8a74d 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 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	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 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	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 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	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 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	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 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2184
71ee43b8a74d 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 return result;
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2186 }
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	2187
71ee43b8a74d 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 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	2189 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	2190 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	2191 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	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 (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	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 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	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 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	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 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	2200 }
71ee43b8a74d 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
71ee43b8a74d 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 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	2203 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	2204 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2205 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	2206 }
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2207
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	2208 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	2209 }
71ee43b8a74d 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
71ee43b8a74d 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 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	2212 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	2213 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	2214 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	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 (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	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 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	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 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	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 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	2223 }
71ee43b8a74d 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
71ee43b8a74d 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 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	2226 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	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 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	2229 }
71ee43b8a74d 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
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5169 diff changeset	2231 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	2232 }
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2233
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 /* initialization */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2236 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2237
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2238 void
5158 9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2239 hash_table_objects_create (void)
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2240 {
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2241 #ifdef MEMORY_USAGE_STATS
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2242 OBJECT_HAS_METHOD (hash_table, memory_usage);
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2243 #endif
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2244 }
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2245
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2246 void
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2247 syms_of_elhash (void)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2248 {
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2249 DEFSUBR (Fhash_table_p);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2250 DEFSUBR (Fmake_hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2251 DEFSUBR (Fcopy_hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2252 DEFSUBR (Fgethash);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2253 DEFSUBR (Fremhash);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2254 DEFSUBR (Fputhash);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2255 DEFSUBR (Fclrhash);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2256 DEFSUBR (Fmaphash);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2257 DEFSUBR (Fhash_table_count);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2258 DEFSUBR (Fhash_table_test);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2259 DEFSUBR (Fhash_table_size);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2260 DEFSUBR (Fhash_table_rehash_size);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2261 DEFSUBR (Fhash_table_rehash_threshold);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2262 DEFSUBR (Fhash_table_weakness);
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2263 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	2264
71ee43b8a74d 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 (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	2266 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	2267 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	2268 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	2269 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	2270
71ee43b8a74d 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 (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	2272 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	2273 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	2274 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	2275 DEFSUBR (Fhash_table_test_hash_function);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2276
563 183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2277 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	2278
563 183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2279 DEFSYMBOL (Qhash_table);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2280 DEFSYMBOL (Qhashtable);
5084 6afe991b8135 Add a PARSE_KEYWORDS macro, use it in #'make-hash-table. Aidan Kehoe <kehoea@parhasard.net> parents: 4976 diff changeset	2281 DEFSYMBOL (Qmake_hash_table);
563 183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2282 DEFSYMBOL (Qweakness);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2283 DEFSYMBOL (Qvalue);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2284 DEFSYMBOL (Qkey_or_value);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2285 DEFSYMBOL (Qkey_and_value);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2286 DEFSYMBOL (Qrehash_size);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2287 DEFSYMBOL (Qrehash_threshold);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2288
563 183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2289 DEFSYMBOL (Qweak); /* obsolete */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2290 DEFSYMBOL (Qkey_weak); /* obsolete */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2291 DEFSYMBOL (Qkey_or_value_weak); /* obsolete */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2292 DEFSYMBOL (Qvalue_weak); /* obsolete */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2293 DEFSYMBOL (Qnon_weak); /* obsolete */
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2294
4820 e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables. Aidan Kehoe <kehoea@parhasard.net> parents: 4779 diff changeset	2295 DEFKEYWORD (Q_data);
563 183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2296 DEFKEYWORD (Q_size);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2297 DEFKEYWORD (Q_rehash_size);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2298 DEFKEYWORD (Q_rehash_threshold);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben] ben parents: 504 diff changeset	2299 DEFKEYWORD (Q_weakness);
428 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
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2302 void
5158 9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2303 vars_of_elhash (void)
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2304 {
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	2305 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	2306
71ee43b8a74d 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 /* 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	2308 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	2309 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	2310 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	2311 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	2312 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	2313 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	2314 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	2315 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	2316 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	2317
71ee43b8a74d 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 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	2319 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	2320
5158 9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2321 #ifdef MEMORY_USAGE_STATS
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2322 OBJECT_HAS_PROPERTY
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2323 (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	2324 #endif /* MEMORY_USAGE_STATS */
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
9e0b43d3095c more cleanups to object-memory-usage stuff Ben Wing <ben@xemacs.org> parents: 5146 diff changeset	2327 void
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 665 diff changeset	2328 init_elhash_once_early (void)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2329 {
5117 3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object' Ben Wing <ben@xemacs.org> parents: 3017 diff changeset	2330 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	2331 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	2332
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	2333 #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	2334 INIT_LISP_OBJECT (hash_table_entry);
3092 141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani] crestani parents: 3017 diff changeset	2335 #endif /* NEW_GC */
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 665 diff changeset	2336
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	2337 /* 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	2338 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	2339
71ee43b8a74d 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 (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	2341 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	2342 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	2343 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	2344
71ee43b8a74d 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 (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	2346 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	2347 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	2348 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	2349
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2350 /* This must NOT be staticpro'd */
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2351 Vall_weak_hash_tables = Qnil;
452 3d3049ae1304 Import from CVS: tag r21-2-41 cvs parents: 450 diff changeset	2352 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	2353
71ee43b8a74d 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 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	2355 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	2356
71ee43b8a74d 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 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	2358 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	2359 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	2360 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	2361 = 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	2362 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	2363 (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	2364 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	2365 (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	2366 lisp_object_equalp_hash, Qequalp, Qequalp_hash);
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2367 }

Mercurial > hg > xemacs-beta

annotate src/elhash.c @ 5524:e05d98bf9644