Simplify (and robustify) regular PACKing
[sbcl.git] / contrib / sb-rotate-byte / ppc-vm.lisp
1 (in-package "SB-ROTATE-BYTE")
2
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     (if (> count 0)
17         (inst rotlwi res integer count)
18         (inst rotrwi res integer (- count)))))
19
20 (define-vop (%32bit-rotate-byte-fixnum/c)
21   (:policy :fast-safe)
22   (:translate %unsigned-32-rotate-byte)
23   (:note "inline 32-bit constant rotation")
24   (:info count)
25   (:args (integer :scs (sb-vm::any-reg) :target res))
26   (:arg-types (:constant (integer -31 31)) sb-vm::positive-fixnum)
27   (:results (res :scs (sb-vm::unsigned-reg)))
28   (:result-types sb-vm::unsigned-byte-32)
29   (:generator 5
30     (aver (not (= count 0)))
31     (cond
32       ;; FIXME: all these 2s should be n-fixnum-tag-bits.
33       ((= count 2))
34       ((> count 2) (inst rotlwi res integer (- count 2)))
35       (t (inst rotrwi res integer (- 2 count))))))
36
37 (macrolet ((def (name arg-type)
38              `(define-vop (,name)
39                (:policy :fast-safe)
40                (:translate %unsigned-32-rotate-byte)
41                (:note "inline 32-bit rotation")
42                (:args (count :scs (sb-vm::signed-reg))
43                       (integer :scs (sb-vm::unsigned-reg) :target res))
44                (:arg-types sb-vm::tagged-num ,arg-type)
45                (:temporary (:scs (sb-vm::unsigned-reg) :from (:argument 0))
46                            realcount)
47                (:results (res :scs (sb-vm::unsigned-reg)))
48                (:result-types sb-vm::unsigned-byte-32)
49                (:generator 10
50                 (let ((label (gen-label))
51                       (end (gen-label)))
52                   (inst cmpwi count 0)
53                   (inst bge label)
54                   (inst addi realcount count 32)
55                   (inst rotlw res integer realcount)
56                   (inst b end)
57                   (emit-label label)
58                   (inst rotlw res integer count)
59                   (emit-label end))))))
60   (def %32bit-rotate-byte sb-vm::unsigned-byte-32)
61   ;; FIXME: see x86-vm.lisp
62   (def %32bit-rotate-byte-fixnum sb-vm::positive-fixnum))