(defpackage "RC5-32/12/16"
  (:use "CL")
  (:nicknames "RC5")
  (:lock t))

(in-package "RC5")

(defun rotl (x y)
  (declare (type (unsigned-byte 32) x y))
  (let ((shift (mod y 32)))
    (logand 
     (logior (ash x shift)
             (ash x (- shift 32)))
     #xffffffff)))

(defun rotr (x y)
  (declare (type (unsigned-byte 32) x y))
  (let ((shift (mod (- 32 (mod y 32)) 32)))
    (logand 
     (logior (ash x (- shift 32))
             (ash x shift))
     #xffffffff)))

(defvar *s*)
(declaim (type (simple-array (unsigned-byte 32) (26)) *s*))

(defun encrypt (p0 p1)
  (declare (type (unsigned-byte 32) p0 p1))
  (do* ((a (logand (+ p0 (aref *s* 0)) #xffffffff)
           (logand (+ (rotl (logxor a b) b) (aref *s* (* 2 i))) #xffffffff))
        (b (logand (+ p1 (aref *s* 1)) #xffffffff)
           (logand (+ (rotl (logxor b a) a) (aref *s* (1+ (* 2 i)))) #xffffffff))
        (i 1 (1+ i)))
       ((> i 12) (values a b))
    (declare (type (unsigned-byte 32) a b))))

(defun decrypt (c0 c1)
  (declare (type (unsigned-byte 32) c0 c1))
  (do* ((b c1 (logxor (rotr (logand (- b (aref *s* (1+ (* 2 i)))) #xffffffff) a) a))
        (a c0 (logxor (rotr (logand (- a (aref *s* (* 2 i))) #xffffffff) b) b))
        (i 12 (1- i)))
       ((<= i 0) (values (logand (- a (aref *s* 0)) #xffffffff)
                         (logand (- b (aref *s* 1)) #xffffffff)))
    (declare (type (unsigned-byte 32) c0 c1))))

(defun setup (k)
  (declare (type (simple-array (unsigned-byte 8) (16)) k))
  (let ((l (make-array 4 :element-type '(unsigned-byte 32) :initial-element 0))
        (s (make-array 26 :element-type '(unsigned-byte 32))))
    (do ((i 15 (1- i)))
        ((< i 0))
      (setf (aref l (truncate i (/ 32 8)))
            (logior (ash (aref l (truncate i (/ 32 8))) 8) (aref k i))))
    (setf (aref s 0) #xb7e15163)
    (do ((i 1 (1+ i)))
        ((>= i 26))
      (setf (aref s i) (logand (+ (aref s (1- i)) #x9e3779b9) #xffffffff)))
    (do* ((a 0) 
          (b 0) 
          (k 0 (1+ k))
          (i 0 (mod (1+ i) 26))
          (j 0 (mod (1+ j) 4)))
         ((>= k (* 3 26)) (setf *s* s))
      (setf (aref s i) (rotl (logand (+ (aref s i) a b) #xffffffff) 3))
      (setf a (aref s i))
      (setf (aref l j) (rotl (logand (+ (aref l j) a b) #xffffffff) (logand (+ a b) #xffffffff)))
      (setf b (aref l j)))))

(sb-vm::defknown %rotr ((unsigned-byte 32) (unsigned-byte 5)) 
    (unsigned-byte 32)
  (sb-c::foldable sb-c::flushable sb-c::movable))
(sb-vm::define-vop (%rotr)
  (:policy :fast-safe)
  (:translate %rotr)
  (:note "inline 32-bit rotation")
  (:args (integer :scs (sb-vm::unsigned-reg))
         (count :scs (sb-vm::unsigned-reg) :target ecx))
  (:arg-types sb-vm::unsigned-num sb-vm::unsigned-num)
  (:temporary (:sc sb-vm::unsigned-reg :offset sb-vm::ecx-offset) ecx)
  (:results (res :scs (sb-vm::unsigned-reg)))
  (:result-types sb-vm::unsigned-num)
  (:generator 5
     (sb-vm::move res integer)
     (sb-vm::move ecx count)
     (sb-vm::inst sb-vm::ror res :cl)))

(defun foo (x y)
  (declare (type (unsigned-byte 32) x)
           (type (unsigned-byte 5) y))
  (%rotr x y))