1 (in-package "SB-ROTATE-BYTE")
3 (defknown rotate-byte (integer byte-specifier integer) integer
5 :overwrite-fndb-silently t)
6 (defknown %rotate-byte (integer bit-index bit-index integer) integer
8 :overwrite-fndb-silently t)
9 (defknown %unsigned-32-rotate-byte ((integer -31 31) (unsigned-byte 32))
12 :overwrite-fndb-silently t)
14 (defknown %unsigned-64-rotate-byte ((integer -63 63) (unsigned-byte 64))
17 :overwrite-fndb-silently t)
19 (macrolet (;; see src/compiler/srctran.lisp
20 (with-byte-specifier ((size-var pos-var spec) &body body)
21 (once-only ((spec `(macroexpand ,spec))
23 `(if (and (consp ,spec)
24 (eq (car ,spec) 'byte)
26 (let ((,size-var (second ,spec))
27 (,pos-var (third ,spec)))
29 (let ((,size-var `(byte-size ,,temp))
30 (,pos-var `(byte-position ,,temp)))
31 `(let ((,,temp ,,spec))
33 (define-source-transform rotate-byte (count spec num)
34 (with-byte-specifier (size pos spec)
35 `(%rotate-byte ,count ,size ,pos ,num))))
37 (defoptimizer (%rotate-byte derive-type) ((count size posn num))
38 ;; FIXME: this looks fairly unwieldy. I'm sure it can be made
39 ;; simpler, and also be made to deal with negative integers too.
40 (let ((size (sb-c::lvar-type size)))
41 (if (numeric-type-p size)
42 (let ((size-high (numeric-type-high size))
43 (num-type (sb-c::lvar-type num)))
46 (<= size-high sb-vm:n-word-bits)
48 (specifier-type `(unsigned-byte ,size-high))))
49 (specifier-type `(unsigned-byte ,size-high))
53 (deftransform %rotate-byte ((count size pos integer)
55 (constant-arg (member 32))
56 (constant-arg (member 0))
57 (unsigned-byte 32)) *)
58 "inline 32-bit rotation"
59 '(%unsigned-32-rotate-byte count integer))
61 ;; Generic implementation for platforms that don't supply VOPs for 32-bit
64 (deftransform %unsigned-32-rotate-byte ((.count. .integer.)
66 (unsigned-byte 32)) *)
68 (logior (ldb (byte 32 0) (ash .integer. (+ .count. 32)))
69 (ash .integer. .count.))
70 (logior (ldb (byte 32 0) (ash .integer. .count.))
71 (ash .integer. (- .count. 32)))))
74 (deftransform %rotate-byte ((count size pos integer)
76 (constant-arg (member 64))
77 (constant-arg (member 0))
78 (unsigned-byte 64)) *)
79 "inline 64-bit rotation"
80 '(%unsigned-64-rotate-byte count integer))
82 ;;; This transform needs to come after the others to ensure it gets
83 ;;; first crack at a zero COUNT, since transforms are currently run
84 ;;; latest-defined first.
85 (deftransform %rotate-byte ((count size pos integer)
86 ((constant-arg (member 0)) * * *) *)
87 "fold identity operation"