Fix sequence type derivation in the presence of negation types.
[sbcl.git] / contrib / sb-rotate-byte / arm-vm.lisp
blob3ca5d528e908f26e57cd5bf85eb45b08e268c439
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 (inst mov res (sb-vm::ror integer (if (plusp count)
17 (- 32 count)
18 (- count))))))
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 ((= count n-fixnum-tag-bits))
34 (inst mov res (sb-vm::ror integer (if (> count 2)
35 (- (+ 32 n-fixnum-tag-bits) count)
36 (- 2 count))))))))
38 (macrolet ((def (name arg-type)
39 `(define-vop (,name)
40 (:policy :fast-safe)
41 (:translate %unsigned-32-rotate-byte)
42 (:note "inline 32-bit rotation")
43 (:args (count :scs (sb-vm::signed-reg) :target res)
44 (integer :scs (sb-vm::unsigned-reg)))
45 (:arg-types sb-vm::tagged-num ,arg-type)
46 (:results (res :scs (sb-vm::unsigned-reg)))
47 (:result-types sb-vm::unsigned-byte-32)
48 (:generator 10
49 (inst cmp count 0)
50 (inst rsb :gt res count 32)
51 (inst rsb :le res count 0)
52 (inst mov res (sb-vm::ror integer res))))))
53 (def %32bit-rotate-byte sb-vm::unsigned-byte-32)
54 ;; FIXME: see x86-vm.lisp
55 (def %32bit-rotate-byte-fixnum sb-vm::positive-fixnum))