(local util (require :host.util))

(macro construct-opcode [& forms]
  `(bor ,(unpack 
           (icollect [i n (ipairs forms)]
                     `(lshift ,(. n 1) ,(. n 2))))))

(local conditions {:equal 0x0
                   :not-equal 0x1
                   :carry 0x2
                   :not-carry 0x3
                   :negative 0x4
                   :positive 0x5
                   :overflow 0x6
                   :no-overflow 0x7
                   :higher-unsigned 0x8
                   :lower-unsigned 0x9
                   :greater-equal-signed 0xa
                   :less-signed 0xb
                   :greater-signed 0xc
                   :less-equal-signed 0xd
                   :always 0xe})

(fn r [n]
  "Create a register for use in instructions"
  {:register (case n
               :pc 0xf
               :lr 0xe
               :sp 0xd
               n n)})

(fn register? [x]
  (and (= (type x) :table) (. x :register)))


(fn bit [flag]
  "Convert a boolean to an integer for shifting"
  (if flag 1 0))

(fn calculate-rotation [x]
  "Construct a valid arm rotation of x"
  (faccumulate [acc nil i 0 32 2 &until acc]
               (let [rotated (util.rotate-left x i)] (if (<= rotated 0xff) i))))

(fn parse-conditions [?options]
  (let [{:cond cond :flags set-flags} (or ?options {})
        set-flags (bit (or set-flags false))
        cond (. conditions (or cond :always))]
    {: cond : set-flags}))

(fn move [dest source ?options]
  {:fnl/docstring "Set register *dest* to a value\n*source* can be a register or an immediate value smaller than 4096"
   :fnl/arglist [dest source & {: cond : flags}]}
  (let [{: cond : set-flags} (parse-conditions ?options)
        source-register (register? source)
        dest (register? dest)]
    (when (not dest) (error "dest must be a register"))
    (if source-register
      (construct-opcode
        [cond 28]
        [0xd 21]
        [set-flags 20]
        [dest 12]
        [source-register 0])
      (let [rotation (calculate-rotation source)]
        (when (= nil rotation) (error "Unencodable immediate value"))
        (construct-opcode
          (cond 28)
          (1 25)
          (0xd 21)
          (set-flags 20)
          (dest 12)
          ((/ rotation 2) 8)
          ((band (util.rotate-left source rotation) 0xff) 0))))))

(fn branch [offset ?options]
  (let [{: cond} (parse-conditions ?options)
        max-immediate 0xffffff
        offset (band offset util.word-max)]
    (bor
      (lshift cond 28)
      (lshift 10 24)
      (band (rshift offset 2) 0xffffff))))

(fn branch-link [offset ?options]
  (let [{: cond} (parse-conditions ?options)
        max-immediate 0xffffff
        offset (band offset util.word-max)]
    (bor
      (lshift cond 28)
      (lshift 11 24)
      (band (rshift offset 2) 0xffffff))))

{: r
 : move
 : branch
 : branch-link}