123 lines
3.4 KiB
Fennel
123 lines
3.4 KiB
Fennel
(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}
|