Tile-drawing routines, serial / monitor support
This commit is contained in:
parent
bae9bdf768
commit
9e6c849faf
10
asm.fnl
10
asm.fnl
|
@ -1,3 +1,4 @@
|
||||||
|
(local lume (require "lume"))
|
||||||
(local {: stream : kvstream : one} (require "stream"))
|
(local {: stream : kvstream : one} (require "stream"))
|
||||||
|
|
||||||
(local opcodes {})
|
(local opcodes {})
|
||||||
|
@ -119,7 +120,7 @@
|
||||||
|
|
||||||
(fn dat-parser.db [db] {:type :var :init (. db 2) :size 1})
|
(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.dw [dw] {:type :var :init (. dw 2) :size 2})
|
||||||
(fn dat-parser.bytes [bytes] {:type :raw : bytes})
|
(fn dat-parser.bytes [bytes] {:type :raw :bytes (. bytes 2)})
|
||||||
(fn dat-parser.ref [ref] {:type :ref :target (. ref 2)})
|
(fn dat-parser.ref [ref] {:type :ref :target (. ref 2)})
|
||||||
(fn dat-parser.flatten [flat block]
|
(fn dat-parser.flatten [flat block]
|
||||||
(parse-dats block (lume.slice flat 2)))
|
(parse-dats block (lume.slice flat 2)))
|
||||||
|
@ -131,7 +132,7 @@
|
||||||
:lookup-addr
|
:lookup-addr
|
||||||
(fn [self name]
|
(fn [self name]
|
||||||
(local ipdat (. self.block.symbols name))
|
(local ipdat (. self.block.symbols name))
|
||||||
(print "looking up" name "in" self)
|
; (print "looking up" name "in" self)
|
||||||
(if
|
(if
|
||||||
(and ipdat (> ipdat (length self.block.pdats)))
|
(and ipdat (> ipdat (length self.block.pdats)))
|
||||||
(+ self.block.addr self.block.size)
|
(+ self.block.addr self.block.size)
|
||||||
|
@ -174,7 +175,7 @@
|
||||||
|
|
||||||
(fn pdat-processor.op.bytes [op env]
|
(fn pdat-processor.op.bytes [op env]
|
||||||
(local bytegen (. opcodes op.opcode))
|
(local bytegen (. opcodes op.opcode))
|
||||||
(pp op)
|
; (pp op)
|
||||||
(if bytegen
|
(if bytegen
|
||||||
(let [opbyte (bytegen op.mode)
|
(let [opbyte (bytegen op.mode)
|
||||||
argbytes
|
argbytes
|
||||||
|
@ -226,6 +227,7 @@
|
||||||
(each [_ pdat (ipairs block.pdats)]
|
(each [_ pdat (ipairs block.pdats)]
|
||||||
(process-pdat pdat :generate nil block-env)
|
(process-pdat pdat :generate nil block-env)
|
||||||
(local pdatbytes (process-pdat pdat :bytes pdat.bytes block-env))
|
(local pdatbytes (process-pdat pdat :bytes pdat.bytes block-env))
|
||||||
|
(assert (= (type pdatbytes) :string) (.. "failed to generate bytes: " (fv pdat)))
|
||||||
(set pdat.bytes pdatbytes)
|
(set pdat.bytes pdatbytes)
|
||||||
(set bytes (.. bytes pdatbytes)))
|
(set bytes (.. bytes pdatbytes)))
|
||||||
(set block.bytes bytes))
|
(set block.bytes bytes))
|
||||||
|
@ -251,7 +253,7 @@
|
||||||
(< (tonumber name) 0x100)))
|
(< (tonumber name) 0x100)))
|
||||||
:lookup-addr
|
:lookup-addr
|
||||||
(fn [self name]
|
(fn [self name]
|
||||||
(print "looking up" name "in" self)
|
; (print "looking up" name "in" self)
|
||||||
(local org (. self.symbol-to-org name))
|
(local org (. self.symbol-to-org name))
|
||||||
(local addr (and org (: (make-env (. self.org-to-block org) self) :lookup-addr name)))
|
(local addr (and org (: (make-env (. self.org-to-block org) self) :lookup-addr name)))
|
||||||
(if (not= addr nil)
|
(if (not= addr nil)
|
||||||
|
|
BIN
luars232.so
Executable file
BIN
luars232.so
Executable file
Binary file not shown.
|
@ -39,6 +39,7 @@
|
||||||
(when self.socket
|
(when self.socket
|
||||||
(self.socket:close)
|
(self.socket:close)
|
||||||
(set self.socket nil)))
|
(set self.socket nil)))
|
||||||
|
:connected? (fn [self] self.socket)
|
||||||
:cmd (fn [self cmd] (self.socket:send (.. cmd "\n")))
|
:cmd (fn [self cmd] (self.socket:send (.. cmd "\n")))
|
||||||
:response
|
:response
|
||||||
(fn [self]
|
(fn [self]
|
||||||
|
|
1
main.lua
1
main.lua
|
@ -4,6 +4,7 @@ table.insert(package.loaders, fennel.make_searcher({correlate=true}))
|
||||||
fv = require("lib.fennelview")
|
fv = require("lib.fennelview")
|
||||||
pp = function(x) print(fv(x)) end
|
pp = function(x) print(fv(x)) end
|
||||||
lume = require("lume")
|
lume = require("lume")
|
||||||
|
luars232 = require("luars232")
|
||||||
|
|
||||||
function reload(modname)
|
function reload(modname)
|
||||||
package.loaded[modname] = nil
|
package.loaded[modname] = nil
|
||||||
|
|
55
serial.fnl
Normal file
55
serial.fnl
Normal file
|
@ -0,0 +1,55 @@
|
||||||
|
; using https://github.com/srdgame/librs232
|
||||||
|
(local rs232 (require :luars232))
|
||||||
|
(local command (require "core.command"))
|
||||||
|
|
||||||
|
(fn check [err ...]
|
||||||
|
(when (not= err rs232.RS232_ERR_NOERROR) (error (rs232.error_tostring err)))
|
||||||
|
...)
|
||||||
|
|
||||||
|
(fn open []
|
||||||
|
(local port (check (rs232.open "/dev/ttyUSB0")))
|
||||||
|
(port:set_baud_rate rs232.RS232_BAUD_9600)
|
||||||
|
(port:set_data_bits rs232.RS232_DATA_8)
|
||||||
|
(port:set_parity rs232.RS232_PARITY_NONE)
|
||||||
|
(port:set_stop_bits rs232.RS232_STOP_1)
|
||||||
|
(port:set_flow_control rs232.RS232_FLOW_HW)
|
||||||
|
port)
|
||||||
|
|
||||||
|
(local machine
|
||||||
|
{:connect
|
||||||
|
(fn [self]
|
||||||
|
(when (not self.port)
|
||||||
|
(set self.port (open))))
|
||||||
|
:disconnect
|
||||||
|
(fn [self]
|
||||||
|
(when self.port
|
||||||
|
(check (self.port:close))
|
||||||
|
(set self.port nil)))
|
||||||
|
:connected? (fn [self] self.port)
|
||||||
|
:cmd
|
||||||
|
(fn [self cmd]
|
||||||
|
(check (self.port:write (.. cmd "\r"))
|
||||||
|
(love.timer.sleep 0.08)))
|
||||||
|
:write
|
||||||
|
(fn [self addr bytes]
|
||||||
|
(var bytes-to-write bytes)
|
||||||
|
(var addrout addr)
|
||||||
|
(while (> (length bytes-to-write) 0)
|
||||||
|
(local bytesout (bytes-to-write:sub 1 10))
|
||||||
|
(local hexbytes (bytesout:gsub "." (fn [c] (string.format "%02X " (string.byte c)))))
|
||||||
|
(self:cmd (.. (string.format "%04X:" addrout) hexbytes))
|
||||||
|
(set bytes-to-write (bytes-to-write:sub 11))
|
||||||
|
(set addrout (+ addrout 10))))
|
||||||
|
:monitor (fn [self] (self:cmd "CALL-151"))
|
||||||
|
})
|
||||||
|
|
||||||
|
(command.add #(not (machine:connected?)) {
|
||||||
|
"serial:connect" #(machine:connect)
|
||||||
|
})
|
||||||
|
|
||||||
|
(command.add #(machine:connected?) {
|
||||||
|
"serial:disconnect" #(machine:disconnect)
|
||||||
|
"serial:start-monitor" #(machine:monitor)
|
||||||
|
})
|
||||||
|
|
||||||
|
machine
|
125
test.fnl
125
test.fnl
|
@ -1,8 +1,10 @@
|
||||||
|
(local lume (require "lume"))
|
||||||
(local {: program : dat-parser : new-block : parse-dats : lo : hi} (require "asm"))
|
(local {: program : dat-parser : new-block : parse-dats : lo : hi} (require "asm"))
|
||||||
(local {: stream : kvstream : one} (require "stream"))
|
(local {: stream : kvstream : one} (require "stream"))
|
||||||
|
|
||||||
(local prg (program))
|
(local prg (program))
|
||||||
(local code1 (prg:org 0xc00))
|
(local code1 (prg:org 0xc00))
|
||||||
|
(local tiles (prg:org 0x6100))
|
||||||
|
|
||||||
(fn dat-parser.vm [bytecodes]
|
(fn dat-parser.vm [bytecodes]
|
||||||
(local block (new-block))
|
(local block (new-block))
|
||||||
|
@ -47,9 +49,9 @@
|
||||||
[:inx]
|
[:inx]
|
||||||
[:inx]
|
[:inx]
|
||||||
[:lda l]
|
[:lda l]
|
||||||
[:sta [self.TOP :x]]
|
[:sta self.TOP :x]
|
||||||
[:lda h]
|
[:lda h]
|
||||||
[:sta [self.TOPH :x]]
|
[:sta self.TOPH :x]
|
||||||
])
|
])
|
||||||
:drop (fn [self] [:block [:dex] [:dex]])
|
:drop (fn [self] [:block [:dex] [:dex]])
|
||||||
:def
|
:def
|
||||||
|
@ -58,6 +60,9 @@
|
||||||
:word
|
:word
|
||||||
(fn [self name ...]
|
(fn [self name ...]
|
||||||
(code1:append name [:jsr :subroutine] [:vm ...] [:vm :ret]))
|
(code1:append name [:jsr :subroutine] [:vm ...] [:vm :ret]))
|
||||||
|
:inline
|
||||||
|
(fn [self ...]
|
||||||
|
[:block [:jsr :subroutine] [:vm ...] [:vm :restore]])
|
||||||
})
|
})
|
||||||
|
|
||||||
(fn inc16 [l h]
|
(fn inc16 [l h]
|
||||||
|
@ -76,6 +81,11 @@
|
||||||
[:inc h]
|
[:inc h]
|
||||||
:go
|
:go
|
||||||
])
|
])
|
||||||
|
(fn achar [c] (bit.bor (string.byte c) 0x80))
|
||||||
|
(fn astr [s]
|
||||||
|
(-> [(string.byte s 1 -1)]
|
||||||
|
(lume.map #(bit.bor $1 0x80))
|
||||||
|
(-> (table.unpack) (string.char))))
|
||||||
|
|
||||||
(code1:append :next
|
(code1:append :next
|
||||||
[:ldy 0]
|
[:ldy 0]
|
||||||
|
@ -113,6 +123,14 @@
|
||||||
|
|
||||||
(code1:append :native [:jmp [vm.IP]])
|
(code1:append :native [:jmp [vm.IP]])
|
||||||
(code1:append :quit [:rts])
|
(code1:append :quit [:rts])
|
||||||
|
(code1:append :restore
|
||||||
|
[:lda vm.IP] [:sta vm.W]
|
||||||
|
[:lda vm.IPH] [:sta vm.WH]
|
||||||
|
[:ldy vm.ROFF]
|
||||||
|
[:dey] [:lda vm.RSTACK :y] [:sta vm.IPH]
|
||||||
|
[:dey] [:lda vm.RSTACK :y] [:sta vm.IP]
|
||||||
|
[:sty vm.ROFF]
|
||||||
|
[:jmp [vm.W]])
|
||||||
|
|
||||||
(vm:def :mixed-hires
|
(vm:def :mixed-hires
|
||||||
[:sta :0xc050]
|
[:sta :0xc050]
|
||||||
|
@ -138,6 +156,14 @@
|
||||||
[:sty vm.TOPH :x]
|
[:sty vm.TOPH :x]
|
||||||
[:sta vm.ST1H :x])
|
[:sta vm.ST1H :x])
|
||||||
|
|
||||||
|
(vm:def :over
|
||||||
|
[:inx] [:inx]
|
||||||
|
[:lda vm.ST2H :x]
|
||||||
|
[:sta vm.TOPH :x]
|
||||||
|
[:lda vm.ST2 :x]
|
||||||
|
[:sta vm.TOP :x])
|
||||||
|
(vm:word :2dup :over :over)
|
||||||
|
|
||||||
(vm:def :>rot ; (a b c -- c a b)
|
(vm:def :>rot ; (a b c -- c a b)
|
||||||
[:lda vm.TOP :x] ; a: c (a b c)
|
[:lda vm.TOP :x] ; a: c (a b c)
|
||||||
[:ldy vm.ST2 :x] ; y: a (a b c)
|
[:ldy vm.ST2 :x] ; y: a (a b c)
|
||||||
|
@ -158,16 +184,16 @@
|
||||||
[:sta vm.ST1 :x] ; a: c (a c c)
|
[:sta vm.ST1 :x] ; a: c (a c c)
|
||||||
[:lda vm.ST2 :x] ; a: a (a c c)
|
[:lda vm.ST2 :x] ; a: a (a c c)
|
||||||
[:sta vm.TOP :x] ; a: a (a c a)
|
[:sta vm.TOP :x] ; a: a (a c a)
|
||||||
[:sty vm.ST1 :x] ; y: b (b c a)
|
[:sty vm.ST2 :x] ; y: b (b c a)
|
||||||
[:lda vm.TOPH :x] ; a: c (a b c)
|
[:lda vm.TOPH :x] ; a: c (a b c)
|
||||||
[:ldy vm.ST1H :x] ; y: b (a b c)
|
[:ldy vm.ST1H :x] ; y: b (a b c)
|
||||||
[:sta vm.ST1H :x] ; a: c (a c c)
|
[:sta vm.ST1H :x] ; a: c (a c c)
|
||||||
[:lda vm.ST2H :x] ; a: a (a c c)
|
[:lda vm.ST2H :x] ; a: a (a c c)
|
||||||
[:sta vm.TOPH :x] ; a: a (a c a)
|
[:sta vm.TOPH :x] ; a: a (a c a)
|
||||||
[:sty vm.ST1H :x] ; y: b (b c a)
|
[:sty vm.ST2H :x] ; y: b (b c a)
|
||||||
)
|
)
|
||||||
|
|
||||||
(vm:def "@"
|
(vm:def :get
|
||||||
[:lda [vm.TOP :x]]
|
[:lda [vm.TOP :x]]
|
||||||
[:tay]
|
[:tay]
|
||||||
(inc16 vm.TOP vm.TOPH)
|
(inc16 vm.TOP vm.TOPH)
|
||||||
|
@ -187,14 +213,99 @@
|
||||||
[:jsr mon.hexout]
|
[:jsr mon.hexout]
|
||||||
[:lda vm.TOP :x]
|
[:lda vm.TOP :x]
|
||||||
[:jsr mon.hexout]
|
[:jsr mon.hexout]
|
||||||
[:lda (string.byte " ") ]
|
[:lda (achar " ")]
|
||||||
[:jsr mon.putchar]
|
[:jsr mon.putchar]
|
||||||
(vm:drop))
|
(vm:drop))
|
||||||
|
|
||||||
|
; starting address:
|
||||||
|
; 0x2000 + (x*2) + (y%4 * 0x100) + ((y/4) * 0x28)
|
||||||
|
; x between 0-19
|
||||||
|
; y between 0-12
|
||||||
|
; yx - 16-bit value, low byte x, high byte y
|
||||||
|
(code1:append :screeny-lookup [:bytes "\0\040\080"])
|
||||||
|
(vm:def :tile>screen ; yx -- p
|
||||||
|
[:lda vm.TOPH :x] ; a=y
|
||||||
|
[:lsr :a] [:lsr :a] ; a=y/4
|
||||||
|
[:tay] ; y=y/4
|
||||||
|
[:lda 0x03]
|
||||||
|
[:and vm.TOPH :x] ; a=y%4
|
||||||
|
[:ora 0x20] ; a=0x20 + y%4
|
||||||
|
[:sta vm.TOPH :x] ; high byte is set (and y is wiped)
|
||||||
|
[:lda vm.TOP :x] ; a=x
|
||||||
|
[:asl :a] ; a = x*2
|
||||||
|
[:clc]
|
||||||
|
[:adc :screeny-lookup :y] ; a=x*2 + (y/4)*0x28
|
||||||
|
[:sta vm.TOP :x] ; low byte is set
|
||||||
|
)
|
||||||
|
|
||||||
|
; note: the graphical tile data must not cross a page boundary!
|
||||||
|
; TODO: add support to the assembler for enforcing that
|
||||||
|
(fn draw-block []
|
||||||
|
[:block
|
||||||
|
[:clc]
|
||||||
|
[:ldy 8]
|
||||||
|
:loop
|
||||||
|
[:lda [vm.TOP :x]]
|
||||||
|
[:sta [vm.ST1 :x]]
|
||||||
|
[:inc vm.TOP :x]
|
||||||
|
[:lda vm.ST1H :x]
|
||||||
|
[:adc 4]
|
||||||
|
[:sta vm.ST1H :x]
|
||||||
|
[:dey]
|
||||||
|
[:bne :loop]])
|
||||||
|
|
||||||
|
(fn draw-vertical-block []
|
||||||
|
[:block
|
||||||
|
(draw-block)
|
||||||
|
[:lda vm.ST1H :x]
|
||||||
|
[:sbc 31] ; with carry clear this is 32
|
||||||
|
[:sta vm.ST1H :x]
|
||||||
|
[:lda vm.ST1 :x]
|
||||||
|
[:ora 0x80]
|
||||||
|
[:sta vm.ST1 :x]
|
||||||
|
(draw-block)])
|
||||||
|
|
||||||
|
(vm:def :drawtile ; p gfx --
|
||||||
|
(draw-vertical-block)
|
||||||
|
[:lda vm.ST1H :x]
|
||||||
|
[:sbc 31]
|
||||||
|
[:sta vm.ST1H :x]
|
||||||
|
[:lda vm.ST1 :x]
|
||||||
|
[:sbc 0x7f]
|
||||||
|
[:sta vm.ST1 :x]
|
||||||
|
(draw-vertical-block)
|
||||||
|
(vm:drop) (vm:drop)
|
||||||
|
)
|
||||||
|
|
||||||
|
(vm:def :cleargfx
|
||||||
|
(vm:push 0x4000)
|
||||||
|
[:block :page
|
||||||
|
[:dec vm.TOPH :x]
|
||||||
|
[:lda 0]
|
||||||
|
[:block :start
|
||||||
|
[:sta [vm.TOP :x]]
|
||||||
|
[:inc vm.TOP :x]
|
||||||
|
[:bne :start]]
|
||||||
|
[:lda vm.TOPH :x]
|
||||||
|
[:cmp 0x20]
|
||||||
|
[:bne :page]]
|
||||||
|
(vm:drop))
|
||||||
|
|
||||||
|
(tiles:append :blanktile [:bytes "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"])
|
||||||
|
(tiles:append :testtile [:bytes "12345678901234567890123456789012"])
|
||||||
|
;; 19x11 means full map is 209 bytes
|
||||||
(code1:append :main
|
(code1:append :main
|
||||||
[:jsr :reset]
|
[:jsr :reset]
|
||||||
[:jsr :interpret]
|
[:jsr :interpret]
|
||||||
[:vm 0xbabe 0xcafe :. :. :quit])
|
[:vm :mixed-hires
|
||||||
|
:cleargfx
|
||||||
|
0x0000 :tile>screen :lit :testtile :drawtile
|
||||||
|
0x0200 :tile>screen :lit :testtile :drawtile
|
||||||
|
0x0002 :tile>screen :lit :testtile :drawtile
|
||||||
|
0x0202 :tile>screen :lit :testtile :drawtile
|
||||||
|
0x0606 :tile>screen :lit :testtile :drawtile
|
||||||
|
0x0913 :tile>screen :lit :testtile :drawtile
|
||||||
|
:quit])
|
||||||
|
|
||||||
(prg:assemble)
|
(prg:assemble)
|
||||||
|
|
||||||
|
|
32
wrap.fnl
32
wrap.fnl
|
@ -1,17 +1,31 @@
|
||||||
(require "lite")
|
(require "lite")
|
||||||
(require "util")
|
(require "util")
|
||||||
|
(local lume (require "lume"))
|
||||||
(local imgui (require "imgui"))
|
(local imgui (require "imgui"))
|
||||||
(local machine (require "machine"))
|
(local serial (require "serial"))
|
||||||
|
(local gsplus (require "machine"))
|
||||||
(local core (require "core"))
|
(local core (require "core"))
|
||||||
(local command (require "core.command"))
|
(local command (require "core.command"))
|
||||||
(local keymap (require "core.keymap"))
|
(local keymap (require "core.keymap"))
|
||||||
|
(local translate (require "core.doc.translate"))
|
||||||
|
|
||||||
(fn upload [] (: (reload "test") :upload machine))
|
(var machine (if (and (pcall #(serial:connect)) (serial:connected?)) serial gsplus))
|
||||||
|
|
||||||
(command.add (fn [] machine.socket) {
|
(command.add #(not= machine serial) {
|
||||||
"honeylisp:upload" upload
|
"serial:switch-machine" #(set machine serial)
|
||||||
|
})
|
||||||
|
(command.add #(not= machine gsplus) {
|
||||||
|
"gsplus:switch-machine" #(set machine gsplus)
|
||||||
|
})
|
||||||
|
(command.add #(machine:connected?) {
|
||||||
|
"honeylisp:upload" (fn []
|
||||||
|
(local p (reload "test"))
|
||||||
|
(p:upload machine)
|
||||||
|
(core.log (string.format "%x" (p:lookup-addr p.start-symbol))))
|
||||||
|
})
|
||||||
|
(command.add (fn [] true) {
|
||||||
|
"honeylisp:rebuild" #(reload "test")
|
||||||
})
|
})
|
||||||
|
|
||||||
(command.add "core.docview" {
|
(command.add "core.docview" {
|
||||||
"fennel:eval" (fn []
|
"fennel:eval" (fn []
|
||||||
(let [ldoc core.active_view.doc
|
(let [ldoc core.active_view.doc
|
||||||
|
@ -31,6 +45,14 @@
|
||||||
(core.log (.. "Hotswapping " modname))
|
(core.log (.. "Hotswapping " modname))
|
||||||
(local (mod err) (lume.hotswap modname))
|
(local (mod err) (lume.hotswap modname))
|
||||||
(when (not= err nil) (print err) (error err)))
|
(when (not= err nil) (print err) (error err)))
|
||||||
|
"honeylisp:address" (fn []
|
||||||
|
(local ldoc core.active_view.doc)
|
||||||
|
(local (aline acol) (translate.start_of_word ldoc (ldoc:get_selection)))
|
||||||
|
(local (bline bcol) (translate.end_of_word ldoc (ldoc:get_selection)))
|
||||||
|
(local word (ldoc:get_text aline acol bline bcol))
|
||||||
|
(local p (require "test"))
|
||||||
|
(core.log (string.format "%s %x" word (or (p:lookup-addr word) -1)))
|
||||||
|
)
|
||||||
})
|
})
|
||||||
(keymap.add {
|
(keymap.add {
|
||||||
"alt+e" "fennel:eval"
|
"alt+e" "fennel:eval"
|
||||||
|
|
Loading…
Reference in a new issue