2020-09-20 17:55:06 +00:00
|
|
|
(local {: program} (require "asm"))
|
2020-09-17 02:34:36 +00:00
|
|
|
(local {: stream : kvstream : one} (require "stream"))
|
|
|
|
|
|
|
|
(local prg (program))
|
2020-09-20 17:55:06 +00:00
|
|
|
(local code1 (prg:org 0xc00))
|
|
|
|
|
|
|
|
; (prg:block :print-chars-forever 0x0c00
|
|
|
|
; :start
|
|
|
|
; [:dex]
|
|
|
|
; [:txa]
|
|
|
|
; [:jsr :0xfded]
|
|
|
|
; [:jmp :start])
|
|
|
|
(local vm {
|
|
|
|
:IP :0x40
|
|
|
|
:IPH :0x41
|
|
|
|
:W :0x42
|
|
|
|
:WH :0x43
|
|
|
|
:ROFF :0x44
|
|
|
|
:TOP :0x80
|
|
|
|
:TOPH :0x81
|
|
|
|
:ST1 :0x7e
|
|
|
|
:ST1H :0x7f
|
|
|
|
:ST2 :0x7c
|
|
|
|
:ST2H :0x7d
|
|
|
|
:RSTACK :0x6000
|
|
|
|
:ret (fn [self] [:jmp :next])
|
|
|
|
:push
|
|
|
|
(fn [self v]
|
|
|
|
(local l (bit.band v 0xff))
|
|
|
|
(local h (bit.band (bit.rshift v 8) 0xff))
|
|
|
|
[:block
|
|
|
|
[:inx]
|
|
|
|
[:inx]
|
|
|
|
[:lda l]
|
|
|
|
[:sta [self.TOP :x]]
|
|
|
|
[:lda h]
|
|
|
|
[:sta [self.TOPH :x]]
|
|
|
|
])
|
|
|
|
:drop (fn [self] [:block [:dex] [:dex]])
|
|
|
|
:def
|
|
|
|
(fn [self name ...]
|
|
|
|
(code1:append name (table.unpack (lume.concat [...] [(self:ret)]))))
|
|
|
|
})
|
|
|
|
(fn inc16 [l h]
|
|
|
|
[:block
|
|
|
|
[:inc l]
|
|
|
|
[:bne :done]
|
|
|
|
[:inc h]
|
|
|
|
:done
|
|
|
|
])
|
|
|
|
(fn add16 [l h]
|
|
|
|
[:block
|
|
|
|
[:adc 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)
|
|
|
|
[:jmp [vm.W]])
|
|
|
|
|
|
|
|
(vm:def
|
|
|
|
[:pla] [:sta vm.IP] [:pla] [:sta vm.IPH]
|
|
|
|
(inc16 vm.IP vm.IPH))
|
|
|
|
|
|
|
|
(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]
|
|
|
|
:interpret ; usage: [jsr :interpret] followed by bytecode
|
|
|
|
[:pla] [:sta vm.IP] [:pla] [:sta vm.IPH]
|
|
|
|
(inc16 vm.IP vm.IPH))
|
|
|
|
|
|
|
|
(vm:def :ret
|
|
|
|
[:ldy vm.ROFF]
|
|
|
|
[:dey] [:lda vm.RSTACK :y] [:sta vm.IPH]
|
|
|
|
[:dey] [:lda vm.RSTACK :y] [:sta vm.IP]
|
|
|
|
[:sty vm.ROFF])
|
|
|
|
|
|
|
|
(code1:append :native [:jmp [vm.IP]])
|
|
|
|
(code1:append :quit [:rts])
|
|
|
|
|
|
|
|
(vm:def :mixed-hires
|
|
|
|
[:sta :0xc050]
|
|
|
|
[:sta :0xc057]
|
|
|
|
[:sta :0xc053])
|
|
|
|
|
|
|
|
(vm:def :drop (vm:drop))
|
|
|
|
|
|
|
|
(vm:def :dup
|
|
|
|
[:inx] [:inx]
|
|
|
|
[:lda vm.ST1H :x]
|
|
|
|
[:sta vm.TOPH :x]
|
|
|
|
[:lda vm.ST1 :x]
|
|
|
|
[:sta vm.TOP :x])
|
|
|
|
|
|
|
|
(vm:def :swap
|
|
|
|
[:lda vm.TOP :x]
|
|
|
|
[:ldy vm.ST1 :x]
|
|
|
|
[:sty vm.TOP :x]
|
|
|
|
[:sta vm.ST1 :x]
|
|
|
|
[:lda vm.TOPH :x]
|
|
|
|
[:ldy vm.ST1H :x]
|
|
|
|
[:sty vm.TOPH :x]
|
|
|
|
[:sta vm.ST1H :x])
|
|
|
|
|
|
|
|
(vm:def :>rot ; (a b c -- c a b)
|
|
|
|
[:lda vm.TOP :x] ; a: c (a b c)
|
|
|
|
[:ldy vm.ST2 :x] ; y: a (a b c)
|
|
|
|
[:sta vm.ST2 :x] ; a: c (c b c)
|
|
|
|
[:lda vm.ST1 :x] ; a: b (c b c)
|
|
|
|
[:sta vm.TOP :x] ; a: b (c b b)
|
|
|
|
[:sty vm.ST1 :x] ; y: a (c a b)
|
|
|
|
[:lda vm.TOPH :x] ; a: c (a b c)
|
|
|
|
[:ldy vm.ST2H :x] ; y: a (a b c)
|
|
|
|
[:sta vm.ST2H :x] ; a: c (c b c)
|
|
|
|
[:lda vm.ST1H :x] ; a: b (c b c)
|
|
|
|
[:sta vm.TOPH :x] ; a: b (c b b)
|
|
|
|
[:sty vm.ST1H :x] ; y: a (c a b)
|
|
|
|
)
|
|
|
|
(vm:def :<rot ; (a b c -- b c a)
|
|
|
|
[:lda vm.TOP :x] ; a: c (a b c)
|
|
|
|
[:ldy vm.ST1 :x] ; y: b (a b c)
|
|
|
|
[:sta vm.ST1 :x] ; a: c (a c c)
|
|
|
|
[:lda vm.ST2 :x] ; a: a (a c c)
|
|
|
|
[:sta vm.TOP :x] ; a: a (a c a)
|
|
|
|
[:sty vm.ST1 :x] ; y: b (b c a)
|
|
|
|
[:lda vm.TOPH :x] ; a: c (a b c)
|
|
|
|
[:ldy vm.ST1H :x] ; y: b (a b c)
|
|
|
|
[:sta vm.ST1H :x] ; a: c (a c c)
|
|
|
|
[:lda vm.ST2H :x] ; a: a (a c c)
|
|
|
|
[:sta vm.TOPH :x] ; a: a (a c a)
|
|
|
|
[:sty vm.ST1H :x] ; y: b (b c a)
|
|
|
|
)
|
|
|
|
|
|
|
|
(vm:def "@"
|
|
|
|
[:lda [vm.TOP :x]]
|
|
|
|
[:tay]
|
|
|
|
(inc16 vm.TOP vm.TOPH)
|
|
|
|
[:lda [vm.TOP :x]]
|
|
|
|
[:sta vm.TOPH :x]
|
|
|
|
[:sty vm.TOP :x])
|
|
|
|
|
|
|
|
(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))
|
2020-09-17 02:34:36 +00:00
|
|
|
|
|
|
|
(prg:assemble)
|
2020-09-20 17:55:06 +00:00
|
|
|
(set prg.start-symbol :mixed-hires)
|
|
|
|
prg
|