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

feat: implement linking

Browse Source
This commit is contained in:
Fey Naomi Schrewe 2025-11-02 20:56:12 +01:00
parent 0791b20f94
commit 537b7f8693
3 changed files with 115 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
host/assembler.fnl
View File

@ -2,10 +2,11 @@
{: r
: move
: branch
: branch-link}
: branch-link
: relocatable-instructions}
(require :host.assembler.opcodes))
(local {: any : slice : push : map} (require :deps.lume))
(local {: word->byte} (require :host.util))
(local {: any : slice : push : map :match find-pred} (require :deps.lume))
(local {: word->byte : hex} (require :host.util))
(fn label [name] {:label name})
(fn label? [value]
@ -16,6 +17,12 @@
(:error (.. "Duplicate label " label))
(tset table :labels label index)))
(fn replace-label!
[form offset]
"Replace the label form with *offset* for later linking"
(each [i v (ipairs form)] (when (label? v) (tset form i offset)))
form)
(fn assemble [forms offset]
(let [state {:labels {} :instructions [] :reverse-labels []}]
(each [_ form (ipairs forms)]
@ -23,18 +30,32 @@
(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)
(let [{: type :offset addend} (. relocatable-instructions (. form 1))]
(push (. state :reverse-labels) {: type :label (. (find-pred form label?) :label) :offset (+ offset (* 4 (length (. state :instructions))))})
((. form 1) (table.unpack (replace-label! (slice form 2) addend))))
((. form 1) (table.unpack (slice form 2)))))))
state))
; (fn link [{: labels : instructions : reverse-labels}]
; ())
(fn link [{: labels : instructions : reverse-labels} base]
(each [_ {: type :label target : offset} (ipairs reverse-labels)]
(match type
:jump-24 (let [index (+ 1 (/ (- offset base) 4))
instruction (. instructions index)
addend (lshift (band instruction 0xffffff) 2)
symbol (. labels target)
relocation (- (+ symbol addend) offset)
new-instruction
(bor
(band instruction (bnot 0xffffff))
(band (rshift relocation 2) 0xffffff))]
(print (hex (band (rshift relocation 2) 0xffffff)) (hex instruction) (hex new-instruction))
(tset instructions index new-instruction))))
instructions)
(assemble
[[move (r 8) (r 2)]
:label-1
[move (r 9) (r 3)]
[branch (label :label-1)]]
0x8000)
(map (link (assemble
[[move (r 8) (r 2)]
:label-1
[move (r 9) (r 3)]
[branch (label :label-1)]]
0x8000)
0x8000) hex)

49
host/assembler/opcodes.fnl
View File

@ -1,4 +1,7 @@
(local util (require :host.util))
(local {: push} (require :deps.lume))
(local relocatable-instructions {})
(macro construct-opcode [& forms]
`(bor ,(unpack
@ -29,6 +32,10 @@
: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)))
@ -48,8 +55,17 @@
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 smaller than 4096"
{: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)
@ -62,16 +78,15 @@
[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))))))
(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)
@ -81,6 +96,7 @@
(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)
@ -90,8 +106,17 @@
(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}
: branch-link
: relocatable-instructions}

43
target/boot.lasm Normal file
View File

@ -0,0 +1,43 @@
(config! {:address 0x8000})
(const! mmio-base 0x3f000000)
(label! :boot)
(move sp :boot)
; shut down cores 1-3
(move-to-coprocessor {:processor 15
:operations [0 5]
:source-register (r 5)
:dest-registers [(c 0) (c 0)]})
(and (r 5) (r 5) 3)
(cmp (r 5) 0)
(branch {:cond :not-equal} :halt)
;; set r3 to gpio base
(move (r 3) :mmio-base)
(or (r 3) (r 3) 0x200000)
;; set r4 to uart-base
(or (r 4) (r 4) 0x1000)
;; disable uart 0
(or (r 5) (r 4) 0x30)
(store (r 5) 0)
;;; see https://www.raspberrypi.org/app/uploads/2012/02/BCM2835-ARM-Peripherals.pdf
;;; pages 100 and following
;; disable pull-up/pull down
(or (r 5) (r 3) 0x94)
(store (r 5) 0)
;; delay for 150 cycles
(move (r 0) 150)
(branch-link :delay)
(label! end)
(branch :end)
(label! delay)
(subtract {:flags true} (r 0) 1)
(branch {:cond :not-equal} #delay)
(branch-exchange lr)