mango/host/assembler/opcodes.fnl

98 lines
2.8 KiB
Fennel

(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}