62 lines
2.3 KiB
Fennel
62 lines
2.3 KiB
Fennel
(local
|
|
{: r
|
|
: move
|
|
: branch
|
|
: branch-link
|
|
: relocatable-instructions}
|
|
(require :host.assembler.opcodes))
|
|
(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]
|
|
(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 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)]
|
|
(if (= (type form) :string)
|
|
(insert-label state form (+ offset (* 4 (length (. state :instructions)))))
|
|
(push (. state :instructions)
|
|
(if (any (slice form 2) label?)
|
|
(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} 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)
|
|
|
|
(map (link (assemble
|
|
[[move (r 8) (r 2)]
|
|
:label-1
|
|
[move (r 9) (r 3)]
|
|
[branch (label :label-1)]]
|
|
0x8000)
|
|
0x8000) hex)
|