Working Forthy example!
This commit is contained in:
parent
1a93fc7e84
commit
bae9bdf768
50
asm.fnl
50
asm.fnl
|
|
@ -77,7 +77,7 @@
|
|||
(fn parse-mode-arg [op]
|
||||
(match op
|
||||
[_ :a] [:a nil]
|
||||
([_ imm] ? (= (type imm) "number")) [:imm imm]
|
||||
([_ imm] ? (or (= (type imm) "number") (= (type imm) "function"))) [:imm imm]
|
||||
([opcode addr] ? (and (= (type addr) "string") (= (opcode:sub 1 1) "b"))) [:rel addr] ; branch
|
||||
[_ addr :x] [:addr-x addr]
|
||||
[_ [addr] :y] [:zp*-y addr]
|
||||
|
|
@ -92,20 +92,20 @@
|
|||
; takes the form [:op args]
|
||||
; pdat - a parsed dat; takes the form {:type type :addr addr ...}
|
||||
(local dat-parser {})
|
||||
(fn new-block [] {:type :block :pdats [] :symbols {}})
|
||||
|
||||
(fn parse-dats [block dats]
|
||||
(var index (+ (length block.pdats) 1))
|
||||
(each [_ dat (ipairs dats)]
|
||||
(if (= (type dat) "string")
|
||||
(tset block.symbols dat index)
|
||||
(tset block.symbols dat (+ (length block.pdats) 1))
|
||||
(let [opcode (. dat 1)
|
||||
parser (. dat-parser opcode)
|
||||
pdat
|
||||
(if
|
||||
parser (parser dat)
|
||||
parser (parser dat block)
|
||||
(. opcodes opcode) (dat-parser.op dat)
|
||||
(error (.. "Unrecognized opcode " (fv opcode))))]
|
||||
(table.insert block.pdats pdat)
|
||||
(set index (+ index 1)))))
|
||||
(table.insert block.pdats pdat))))
|
||||
block)
|
||||
|
||||
(fn dat-parser.op [op]
|
||||
|
|
@ -115,11 +115,14 @@
|
|||
(fn dat-parser.block [block]
|
||||
(let [dats (table.clone block)]
|
||||
(table.remove dats 1)
|
||||
(parse-dats {:type :block :pdats [] :symbols {}} dats)))
|
||||
(parse-dats (new-block) dats)))
|
||||
|
||||
(fn dat-parser.db [db] {:type :var :init (. db 2) :size 1})
|
||||
(fn dat-parser.dw [dw] {:type :var :init (. dw 2) :size 2})
|
||||
(fn dat-parser.bytes [bytes] {:type :raw : bytes})
|
||||
(fn dat-parser.ref [ref] {:type :ref :target (. ref 2)})
|
||||
(fn dat-parser.flatten [flat block]
|
||||
(parse-dats block (lume.slice flat 2)))
|
||||
|
||||
(fn make-env [block parent]
|
||||
{:parent parent
|
||||
|
|
@ -137,18 +140,26 @@
|
|||
|
||||
(self.parent:lookup-addr name)))})
|
||||
|
||||
|
||||
(fn lo [v] (bit.band v 0xff))
|
||||
(fn hi [v] (bit.band (bit.rshift v 8) 0xff))
|
||||
(fn int8-to-bytes [i]
|
||||
(string.char (bit.band i 0xff)))
|
||||
(string.char (lo i)))
|
||||
(fn int16-to-bytes [i]
|
||||
(string.char (bit.band i 0xff) (bit.band (bit.rshift i 8) 0xff)))
|
||||
(string.char (lo i) (hi i)))
|
||||
|
||||
(local pdat-processor {
|
||||
:op {}
|
||||
:var {}
|
||||
:ref {}
|
||||
:raw {}
|
||||
:block {}
|
||||
})
|
||||
|
||||
(fn process-pdat [pdat process default ...]
|
||||
(local processor (. pdat-processor pdat.type process))
|
||||
(if processor (processor pdat ...) default))
|
||||
|
||||
(fn pdat-processor.op.patch [op env]
|
||||
(when (and op.mode (= (op.mode:sub 1 4) :addr))
|
||||
(let [zp-mode (.. :zp (op.mode:sub 5))
|
||||
|
|
@ -159,6 +170,7 @@
|
|||
(fn pdat-processor.raw.size [raw] (length raw.bytes))
|
||||
(fn pdat-processor.op.size [op] (size op.mode))
|
||||
(fn pdat-processor.var.size [d] d.size)
|
||||
(fn pdat-processor.ref.size [r] 2)
|
||||
|
||||
(fn pdat-processor.op.bytes [op env]
|
||||
(local bytegen (. opcodes op.opcode))
|
||||
|
|
@ -167,11 +179,14 @@
|
|||
(let [opbyte (bytegen op.mode)
|
||||
argbytes
|
||||
(if
|
||||
(and (= op.mode :imm) (= (type op.arg) "function"))
|
||||
(int8-to-bytes (op.arg env))
|
||||
|
||||
(= op.mode :imm) (int8-to-bytes op.arg)
|
||||
(= op.mode :rel)
|
||||
(int8-to-bytes (- (env:lookup-addr op.arg env) (+ op.addr 2)))
|
||||
(= (size op.mode) 2) (int8-to-bytes (env:lookup-addr op.arg env))
|
||||
(= (size op.mode) 3) (int16-to-bytes (env:lookup-addr op.arg env))
|
||||
(int8-to-bytes (- (env:lookup-addr op.arg) (+ op.addr 2)))
|
||||
(= (size op.mode) 2) (int8-to-bytes (env:lookup-addr op.arg))
|
||||
(= (size op.mode) 3) (int16-to-bytes (env:lookup-addr op.arg))
|
||||
"")]
|
||||
(if opbyte
|
||||
(.. (int8-to-bytes opbyte) argbytes)
|
||||
|
|
@ -182,10 +197,8 @@
|
|||
1 (int8-to-bytes (or d.init 0))
|
||||
2 (int16-to-bytes (or d.init 0))
|
||||
n (string.rep "\0" n)))
|
||||
|
||||
(fn process-pdat [pdat process default ...]
|
||||
(local processor (. pdat-processor pdat.type process))
|
||||
(if processor (processor pdat ...) default))
|
||||
(fn pdat-processor.ref.bytes [ref env]
|
||||
(int16-to-bytes (env:lookup-addr ref.target)))
|
||||
|
||||
(fn pdat-processor.block.symbols [block]
|
||||
(lume.keys block.symbols))
|
||||
|
|
@ -226,7 +239,7 @@
|
|||
(fn [self org]
|
||||
(var block (. self.org-to-block org))
|
||||
(when (not block)
|
||||
(set block {:type :block :pdats [] :symbols {}})
|
||||
(set block (new-block))
|
||||
(tset self.org-to-block org block))
|
||||
{: block
|
||||
:append (fn [self ...] (parse-dats self.block [...]) self)})
|
||||
|
|
@ -267,4 +280,5 @@
|
|||
(machine:write org block.bytes)))
|
||||
})
|
||||
|
||||
{: program}
|
||||
{: program : dat-parser : pdat-processor : new-block : parse-dats : lo : hi}
|
||||
|
||||
|
|
|
|||
91
test.fnl
91
test.fnl
|
|
@ -1,23 +1,38 @@
|
|||
(local {: program} (require "asm"))
|
||||
(local {: program : dat-parser : new-block : parse-dats : lo : hi} (require "asm"))
|
||||
(local {: stream : kvstream : one} (require "stream"))
|
||||
|
||||
(local prg (program))
|
||||
(local code1 (prg:org 0xc00))
|
||||
|
||||
; (prg:block :print-chars-forever 0x0c00
|
||||
; :start
|
||||
; [:dex]
|
||||
; [:txa]
|
||||
; [:jsr :0xfded]
|
||||
; [:jmp :start])
|
||||
(fn dat-parser.vm [bytecodes]
|
||||
(local block (new-block))
|
||||
(each [_ bytecode (ipairs (lume.slice bytecodes 2))]
|
||||
(if
|
||||
(= (type bytecode) :number)
|
||||
(parse-dats block [[:ref :lit] [:dw bytecode]])
|
||||
|
||||
(= (type bytecode) :string)
|
||||
(parse-dats block [[:ref bytecode]])
|
||||
|
||||
(= (type bytecode) :table)
|
||||
(parse-dats block bytecode)
|
||||
|
||||
(error (.. "VM can't parse " (fv bytecode)))))
|
||||
block)
|
||||
(local mon {
|
||||
:hexout :0xfdda
|
||||
:putchar :0xfded
|
||||
:bell :0xff3a
|
||||
})
|
||||
|
||||
(local vm {
|
||||
:IP :0x40
|
||||
:IPH :0x41
|
||||
:W :0x42
|
||||
:WH :0x43
|
||||
:ROFF :0x44
|
||||
:IP :0x60
|
||||
:IPH :0x61
|
||||
:W :0x62
|
||||
:WH :0x63
|
||||
:ROFF :0x64
|
||||
:TOP :0x80
|
||||
:TOPH :0x81
|
||||
:TOPH :0x81
|
||||
:ST1 :0x7e
|
||||
:ST1H :0x7f
|
||||
:ST2 :0x7c
|
||||
|
|
@ -40,7 +55,11 @@
|
|||
:def
|
||||
(fn [self name ...]
|
||||
(code1:append name (table.unpack (lume.concat [...] [(self:ret)]))))
|
||||
:word
|
||||
(fn [self name ...]
|
||||
(code1:append name [:jsr :subroutine] [:vm ...] [:vm :ret]))
|
||||
})
|
||||
|
||||
(fn inc16 [l h]
|
||||
[:block
|
||||
[:inc l]
|
||||
|
|
@ -50,27 +69,38 @@
|
|||
])
|
||||
(fn add16 [l h]
|
||||
[:block
|
||||
[:clc]
|
||||
[:adc l]
|
||||
[:sta l]
|
||||
[:bcc :go]
|
||||
[:inc h]
|
||||
:go
|
||||
])
|
||||
|
||||
(code1:append :next
|
||||
[:lda vm.IP] [:sta vm.W]
|
||||
[:lda vm.IPH] [:sta vm.WH]
|
||||
[:lda 2] (add16 vm.IP vm.IPH)
|
||||
[:ldy 0]
|
||||
[:lda [vm.IP] :y] [:sta vm.W]
|
||||
(inc16 vm.IP vm.IPH)
|
||||
[:lda [vm.IP] :y] [:sta vm.WH]
|
||||
(inc16 vm.IP vm.IPH)
|
||||
[:jmp [vm.W]])
|
||||
|
||||
(vm:def
|
||||
[:pla] [:sta vm.IP] [:pla] [:sta vm.IPH]
|
||||
(inc16 vm.IP vm.IPH))
|
||||
(code1:append :reset
|
||||
[:lda #(lo ($1:lookup-addr :quit))]
|
||||
[:sta vm.IP]
|
||||
[:lda #(hi ($1:lookup-addr :quit))]
|
||||
[:sta vm.IPH]
|
||||
[:lda 0]
|
||||
[:sta vm.ROFF]
|
||||
[:ldx 0xfe]
|
||||
[:rts])
|
||||
|
||||
(vm:def
|
||||
:subroutine ; usage: [jsr :subroutine] followed by bytecode
|
||||
[:ldy vm.ROFF]
|
||||
[:lda vm.IP] [:sta vm.RSTACK :y] [:iny]
|
||||
[:lda vm.IPH] [:sta vm.RSTACK :y] [:iny]
|
||||
[:sty vm.ROFF]
|
||||
:interpret ; usage: [jsr :interpret] followed by bytecode
|
||||
[:pla] [:sta vm.IP] [:pla] [:sta vm.IPH]
|
||||
(inc16 vm.IP vm.IPH))
|
||||
|
|
@ -147,10 +177,25 @@
|
|||
|
||||
(vm:def :lit
|
||||
[:inx] [:inx] [:ldy 0]
|
||||
[:lda [vm.IP] :y] [:sta [vm.TOP :x]]
|
||||
[:lda [vm.IPH] :y] [:sta [vm.TOP :x]]
|
||||
[:lda 2] (add16 vm.IP vm.IPH))
|
||||
[:lda [vm.IP] :y] [:sta vm.TOP :x]
|
||||
(inc16 vm.IP vm.IPH)
|
||||
[:lda [vm.IP] :y] [:sta vm.TOPH :x]
|
||||
(inc16 vm.IP vm.IPH))
|
||||
|
||||
(vm:def :.
|
||||
[:lda vm.TOPH :x]
|
||||
[:jsr mon.hexout]
|
||||
[:lda vm.TOP :x]
|
||||
[:jsr mon.hexout]
|
||||
[:lda (string.byte " ") ]
|
||||
[:jsr mon.putchar]
|
||||
(vm:drop))
|
||||
|
||||
(code1:append :main
|
||||
[:jsr :reset]
|
||||
[:jsr :interpret]
|
||||
[:vm 0xbabe 0xcafe :. :. :quit])
|
||||
|
||||
(prg:assemble)
|
||||
(set prg.start-symbol :mixed-hires)
|
||||
|
||||
prg
|
||||
|
|
|
|||
Loading…
Reference in a new issue