(local util (require :host.util))
(local {: push} (require :deps.lume))

(local relocatable-instructions {})

(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 c [n]
  "Create a coprocessor register for use in instructions"
  {:coprocessor 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 immediate-12bit [x]
  "Calculate a 12 bit immediate value"
  (let [rotation (calculate-rotation x)]
    (when (= nil rotation) (error "Unencodable immediate value"))
    (bor
      (band (util.rotate-left x rotation) 0xff)
      (lshift (/ rotation 2) 8))))

(fn move [dest source ?options]
  {:fnl/docstring
   "Set register *dest* to a value\n*source* can be a register or an immediate value"
   :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])
      (construct-opcode
        (cond 28)
        (1 25)
        (0xd 21)
        (set-flags 20)
        (dest 12)
        (immediate-12bit source)))))

(fn subtract [offset ?options])

(fn branch [offset ?options]
  (let [{: cond} (parse-conditions ?options)
        max-immediate 0xffffff
        offset (band offset util.word-max)]
    (construct-opcode
      (cond 28)
      (10 24)
      ((band (rshift offset 2) 0xffffff) 0))))
(tset relocatable-instructions branch {:type :jump-24 :offset -8})

(fn branch-link [offset ?options]
  (let [{: cond} (parse-conditions ?options)
        max-immediate 0xffffff
        offset (band offset util.word-max)]
    (construct-opcode
      (cond 28)
      (11 24)
      ((band (rshift offset 2) 0xffffff) 0))))
(tset relocatable-instructions branch-link {:type :jump-24 :offset -8})

(fn branch-exchange [{: register} ?options]
  (let [{: cond} (parse-conditions ?options)]
    (construct-opcode
      (cond 28)
      (0x12fff1 4)
      (register 0))))

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