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