(FILECREATED " 2-Jul-86 13:44:14" {ERIS}<LISPCORE>LIBRARY>CMLHASH.;14
 7207   

      changes to:  (FNS MAKE-HASH-TABLE)

      previous date: "27-Jun-86 18:33:36" {ERIS}<LISPCORE>LIBRARY>CMLHASH.;13)


(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT CMLHASHCOMS)

(RPAQQ CMLHASHCOMS
 [(* * External interface)
                    (SETFS CL:GETHASH)
                    (FNS CL:MAPHASH CL:PUTHASH HASH-TABLE-COUNT HASH-TABLE-P MAKE-HASH-TABLE SXHASH)
                    (P (MOVD (QUOTE GETHASH)
                             (QUOTE CL:GETHASH)))
                    (* * Internal interface)
                    (CONSTANTS SXHASH-MAX)
                    (FUNCTIONS SXHASH-LIST SXHASH-ROT SXHASH-STRING \EQHASHINGBITS)
                    (FNS CLHASH::EQLHASHBITSFN)
                    (PROP FILETYPE CMLHASH)
                    (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
                           (ADDVARS (NLAMA)
                                  (NLAML)
                                  (LAMA MAKE-HASH-TABLE HASH-TABLE-P HASH-TABLE-COUNT CL:PUTHASH 
                                        CL:MAPHASH])
(* * External interface)


(DEFSETF CL:GETHASH
 CL:PUTHASH)

(DEFINEQ

(CL:MAPHASH

  (CL:LAMBDA (FUNCTION HASH-TABLE)
                                     (* raf 
                                                                           "17-Nov-85 02:35")

    [MAPHASH HASH-TABLE (FUNCTION (LAMBDA (VALUE KEY)
                                    (FUNCALL FUNCTION KEY VALUE]
    NIL))

(CL:PUTHASH

  (CL:LAMBDA (KEY HASH-TABLE VALUE &OPTIONAL DEFAULT)
    (PUTHASH KEY VALUE HASH-TABLE)))

(HASH-TABLE-COUNT

  (CL:LAMBDA (HASH-TABLE)
    (HARRAYPROP HASH-TABLE (QUOTE NUMKEYS))))

(HASH-TABLE-P

  (CL:LAMBDA (OBJECT)
    (HARRAYP OBJECT)))

(MAKE-HASH-TABLE

  [CL:LAMBDA (&KEY (TEST (QUOTE EQL))
                   (SIZE 65)
                   REHASH-SIZE REHASH-THRESHOLD)
             (* lmm " 2-Jul-86 13:43")

                                                             (* 

                                         "Creates and returns a hash table.  See manual for details.")

         [AND (NOT (SYMBOLP TEST))
              (COND
                 ((EQP TEST (CL:FUNCTION EQ
))
                  (SETQ TEST (QUOTE EQ
)))
                 ((EQP TEST (CL:FUNCTION EQL))
                  (SETQ TEST (QUOTE EQL)))
                 ((EQP TEST (CL:FUNCTION CL:EQUAL))
                  (SETQ TEST (QUOTE CL:EQUAL]
         (ECASE TEST (EQ (HASHARRAY SIZE REHASH-SIZE))
                (EQL (HASHARRAY SIZE REHASH-SIZE (FUNCTION CLHASH::EQLHASHBITSFN)
                            (FUNCTION EQL)))
                (CL:EQUAL (HASHARRAY SIZE REHASH-SIZE (FUNCTION SXHASH)
                                 (FUNCTION CL:EQUAL])

(SXHASH

  [LAMBDA (OBJECT)
                                                     (* raf 
                                                                           "23-Jan-86 18:03")

    (TYPECASE OBJECT (SIMPLE-STRING (STRINGHASHBITS OBJECT))
           (SYMBOL (STRINGHASHBITS (SYMBOL-NAME OBJECT)))
           (STRING (SXHASH-STRING OBJECT))
           (LIST (SXHASH-LIST OBJECT))
           (ARRAY (ARRAY-RANK OBJECT))
           (FLOAT (LOGXOR (fetch
 (FLOATP HIWORD) of
 OBJECT)
                         (fetch
 (FLOATP LOWORD) of
 OBJECT)))
           (INTEGER (LOGAND OBJECT 65535))
           [RATIO (LOGXOR (SXHASH
 (NUMERATOR OBJECT))
                         (SXHASH
 (DENOMINATOR OBJECT]
           [COMPLEX (LOGXOR (SXHASH
 (REALPART OBJECT))
                           (SXHASH
 (IMAGPART OBJECT]
           (T (\EQHASHINGBITS OBJECT])
)
(MOVD (QUOTE GETHASH)
      (QUOTE CL:GETHASH))
(* * Internal interface)



(RPAQQ SXHASH-MAX
 13)
(DECLARE: EVAL@COMPILE 
(CONSTANTS SXHASH-MAX)
)
(DEFMACRO SXHASH-LIST
 (SEQUENCE) (BQUOTE (CL:DO ((SEQUENCE (\, SEQUENCE)
                                                        (CDR SEQUENCE))
                                                 (INDEX 0 (1+ INDEX))
                                                 (HASH 2))
                                                ((OR (ATOM SEQUENCE)
                                                     (= INDEX SXHASH-MAX))
                                                 HASH)
                                                (DECLARE
 (TYPE FIXNUM HASH))
                                                (SETQ HASH (SXHASH-ROT (LOGXOR HASH
                                                                              (SXHASH (CAR SEQUENCE))
                                                                              )
                                                                  7)))))

(DEFMACRO SXHASH-ROT
 (X NUM) "Rotates x left by num bits." (BQUOTE (ROT (\, X)
                                                                        (\, NUM)
                                                                        (\, (INTEGERLENGTH 
                                                                                 MOST-POSITIVE-FIXNUM
                                                                                   )))))

(DEFMACRO SXHASH-STRING
 (SEQUENCE) "Returns hash value for a non-simple string."
   (BQUOTE (CL:DO ((I 0 (1+ I))
                   (LENGTH (MAX (CL:LENGTH (\, SEQUENCE))
                                SXHASH-MAX))
                   (HASH 0))
                  ((= I LENGTH)
                   HASH)
                  (DECLARE
 (TYPE FIXNUM I LENGTH HASH))
                  (SETQ HASH (SXHASH-ROT (LOGXOR HASH (CHAR-INT (AREF (\, SEQUENCE)
                                                                      I)))
                                    7)))))

(DEFMACRO \EQHASHINGBITS
 (X) (BQUOTE (LOGXOR (\HILOC (\, X))
                                            (LOGXOR (LLSH (LOGAND (\LOLOC (\, X))
                                                                 8191)
                                                          3)
                                                   (LRSH (\LOLOC (\, X))
                                                         9)))))

(DEFINEQ

(CLHASH::EQLHASHBITSFN

  [LAMBDA (OBJ)
                                              (* lmm "26-Jun-86 18:04")

    (TYPECASE OBJ (CHARACTER)
           (INTEGER (LOGAND OBJ 65535))
           (FLOAT (LOGXOR (fetch
 (FLOATP HIWORD) of
 OBJ)
                         (fetch
 (FLOATP LOWORD) of
 OBJ)))
           [RATIO (LOGXOR (CLHASH::EQLHASHBITSFN
 (NUMERATOR OBJ))
                         (CLHASH::EQLHASHBITSFN
 (DENOMINATOR OBJ]
           [COMPLEX (LOGXOR (CLHASH::EQLHASHBITSFN
 (REALPART OBJ))
                           (CLHASH::EQLHASHBITSFN
 (IMAGPART OBJ]
           (T (\EQHASHINGBITS OBJ])
)

(PUTPROPS CMLHASH FILETYPE
 COMPILE-FILE)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 MAKE-HASH-TABLE HASH-TABLE-P HASH-TABLE-COUNT CL:PUTHASH CL:MAPHASH)
)
(PUTPROPS CMLHASH COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1245 3741 (CL:MAPHASH 1255 . 1580) (CL:PUTHASH 1582 . 1688) (HASH-TABLE-COUNT 1690 . 
1783) (HASH-TABLE-P 1785 . 1847) (MAKE-HASH-TABLE 1849 . 2854) (SXHASH 2856 . 3739)) (6229 6879 (
CLHASH::EQLHASHBITSFN 6239 . 6877)))))
STOP