(FILECREATED "26-Jun-86 18:04:50" {ERIS}<LISPCORE>LIBRARY>CMLHASH.;12
 7467   

      changes to:  (FNS CLHASH::EQLHASHBITSFN MAKE-HASH-TABLE)
                   (SETFS CL:GETHASH)
                   (VARS CMLHASHCOMS)
                   (PROPS (CMLHASH FILETYPE))
                   (FUNCTIONS \EQHASHINGBITS)

      previous date: "20-Apr-86 16:41:32" {ERIS}<LISPCORE>LIBRARY>CMLHASH.;8)


(* 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 (FUNCTION EQL))
                   (SIZE 65)
                   REHASH-SIZE REHASH-THRESHOLD)
             (* lmm "26-Jun-86 17:53")

                                                             (* 

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

         [COND
            ((EQP TEST (CL:FUNCTION EQP
))
             (SETQ TEST (QUOTE EQP
)))
            ((EQP TEST (CL:FUNCTION EQL))
             (SETQ TEST (QUOTE EQL)))
            ((EQP TEST (CL:FUNCTION CL:EQUAL))
             (SETQ TEST (QUOTE CL:EQUAL]
         (COND
            ((EQ TEST (QUOTE EQ
))
             (HASHARRAY SIZE REHASH-SIZE))
            ((EQ TEST (QUOTE EQL))
             (HASHARRAY SIZE REHASH-SIZE (FUNCTION CLHASH::EQLHASHBITSFN)
                    (FUNCTION EQL)))
            ((EQ TEST (QUOTE EQUAL
))
             (HASHARRAY SIZE REHASH-SIZE (FUNCTION SXHASH)
                    (FUNCTION CL:EQUAL)))
            (T (ERROR "Bad TEST for MAKE-HASH-ARRAY" TEST])

(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 (1434 4001 (CL:MAPHASH 1444 . 1769) (CL:PUTHASH 1771 . 1877) (HASH-TABLE-COUNT 1879 . 
1972) (HASH-TABLE-P 1974 . 2036) (MAKE-HASH-TABLE 2038 . 3114) (SXHASH 3116 . 3999)) (6489 7139 (
CLHASH::EQLHASHBITSFN 6499 . 7137)))))
STOP