9e947fd595d64a12bfacc1b04bbefc092e45dc63
[sbcl.git] / contrib / sb-rotate-byte / rotate-byte.lisp
1 (in-package "SB-ROTATE-BYTE")
2
3 (defun rotate-byte (count bytespec integer)
4   "Rotates a field of bits within INTEGER; specifically, returns an
5 integer that contains the bits of INTEGER rotated COUNT times
6 leftwards within the byte specified by BYTESPEC, and elsewhere
7 contains the bits of INTEGER."
8   (rotate-byte count bytespec integer))
9
10 (defun %rotate-byte (count size pos integer)
11   (let ((count (nth-value 1 (round count size)))
12         (mask (1- (ash 1 size))))
13     (logior (logand integer (lognot (ash mask pos)))
14             (let ((field (logand (ash mask pos) integer)))
15               (logand (ash mask pos)
16                       (if (> count 0)
17                           (logior (ash field count)
18                                   (ash field (- count size)))
19                           (logior (ash field count)
20                                   (ash field (+ count size)))))))))
21
22 (defun %unsigned-32-rotate-byte (count integer)
23   ;; inhibit transforms
24   (declare (notinline %rotate-byte))
25   (%rotate-byte count 32 0 integer))