;;; -*- Mode: LISP; Package: USER; Base: 10.; fonts:(cptfontb) -*- ;;; $Header: /ct/ctlisp/cthash.l,v 1.7 84/06/19 23:22:33 alex Exp $ ;;; $Log: /ct/ctlisp/cthash.l,v $ ;;;Revision 1.7 84/06/19 23:22:33 alex ;;;Fix the problem of the Maclisp array stuff. ;;; ;;;Revision 1.6 83/08/07 17:10:39 mark ;;;Same as previous version, trying to get it checked in frozen. ;;; ;;;Revision 1.5 83/08/07 17:08:37 mark ;;;Same as previous version. Checkin to ensure it becomes frozen. ;;; ;;;Revision 1.4 83/07/04 01:11:17 mark ;;; ;;; Fixed incompatible "//" to be "!/" so as to correct Franz bug. ;;; ;;; ;;;Revision 1.3 83/07/04 00:40:44 mark ;;; This version has been compiled and tested on both dialects. ;;; There are no substantive changes to the original code. ;;; A few comments were added here and there and some formatting ;;; was done. -- mlm ;;; ;;;Revision 1.2 83/07/03 19:02:43 mark ;;; Intermediate version -- session interrupted. It has been left in ;;; a consistent state, with only some comments and such modified. mlm. ;;; ;;;Revision 1.1 83/06/27 16:12:18 penny ;;; Initial revision ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; CT_HASH ;;; ;;; John Shelton June 83 ;;; ;;; ;;; ;;; Originally written in support of Ada Generic IO, these hashtable ;;; ;;; routines may be of general interest. --mlm. ;;; ;;; ;;; ;;; "I was afraid it would come to this. The hashing fun(s) on ;;; ;;; the LispM are not quite right; neither are they in Franz lisp. ;;; ;;; Thus, they are implemented here. Syntax similar to LM manual. ;;; ;;; Hash tables here are implemented as arrays. The size of the ;;; ;;; array is the size of the table. Hash tables do not grow ;;; ;;; automatically; instead, a GROW function is called. The initial ;;; ;;; application of this code demands a table that never grows, but ;;; ;;; does something entirely different when full. ;;; ;;; Franz uses maclisp style arrays. Therefore, we use maclisp ;;; ;;; style arrays in the lisp machine version, too. This causes ;;; ;;; some minor overhead, but makes the two versions compatible. ;;; ;;; 'Compatibility is good.' (as taken from E. Faber.) ;;; ;;; Items are stored in the array as a cons of the key and the ;;; ;;; value. An empty slot in the array is easily identified because ;;; ;;; it is NIL. Functions that return a hash value always return ;;; ;;; the cons (or NIL); this allows nil keys and nil values to be ;;; ;;; used without confusion. If you retrieve a value, it will only ;;; ;;; be NIL if there is no value. If the really true value is NIL, ;;; ;;; you will get back ( . NIL). Some caution should be ;;; ;;; exercised; wantonly taking the CDR of a retrieved value will ;;; ;;; obscure the NIL from the NIL. (Har har.) ;;; ;;; A hash table has some additional information associated with ;;; ;;; it. The size of the array is known, and the function to call ;;; ;;; if the table is full. Normally, for pure LISPM code, these ;;; ;;; things would be stored in an array leader, but since this code ;;; ;;; must run in Franz Lisp as well, we have to resort to some ;;; ;;; kludges." -- john ;;; ;;; ;;; ;;; This file is part of a proprietary software project. Source ;;; ;;; code and documentation describing implementation details are ;;; ;;; available on a confidential, non-disclosure basis only. These ;;; ;;; materials, including this file in particular, are trade secrets ;;; ;;; of Computer * Thought Corporation. ;;; ;;; ;;; ;;; (c) Copyright 1982 and 1983, Computer * Thought Corporation. ;;; ;;; All Rights Reserved. ;;; ;;; ;;; ;;; Reference materials: ;;; ;;; Foderaro and Sklower, The FRANZ LISP Manual, September 1981. ;;; ;;; Weinreb and Moon, LISP MACHINE MANUAL, Symbolics, July 1981. ;;; ;;; Charniak et al., 1980. Artificial Intelligence Programming. ;;; ;;; Miller, 1982. The C*T Ada Tutor: Guide to the Implementation. ;;; ;;; The following code assumes familiarity with these materials. ;;; ;;; ;;; ;;; ASSUMES CT_LOAD AND SUITABLE FILEMAP ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Ensure presence of needed files. (eval-when (compile load eval) (ct_load 'charmac)) ;CT char set extensions. (eval-when (compile load eval) (ct_load 'aip)) ;AIP macros pkg. (eval-when (compile load eval) (ct_load 'compat)) ;Franz/LM compat pkg. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Compiler Declarations and Global Variables -- #+franz (declare (macros t)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Externally Call-able Functions/Macros -- ;;; ( ) ;;; Extracts the real array from a hash table. (defun ht_array (ht) (car ht)) ;;; Extracts the size of the array from a hash table. (defun ht_size (ht) (cadr ht)) ;;; Extracts the grow function from a hash table. (defun ht_grow (ht) (caddr ht)) ;;; Extracts the OWNER of the table. This is used in Ada's direct-io ;;; package as a pointer to the file object owning the hash table. (defun ht_owner (ht) (cadddr ht)) ;;; Extracts the maximum key value used to store in the table. (defun ht_max_key (ht) (caddddr ht)) ;;; Creates a new hash table, returning it. Choose a size that is a ;;; prime multiple of 16, if you can. That will make things hash ;;; better. Make-array (in Z-lisp) returns an array already ;;; initialized to nil for you. (defun ct_make_hash_table (size grow_fn owner) (let ((name (gensym))) #+lispm (setq name (make-array size)) #+franz (*array name t size) (list name size grow_fn owner 0))) ;initial max key is 0 ;;; Clears out the hash table. Sort of cheats to do it, by replacing ;;; the array with a new one. There are other ways to do this, of course. (defun ct_clrhash (table) #+franz (*array (ht_array table) t (ht_size table)) #+lispm (%= (car table) (make-array (ht_size table))) (rplaca (cddddr table) 0)) ;;; continued -- ;;; Externally callables, cont'd -- ;;; Installs a new entry in the hash table. If the table is full, ;;; calls the grow function (which should make the table non-full ;;; somehow) and then retries. We don't actually get the table REALLY ;;; full; we merely try to get it largely full. (defun ct_puthash (key value table) (loop for i from 0 to (!/ (ht_size table) 2) with size = (ht_size table) with j = (ct_hash key size) with array = (ht_array table) do (cond ((or (null #+franz (apply array (list (remainder (+ i j) size))) #+lispm (aref array (remainder (+ i j) size)) ) (= (car #+franz (apply array (list (remainder (+ i j) size))) #+lispm (aref array (remainder (+ i j) size)) ) key)) (rplaca (cddddr table) (max key (ht_max_key table))) #+franz (eval `(store (,array ,(remainder (+ i j) size)) ',(cons key value))) #+lispm (eval `(aset ',(cons key value) ',array ,(remainder (+ i j) size))) (return t))) finally (funcall (ht_grow table) table) finally (ct_puthash key value table))) ;;; Locates a value in the hash table, if possible. (defun ct_gethash (key table) (loop for i from 0 to (1- (ht_size table)) with size = (ht_size table) with j = (ct_hash key size) with array = (ht_array table) do (cond (#+franz (equal (car (apply array (list (remainder (+ i j) size)))) key) #+lispm (equal (car (aref array (remainder (+ i j) size))) key) (return #+franz (apply array (list (remainder (+ i j) size))) #+lispm (aref array (remainder (+ i j) size)) )) (#+franz (null (car (apply array (list (remainder (+ i j) size))))) #+lispm (null (aref array (remainder (+ i j) size))) (return nil))) finally (return nil))) ;;; A simple hashing function: We want numbers near each other to hash ;;; to different values. This might be improved some time. (defun ct_hash (key size) (remainder key size)) ;;; eof ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;