Working Forthy example!

This commit is contained in:
Jeremy Penner 2020-09-20 21:39:17 -04:00
parent 1a93fc7e84
commit bae9bdf768
2 changed files with 100 additions and 41 deletions

50
asm.fnl
View file

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

View file

@ -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