More fixes for cmucl host. Should be all good now.
[sbcl.git] / contrib / sb-rotate-byte / x86-vm.lisp
blob27cf845e6fc3d5a9a7cbf90a611e07216ead4ba3
1 (in-package "SB-ROTATE-BYTE")
3 (define-vop (%32bit-rotate-byte/c)
4 (:policy :fast-safe)
5 (:translate %unsigned-32-rotate-byte)
6 (:note "inline 32-bit constant rotation")
7 (:info count)
8 (:args (integer :scs (sb-vm::unsigned-reg) :target res))
9 (:arg-types (:constant (integer -31 31)) sb-vm::unsigned-byte-32)
10 (:results (res :scs (sb-vm::unsigned-reg)))
11 (:result-types sb-vm::unsigned-byte-32)
12 (:generator 5
13 ;; the 0 case is an identity operation and should be
14 ;; DEFTRANSFORMed away.
15 (aver (not (= count 0)))
16 (move res integer)
17 (if (> count 0)
18 (inst rol res count)
19 (inst ror res (- count)))))
21 (define-vop (%32bit-rotate-byte-fixnum/c)
22 (:policy :fast-safe)
23 (:translate %unsigned-32-rotate-byte)
24 (:note "inline 32-bit constant rotation")
25 (:info count)
26 (:args (integer :scs (sb-vm::any-reg) :target res))
27 (:arg-types (:constant (integer -31 31)) sb-vm::positive-fixnum)
28 (:results (res :scs (sb-vm::unsigned-reg)))
29 (:result-types sb-vm::unsigned-byte-32)
30 (:generator 5
31 (aver (not (= count 0)))
32 (inst mov res integer)
33 (cond
34 ;; FIXME: all these 2s should be n-fixnum-tag-bits.
35 ((= count 2))
36 ((> count 2) (inst rol res (- count 2)))
37 (t (inst ror res (- 2 count))))))
39 (macrolet ((def (name arg-type)
40 `(define-vop (,name)
41 (:policy :fast-safe)
42 (:translate %unsigned-32-rotate-byte)
43 (:note "inline 32-bit rotation")
44 (:args (count :scs (sb-vm::signed-reg) :target ecx)
45 (integer :scs (sb-vm::unsigned-reg) :target res))
46 (:arg-types sb-vm::tagged-num ,arg-type)
47 (:temporary (:sc sb-vm::signed-reg :offset sb-vm::ecx-offset)
48 ecx)
49 (:results (res :scs (sb-vm::unsigned-reg) :from :load))
50 (:result-types sb-vm::unsigned-byte-32)
51 (:generator 10
52 (let ((label (gen-label))
53 (end (gen-label)))
54 (move res integer)
55 (move ecx count)
56 (inst cmp ecx 0)
57 (inst jmp :ge label)
58 (inst neg ecx)
59 (inst ror res :cl)
60 (inst jmp end)
61 (emit-label label)
62 (inst rol res :cl)
63 (emit-label end))))))
64 (def %32bit-rotate-byte sb-vm::unsigned-byte-32)
65 ;; FIXME: it's not entirely clear to me why we need this second
66 ;; definition -- or rather, why the compiler isn't smart enough to
67 ;; MOVE a POSITIVE-FIXNUM argument to an UNSIGNED-BYTE-32 argument,
68 ;; and then go from there. Still, not having it leads to scary
69 ;; compilation messages of the form:
71 ;; unable to do inline 32-bit constant rotation (cost 5) because:
72 ;; This shouldn't happen! Bug?
73 ;; argument types invalid
74 ;; argument primitive types:
75 ;; (SB-VM::POSITIVE-FIXNUM SB-VM::POSITIVE-FIXNUM)
77 ;; so better leave it in.
78 (def %32bit-rotate-byte-fixnum sb-vm::positive-fixnum))