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   (cond #-sb-xc-host ((constant-lvar-p x) (sxhash (lvar-value x)))
  96         (t '(%sxhash-simple-string x))))
  97 (deftransform sxhash ((x) (symbol))
  98   (cond #-sb-xc-host ((constant-lvar-p x) (sxhash (lvar-value x)))
  99         ((csubtypep (lvar-type x) (specifier-type 'null))
 100          (ash sb!vm::nil-value (- sb!vm:n-fixnum-tag-bits)))
 101         ((csubtypep (lvar-type x) (specifier-type 'keyword))
 102          ;; All interned symbols have a precomputed hash.
 103          ;; There's no way to ask the type system whether a symbol is known to
 104          ;; be interned, but we *can* test for the specific case of keywords.
 105          ;; Even if it gets uninterned, this shortcut remains valid.
 106          `(symbol-hash x)) ; Never need to lazily compute and memoize
 107         (t
 108           ;; Cache the value of the symbol's sxhash in the symbol-hash
 109           ;; slot.
 110           '(let ((result (symbol-hash x)))
 111             ;; 0 marks uninitialized slot. We can't use negative
 112             ;; values for the uninitialized slots since NIL might be
 113             ;; located so high in memory on some platforms that its
 114             ;; SYMBOL-HASH (which contains NIL itself) is a negative
 115             ;; fixnum.
 116             (if (= 0 result)
 117                 (ensure-symbol-hash x)
 118                 result)))))
 119
 120 (deftransform psxhash ((x &optional depthoid) (character &optional t))
 121   `(char-code (char-upcase x)))
 122
 123 (deftransform psxhash ((x &optional depthoid) (integer &optional t))
 124   `(sxhash x))