contrib/sb-rotate-byte/x86-64-vm.lisp

   1 (in-package "SB-ROTATE-BYTE")
   2
   3 \f
   4 ;;; 32-bit rotates
   5
   6 (define-vop (%32bit-rotate-byte/c)
   7   (:policy :fast-safe)
   8   (:translate %unsigned-32-rotate-byte)
   9   (:note "inline 32-bit constant rotation")
  10   (:args (integer :scs (sb-vm::unsigned-reg) :target result))
  11   (:info count)
  12   (:arg-types (:constant (integer -31 31)) sb-vm::unsigned-num)
  13   (:results (result :scs (sb-vm::unsigned-reg)))
  14   (:result-types sb-vm::unsigned-num)
  15   (:generator 5
  16     (aver (not (= count 0)))
  17     (move result integer)
  18     (if (> count 0)
  19         (inst rol (sb-vm::reg-in-size result :dword) count)
  20         (inst ror (sb-vm::reg-in-size result :dword) count))))
  21
  22 (define-vop (%32bit-rotate-byte)
  23   (:policy :fast-safe)
  24   (:translate %unsigned-32-rotate-byte)
  25   (:args (count :scs (sb-vm::signed-reg) :target rcx)
  26          (integer :scs (sb-vm::unsigned-reg) :target result))
  27   (:arg-types sb-vm::tagged-num sb-vm::unsigned-num)
  28   (:temporary (:sc sb-vm::signed-reg :offset sb-vm::rcx-offset)
  29               rcx)
  30   (:results (result :scs (sb-vm::unsigned-reg) :from :load))
  31   (:result-types sb-vm::unsigned-num)
  32   (:generator 10
  33     (let ((label (gen-label))
  34           (end (gen-label)))
  35       (move result integer)
  36       (move rcx count)
  37       (inst cmp (sb-vm::reg-in-size rcx :dword) 0)
  38       (inst jmp :ge label)
  39       (inst neg (sb-vm::reg-in-size rcx :dword))
  40       (inst ror (sb-vm::reg-in-size result :dword) :cl)
  41       (inst jmp end)
  42       (emit-label label)
  43       (inst rol (sb-vm::reg-in-size result :dword) :cl)
  44       (emit-label end))))
  45 \f
  46 ;;; 64-bit rotates
  47
  48 (define-vop (%64bit-rotate-byte/c)
  49   (:policy :fast-safe)
  50   (:translate %unsigned-64-rotate-byte)
  51   (:note "inline 64-bit constant rotation")
  52   (:args (integer :scs (sb-vm::unsigned-reg) :target result))
  53   (:info count)
  54   (:arg-types (:constant (integer -63 63)) sb-vm::unsigned-num)
  55   (:results (result :scs (sb-vm::unsigned-reg)))
  56   (:result-types sb-vm::unsigned-num)
  57   (:generator 5
  58     (aver (not (= count 0)))
  59     (move result integer)
  60     (if (> count 0)
  61         (inst rol result count)
  62         (inst ror result (- count)))))
  63
  64 (define-vop (%64bit-rotate-byte)
  65   (:policy :fast-safe)
  66   (:translate %unsigned-64-rotate-byte)
  67   (:args (count :scs (sb-vm::signed-reg) :target rcx)
  68          (integer :scs (sb-vm::unsigned-reg) :target result))
  69   (:arg-types sb-vm::tagged-num sb-vm::unsigned-num)
  70   (:temporary (:sc sb-vm::signed-reg :offset sb-vm::rcx-offset)
  71               rcx)
  72   (:results (result :scs (sb-vm::unsigned-reg) :from :load))
  73   (:result-types sb-vm::unsigned-num)
  74   (:generator 10
  75     (let ((label (gen-label))
  76           (end (gen-label)))
  77       (move result integer)
  78       (move rcx count)
  79       (inst cmp rcx 0)
  80       (inst jmp :ge label)
  81       (inst neg rcx)
  82       (inst ror result :cl)
  83       (inst jmp end)
  84       (emit-label label)
  85       (inst rol result :cl)
  86       (emit-label end))))