contrib/sb-rotate-byte/x86-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     (move res integer)
  17     (if (> count 0)
  18         (inst rol res count)
  19         (inst ror res (- count)))))
  20
  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))))))
  38
  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:
  70   ;;
  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)
  76   ;;
  77   ;; so better leave it in.
  78   (def %32bit-rotate-byte-fixnum sb-vm::positive-fixnum))