annotate src/elhash.c @ 4885:6772ce4d982b

Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums lisp/ChangeLog addition: 2010-01-24 Aidan Kehoe <kehoea@parhasard.net> Correct the semantics of #'member*, #'eql, #'assoc* in the presence of bignums; change the integerp byte code to fixnump semantics. * bytecomp.el (fixnump, integerp, byte-compile-integerp): Change the integerp byte code to fixnump; add a byte-compile method to integerp using fixnump and numberp and avoiding a funcall most of the time, since in the non-core contexts where integerp is used, it's mostly distinguishing between fixnums and things that are not numbers at all. * byte-optimize.el (side-effect-free-fns, byte-after-unbind-ops) (byte-compile-side-effect-and-error-free-ops): Replace the integerp bytecode with fixnump; add fixnump to the side-effect-free-fns. Add the other extended number type predicates to the list in passing. * obsolete.el (floatp-safe): Mark this as obsolete. * cl.el (eql): Go into more detail in the docstring here. Don't bother checking whether both arguments are numbers; one is enough, #'equal will fail correctly if they have distinct types. (subst): Replace a call to #'integerp (deciding whether to use #'memq or not) with one to #'fixnump. Delete most-positive-fixnum, most-negative-fixnum from this file; they're now always in C, so they can't be modified from Lisp. * cl-seq.el (member*, assoc*, rassoc*): Correct these functions in the presence of bignums. * cl-macs.el (cl-make-type-test): The type test for a fixnum is now fixnump. Ditch floatp-safe, use floatp instead. (eql): Correct this compiler macro in the presence of bignums. (assoc*): Correct this compiler macro in the presence of bignums. * simple.el (undo): Change #'integerp to #'fixnump here, since we use #'delq with the same value as ELT a few lines down. src/ChangeLog addition: 2010-01-24 Aidan Kehoe <kehoea@parhasard.net> Fix problems with #'eql, extended number types, and the hash table implementation; change the Bintegerp bytecode to fixnump semantics even on bignum builds, since #'integerp can have a fast implementation in terms of #'fixnump for most of its extant uses, but not vice-versa. * lisp.h: Always #include number.h; we want the macros provided in it, even if the various number types are not available. * number.h (NON_FIXNUM_NUMBER_P): New macro, giving 1 when its argument is of non-immediate number type. Equivalent to FLOATP if WITH_NUMBER_TYPES is not defined. * elhash.c (lisp_object_eql_equal, lisp_object_eql_hash): Use NON_FIXNUM_NUMBER_P in these functions, instead of FLOATP, giving more correct behaviour in the presence of the extended number types. * bytecode.c (Bfixnump, execute_optimized_program): Rename Bintegerp to Bfixnump; change its semantics to reflect the new name on builds with bignum support. * data.c (Ffixnump, Fintegerp, syms_of_data, vars_of_data): Always make #'fixnump available, even on non-BIGNUM builds; always implement #'integerp in this file, even on BIGNUM builds. Move most-positive-fixnum, most-negative-fixnum here from number.c, so they are Lisp constants even on builds without number types, and attempts to change or bind them error. Use the NUMBERP and INTEGERP macros even on builds without extended number types. * data.c (fixnum_char_or_marker_to_int): Rename this function from integer_char_or_marker_to_int, to better reflect the arguments it accepts. * number.c (Fevenp, Foddp, syms_of_number): Never provide #'integerp in this file. Remove #'oddp, #'evenp; their implementations are overridden by those in cl.el. * number.c (vars_of_number): most-positive-fixnum, most-negative-fixnum are no longer here. man/ChangeLog addition: 2010-01-23 Aidan Kehoe <kehoea@parhasard.net> Generally: be careful to say fixnum, not integer, when talking about fixed-precision integral types. I'm sure I've missed instances, both here and in the docstrings, but this is a decent start. * lispref/text.texi (Columns): Document where only fixnums, not integers generally, are accepted. (Registers): Remove some ancient char-int confoundance here. * lispref/strings.texi (Creating Strings, Creating Strings): Be more exact in describing where fixnums but not integers in general are accepted. (Creating Strings): Use a more contemporary example to illustrate how concat deals with lists including integers about #xFF. Delete some obsolete documentation on same. (Char Table Types): Document that only fixnums are accepted as values in syntax tables. * lispref/searching.texi (String Search, Search and Replace): Be exact in describing where fixnums but not integers in general are accepted. * lispref/range-tables.texi (Range Tables): Be exact in describing them; only fixnums are accepted to describe ranges. * lispref/os.texi (Killing XEmacs, User Identification) (Time of Day, Time Conversion): Be more exact about using fixnum where only fixed-precision integers are accepted. * lispref/objects.texi (Integer Type): Be more exact (and up-to-date) about the possible values for integers. Cross-reference to documentation of the bignum extension. (Equality Predicates): (Range Table Type): (Array Type): Use fixnum, not integer, to describe a fixed-precision integer. (Syntax Table Type): Correct some English syntax here. * lispref/numbers.texi (Numbers): Change the phrasing here to use fixnum to mean the fixed-precision integers normal in emacs. Document that our terminology deviates from that of Common Lisp, and that we're working on it. (Compatibility Issues): Reiterate the Common Lisp versus Emacs Lisp compatibility issues. (Comparison of Numbers, Arithmetic Operations): * lispref/commands.texi (Command Loop Info, Working With Events): * lispref/buffers.texi (Modification Time): Be more exact in describing where fixnums but not integers in general are accepted.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 24 Jan 2010 15:21:27 +0000
parents e6dec75ded0e
children 6ef8256a020a db2db229ee82
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
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.
2421
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
3 Copyright (C) 1995, 1996, 2002, 2004 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 Copyright (C) 1997 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ANY WARRANTY; without even the implied warranty of MERCNTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 /* Synched up with: Not in FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
1292
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1204
diff changeset
25 /* Author: Lost in the mists of history. At least back to Lucid 19.3,
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1204
diff changeset
26 circa Sep 1992. Early hash table implementation allowed only `eq' as a
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1204
diff changeset
27 test -- other tests possible only when these objects were created from
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1204
diff changeset
28 the C code.
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1204
diff changeset
29
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1204
diff changeset
30 Expansion to allow general `equal'-test Lisp-creatable tables, and hash
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1204
diff changeset
31 methods for the various Lisp objects in existence at the time, added
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1204
diff changeset
32 during 19.12 I think (early 1995?), by Ben Wing.
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1204
diff changeset
33
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1204
diff changeset
34 Weak hash tables added by Jamie (maybe?) early on, perhaps around 19.6,
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1204
diff changeset
35 maybe earlier; again, only possible through the C code, and only
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1204
diff changeset
36 supported fully weak hash tables. Expansion to other kinds of weakness,
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1204
diff changeset
37 and exporting of the interface to Lisp, by Ben Wing during 19.12
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1204
diff changeset
38 (early-mid 1995) or maybe 19.13 cycle (mid 1995).
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1204
diff changeset
39
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1204
diff changeset
40 Expansion to full Common Lisp spec and interface, redoing of the
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1204
diff changeset
41 implementation, by Martin Buchholz, 1997? (Former hash table
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1204
diff changeset
42 implementation used "double hashing", I'm pretty sure, and was weirdly
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1204
diff changeset
43 tied into the generic hash.c code. Martin completely separated them.)
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1204
diff changeset
44 */
f3437b56874d [xemacs-hg @ 2003-02-13 09:57:04 by ben]
ben
parents: 1204
diff changeset
45
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
46 /* This file implements the hash table lisp object type.
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
47
504
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb]
martinb
parents: 497
diff changeset
48 This implementation was mostly written by Martin Buchholz in 1997.
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb]
martinb
parents: 497
diff changeset
49
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb]
martinb
parents: 497
diff changeset
50 The Lisp-level API (derived from Common Lisp) is almost completely
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb]
martinb
parents: 497
diff changeset
51 compatible with GNU Emacs 21, even though the implementations are
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb]
martinb
parents: 497
diff changeset
52 totally independent.
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb]
martinb
parents: 497
diff changeset
53
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
54 The hash table technique used is "linear probing". Collisions are
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
55 resolved by putting the item in the next empty place in the array
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
56 following the collision. Finding a hash entry performs a linear
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
57 search in the cluster starting at the hash value.
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
58
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
59 On deletions from the hash table, the entries immediately following
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
60 the deleted entry are re-entered in the hash table. We do not have
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
61 a special way to mark deleted entries (known as "tombstones").
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
62
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
63 At the end of the hash entries ("hentries"), we leave room for an
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
64 entry that is always empty (the "sentinel").
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
65
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
66 The traditional literature on hash table implementation
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
67 (e.g. Knuth) suggests that too much "primary clustering" occurs
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
68 with linear probing. However, this literature was written when
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
69 locality of reference was not a factor. The discrepancy between
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
70 CPU speeds and memory speeds is increasing, and the speed of access
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
71 to memory is highly dependent on memory caches which work best when
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
72 there is high locality of data reference. Random access to memory
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
73 is up to 20 times as expensive as access to the nearest address
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
74 (and getting worse). So linear probing makes sense.
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
75
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
76 But the representation doesn't actually matter that much with the
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
77 current elisp engine. Funcall is sufficiently slow that the choice
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
78 of hash table implementation is noise. */
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
79
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 #include "bytecode.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 #include "elhash.h"
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
84 #include "opaque.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;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 static Lisp_Object Qhashtable, Qhash_table;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
88 static Lisp_Object Qweakness, Qvalue, Qkey_or_value, Qkey_and_value;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 static Lisp_Object Vall_weak_hash_tables;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 static Lisp_Object Qrehash_size, Qrehash_threshold;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 static Lisp_Object Q_size, Q_test, Q_weakness, Q_rehash_size, Q_rehash_threshold;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 /* obsolete as of 19990901 in xemacs-21.2 */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
94 static Lisp_Object Qweak, Qkey_weak, Qvalue_weak, Qkey_or_value_weak;
4820
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4779
diff changeset
95 static Lisp_Object Qnon_weak, Q_type, Q_data;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 struct Lisp_Hash_Table
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 {
3017
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2720
diff changeset
99 struct LCRECORD_HEADER header;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
100 Elemcount size;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
101 Elemcount count;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
102 Elemcount rehash_count;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 double rehash_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 double rehash_threshold;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
105 Elemcount golden_ratio;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 hash_table_hash_function_t hash_function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 hash_table_test_function_t test_function;
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
108 htentry *hentries;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 enum hash_table_weakness weakness;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 Lisp_Object next_weak; /* Used to chain together all of the weak
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 hash tables. Don't mark through this. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
114 #define CLEAR_HTENTRY(htentry) \
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
115 ((*(EMACS_UINT*)(&((htentry)->key))) = 0, \
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
116 (*(EMACS_UINT*)(&((htentry)->value))) = 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 #define HASH_TABLE_DEFAULT_SIZE 16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 #define HASH_TABLE_DEFAULT_REHASH_SIZE 1.3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 #define HASH_TABLE_MIN_SIZE 10
4778
0081fd36b783 Cast enumerations to int before comparing them for the sake of VC++.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4777
diff changeset
121 #define HASH_TABLE_DEFAULT_REHASH_THRESHOLD(size, test_function) \
4779
fd98353950a4 Make my last change to elhash.c more kosher, comparing pointers not ints
Aidan Kehoe <kehoea@parhasard.net>
parents: 4778
diff changeset
122 (((size) > 4096 && NULL == (test_function)) ? 0.7 : 0.6)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
124 #define HASHCODE(key, ht) \
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
125 ((((ht)->hash_function ? (ht)->hash_function (key) : LISP_HASH (key)) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
126 * (ht)->golden_ratio) \
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
127 % (ht)->size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 #define KEYS_EQUAL_P(key1, key2, testfun) \
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 432
diff changeset
130 (EQ (key1, key2) || ((testfun) && (testfun) (key1, key2)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 #define LINEAR_PROBING_LOOP(probe, entries, size) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 for (; \
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
134 !HTENTRY_CLEAR_P (probe) || \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 (probe == entries + size ? \
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
136 (probe = entries, !HTENTRY_CLEAR_P (probe)) : 0); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 probe++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
139 #ifdef ERROR_CHECK_STRUCTURES
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 check_hash_table_invariants (Lisp_Hash_Table *ht)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 assert (ht->count < ht->size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 assert (ht->count <= ht->rehash_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 assert (ht->rehash_count < ht->size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 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
147 assert (HTENTRY_CLEAR_P (ht->hentries + ht->size));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 #define check_hash_table_invariants(ht)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 /* 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
154 static Elemcount
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
155 hash_table_size (Elemcount requested_size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 /* Return some prime near, but greater than or equal to, SIZE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 Decades from the time of writing, someone will have a system large
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 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
160 static const Elemcount primes [] =
428
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 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
163 1361, 1777, 2333, 3037, 3967, 5167, 6719, 8737, 11369, 14783,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 19219, 24989, 32491, 42257, 54941, 71429, 92861, 120721, 156941,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 204047, 265271, 344857, 448321, 582821, 757693, 985003, 1280519,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 1664681, 2164111, 2813353, 3657361, 4754591, 6180989, 8035301,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 10445899, 13579681, 17653589, 22949669, 29834603, 38784989,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 50420551, 65546729, 85210757, 110774011, 144006217, 187208107,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 243370577, 316381771, 411296309, 534685237, 695090819, 903618083,
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 617
diff changeset
170 1174703521, 1527114613, 1985248999 /* , 2580823717UL, 3355070839UL */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 /* We've heard of binary search. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 int low, high;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 for (low = 0, high = countof (primes) - 1; high - low > 1;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 /* Loop Invariant: size < primes [high] */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 int mid = (low + high) / 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 if (primes [mid] < requested_size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 low = mid;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 high = mid;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 return primes [high];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 #if 0 /* I don't think these are needed any more.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 If using the general lisp_object_equal_*() functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 causes efficiency problems, these can be resurrected. --ben */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 /* equality and hash functions for Lisp strings */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 lisp_string_equal (Lisp_Object str1, Lisp_Object str2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 /* This is wrong anyway. You can't use strcmp() on Lisp strings,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 because they can contain zero characters. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 return !strcmp ((char *) XSTRING_DATA (str1), (char *) XSTRING_DATA (str2));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
199 static Hashcode
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 lisp_string_hash (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 return hash_string (XSTRING_DATA (str), XSTRING_LENGTH (str));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 #endif /* 0 */
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 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 lisp_object_eql_equal (Lisp_Object obj1, Lisp_Object obj2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 {
4885
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4820
diff changeset
210 return EQ (obj1, obj2) ||
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4820
diff changeset
211 (NON_FIXNUM_NUMBER_P (obj1) && internal_equal (obj1, obj2, 0));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
214 static Hashcode
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 lisp_object_eql_hash (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 {
4885
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4820
diff changeset
217 return NON_FIXNUM_NUMBER_P (obj) ? internal_hash (obj, 0) : LISP_HASH (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 lisp_object_equal_equal (Lisp_Object obj1, Lisp_Object obj2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 return internal_equal (obj1, obj2, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
226 static Hashcode
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 lisp_object_equal_hash (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 return internal_hash (obj, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 mark_hash_table (Lisp_Object obj)
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 Lisp_Hash_Table *ht = XHASH_TABLE (obj);
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 /* 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
239 values (we scan over them after everything else has been marked,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 and mark or remove them as necessary). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 if (ht->weakness == HASH_TABLE_NON_WEAK)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
243 htentry *e, *sentinel;
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 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
246 if (!HTENTRY_CLEAR_P (e))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 mark_object (e->key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 mark_object (e->value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 }
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 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 /* 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
256 the same weakness and test function, they have the same number of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 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
258
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 This is similar to Common Lisp `equalp' of hash tables, with the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 difference that CL requires the keys to be compared with the test
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 function, which we don't do. Doing that would require consing, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 consing is a bad idea in `equal'. Anyway, our method should provide
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 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
264 function, then Fgethash() in hash_table_equal_mapper() will fail. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 hash_table_equal (Lisp_Object hash_table1, Lisp_Object hash_table2, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 Lisp_Hash_Table *ht1 = XHASH_TABLE (hash_table1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 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
270 htentry *e, *sentinel;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 if ((ht1->test_function != ht2->test_function) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 (ht1->weakness != ht2->weakness) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 (ht1->count != ht2->count))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 depth++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 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
280 if (!HTENTRY_CLEAR_P (e))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 /* 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
282 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 Lisp_Object value_in_other = Fgethash (e->key, hash_table2, Qunbound);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 if (UNBOUNDP (value_in_other) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 !internal_equal (e->value, value_in_other, depth))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 return 0; /* Give up */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
291
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
292 /* 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
293 Examining all entries is too expensive, and examining a random
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
294 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
295 static Hashcode
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1726
diff changeset
296 hash_table_hash (Lisp_Object hash_table, int UNUSED (depth))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
297 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
298 return XHASH_TABLE (hash_table)->count;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
299 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
300
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 /* Printing hash tables.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 This is non-trivial, because we use a readable structure-style
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 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
306 readably printed in the form of:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307
4820
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4779
diff changeset
308 #s(hash-table :size 2 :data (key1 value1 key2 value2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 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
311 `: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
312 `: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
313 `: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
314 `: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
315 `: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
316 `:data' (a list)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
318 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
319
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 #<hash-table size 2/13 data (key1 value1 key2 value2) 0x874d>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 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
323 `...'. This printer does not cons. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324
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 /* Print the data of the hash table. This maps through a Lisp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 hash table and prints key/value pairs using PRINTCHARFUN. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 print_hash_table_data (Lisp_Hash_Table *ht, Lisp_Object printcharfun)
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 int count = 0;
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
332 htentry *e, *sentinel;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333
4820
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4779
diff changeset
334 write_c_string (printcharfun, " :data (");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 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
337 if (!HTENTRY_CLEAR_P (e))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 if (count > 0)
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
340 write_c_string (printcharfun, " ");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 if (!print_readably && count > 3)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
343 write_c_string (printcharfun, "...");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 break;
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 print_internal (e->key, printcharfun, 1);
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
347 write_fmt_string_lisp (printcharfun, " %S", 1, e->value);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 count++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
351 write_c_string (printcharfun, ")");
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 static void
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1726
diff changeset
355 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
356 int UNUSED (escapeflag))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 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
359 Ascbyte pigbuf[350];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
361 write_c_string (printcharfun,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
362 print_readably ? "#s(hash-table" : "#<hash-table");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 /* These checks have a kludgy look to them, but they are safe.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 Due to nature of hashing, you cannot use arbitrary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 test functions anyway. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 if (!ht->test_function)
4820
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4779
diff changeset
368 write_c_string (printcharfun, " :test eq");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 else if (ht->test_function == lisp_object_equal_equal)
4820
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4779
diff changeset
370 write_c_string (printcharfun, " :test equal");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 else if (ht->test_function == lisp_object_eql_equal)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 DO_NOTHING;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2421
diff changeset
374 ABORT ();
428
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 if (ht->count || !print_readably)
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 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
379 write_fmt_string (printcharfun, " :size %ld", (long) ht->count);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 else
4820
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4779
diff changeset
381 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
382 (long) ht->size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 if (ht->weakness != HASH_TABLE_NON_WEAK)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 {
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
387 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
388 (printcharfun, " :weakness %s",
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
389 (ht->weakness == HASH_TABLE_WEAK ? "key-and-value" :
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
390 ht->weakness == HASH_TABLE_KEY_WEAK ? "key" :
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
391 ht->weakness == HASH_TABLE_VALUE_WEAK ? "value" :
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
392 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
393 "you-d-better-not-see-this"));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395
4777
c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4693
diff changeset
396 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
397 {
c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4693
diff changeset
398 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
399 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
400 }
c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4693
diff changeset
401
c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4693
diff changeset
402 if (ht->rehash_threshold
c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4693
diff changeset
403 != HASH_TABLE_DEFAULT_REHASH_THRESHOLD (ht->size,
c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4693
diff changeset
404 ht->test_function))
c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4693
diff changeset
405 {
c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4693
diff changeset
406 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
407 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
408 }
c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4693
diff changeset
409
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 if (ht->count)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 print_hash_table_data (ht, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 if (print_readably)
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
414 write_c_string (printcharfun, ")");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 else
2421
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
416 write_fmt_string (printcharfun, " 0x%x>", ht->header.uid);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418
4117
229bd619740a [xemacs-hg @ 2007-08-15 11:06:02 by crestani]
crestani
parents: 4072
diff changeset
419 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 static void
4117
229bd619740a [xemacs-hg @ 2007-08-15 11:06:02 by crestani]
crestani
parents: 4072
diff changeset
421 free_hentries (htentry *hentries,
2333
ba4677f54a05 [xemacs-hg @ 2004-10-14 17:26:18 by james]
james
parents: 2286
diff changeset
422 #ifdef ERROR_CHECK_STRUCTURES
ba4677f54a05 [xemacs-hg @ 2004-10-14 17:26:18 by james]
james
parents: 2286
diff changeset
423 size_t size
4117
229bd619740a [xemacs-hg @ 2007-08-15 11:06:02 by crestani]
crestani
parents: 4072
diff changeset
424 #else /* not ERROR_CHECK_STRUCTURES) */
2333
ba4677f54a05 [xemacs-hg @ 2004-10-14 17:26:18 by james]
james
parents: 2286
diff changeset
425 size_t UNUSED (size)
4117
229bd619740a [xemacs-hg @ 2007-08-15 11:06:02 by crestani]
crestani
parents: 4072
diff changeset
426 #endif /* not ERROR_CHECK_STRUCTURES) */
2333
ba4677f54a05 [xemacs-hg @ 2004-10-14 17:26:18 by james]
james
parents: 2286
diff changeset
427 )
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
428 {
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
429 #ifdef ERROR_CHECK_STRUCTURES
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
430 /* Ensure a crash if other code uses the discarded entries afterwards. */
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
431 htentry *e, *sentinel;
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
432
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
433 for (e = hentries, sentinel = e + size; e < sentinel; e++)
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
434 * (unsigned long *) e = 0xdeadbeef; /* -559038737 base 10 */
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
435 #endif
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
436
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
437 if (!DUMPEDP (hentries))
1726
a8d8f419b459 [xemacs-hg @ 2003-09-30 15:26:34 by james]
james
parents: 1598
diff changeset
438 xfree (hentries, htentry *);
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
439 }
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
440
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
441 static void
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 finalize_hash_table (void *header, int for_disksave)
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 if (!for_disksave)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 Lisp_Hash_Table *ht = (Lisp_Hash_Table *) header;
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
447 free_hentries (ht->hentries, ht->size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 ht->hentries = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 }
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3092
diff changeset
451 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
453 static const struct memory_description htentry_description_1[] = {
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
454 { XD_LISP_OBJECT, offsetof (htentry, key) },
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
455 { XD_LISP_OBJECT, offsetof (htentry, value) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 { XD_END }
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
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
459 static const struct sized_memory_description htentry_description = {
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
460 sizeof (htentry),
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
461 htentry_description_1
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
464 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
465 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
466 { 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
467 { 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
468 { XD_END }
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
469 };
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
470
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
471 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
472 sizeof (htentry),
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
473 htentry_weak_description_1
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
474 };
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
475
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
476 DEFINE_LRECORD_IMPLEMENTATION ("hash-table-entry", hash_table_entry,
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
477 1, /*dumpable-flag*/
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
478 0, 0, 0, 0, 0,
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
479 htentry_description_1,
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
480 Lisp_Hash_Table_Entry);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
481 #endif /* NEW_GC */
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
482
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
483 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
484 /* 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
485 and so this will work. */
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
486 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
487 { XD_LISP_OBJECT_BLOCK_PTR, HASH_TABLE_NON_WEAK,
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
488 XD_INDIRECT (0, 1), { &htentry_description } },
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
489 { XD_LISP_OBJECT_BLOCK_PTR, 0, XD_INDIRECT (0, 1),
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
490 { &htentry_weak_description }, XD_FLAG_UNION_DEFAULT_ENTRY },
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
491 #else /* not NEW_GC */
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2333
diff changeset
492 { 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
493 { &htentry_description } },
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
494 { 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
495 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
496 #endif /* not NEW_GC */
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
497 { XD_END }
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
498 };
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
499
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
500 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
501 sizeof (htentry *),
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
502 htentry_union_description_1
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
503 };
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
504
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
505 const struct memory_description hash_table_description[] = {
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
506 { XD_ELEMCOUNT, offsetof (Lisp_Hash_Table, size) },
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
507 { XD_INT, offsetof (Lisp_Hash_Table, weakness) },
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
508 { 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
509 { &htentry_union_description } },
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
510 { XD_LO_LINK, offsetof (Lisp_Hash_Table, next_weak) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3092
diff changeset
514 #ifdef NEW_GC
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3092
diff changeset
515 DEFINE_LRECORD_IMPLEMENTATION ("hash-table", hash_table,
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3092
diff changeset
516 1, /*dumpable-flag*/
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3092
diff changeset
517 mark_hash_table, print_hash_table,
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3092
diff changeset
518 0, hash_table_equal, hash_table_hash,
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3092
diff changeset
519 hash_table_description,
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3092
diff changeset
520 Lisp_Hash_Table);
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3092
diff changeset
521 #else /* not NEW_GC */
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 826
diff changeset
522 DEFINE_LRECORD_IMPLEMENTATION ("hash-table", hash_table,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 826
diff changeset
523 1, /*dumpable-flag*/
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 826
diff changeset
524 mark_hash_table, print_hash_table,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 826
diff changeset
525 finalize_hash_table,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 826
diff changeset
526 hash_table_equal, hash_table_hash,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 826
diff changeset
527 hash_table_description,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 826
diff changeset
528 Lisp_Hash_Table);
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3092
diff changeset
529 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 static Lisp_Hash_Table *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 xhash_table (Lisp_Object hash_table)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 {
1123
37bdd24225ef [xemacs-hg @ 2002-11-27 07:15:02 by ben]
ben
parents: 934
diff changeset
534 /* #### What's going on here? Why the gc_in_progress check? */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 if (!gc_in_progress)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 CHECK_HASH_TABLE (hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 check_hash_table_invariants (XHASH_TABLE (hash_table));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 return XHASH_TABLE (hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 /* Creation of Hash Tables */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 /* Creation of hash tables, without error-checking. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 compute_hash_table_derived_values (Lisp_Hash_Table *ht)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
550 ht->rehash_count = (Elemcount)
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
551 ((double) ht->size * ht->rehash_threshold);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
552 ht->golden_ratio = (Elemcount)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 ((double) ht->size * (.6180339887 / (double) sizeof (Lisp_Object)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 Lisp_Object
450
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
557 make_standard_lisp_hash_table (enum hash_table_test test,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
558 Elemcount size,
450
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
559 double rehash_size,
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
560 double rehash_threshold,
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
561 enum hash_table_weakness weakness)
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
562 {
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents: 458
diff changeset
563 hash_table_hash_function_t hash_function = 0;
450
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
564 hash_table_test_function_t test_function = 0;
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
565
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
566 switch (test)
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
567 {
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
568 case HASH_TABLE_EQ:
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
569 test_function = 0;
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
570 hash_function = 0;
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
571 break;
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
572
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
573 case HASH_TABLE_EQL:
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
574 test_function = lisp_object_eql_equal;
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
575 hash_function = lisp_object_eql_hash;
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
576 break;
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
577
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
578 case HASH_TABLE_EQUAL:
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
579 test_function = lisp_object_equal_equal;
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
580 hash_function = lisp_object_equal_hash;
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
581 break;
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
582
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
583 default:
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2421
diff changeset
584 ABORT ();
450
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
585 }
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
586
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
587 return make_general_lisp_hash_table (hash_function, test_function,
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
588 size, rehash_size, rehash_threshold,
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
589 weakness);
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
590 }
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
591
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
592 Lisp_Object
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
593 make_general_lisp_hash_table (hash_table_hash_function_t hash_function,
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
594 hash_table_test_function_t test_function,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
595 Elemcount size,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 double rehash_size,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 double rehash_threshold,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 enum hash_table_weakness weakness)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 Lisp_Object hash_table;
3017
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2720
diff changeset
601 Lisp_Hash_Table *ht = ALLOC_LCRECORD_TYPE (Lisp_Hash_Table, &lrecord_hash_table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602
450
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
603 ht->test_function = test_function;
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
604 ht->hash_function = hash_function;
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
605 ht->weakness = weakness;
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
606
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
607 ht->rehash_size =
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
608 rehash_size > 1.0 ? rehash_size : HASH_TABLE_DEFAULT_REHASH_SIZE;
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
609
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
610 ht->rehash_threshold =
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
611 rehash_threshold > 0.0 ? rehash_threshold :
4777
c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4693
diff changeset
612 HASH_TABLE_DEFAULT_REHASH_THRESHOLD (size, ht->test_function);
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
613
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 if (size < HASH_TABLE_MIN_SIZE)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 size = HASH_TABLE_MIN_SIZE;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
616 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
617 + 1.0));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 ht->count = 0;
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
619
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 compute_hash_table_derived_values (ht);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
622 /* We leave room for one never-occupied sentinel htentry at the end. */
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
623 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
624 ht->hentries = (htentry *) alloc_lrecord_array (sizeof (htentry),
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
625 ht->size + 1,
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
626 &lrecord_hash_table_entry);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
627 #else /* not NEW_GC */
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
628 ht->hentries = xnew_array_and_zero (htentry, ht->size + 1);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
629 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
631 hash_table = wrap_hash_table (ht);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 if (weakness == HASH_TABLE_NON_WEAK)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 ht->next_weak = Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 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
637
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 return 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 Lisp_Object
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
642 make_lisp_hash_table (Elemcount size,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 enum hash_table_weakness weakness,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 enum hash_table_test test)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 {
450
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
646 return make_standard_lisp_hash_table (test, size, -1.0, -1.0, weakness);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 /* Pretty reading of hash tables.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 Here we use the existing structures mechanism (which is,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 unfortunately, pretty cumbersome) for validating and instantiating
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 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
654 #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
655 properties, and that the hash table is returned. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 /* Validation functions: each keyword provides its own validation
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 function. The errors should maybe be continuable, but it is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 unclear how this would cope with ERRB. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 static int
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1726
diff changeset
661 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
662 Error_Behavior errb)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 if (NATNUMP (value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
667 maybe_signal_error_1 (Qwrong_type_argument, list2 (Qnatnump, value),
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1726
diff changeset
668 Qhash_table, errb);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
672 static Elemcount
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 decode_hash_table_size (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 return NILP (obj) ? HASH_TABLE_DEFAULT_SIZE : XINT (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 static int
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1726
diff changeset
679 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
680 Error_Behavior errb)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
682 if (EQ (value, Qnil)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
683 if (EQ (value, Qt)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
684 if (EQ (value, Qkey)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
685 if (EQ (value, Qkey_and_value)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
686 if (EQ (value, Qkey_or_value)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
687 if (EQ (value, Qvalue)) return 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 /* 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
690 if (EQ (value, Qnon_weak)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
691 if (EQ (value, Qweak)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
692 if (EQ (value, Qkey_weak)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
693 if (EQ (value, Qkey_or_value_weak)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
694 if (EQ (value, Qvalue_weak)) return 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
696 maybe_invalid_constant ("Invalid hash table weakness",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 value, Qhash_table, errb);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 static enum hash_table_weakness
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 decode_hash_table_weakness (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
704 if (EQ (obj, Qnil)) return HASH_TABLE_NON_WEAK;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
705 if (EQ (obj, Qt)) return HASH_TABLE_WEAK;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
706 if (EQ (obj, Qkey_and_value)) return HASH_TABLE_WEAK;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
707 if (EQ (obj, Qkey)) return HASH_TABLE_KEY_WEAK;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
708 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
709 if (EQ (obj, Qvalue)) return HASH_TABLE_VALUE_WEAK;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 /* 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
712 if (EQ (obj, Qnon_weak)) return HASH_TABLE_NON_WEAK;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
713 if (EQ (obj, Qweak)) return HASH_TABLE_WEAK;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
714 if (EQ (obj, Qkey_weak)) return HASH_TABLE_KEY_WEAK;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
715 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
716 if (EQ (obj, Qvalue_weak)) return HASH_TABLE_VALUE_WEAK;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
718 invalid_constant ("Invalid hash table weakness", obj);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
719 RETURN_NOT_REACHED (HASH_TABLE_NON_WEAK);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 static int
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1726
diff changeset
723 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
724 Error_Behavior errb)
428
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 if (EQ (value, Qnil)) return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 if (EQ (value, Qeq)) return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 if (EQ (value, Qequal)) return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 if (EQ (value, Qeql)) return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
731 maybe_invalid_constant ("Invalid hash table test",
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1726
diff changeset
732 value, Qhash_table, errb);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 static enum hash_table_test
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 decode_hash_table_test (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 if (EQ (obj, Qnil)) return HASH_TABLE_EQL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 if (EQ (obj, Qeq)) return HASH_TABLE_EQ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 if (EQ (obj, Qequal)) return HASH_TABLE_EQUAL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 if (EQ (obj, Qeql)) return HASH_TABLE_EQL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
744 invalid_constant ("Invalid hash table test", obj);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
745 RETURN_NOT_REACHED (HASH_TABLE_EQ);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 static int
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1726
diff changeset
749 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
750 Lisp_Object value, Error_Behavior errb)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 if (!FLOATP (value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
754 maybe_signal_error_1 (Qwrong_type_argument, list2 (Qfloatp, value),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 Qhash_table, errb);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 double rehash_size = XFLOAT_DATA (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 if (rehash_size <= 1.0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
763 maybe_invalid_argument
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 ("Hash table rehash size must be greater than 1.0",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 value, Qhash_table, errb);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 static double
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 decode_hash_table_rehash_size (Lisp_Object rehash_size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 {
4585
871eb054b34a Document non-obvious usages.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 4410
diff changeset
776 /* -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
777 return NILP (rehash_size) ? -1.0 : XFLOAT_DATA (rehash_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 static int
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1726
diff changeset
781 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
782 Lisp_Object value, Error_Behavior errb)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 if (!FLOATP (value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
786 maybe_signal_error_1 (Qwrong_type_argument, list2 (Qfloatp, value),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 Qhash_table, errb);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 double rehash_threshold = XFLOAT_DATA (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 if (rehash_threshold <= 0.0 || rehash_threshold >= 1.0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
795 maybe_invalid_argument
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 ("Hash table rehash threshold must be between 0.0 and 1.0",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 value, Qhash_table, errb);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 static double
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 decode_hash_table_rehash_threshold (Lisp_Object rehash_threshold)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 {
4585
871eb054b34a Document non-obvious usages.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 4410
diff changeset
808 /* -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
809 return NILP (rehash_threshold) ? -1.0 : XFLOAT_DATA (rehash_threshold);
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_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
814 Error_Behavior errb)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 int len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817
4585
871eb054b34a Document non-obvious usages.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 4410
diff changeset
818 /* Check for improper lists while getting length. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 GET_EXTERNAL_LIST_LENGTH (value, len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 if (len & 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
823 maybe_sferror
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 ("Hash table data must have alternating key/value pairs",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 value, Qhash_table, errb);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 }
4585
871eb054b34a Document non-obvious usages.
Stephen J. Turnbull <stephen@xemacs.org>
parents: 4410
diff changeset
828
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 }
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 /* The actual instantiation of a hash table. This does practically no
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 error checking, because it relies on the fact that the paranoid
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 functions above have error-checked everything to the last details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 If this assumption is wrong, we will get a crash immediately (with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 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
837 the structure mechanism. So there. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 hash_table_instantiate (Lisp_Object plist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 Lisp_Object hash_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 Lisp_Object test = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 Lisp_Object size = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 Lisp_Object rehash_size = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 Lisp_Object rehash_threshold = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 Lisp_Object weakness = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 Lisp_Object data = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848
4820
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4779
diff changeset
849 if (KEYWORDP (Fcar (plist)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 {
4820
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4779
diff changeset
851 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
852 {
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4779
diff changeset
853 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
854 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
855 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
856 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
857 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
858 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
859 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
860 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
861 "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
862 key);
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4779
diff changeset
863 else ABORT();
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4779
diff changeset
864 }
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4779
diff changeset
865 }
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4779
diff changeset
866 else
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4779
diff changeset
867 {
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4779
diff changeset
868 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
869 {
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4779
diff changeset
870 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
871 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
872 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
873 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
874 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
875 else if (EQ (key, Qdata)) data = value;
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4779
diff changeset
876 else if (EQ (key, Qtype))/*obsolete*/ weakness = value;
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4779
diff changeset
877 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
878 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
879 "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
880 key);
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4779
diff changeset
881 else ABORT();
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4779
diff changeset
882 }
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 /* Create the hash table. */
450
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
886 hash_table = make_standard_lisp_hash_table
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 (decode_hash_table_test (test),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 decode_hash_table_size (size),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 decode_hash_table_rehash_size (rehash_size),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 decode_hash_table_rehash_threshold (rehash_threshold),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 decode_hash_table_weakness (weakness));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 /* I'm not sure whether this can GC, but better safe than sorry. */
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 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 GCPRO1 (hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 /* And fill it with data. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 while (!NILP (data))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 Lisp_Object key, value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 key = XCAR (data); data = XCDR (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 value = XCAR (data); data = XCDR (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 Fputhash (key, value, hash_table);
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 UNGCPRO;
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 return hash_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 structure_type_create_hash_table_structure_name (Lisp_Object structure_name)
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 struct structure_type *st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 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
918
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4779
diff changeset
919 /* 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
920 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
921 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
922 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
923 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
924 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
925 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
926
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4779
diff changeset
927 /* Next the mutually exclusive, older, non-keyword syntax: */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 define_structure_type_keyword (st, Qtest, hash_table_test_validate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 define_structure_type_keyword (st, Qsize, hash_table_size_validate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 define_structure_type_keyword (st, Qrehash_size, hash_table_rehash_size_validate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 define_structure_type_keyword (st, Qrehash_threshold, hash_table_rehash_threshold_validate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 define_structure_type_keyword (st, Qweakness, hash_table_weakness_validate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 define_structure_type_keyword (st, Qdata, hash_table_data_validate);
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 /* obsolete as of 19990901 in xemacs-21.2 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 define_structure_type_keyword (st, Qtype, hash_table_weakness_validate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 /* Create a built-in Lisp structure type named `hash-table'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 We make #s(hashtable ...) equivalent to #s(hash-table ...),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 for backward compatibility.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 This is called from emacs.c. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 structure_type_create_hash_table (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 structure_type_create_hash_table_structure_name (Qhash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 structure_type_create_hash_table_structure_name (Qhashtable); /* compat */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 /* Definition of Lisp-visible methods */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 DEFUN ("hash-table-p", Fhash_table_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 Return t if OBJECT is a hash table, else nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 return HASH_TABLEP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 DEFUN ("make-hash-table", Fmake_hash_table, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 Return a new empty hash table object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 Use Common Lisp style keywords to specify hash table properties.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 Keyword :test can be `eq', `eql' (default) or `equal'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 Comparison between keys is done using this function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 If speed is important, consider using `eq'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 When storing strings in the hash table, you will likely need to use `equal'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 Keyword :size specifies the number of keys likely to be inserted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 This number of entries can be inserted without enlarging the hash table.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 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
976 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
977
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 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
979 and specifies the load factor of the hash table which triggers enlarging.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
981 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
982 `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
983
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
984 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
985 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
986 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
987 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
988 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
989 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
990 would prevent the object from being collected.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 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
993 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
994 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
995 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
996 if the value is not.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 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
999 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
1000 unmarked outside of weak hash tables. The pair will remain in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 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
1002 hash table, even if the key is not.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1003
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1004 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
1005 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
1006 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
1007 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
1008 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
1009
4777
c69aeb86b2a3 Serialise non-default hash table rehash thresholds correctly; use this.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4693
diff changeset
1010 arguments: (&key TEST SIZE REHASH-SIZE REHASH-THRESHOLD WEAKNESS)
428
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 (int nargs, Lisp_Object *args))
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 int i = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 Lisp_Object test = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 Lisp_Object size = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 Lisp_Object rehash_size = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 Lisp_Object rehash_threshold = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 Lisp_Object weakness = Qnil;
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 while (i + 1 < nargs)
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 Lisp_Object keyword = args[i++];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 Lisp_Object value = args[i++];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 if (EQ (keyword, Q_test)) test = value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 else if (EQ (keyword, Q_size)) size = value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 else if (EQ (keyword, Q_rehash_size)) rehash_size = value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 else if (EQ (keyword, Q_rehash_threshold)) rehash_threshold = value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 else if (EQ (keyword, Q_weakness)) weakness = value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 else if (EQ (keyword, Q_type))/*obsolete*/ weakness = value;
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
1032 else invalid_constant ("Invalid hash table property keyword", keyword);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 if (i < nargs)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
1036 sferror ("Hash table property requires a value", args[i]);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 #define VALIDATE_VAR(var) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 if (!NILP (var)) hash_table_##var##_validate (Q##var, var, ERROR_ME);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 VALIDATE_VAR (test);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 VALIDATE_VAR (size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 VALIDATE_VAR (rehash_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 VALIDATE_VAR (rehash_threshold);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 VALIDATE_VAR (weakness);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046
450
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
1047 return make_standard_lisp_hash_table
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 (decode_hash_table_test (test),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 decode_hash_table_size (size),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 decode_hash_table_rehash_size (rehash_size),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 decode_hash_table_rehash_threshold (rehash_threshold),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 decode_hash_table_weakness (weakness));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 DEFUN ("copy-hash-table", Fcopy_hash_table, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 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
1057 The keys and values will not themselves be copied.
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 (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1061 const Lisp_Hash_Table *ht_old = xhash_table (hash_table);
3017
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2720
diff changeset
1062 Lisp_Hash_Table *ht = ALLOC_LCRECORD_TYPE (Lisp_Hash_Table, &lrecord_hash_table);
1e7cc382eb16 [xemacs-hg @ 2005-10-24 10:07:26 by ben]
ben
parents: 2720
diff changeset
1063 COPY_LCRECORD (ht, ht_old);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
1065 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
1066 ht->hentries = (htentry *) alloc_lrecord_array (sizeof (htentry),
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
1067 ht_old->size + 1,
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
1068 &lrecord_hash_table_entry);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
1069 #else /* not NEW_GC */
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1070 ht->hentries = xnew_array (htentry, ht_old->size + 1);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
1071 #endif /* not NEW_GC */
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1072 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
1073
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1074 hash_table = wrap_hash_table (ht);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 if (! EQ (ht->next_weak, Qunbound))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 ht->next_weak = Vall_weak_hash_tables;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 Vall_weak_hash_tables = hash_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 return hash_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 }
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 static void
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1086 resize_hash_table (Lisp_Hash_Table *ht, Elemcount new_size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1088 htentry *old_entries, *new_entries, *sentinel, *e;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1089 Elemcount old_size;
428
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 old_size = ht->size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 ht->size = new_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 old_entries = ht->hentries;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
1096 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
1097 ht->hentries = (htentry *) alloc_lrecord_array (sizeof (htentry),
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
1098 new_size + 1,
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
1099 &lrecord_hash_table_entry);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
1100 #else /* not NEW_GC */
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1101 ht->hentries = xnew_array_and_zero (htentry, new_size + 1);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
1102 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 new_entries = ht->hentries;
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 compute_hash_table_derived_values (ht);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1107 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
1108 if (!HTENTRY_CLEAR_P (e))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1110 htentry *probe = new_entries + HASHCODE (e->key, ht);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 LINEAR_PROBING_LOOP (probe, new_entries, new_size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 *probe = *e;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115
4117
229bd619740a [xemacs-hg @ 2007-08-15 11:06:02 by crestani]
crestani
parents: 4072
diff changeset
1116 #ifndef NEW_GC
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1117 free_hentries (old_entries, old_size);
4117
229bd619740a [xemacs-hg @ 2007-08-15 11:06:02 by crestani]
crestani
parents: 4072
diff changeset
1118 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1121 /* 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
1122 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
1123 and thus their HASHCODEs have changed. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1125 pdump_reorganize_hash_table (Lisp_Object hash_table)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1127 const Lisp_Hash_Table *ht = xhash_table (hash_table);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
1128 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
1129 htentry *new_entries =
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
1130 (htentry *) alloc_lrecord_array (sizeof (htentry), ht->size + 1,
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
1131 &lrecord_hash_table_entry);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
1132 #else /* not NEW_GC */
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1133 htentry *new_entries = xnew_array_and_zero (htentry, ht->size + 1);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
1134 #endif /* not NEW_GC */
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1135 htentry *e, *sentinel;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1136
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1137 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
1138 if (!HTENTRY_CLEAR_P (e))
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1139 {
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1140 htentry *probe = new_entries + HASHCODE (e->key, ht);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1141 LINEAR_PROBING_LOOP (probe, new_entries, ht->size)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1142 ;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1143 *probe = *e;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1144 }
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1145
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1146 memcpy (ht->hentries, new_entries, ht->size * sizeof (htentry));
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1147
4117
229bd619740a [xemacs-hg @ 2007-08-15 11:06:02 by crestani]
crestani
parents: 4072
diff changeset
1148 #ifndef NEW_GC
1726
a8d8f419b459 [xemacs-hg @ 2003-09-30 15:26:34 by james]
james
parents: 1598
diff changeset
1149 xfree (new_entries, htentry *);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
1150 #endif /* not NEW_GC */
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 enlarge_hash_table (Lisp_Hash_Table *ht)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1156 Elemcount new_size =
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1157 hash_table_size ((Elemcount) ((double) ht->size * ht->rehash_size));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 resize_hash_table (ht, new_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160
4072
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan]
aidan
parents: 3263
diff changeset
1161 htentry *
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1162 find_htentry (Lisp_Object key, const Lisp_Hash_Table *ht)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 hash_table_test_function_t test_function = ht->test_function;
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1165 htentry *entries = ht->hentries;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1166 htentry *probe = entries + HASHCODE (key, ht);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 LINEAR_PROBING_LOOP (probe, entries, ht->size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 if (KEYS_EQUAL_P (probe->key, key, test_function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 return probe;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174
2421
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1175 /* A version of Fputhash() that increments the value by the specified
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1176 amount and dispenses will all error checks. Assumes that tables does
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1177 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
1178 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
1179 total time. */
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1180
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1181 void
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1182 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
1183 {
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1184 Lisp_Hash_Table *ht = XHASH_TABLE (table);
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1185 htentry *entries = ht->hentries;
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1186 htentry *probe = entries + HASHCODE (key, ht);
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1187
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1188 LINEAR_PROBING_LOOP (probe, entries, ht->size)
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1189 if (EQ (probe->key, key))
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1190 break;
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1191
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1192 if (!HTENTRY_CLEAR_P (probe))
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1193 probe->value = make_int (XINT (probe->value) + offset);
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1194 else
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1195 {
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1196 probe->key = key;
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1197 probe->value = make_int (offset);
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1198
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1199 if (++ht->count >= ht->rehash_count)
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1200 enlarge_hash_table (ht);
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1201 }
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1202 }
ab71ad6ff3dd [xemacs-hg @ 2004-12-06 03:50:53 by ben]
ben
parents: 2367
diff changeset
1203
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 DEFUN ("gethash", Fgethash, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 Find hash value for KEY in HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 If there is no corresponding value, return DEFAULT (which defaults to nil).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 (key, hash_table, default_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1210 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
1211 htentry *e = find_htentry (key, ht);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1213 return HTENTRY_CLEAR_P (e) ? default_ : e->value;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 }
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 DEFUN ("puthash", Fputhash, 3, 3, 0, /*
4410
aae1994dfeec Document return values for #'puthash, #'clrhash.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4398
diff changeset
1217 Hash KEY to VALUE in HASH-TABLE, and return VALUE.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 (key, value, hash_table))
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 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
1222 htentry *e = find_htentry (key, ht);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1224 if (!HTENTRY_CLEAR_P (e))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 return e->value = value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 e->key = key;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 e->value = value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 if (++ht->count >= ht->rehash_count)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 enlarge_hash_table (ht);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 return value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1236 /* Remove htentry pointed at by PROBE.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 Subsequent entries are removed and reinserted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 We don't use tombstones - too wasteful. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 static void
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1240 remhash_1 (Lisp_Hash_Table *ht, htentry *entries, htentry *probe)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1242 Elemcount size = ht->size;
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1243 CLEAR_HTENTRY (probe);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 probe++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 ht->count--;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 LINEAR_PROBING_LOOP (probe, entries, size)
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 Lisp_Object key = probe->key;
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1250 htentry *probe2 = entries + HASHCODE (key, ht);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 LINEAR_PROBING_LOOP (probe2, entries, size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 if (EQ (probe2->key, key))
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1253 /* htentry at probe doesn't need to move. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 goto continue_outer_loop;
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1255 /* Move htentry from probe to new home at probe2. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 *probe2 = *probe;
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1257 CLEAR_HTENTRY (probe);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 continue_outer_loop: continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 DEFUN ("remhash", Fremhash, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 Remove the entry for KEY from HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 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
1265 Return non-nil if an entry was removed.
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 (key, hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 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
1270 htentry *e = find_htentry (key, ht);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1272 if (HTENTRY_CLEAR_P (e))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 remhash_1 (ht, ht->hentries, e);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 DEFUN ("clrhash", Fclrhash, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 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
1281 Return HASH-TABLE.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 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
1286 htentry *e, *sentinel;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 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
1289 CLEAR_HTENTRY (e);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 ht->count = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 return hash_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 /* Accessor Functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 DEFUN ("hash-table-count", Fhash_table_count, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 Return the number of entries in HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 return make_int (xhash_table (hash_table)->count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 DEFUN ("hash-table-test", Fhash_table_test, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 Return the test function of HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 This can be one of `eq', `eql' or `equal'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 hash_table_test_function_t fun = xhash_table (hash_table)->test_function;
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 return (fun == lisp_object_eql_equal ? Qeql :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 fun == lisp_object_equal_equal ? Qequal :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 Qeq);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 DEFUN ("hash-table-size", Fhash_table_size, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 Return the size of HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 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
1323 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 return make_int (xhash_table (hash_table)->size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 Return the current rehash size of HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 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
1332 is enlarged when the rehash threshold is exceeded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 return make_float (xhash_table (hash_table)->rehash_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 Return the current rehash threshold of HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 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
1342 beyond which the HASH-TABLE is enlarged by rehashing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 {
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
1346 return make_float (xhash_table (hash_table)->rehash_threshold);
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349 DEFUN ("hash-table-weakness", Fhash_table_weakness, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350 Return the weakness of HASH-TABLE.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1351 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
1352 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 switch (xhash_table (hash_table)->weakness)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1357 case HASH_TABLE_WEAK: return Qkey_and_value;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1358 case HASH_TABLE_KEY_WEAK: return Qkey;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1359 case HASH_TABLE_KEY_VALUE_WEAK: return Qkey_or_value;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1360 case HASH_TABLE_VALUE_WEAK: return Qvalue;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1361 default: return Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 /* obsolete as of 19990901 in xemacs-21.2 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 DEFUN ("hash-table-type", Fhash_table_type, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 Return the type of HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 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
1369 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 switch (xhash_table (hash_table)->weakness)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1374 case HASH_TABLE_WEAK: return Qweak;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1375 case HASH_TABLE_KEY_WEAK: return Qkey_weak;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1376 case HASH_TABLE_KEY_VALUE_WEAK: return Qkey_or_value_weak;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1377 case HASH_TABLE_VALUE_WEAK: return Qvalue_weak;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1378 default: return Qnon_weak;
428
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 /* Mapping Functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 /************************************************************************/
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1385
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1386 /* 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
1387 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
1388 - by the mapping function
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1389 - by gc (if the hash table is weak)
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1390
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1391 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
1392 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
1393 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
1394 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
1395 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
1396
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb]
martinb
parents: 489
diff changeset
1397 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
1398 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
1399 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
1400 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
1401 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
1402 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
1403 functions gethash, puthash and remhash should be implementable
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb]
martinb
parents: 489
diff changeset
1404 without having to think about maphash.
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb]
martinb
parents: 489
diff changeset
1405
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb]
martinb
parents: 489
diff changeset
1406 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
1407 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
1408 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
1409 function in perl has this limitation.
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb]
martinb
parents: 489
diff changeset
1410
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb]
martinb
parents: 489
diff changeset
1411 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
1412 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
1413 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
1414
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb]
martinb
parents: 497
diff changeset
1415 -- Martin
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb]
martinb
parents: 497
diff changeset
1416 */
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb]
martinb
parents: 497
diff changeset
1417
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb]
martinb
parents: 497
diff changeset
1418 /* 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
1419
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb]
martinb
parents: 497
diff changeset
1420 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
1421 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
1422 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
1423 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
1424 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
1425 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
1426 single extra check for this secondary table -- totally
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb]
martinb
parents: 497
diff changeset
1427 insignificant speedwise. if you really cared about making
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb]
martinb
parents: 497
diff changeset
1428 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
1429 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
1430 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
1431 table when mapping. the advantages of this are
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb]
martinb
parents: 497
diff changeset
1432
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb]
martinb
parents: 497
diff changeset
1433 [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
1434
bcda0b3445a6 [xemacs-hg @ 2001-05-05 08:19:18 by martinb]
martinb
parents: 497
diff changeset
1435 [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
1436 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
1437 very small.
497
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb]
martinb
parents: 489
diff changeset
1438 */
11b53bb7daf5 [xemacs-hg @ 2001-05-02 10:22:58 by martinb]
martinb
parents: 489
diff changeset
1439
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1440 static Lisp_Object
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1441 maphash_unwind (Lisp_Object unwind_obj)
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1442 {
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1443 void *ptr = (void *) get_opaque_ptr (unwind_obj);
1726
a8d8f419b459 [xemacs-hg @ 2003-09-30 15:26:34 by james]
james
parents: 1598
diff changeset
1444 xfree (ptr, void *);
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1445 free_opaque_ptr (unwind_obj);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1446 return Qnil;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1447 }
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1448
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1449 /* 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
1450 static Lisp_Object *
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1451 copy_compress_hentries (const Lisp_Hash_Table *ht)
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1452 {
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1453 Lisp_Object * const objs =
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1454 /* 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
1455 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
1456 const htentry *e, *sentinel;
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1457 Lisp_Object *pobj;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1458
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1459 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
1460 if (!HTENTRY_CLEAR_P (e))
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1461 {
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1462 *(pobj++) = e->key;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1463 *(pobj++) = e->value;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1464 }
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1465
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1466 type_checking_assert (pobj == objs + 2 * ht->count);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1467
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1468 return objs;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1469 }
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1470
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 DEFUN ("maphash", Fmaphash, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 Map FUNCTION over entries in HASH-TABLE, calling it with two args,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 each key and value in HASH-TABLE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1475 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
1476 may remhash or puthash the entry currently being processed by FUNCTION.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 (function, hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 {
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1480 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
1481 Lisp_Object * const objs = copy_compress_hentries (ht);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1482 Lisp_Object args[3];
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1483 const Lisp_Object *pobj, *end;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1484 int speccount = specpdl_depth ();
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1485 struct gcpro gcpro1;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1486
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1487 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
1488 GCPRO1 (objs[0]);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1489 gcpro1.nvars = 2 * ht->count;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1491 args[0] = function;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1492
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1493 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
1494 {
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1495 args[1] = pobj[0];
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1496 args[2] = pobj[1];
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1497 Ffuncall (countof (args), args);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1498 }
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1499
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1500 unbind_to (speccount);
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1501 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1506 /* 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
1507 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
1508 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
1509 Mapping terminates if FUNCTION returns something other than 0. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 void
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1511 elisp_maphash_unsafe (maphash_function_t function,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 Lisp_Object hash_table, void *extra_arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1514 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
1515 const htentry *e, *sentinel;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517 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
1518 if (!HTENTRY_CLEAR_P (e))
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1519 if (function (e->key, e->value, extra_arg))
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1520 return;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1523 /* 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
1524 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
1525 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
1526 void
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1527 elisp_maphash (maphash_function_t function,
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1528 Lisp_Object hash_table, void *extra_arg)
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1529 {
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1530 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
1531 Lisp_Object * const objs = copy_compress_hentries (ht);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1532 const Lisp_Object *pobj, *end;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1533 int speccount = specpdl_depth ();
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1534 struct gcpro gcpro1;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1535
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1536 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
1537 GCPRO1 (objs[0]);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1538 gcpro1.nvars = 2 * ht->count;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1539
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1540 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
1541 if (function (pobj[0], pobj[1], extra_arg))
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1542 break;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1543
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1544 unbind_to (speccount);
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1545 UNGCPRO;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1546 }
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 /* 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
1549 PREDICATE must not modify HASH-TABLE. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551 elisp_map_remhash (maphash_function_t predicate,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552 Lisp_Object hash_table, void *extra_arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 {
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1554 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
1555 Lisp_Object * const objs = copy_compress_hentries (ht);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1556 const Lisp_Object *pobj, *end;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1557 int speccount = specpdl_depth ();
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1558 struct gcpro gcpro1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1560 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
1561 GCPRO1 (objs[0]);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1562 gcpro1.nvars = 2 * ht->count;
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1563
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1564 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
1565 if (predicate (pobj[0], pobj[1], extra_arg))
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1566 Fremhash (pobj[0], hash_table);
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1567
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1568 unbind_to (speccount);
489
4a8bb4aa9740 [xemacs-hg @ 2001-04-30 08:49:24 by martinb]
martinb
parents: 464
diff changeset
1569 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1570 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574 /* garbage collecting weak hash tables */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 /************************************************************************/
1598
ac1be85b4a5f [xemacs-hg @ 2003-07-31 13:32:24 by crestani]
crestani
parents: 1292
diff changeset
1576 #ifdef USE_KKCC
2645
e6854ec89f8e [xemacs-hg @ 2005-03-10 09:12:36 by crestani]
crestani
parents: 2551
diff changeset
1577 #define MARK_OBJ(obj) do { \
e6854ec89f8e [xemacs-hg @ 2005-03-10 09:12:36 by crestani]
crestani
parents: 2551
diff changeset
1578 Lisp_Object mo_obj = (obj); \
e6854ec89f8e [xemacs-hg @ 2005-03-10 09:12:36 by crestani]
crestani
parents: 2551
diff changeset
1579 if (!marked_p (mo_obj)) \
e6854ec89f8e [xemacs-hg @ 2005-03-10 09:12:36 by crestani]
crestani
parents: 2551
diff changeset
1580 { \
e6854ec89f8e [xemacs-hg @ 2005-03-10 09:12:36 by crestani]
crestani
parents: 2551
diff changeset
1581 kkcc_gc_stack_push_lisp_object (mo_obj, 0, -1); \
e6854ec89f8e [xemacs-hg @ 2005-03-10 09:12:36 by crestani]
crestani
parents: 2551
diff changeset
1582 did_mark = 1; \
e6854ec89f8e [xemacs-hg @ 2005-03-10 09:12:36 by crestani]
crestani
parents: 2551
diff changeset
1583 } \
1598
ac1be85b4a5f [xemacs-hg @ 2003-07-31 13:32:24 by crestani]
crestani
parents: 1292
diff changeset
1584 } while (0)
ac1be85b4a5f [xemacs-hg @ 2003-07-31 13:32:24 by crestani]
crestani
parents: 1292
diff changeset
1585
ac1be85b4a5f [xemacs-hg @ 2003-07-31 13:32:24 by crestani]
crestani
parents: 1292
diff changeset
1586 #else /* NO USE_KKCC */
ac1be85b4a5f [xemacs-hg @ 2003-07-31 13:32:24 by crestani]
crestani
parents: 1292
diff changeset
1587
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1588 #define MARK_OBJ(obj) do { \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1589 Lisp_Object mo_obj = (obj); \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1590 if (!marked_p (mo_obj)) \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1591 { \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1592 mark_object (mo_obj); \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1593 did_mark = 1; \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1594 } \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1595 } while (0)
1598
ac1be85b4a5f [xemacs-hg @ 2003-07-31 13:32:24 by crestani]
crestani
parents: 1292
diff changeset
1596 #endif /*NO USE_KKCC */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1597
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599 /* Complete the marking for semi-weak hash tables. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601 finish_marking_weak_hash_tables (void)
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 Lisp_Object hash_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1604 int did_mark = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606 for (hash_table = Vall_weak_hash_tables;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 !NILP (hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 hash_table = XHASH_TABLE (hash_table)->next_weak)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1610 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
1611 const htentry *e = ht->hentries;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1612 const htentry *sentinel = e + ht->size;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1613
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614 if (! marked_p (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1615 /* The hash table is probably garbage. Ignore it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1617
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618 /* Now, scan over all the pairs. For all pairs that are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619 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
1620 keeping this pair. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621 switch (ht->weakness)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623 case HASH_TABLE_KEY_WEAK:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624 for (; e < sentinel; e++)
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1625 if (!HTENTRY_CLEAR_P (e))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1626 if (marked_p (e->key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1627 MARK_OBJ (e->value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1630 case HASH_TABLE_VALUE_WEAK:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631 for (; e < sentinel; e++)
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1632 if (!HTENTRY_CLEAR_P (e))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633 if (marked_p (e->value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 MARK_OBJ (e->key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1637 case HASH_TABLE_KEY_VALUE_WEAK:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1638 for (; e < sentinel; e++)
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1639 if (!HTENTRY_CLEAR_P (e))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1640 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1641 if (marked_p (e->value))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1642 MARK_OBJ (e->key);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1643 else if (marked_p (e->key))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1644 MARK_OBJ (e->value);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1645 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1646 break;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1647
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648 case HASH_TABLE_KEY_CAR_WEAK:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 for (; e < sentinel; e++)
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1650 if (!HTENTRY_CLEAR_P (e))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 if (!CONSP (e->key) || marked_p (XCAR (e->key)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653 MARK_OBJ (e->key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654 MARK_OBJ (e->value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657
450
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
1658 /* We seem to be sprouting new weakness types at an alarming
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
1659 rate. At least this is not externally visible - and in
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
1660 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
1661 glyph code. */
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
1662 case HASH_TABLE_KEY_CAR_VALUE_WEAK:
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
1663 for (; e < sentinel; e++)
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1664 if (!HTENTRY_CLEAR_P (e))
450
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
1665 {
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
1666 if (!CONSP (e->key) || marked_p (XCAR (e->key)))
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
1667 {
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
1668 MARK_OBJ (e->key);
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
1669 MARK_OBJ (e->value);
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
1670 }
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
1671 else if (marked_p (e->value))
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
1672 MARK_OBJ (e->key);
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
1673 }
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
1674 break;
98528da0b7fc Import from CVS: tag r21-2-40
cvs
parents: 444
diff changeset
1675
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 case HASH_TABLE_VALUE_CAR_WEAK:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677 for (; e < sentinel; e++)
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1678 if (!HTENTRY_CLEAR_P (e))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 if (!CONSP (e->value) || marked_p (XCAR (e->value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681 MARK_OBJ (e->key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 MARK_OBJ (e->value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1688 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691 return did_mark;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695 prune_weak_hash_tables (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1696 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 Lisp_Object hash_table, prev = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698 for (hash_table = Vall_weak_hash_tables;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 !NILP (hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700 hash_table = XHASH_TABLE (hash_table)->next_weak)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1701 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702 if (! marked_p (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1704 /* This hash table itself is garbage. Remove it from the list. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1705 if (NILP (prev))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706 Vall_weak_hash_tables = XHASH_TABLE (hash_table)->next_weak;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1707 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708 XHASH_TABLE (prev)->next_weak = XHASH_TABLE (hash_table)->next_weak;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1711 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712 /* Now, scan over all the pairs. Remove all of the pairs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1713 in which the key or value, or both, is unmarked
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714 (depending on the weakness of the hash table). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1715 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
1716 htentry *entries = ht->hentries;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1717 htentry *sentinel = entries + ht->size;
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1718 htentry *e;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1719
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1720 for (e = entries; e < sentinel; e++)
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1721 if (!HTENTRY_CLEAR_P (e))
428
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 again:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1724 if (!marked_p (e->key) || !marked_p (e->value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1725 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1726 remhash_1 (ht, entries, e);
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1123
diff changeset
1727 if (!HTENTRY_CLEAR_P (e))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1728 goto again;
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1731
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1732 prev = hash_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1734 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1735 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1736
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1737 /* 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
1738
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1739 Hashcode
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740 internal_array_hash (Lisp_Object *arr, int size, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1742 int i;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1743 Hashcode hash = 0;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1744 depth++;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746 if (size <= 5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1747 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1748 for (i = 0; i < size; i++)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1749 hash = HASH2 (hash, internal_hash (arr[i], depth));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750 return hash;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751 }
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 /* just pick five elements scattered throughout the array.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754 A slightly better approach would be to offset by some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755 noise factor from the points chosen below. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756 for (i = 0; i < 5; i++)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1757 hash = HASH2 (hash, internal_hash (arr[i*size/5], depth));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1758
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759 return hash;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762 /* 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
1763 objects with the comparison being `equal' (for `eq', you can just
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764 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
1765 tradeoff between the speed of the hash function and how good the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766 hashing is. In particular, the hash function needs to be FAST,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767 so you can't just traipse down the whole tree hashing everything
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768 together. Most of the time, objects will differ in the first
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1769 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
1770 and only hash at most 5 elements out of a vector. Theoretically
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 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
1772 hash, but practically this won't ever happen. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1774 Hashcode
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775 internal_hash (Lisp_Object obj, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777 if (depth > 5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 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
1779
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
1780 if (CONSP(obj))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781 {
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
1782 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
1783 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
1784
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
1785 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
1786
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
1787 if (!CONSP(XCDR(obj)))
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
1788 {
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
1789 /* special case for '(a . b) conses */
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
1790 return HASH2(internal_hash(XCAR(obj), depth),
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
1791 internal_hash(XCDR(obj), depth));
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
1792 }
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
1793
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
1794 /* 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
1795 same contents in distinct orders differently. */
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
1796 hash = internal_hash(XCAR(obj), depth);
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
1797
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
1798 obj = XCDR(obj);
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
1799 for (s = 1; s < 6 && CONSP(obj); obj = XCDR(obj), 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
1800 {
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
1801 h = internal_hash(XCAR(obj), depth);
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
1802 hash = HASH3(hash, h, 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
1803 }
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
1804
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
1805 return hash;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 if (STRINGP (obj))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 return hash_string (XSTRING_DATA (obj), XSTRING_LENGTH (obj));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 if (LRECORDP (obj))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1813 const struct lrecord_implementation
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814 *imp = XRECORD_LHEADER_IMPLEMENTATION (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 if (imp->hash)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 return imp->hash (obj, depth);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 return LISP_HASH (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822 DEFUN ("sxhash", Fsxhash, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823 Return a hash value for OBJECT.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1824 \(equal obj1 obj2) implies (= (sxhash obj1) (sxhash obj2)).
428
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 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 return make_int (internal_hash (object, 0));
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 #if 0
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1832 DEFUN ("internal-hash-value", Finternal_hash_value, 1, 1, 0, /*
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 Hash value of OBJECT. For debugging.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1834 The value is returned as (HIGH . LOW).
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 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838 /* This function is pretty 32bit-centric. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1839 Hashcode hash = internal_hash (object, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1840 return Fcons (hash >> 16, hash & 0xffff);
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 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844
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 /* initialization */
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850 syms_of_elhash (void)
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 DEFSUBR (Fhash_table_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 DEFSUBR (Fmake_hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854 DEFSUBR (Fcopy_hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855 DEFSUBR (Fgethash);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 DEFSUBR (Fremhash);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857 DEFSUBR (Fputhash);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858 DEFSUBR (Fclrhash);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859 DEFSUBR (Fmaphash);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860 DEFSUBR (Fhash_table_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1861 DEFSUBR (Fhash_table_test);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862 DEFSUBR (Fhash_table_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 DEFSUBR (Fhash_table_rehash_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1864 DEFSUBR (Fhash_table_rehash_threshold);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865 DEFSUBR (Fhash_table_weakness);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866 DEFSUBR (Fhash_table_type); /* obsolete */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 DEFSUBR (Fsxhash);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869 DEFSUBR (Finternal_hash_value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
1872 DEFSYMBOL_MULTIWORD_PREDICATE (Qhash_tablep);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
1873 DEFSYMBOL (Qhash_table);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
1874 DEFSYMBOL (Qhashtable);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
1875 DEFSYMBOL (Qweakness);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
1876 DEFSYMBOL (Qvalue);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
1877 DEFSYMBOL (Qkey_or_value);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
1878 DEFSYMBOL (Qkey_and_value);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
1879 DEFSYMBOL (Qrehash_size);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
1880 DEFSYMBOL (Qrehash_threshold);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
1882 DEFSYMBOL (Qweak); /* obsolete */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
1883 DEFSYMBOL (Qkey_weak); /* obsolete */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
1884 DEFSYMBOL (Qkey_or_value_weak); /* obsolete */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
1885 DEFSYMBOL (Qvalue_weak); /* obsolete */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
1886 DEFSYMBOL (Qnon_weak); /* obsolete */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1887
4820
e6dec75ded0e Use keywords, not ordinary symbols, in the structure syntax for hash tables.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4779
diff changeset
1888 DEFKEYWORD (Q_data);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
1889 DEFKEYWORD (Q_test);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
1890 DEFKEYWORD (Q_size);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
1891 DEFKEYWORD (Q_rehash_size);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
1892 DEFKEYWORD (Q_rehash_threshold);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
1893 DEFKEYWORD (Q_weakness);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 504
diff changeset
1894 DEFKEYWORD (Q_type); /* obsolete */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1895 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897 void
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1898 init_elhash_once_early (void)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1900 INIT_LRECORD_IMPLEMENTATION (hash_table);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
1901 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
1902 INIT_LRECORD_IMPLEMENTATION (hash_table_entry);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 3017
diff changeset
1903 #endif /* NEW_GC */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1904
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 /* This must NOT be staticpro'd */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906 Vall_weak_hash_tables = Qnil;
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 450
diff changeset
1907 dump_add_weak_object_chain (&Vall_weak_hash_tables);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908 }