mirror of
https://github.com/PDP-10/its.git
synced 2026-01-19 01:27:05 +00:00
65 lines
2.1 KiB
Common Lisp
65 lines
2.1 KiB
Common Lisp
;;-*-LISP-*-
|
|
;; LISPM compatible functions for hash-tables on EQ and EQUAL.
|
|
;; Hashing off the address using MAKNUM is easy in Maclisp
|
|
;; since the garbage collector is not relocating.
|
|
|
|
(herald hash 1)
|
|
|
|
(eval-when (compile)
|
|
(setq defmacro-for-compiling nil))
|
|
|
|
(defmacro make-hash-table-internal (dim factor)
|
|
`(let ((hash-table (*array nil t (+ ,dim 3))))
|
|
(setf (hash-ind) gethash)
|
|
(setf (hash-dim) ,dim)
|
|
(setf (hash-factor) ,factor)
|
|
hash-table))
|
|
|
|
(defmacro hash-ref (index &optional (hash-table 'hash-table))
|
|
`(arraycall t ,hash-table (+ ,index 3)))
|
|
(defmacro hash-ind (&optional (hash-table 'hash-table))
|
|
`(arraycall t ,hash-table 0))
|
|
(defmacro hash-dim (&optional (hash-table 'hash-table))
|
|
`(arraycall t ,hash-table 1))
|
|
(defmacro hash-factor (&optional (hash-table 'hash-table))
|
|
`(arraycall t ,hash-table 2))
|
|
|
|
(defvar gethash (list 'gethash) "Unique object for hash-table-verification")
|
|
|
|
(defun hash-table-identity (hash-table)
|
|
(if (and (eq (typep hash-table) 'array)
|
|
(eq (hash-ind) gethash))
|
|
hash-table
|
|
(hash-table-identity (error "not a hash table" hash-table 'wrng-type-arg))))
|
|
|
|
(defun gethash (hash-table key)
|
|
(if *rset (setq hash-table (hash-table-identity hash-table)))
|
|
(do ((alist (hash-ref (\ (maknum key) (hash-dim)))
|
|
(cdr alist)))
|
|
((null alist) (values nil nil))
|
|
(if (eq key (caar alist))
|
|
(return (values (cdar alist) t)))))
|
|
|
|
(defun puthash (key value hash-table)
|
|
(if *rset (setq hash-table (hash-table-identity hash-table)))
|
|
(do ((alist (hash-ref (\ (maknum key) (hash-dim)))
|
|
(cdr alist)))
|
|
((null alist)
|
|
(setf (hash-ref (\ (maknum key) (hash-dim)))
|
|
(list (cons key value))))
|
|
(if (eq key (caar alist))
|
|
(return (setf (cdar alist) value))))
|
|
value)
|
|
|
|
(DEFUN MAPHASH (FUNCTION HASH-TABLE)
|
|
(if *rset (setq hash-table (hash-table-identity hash-table)))
|
|
(DO ((J 0 (1+ J))
|
|
(N (HASH-DIM)))
|
|
((= J N))
|
|
(DO ((ALIST (HASH-REF J) (CDR ALIST)))
|
|
((NULL ALIST))
|
|
(FUNCALL FUNCTION (CDAR ALIST)))))
|
|
|
|
(defun make-hash-table () ; for now this is all I need
|
|
(make-hash-table-internal 100 1.3))
|