diff --git a/asm.fnl b/asm.fnl index 2fed658..e058edb 100644 --- a/asm.fnl +++ b/asm.fnl @@ -1,3 +1,4 @@ +(local lume (require "lume")) (local {: stream : kvstream : one} (require "stream")) (local opcodes {}) @@ -119,7 +120,7 @@ (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.bytes [bytes] {:type :raw :bytes (. bytes 2)}) (fn dat-parser.ref [ref] {:type :ref :target (. ref 2)}) (fn dat-parser.flatten [flat block] (parse-dats block (lume.slice flat 2))) @@ -131,7 +132,7 @@ :lookup-addr (fn [self name] (local ipdat (. self.block.symbols name)) - (print "looking up" name "in" self) +; (print "looking up" name "in" self) (if (and ipdat (> ipdat (length self.block.pdats))) (+ self.block.addr self.block.size) @@ -174,7 +175,7 @@ (fn pdat-processor.op.bytes [op env] (local bytegen (. opcodes op.opcode)) - (pp op) +; (pp op) (if bytegen (let [opbyte (bytegen op.mode) argbytes @@ -226,6 +227,7 @@ (each [_ pdat (ipairs block.pdats)] (process-pdat pdat :generate nil 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 bytes (.. bytes pdatbytes))) (set block.bytes bytes)) @@ -251,7 +253,7 @@ (< (tonumber name) 0x100))) :lookup-addr (fn [self name] - (print "looking up" name "in" self) +; (print "looking up" name "in" self) (local org (. self.symbol-to-org name)) (local addr (and org (: (make-env (. self.org-to-block org) self) :lookup-addr name))) (if (not= addr nil) diff --git a/luars232.so b/luars232.so new file mode 100755 index 0000000..001bdb1 Binary files /dev/null and b/luars232.so differ diff --git a/machine.fnl b/machine.fnl index c34e357..7c09475 100644 --- a/machine.fnl +++ b/machine.fnl @@ -39,6 +39,7 @@ (when self.socket (self.socket:close) (set self.socket nil))) + :connected? (fn [self] self.socket) :cmd (fn [self cmd] (self.socket:send (.. cmd "\n"))) :response (fn [self] diff --git a/main.lua b/main.lua index 6f6b835..43bc95a 100644 --- a/main.lua +++ b/main.lua @@ -4,6 +4,7 @@ table.insert(package.loaders, fennel.make_searcher({correlate=true})) fv = require("lib.fennelview") pp = function(x) print(fv(x)) end lume = require("lume") +luars232 = require("luars232") function reload(modname) package.loaded[modname] = nil diff --git a/serial.fnl b/serial.fnl new file mode 100644 index 0000000..029dfc3 --- /dev/null +++ b/serial.fnl @@ -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 diff --git a/test.fnl b/test.fnl index 14c1a6a..07e2cfd 100644 --- a/test.fnl +++ b/test.fnl @@ -1,8 +1,10 @@ +(local lume (require "lume")) (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)) +(local tiles (prg:org 0x6100)) (fn dat-parser.vm [bytecodes] (local block (new-block)) @@ -47,9 +49,9 @@ [:inx] [:inx] [:lda l] - [:sta [self.TOP :x]] + [:sta self.TOP :x] [:lda h] - [:sta [self.TOPH :x]] + [:sta self.TOPH :x] ]) :drop (fn [self] [:block [:dex] [:dex]]) :def @@ -58,6 +60,9 @@ :word (fn [self name ...] (code1:append name [:jsr :subroutine] [:vm ...] [:vm :ret])) + :inline + (fn [self ...] + [:block [:jsr :subroutine] [:vm ...] [:vm :restore]]) }) (fn inc16 [l h] @@ -76,6 +81,11 @@ [:inc h] :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 [:ldy 0] @@ -113,6 +123,14 @@ (code1:append :native [:jmp [vm.IP]]) (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 [:sta :0xc050] @@ -138,6 +156,14 @@ [:sty vm.TOPH :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) [:lda vm.TOP :x] ; a: c (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) [: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) + [:sty vm.ST2 :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) + [:sty vm.ST2H :x] ; y: b (b c a) ) -(vm:def "@" +(vm:def :get [:lda [vm.TOP :x]] [:tay] (inc16 vm.TOP vm.TOPH) @@ -187,14 +213,99 @@ [:jsr mon.hexout] [:lda vm.TOP :x] [:jsr mon.hexout] - [:lda (string.byte " ") ] + [:lda (achar " ")] [:jsr mon.putchar] (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 [:jsr :reset] [: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) diff --git a/wrap.fnl b/wrap.fnl index 2a20e71..d1addc9 100644 --- a/wrap.fnl +++ b/wrap.fnl @@ -1,17 +1,31 @@ (require "lite") (require "util") +(local lume (require "lume")) (local imgui (require "imgui")) -(local machine (require "machine")) +(local serial (require "serial")) +(local gsplus (require "machine")) (local core (require "core")) (local command (require "core.command")) (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) { - "honeylisp:upload" upload +(command.add #(not= machine serial) { + "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" { "fennel:eval" (fn [] (let [ldoc core.active_view.doc @@ -31,6 +45,14 @@ (core.log (.. "Hotswapping " modname)) (local (mod err) (lume.hotswap modname)) (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 { "alt+e" "fennel:eval"