src/code/sxhash.lisp

   1 ;;;; that part of SXHASH logic which runs not only in the target Lisp but
   2 ;;;; in the cross-compilation host Lisp
   3
   4 ;;;; This software is part of the SBCL system. See the README file for
   5 ;;;; more information.
   6 ;;;;
   7 ;;;; This software is derived from the CMU CL system, which was
   8 ;;;; written at Carnegie Mellon University and released into the
   9 ;;;; public domain. The software is in the public domain and is
  10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  11 ;;;; files for more information.
  12
  13 (in-package "SB!C")
  14
  15 (sb!xc:define-modify-macro mixf (y) mix)
  16
  17 ;;; SXHASH of FLOAT values is defined directly in terms of DEFTRANSFORM in
  18 ;;; order to avoid boxing.
  19 (deftransform sxhash ((x) (single-float))
  20   '(let* ((val (+ 0.0f0 x))
  21           (bits (logand (single-float-bits val) #.(1- (ash 1 32)))))
  22      (logxor 66194023
  23              (sxhash (the fixnum
  24                           (logand most-positive-fixnum
  25                                   (logxor bits
  26                                           (ash bits -7))))))))
  27 (deftransform sxhash ((x) (double-float))
  28   '(let* ((val (+ 0.0d0 x))
  29           (hi (logand (double-float-high-bits val) #.(1- (ash 1 32))))
  30           (lo (double-float-low-bits val))
  31           (hilo (logxor hi lo)))
  32      (logxor 475038542
  33              (sxhash (the fixnum
  34                           (logand most-positive-fixnum
  35                                   (logxor hilo
  36                                           (ash hilo -7))))))))
  37
  38 ;;; SXHASH of FIXNUM values is defined as a DEFTRANSFORM because it's so
  39 ;;; simple.
  40 (deftransform sxhash ((x) (fixnum))
  41   (let ((c (logand 1193941380939624010 sb!xc:most-positive-fixnum)))
  42     ;; shift by -1 to get sign bit into hash
  43     `(logand (logxor (ash x 4) (ash x -1) ,c) sb!xc:most-positive-fixnum)))
  44
  45 ;;; SXHASH of SIMPLE-BIT-VECTOR values is defined as a DEFTRANSFORM
  46 ;;; because it is endian-dependent.
  47 (deftransform sxhash ((x) (simple-bit-vector))
  48   `(let ((result 410823708))
  49     (declare (type fixnum result))
  50     (let ((length (length x)))
  51       (cond
  52         ((= length 0) (mix result (sxhash 0)))
  53         (t
  54          (mixf result (sxhash (length x)))
  55          (do* ((i 0 (+ i 1))
  56                ;; FIXME: should we respect DEPTHOID?  SXHASH on
  57                ;; strings doesn't seem to...
  58                (end-1 (floor (1- length) sb!vm:n-word-bits)))
  59               ((= i end-1)
  60                (let ((num
  61                       (logand
  62                        (ash (1- (ash 1 (mod length sb!vm:n-word-bits)))
  63                             ,(ecase sb!c:*backend-byte-order*
  64                                (:little-endian 0)
  65                                (:big-endian
  66                                 '(- sb!vm:n-word-bits
  67                                     (mod length sb!vm:n-word-bits)))))
  68                        (%vector-raw-bits x i))))
  69                  (mix result ,(ecase sb!c:*backend-byte-order*
  70                                 (:little-endian
  71                                  '(logand num most-positive-fixnum))
  72                                 (:big-endian
  73                                  '(ash num (- sb!vm:n-lowtag-bits)))))))
  74            (declare (type index i end-1))
  75            (let ((num (%vector-raw-bits x i)))
  76              (mixf result ,(ecase sb!c:*backend-byte-order*
  77                              (:little-endian
  78                               '(logand num most-positive-fixnum))
  79                              ;; FIXME: I'm not certain that
  80                              ;; N-LOWTAG-BITS is the clearest way of
  81                              ;; expressing this: it's essentially the
  82                              ;; difference between `(UNSIGNED-BYTE
  83                              ;; ,SB!VM:N-WORD-BITS) and (AND FIXNUM
  84                              ;; UNSIGNED-BYTE).
  85                              (:big-endian
  86                               '(ash num (- sb!vm:n-lowtag-bits))))))))))))
  87
  88 ;;; Some other common SXHASH cases are defined as DEFTRANSFORMs in
  89 ;;; order to avoid having to do TYPECASE at runtime.
  90 ;;;
  91 ;;; We also take the opportunity to handle the cases of constant
  92 ;;; strings, and of symbols whose names are known at compile time;
  93 ;;; except that since SXHASH on the cross-compilation host is not in
  94 ;;; general compatible with SXHASH on the target SBCL, we can't so
  95 ;;; easily do this optimization in the cross-compiler, and SBCL itself
  96 ;;; doesn't seem to need this optimization, so we don't try.
  97 (deftransform sxhash ((x) (simple-string))
  98   (if #+sb-xc-host nil #-sb-xc-host (constant-lvar-p x)
  99       (sxhash (lvar-value x))
 100       '(%sxhash-simple-string x)))
 101 (deftransform sxhash ((x) (symbol))
 102   (if #+sb-xc-host nil #-sb-xc-host (constant-lvar-p x)
 103       (sxhash (lvar-value x))
 104       (if (csubtypep (lvar-type x) (specifier-type 'null))
 105           ;; FIXME: this isn't in fact as optimized as it could be;
 106           ;; this does a memory load, whereas (because we know the
 107           ;; layout of NIL) we could simply take the address of NIL
 108           ;; (or the contents of NULL-TN) and mask off the appropriate
 109           ;; bits, since SYMBOL-HASH of NIL is also NIL's CDR, which
 110           ;; is NIL.  -- CSR, 2004-07-14
 111           '(symbol-hash x)
 112           ;; Cache the value of the symbol's sxhash in the symbol-hash
 113           ;; slot.
 114           '(let ((result (symbol-hash x)))
 115             ;; 0 marks uninitialized slot. We can't use negative
 116             ;; values for the uninitialized slots since NIL might be
 117             ;; located so high in memory on some platforms that its
 118             ;; SYMBOL-HASH (which contains NIL itself) is a negative
 119             ;; fixnum.
 120             (if (= 0 result)
 121                 (let ((sxhash (%sxhash-simple-string (symbol-name x))))
 122                   ;; We could do a (logior sxhash #x10000000) to
 123                   ;; ensure that we never store a 0 in the
 124                   ;; slot. However, it's such an unlikely event
 125                   ;; (1/5e8?) that it makes more sense to optimize for
 126                   ;; the common case...
 127                   (%set-symbol-hash x sxhash)
 128                   sxhash)
 129                 result)))))
 130
 131 (deftransform psxhash ((x &optional depthoid) (character &optional t))
 132   `(char-code (char-upcase x)))
 133
 134 (deftransform psxhash ((x &optional depthoid) (integer &optional t))
 135   `(sxhash x))