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 ((bits (single-float-bits x)))
  21      (logxor 66194023
  22              (sxhash (the fixnum
  23                           (logand most-positive-fixnum
  24                                   (logxor bits
  25                                           (ash bits -7))))))))
  26 (deftransform sxhash ((x) (double-float))
  27   '(let* ((val x)
  28           (hi (double-float-high-bits val))
  29           (lo (double-float-low-bits val))
  30           (hilo (logxor hi lo)))
  31      (logxor 475038542
  32              (sxhash (the fixnum
  33                           (logand most-positive-fixnum
  34                                   (logxor hilo
  35                                           (ash hilo -7))))))))
  36
  37 ;;; SXHASH of FIXNUM values is defined as a DEFTRANSFORM because it's so
  38 ;;; simple.
  39 (deftransform sxhash ((x) (fixnum))
  40   '(logand most-positive-fixnum
  41            (logxor (ash (logand x (ash most-positive-fixnum -4)) 4)
  42                    (ash x -1) ; to get sign bit into hash
  43                    361475658)))
  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     (mixf result (sxhash (length x)))
  51     (do* ((i sb!vm:vector-data-offset (+ i 1))
  52           ;; FIXME: should we respect DEPTHOID?  SXHASH on strings
  53           ;; doesn't seem to...
  54           (end (+ sb!vm:vector-data-offset
  55                   (ceiling (length x) sb!vm:n-word-bits))))
  56          ((= i end) result)
  57       (declare (type index i end))
  58       (let ((num
  59              (if (= i (1- end))
  60                  (logand
  61                   (ash (1- (ash 1 (mod (length x) sb!vm:n-word-bits)))
  62                        ,(ecase sb!c:*backend-byte-order*
  63                           (:little-endian 0)
  64                           (:big-endian
  65                            '(- sb!vm:n-word-bits
  66                                (mod (length x) sb!vm:n-word-bits)))))
  67                   (%raw-bits x i))
  68                  (%raw-bits x i))))
  69         (declare (type (unsigned-byte 32) num))
  70         (mixf result ,(ecase sb!c:*backend-byte-order*
  71                         (:little-endian '(logand num most-positive-fixnum))
  72                         ;; FIXME: I'm not certain that N-LOWTAG-BITS
  73                         ;; is the clearest way of expressing this:
  74                         ;; it's essentially the difference between
  75                         ;; `(UNSIGNED-BYTE ,SB!VM:N-WORD-BITS) and
  76                         ;; (AND FIXNUM UNSIGNED-BYTE).
  77                         (:big-endian '(ash num (- sb!vm:n-lowtag-bits)))))))))
  78
  79 ;;; Some other common SXHASH cases are defined as DEFTRANSFORMs in
  80 ;;; order to avoid having to do TYPECASE at runtime.
  81 ;;;
  82 ;;; We also take the opportunity to handle the cases of constant
  83 ;;; strings, and of symbols whose names are known at compile time;
  84 ;;; except that since SXHASH on the cross-compilation host is not in
  85 ;;; general compatible with SXHASH on the target SBCL, we can't so
  86 ;;; easily do this optimization in the cross-compiler, and SBCL itself
  87 ;;; doesn't seem to need this optimization, so we don't try.
  88 (deftransform sxhash ((x) (simple-string))
  89   (if #+sb-xc-host nil #-sb-xc-host (constant-continuation-p x)
  90       (sxhash (continuation-value x))
  91       '(%sxhash-simple-string x)))
  92 (deftransform sxhash ((x) (symbol))
  93   (if #+sb-xc-host nil #-sb-xc-host (constant-continuation-p x)
  94       (sxhash (continuation-value x))
  95       '(%sxhash-simple-string (symbol-name x))))
  96
  97