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