fey.naomi/mango
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat: add assembler test file

Browse Source
This commit is contained in:
Fey Naomi Schrewe 2025-10-15 21:04:23 +02:00
parent 99f6e167ea
commit dcf9b5e89d
3 changed files with 117 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
host/assembler.fnl
View File

@ -1 +1,44 @@
(local opcodes (require :host.assembler.opcodes)) (local
{: r
: move
: branch
: branch-link}
(require :host.assembler.opcodes))
(local {: any : slice : push} (require :deps.lume))
(fn label [name] {:label name})
(fn label? [value]
(if (and (= (type value) :table) (. value :label)) true false))
(fn insert-label [table label index]
(if (. table :label)
(:error (.. "Duplicate label " label))
(tset table :labels label index)))
(fn assemble [forms offset]
(let [state {:labels {} :instructions [] :reverse-labels []}]
(each [_ form (ipairs forms)]
(if (= (type form) :string)
(insert-label state form (+ offset (* 4 (length (. state :instructions)))))
(push (. state :instructions)
(if (any (slice form 2) label?)
(do
(push (. state :reverse-labels) (+ 1 (length (. state :instructions))))
form)
((. form 1) (table.unpack (slice form 2)))))))
state))
(fn link [{: labels : instructions : reverse-labels}]
())
(macro x [...]
`[,(unpack (icollect [_ form (ipairs ...)] '[,(. form 1)]))])
(macrodebug (x (move (r 9) (r 8))))
(assemble
[[move (r 8) (r 2)]
:label-1
[move (r 9) (r 3)]
[branch (label :label-1)]]
0x8000)

142
host/assembler/opcodes.fnl
View File

@ -1,95 +1,95 @@
(local util (require :host.util)) (local util (require :host.util))
(macro construct-code [& forms] (macro construct-opcode [& forms]
`(bor `(bor ,(unpack
,(unpack (icollect [i n (ipairs forms)]
(icollect [i n (ipairs forms)] `(lshift ,(. n 1) ,(. n 2)))))) `(lshift ,(. n 1) ,(. n 2))))))
(local conditions {:equal 0x0 (local conditions {:equal 0x0
:not-equal 0x1 :not-equal 0x1
:carry 0x2 :carry 0x2
:not-carry 0x3 :not-carry 0x3
:negative 0x4 :negative 0x4
:positive 0x5 :positive 0x5
:overflow 0x6 :overflow 0x6
:no-overflow 0x7 :no-overflow 0x7
:higher-unsigned 0x8 :higher-unsigned 0x8
:lower-unsigned 0x9 :lower-unsigned 0x9
:greater-equal-signed 0xa :greater-equal-signed 0xa
:less-signed 0xb :less-signed 0xb
:greater-signed 0xc :greater-signed 0xc
:less-equal-signed 0xd :less-equal-signed 0xd
:always 0xe}) :always 0xe})
(fn r [n] (fn r [n]
"Create a register for use in instructions" "Create a register for use in instructions"
{:register (case n {:register (case n
:pc 0xf :pc 0xf
:lr 0xe :lr 0xe
:sp 0xd :sp 0xd
n n)}) n n)})
(fn register? [x] (fn register? [x]
(and (= (type x) :table) (. x :register))) (and (= (type x) :table) (. x :register)))
(fn bit [flag] (fn bit [flag]
"Convert a boolean to an integer for shifting" "Convert a boolean to an integer for shifting"
(if flag 1 0)) (if flag 1 0))
(fn calculate-rotation [x] (fn calculate-rotation [x]
"Construct a valid arm rotation of x" "Construct a valid arm rotation of x"
(faccumulate [acc nil i 0 32 2 &until acc] (faccumulate [acc nil i 0 32 2 &until acc]
(let [rotated (util.rotate-left x i)] (if (<= rotated 0xff) i)))) (let [rotated (util.rotate-left x i)] (if (<= rotated 0xff) i))))
(fn parse-conditions [?options] (fn parse-conditions [?options]
(let [{:cond cond :flags set-flags} (or ?options {}) (let [{:cond cond :flags set-flags} (or ?options {})
set-flags (bit (or set-flags false)) set-flags (bit (or set-flags false))
cond (. conditions (or cond :always))] cond (. conditions (or cond :always))]
{: cond : set-flags})) {: cond : set-flags}))
(fn move [dest source ?options] (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/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}]} :fnl/arglist [dest source & {: cond : flags}]}
(let [{: cond : set-flags} (parse-conditions ?options) (let [{: cond : set-flags} (parse-conditions ?options)
source-register (register? source) source-register (register? source)
dest (register? dest)] dest (register? dest)]
(when (not dest) (error "dest must be a register")) (when (not dest) (error "dest must be a register"))
(if source-register (if source-register
(bor (bor
(lshift cond 28) (lshift cond 28)
(lshift 0xd 21) (lshift 0xd 21)
(lshift set-flags 20) (lshift set-flags 20)
(lshift dest 12) (lshift dest 12)
source-register) source-register)
(let [rotation (calculate-rotation source)] (let [rotation (calculate-rotation source)]
(when (= nil rotation) (error "Unencodable immediate value")) (when (= nil rotation) (error "Unencodable immediate value"))
(bor (bor
(lshift cond 28) (lshift cond 28)
(lshift 1 25) (lshift 1 25)
(lshift 0xd 21) (lshift 0xd 21)
(lshift set-flags 20) (lshift set-flags 20)
(lshift dest 12) (lshift dest 12)
(lshift (/ rotation 2) 8) (lshift (/ rotation 2) 8)
(band (util.rotate-left source rotation) 0xff)))))) (band (util.rotate-left source rotation) 0xff))))))
(fn branch [offset ?options] (fn branch [offset ?options]
(let [{: cond} (parse-conditions ?options) (let [{: cond} (parse-conditions ?options)
max-immediate 0xffffff max-immediate 0xffffff
offset (band offset util.word-max)] offset (band offset util.word-max)]
(bor (bor
(lshift cond 28) (lshift cond 28)
(lshift 10 24) (lshift 10 24)
(band (rshift offset 2) 0xffffff)))) (band (rshift offset 2) 0xffffff))))
(fn branch-link [offset ?options] (fn branch-link [offset ?options]
(let [{: cond} (parse-conditions ?options) (let [{: cond} (parse-conditions ?options)
max-immediate 0xffffff max-immediate 0xffffff
offset (band offset util.word-max)] offset (band offset util.word-max)]
(bor (bor
(lshift cond 28) (lshift cond 28)
(lshift 11 24) (lshift 11 24)
(band (rshift offset 2) 0xffffff)))) (band (rshift offset 2) 0xffffff))))
{: r {: r
: move : move

2
test/assembler/opcodes.fnl Normal file
View File

@ -0,0 +1,2 @@
(local t (require :deps.faith))
(local opcodes (require :host.assembler.opcodes))