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))