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 ;;; SXHASH of FLOAT values is defined directly in terms of DEFTRANSFORM in
  16 ;;; order to avoid boxing.
  17 (deftransform sxhash ((x) (single-float))
  18   '(let* ((val (+ 0.0f0 x))
  19           (bits (logand (single-float-bits val) #.(1- (ash 1 32)))))
  20      (logxor 66194023
  21              (sxhash (the fixnum
  22                           (logand most-positive-fixnum
  23                                   (logxor bits
  24                                           (ash bits -7))))))))
  25 (deftransform sxhash ((x) (double-float))
  26   '(let* ((val (+ 0.0d0 x))
  27           (hi (logand (double-float-high-bits val) #.(1- (ash 1 32))))
  28           (lo (double-float-low-bits val))
  29           (hilo (logxor hi lo)))
  30      (logxor 475038542
  31              (sxhash (the fixnum
  32                           (logand most-positive-fixnum
  33                                   (logxor hilo
  34                                           (ash hilo -7))))))))
  35
  36 ;;; SXHASH of FIXNUM values is defined as a DEFTRANSFORM because it's so
  37 ;;; simple.
  38 (deftransform sxhash ((x) (fixnum))
  39   (let ((c (logand 1193941380939624010 sb!xc:most-positive-fixnum)))
  40     ;; shift by -1 to get sign bit into hash
  41     `(logand (logxor (ash x 4) (ash x -1) ,c) sb!xc:most-positive-fixnum)))
  42
  43 ;;; SXHASH of SIMPLE-BIT-VECTOR values is defined as a DEFTRANSFORM
  44 ;;; because it is endian-dependent.
  45 (deftransform sxhash ((x) (simple-bit-vector))
  46   `(let ((result 410823708)
  47          (length (length x)))
  48     (declare (type fixnum result))
  49     (cond
  50       ((zerop length)
  51        (mix result (sxhash 0)))
  52       (t
  53        (mixf result (sxhash length))
  54        (multiple-value-bind (n-full-words n-bits-remaining)
  55            (floor length sb!vm:n-word-bits)
  56          (flet ((mix-into-result (num)
  57                   (mixf result
  58                         ,(ecase sb!c:*backend-byte-order*
  59                                 (:little-endian
  60                                  '(logand num most-positive-fixnum))
  61                                 ;; FIXME: I'm not certain that
  62                                 ;; N-LOWTAG-BITS is the clearest way of
  63                                 ;; expressing this: it's essentially the
  64                                 ;; difference between `(UNSIGNED-BYTE
  65                                 ;; ,SB!VM:N-WORD-BITS) and (AND FIXNUM
  66                                 ;; UNSIGNED-BYTE).
  67                                 (:big-endian
  68                                  '(ash num (- sb!vm:n-lowtag-bits)))))))
  69            (declare (inline mix-into-result))
  70            ;; FIXME: should we respect DEPTHOID?  SXHASH on strings
  71            ;; doesn't seem to...
  72            (dotimes (i n-full-words)
  73              (mix-into-result (%vector-raw-bits x i)))
  74            (if (zerop n-bits-remaining)
  75                result
  76                (mix-into-result
  77                 (logand (ash (1- (ash 1 n-bits-remaining))
  78                              ,(ecase sb!c:*backend-byte-order*
  79                                      (:little-endian 0)
  80                                      (:big-endian
  81                                       '(- sb!vm:n-word-bits
  82                                         n-bits-remaining))))
  83                         (%vector-raw-bits x n-full-words))))))))))
  84
  85 ;;; Some other common SXHASH cases are defined as DEFTRANSFORMs in
  86 ;;; order to avoid having to do TYPECASE at runtime.
  87 ;;;
  88 ;;; We also take the opportunity to handle the cases of constant
  89 ;;; strings, and of symbols whose names are known at compile time;
  90 ;;; except that since SXHASH on the cross-compilation host is not in
  91 ;;; general compatible with SXHASH on the target SBCL, we can't so
  92 ;;; easily do this optimization in the cross-compiler, and SBCL itself
  93 ;;; doesn't seem to need this optimization, so we don't try.
  94 (deftransform sxhash ((x) (simple-string))
  95   (if #+sb-xc-host nil #-sb-xc-host (constant-lvar-p x)
  96       (sxhash (lvar-value x))
  97       '(%sxhash-simple-string x)))
  98 (deftransform sxhash ((x) (symbol))
  99   (if #+sb-xc-host nil #-sb-xc-host (constant-lvar-p x)
 100       (sxhash (lvar-value x))
 101       (if (csubtypep (lvar-type x) (specifier-type 'null))
 102           ;; FIXME: this isn't in fact as optimized as it could be;
 103           ;; this does a memory load, whereas (because we know the
 104           ;; layout of NIL) we could simply take the address of NIL
 105           ;; (or the contents of NULL-TN) and mask off the appropriate
 106           ;; bits, since SYMBOL-HASH of NIL is also NIL's CDR, which
 107           ;; is NIL.  -- CSR, 2004-07-14
 108           '(symbol-hash x)
 109           ;; Cache the value of the symbol's sxhash in the symbol-hash
 110           ;; slot.
 111           '(let ((result (symbol-hash x)))
 112             ;; 0 marks uninitialized slot. We can't use negative
 113             ;; values for the uninitialized slots since NIL might be
 114             ;; located so high in memory on some platforms that its
 115             ;; SYMBOL-HASH (which contains NIL itself) is a negative
 116             ;; fixnum.
 117             (if (= 0 result)
 118                 (ensure-symbol-hash x)
 119                 result)))))
 120
 121 (deftransform psxhash ((x &optional depthoid) (character &optional t))
 122   `(char-code (char-upcase x)))
 123
 124 (deftransform psxhash ((x &optional depthoid) (integer &optional t))
 125   `(sxhash x))