Tile-drawing routines, serial / monitor support

This commit is contained in:
Jeremy Penner 2020-09-27 14:53:16 -04:00
parent bae9bdf768
commit 9e6c849faf
7 changed files with 208 additions and 16 deletions

10
asm.fnl
View file

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

Binary file not shown.

View file

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

View file

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

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

View file

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