diff --git a/asm/asm.fnl b/asm/asm.fnl index f2b7cb7..f1d08d5 100644 --- a/asm/asm.fnl +++ b/asm/asm.fnl @@ -158,7 +158,7 @@ }) (fn process-pdat [pdat process default ...] - (pp pdat) +; (pp pdat) (local processor (. pdat-processor pdat.type process)) (if processor (processor pdat ...) default)) @@ -309,10 +309,10 @@ (set self.dbgfile nil)) self) :upload - (fn [self machine only-self] - (when (and (not only-self) self.prg-base) (self.prg-base:upload machine)) - (each [org block (pairs self.org-to-block)] - (machine:write block.addr block.bytes))) + (fn [self machine] + (if machine.upload (machine:upload self) + (each [org block (pairs self.org-to-block)] + (machine:write block.addr block.bytes)))) }) {:new program} diff --git a/asm/tape.fnl b/asm/tape.fnl new file mode 100644 index 0000000..2940f25 --- /dev/null +++ b/asm/tape.fnl @@ -0,0 +1,56 @@ +(local asm (require :asm.asm)) +(local util (require :lib.util)) +(local lume (require :lib.lume)) + +(local tokens {}) + (each [i tok (ipairs [:end :for :next :data :input :del :dim :read :gr :text :pr# :in# :call :plot + :hlin :vlin :hgr2 :hgr :hcolor= :hplot :draw :xdraw :htab :home :rot= :scale= + :shload :trace :notrace :normal :inverse :flash :color= :pop :vtab :himem: + :lomem: :onerr :resume :recall :store :speed= :let :goto :run :if :restore + :& :gosub :return :rem :stop :on :wait :load :save :deffn :poke :print :cont + :list :clear :get :new :tab :to :fn :src :then :at :not :step :+ :- :* "/" ";" + :and :or :> := :< :sgn :int :abs :usr :fre :scrn :pdl :pos :sqr :rnd :log :exp + :cos :sin :tan :atn :peek :len :str$ :val :asc :chr$ :left$ :right$ :mid$])] + (tset tokens tok (+ i 0x7f))) + +(fn basic [prg] + (fn parse-line [line] + (local block [:block [:ref :nextline] [:dw (. line 1)]]) + (each [_ tok (ipairs (lume.slice line 2))] + (table.insert block + (if (= (type tok) :table) tok + (. tokens tok) [:db (. tokens tok)] + [:bytes (tostring tok)]))) + (table.insert block [:db 0]) + (table.insert block :nextline) + block) + (fn prg.dat-parser.basic [lines] + (local block (prg:new-block)) + (each [_ line (ipairs (lume.slice lines 2))] + (prg:parse-dats block [(parse-line line)])) + (prg:parse-dats block [[:dw 0]]) + block) + prg) + +(fn loader [prg] + (local lprg (basic (asm.new prg))) + (local lorg (lprg:org 0x0801)) + (lorg:append [:basic [10 :call :2061]]) + (local generator + {:chunks [] + :write + (fn [self addr bytes] + (local end (+ addr (bytes:len) -1)) ; end address inclusive + (lorg:append + [:lda #(util.lo addr)] [:sta :0x3c] + [:lda #(util.hi addr)] [:sta :0x3d] + [:lda #(util.lo end)] [:sta :0x3e] + [:lda #(util.hi end)] [:sta :0x3f] + [:jsr :0xfefd]) + (table.insert self.chunks bytes))}) + (prg:upload generator) + (lorg:append [:jmp prg.start-symbol]) + (lprg:assemble) + (values lprg generator.chunks)) + +{: basic : loader} diff --git a/asm/vm.fnl b/asm/vm.fnl index 993de03..b1f5539 100644 --- a/asm/vm.fnl +++ b/asm/vm.fnl @@ -94,13 +94,16 @@ [:block [:vm :native] [:block ...] [:jsr :interpret]]) :hotswap-sync (fn [self] - (link.machine:stub code1 :next - [:lda #(lo ($1:lookup-addr :G-POST-HOTSWAP-RESET))] - [:sta self.IP] - [:lda #(hi ($1:lookup-addr :G-POST-HOTSWAP-RESET))] - [:sta self.IPH] - [:jmp :next]) - [:vm :debug-stub [:block :G-POST-HOTSWAP-RESET]]) + (if link.machine.stub + (do + (link.machine:stub code1 :next + [:lda #(lo ($1:lookup-addr :G-POST-HOTSWAP-RESET))] + [:sta self.IP] + [:lda #(hi ($1:lookup-addr :G-POST-HOTSWAP-RESET))] + [:sta self.IPH] + [:jmp :next]) + [:vm :debug-stub [:block :G-POST-HOTSWAP-RESET]]) + [:block])) }) (code1:append :next diff --git a/game/init.fnl b/game/init.fnl index 8e01180..8da16c2 100644 --- a/game/init.fnl +++ b/game/init.fnl @@ -8,7 +8,7 @@ (local prg (asm.new)) ; (prg:debug-to "test.dbg") -(local tiles (prg:org 0x6100)) +(local tiles (prg:org 0x4100)) (local vm (VM.new prg)) (local code1 vm.code) @@ -153,7 +153,7 @@ ; but REPL debug stub should be very available as a task ; 20x12 means full map is 240 bytes - we have an extra 16 bytes at the end to mess with? -(tile.appendmaps (prg:org 0x6800)) +(tile.appendmaps (prg:org 0x4800)) (code1:append :main [:jsr :reset] @@ -167,3 +167,4 @@ :quit]) (prg:assemble) + diff --git a/link/init.fnl b/link/init.fnl index 860b0cf..086968a 100644 --- a/link/init.fnl +++ b/link/init.fnl @@ -2,8 +2,9 @@ {:switch (fn [self name] (set self.machine (require (.. "link." name))) - (set self.name name))}) - + (set self.name name)) + :types [:serial :gsplus :tape]}) + (local serial (require :link.serial)) (link:switch (if (and (pcall #(serial:connect)) (serial:connected?)) :serial :gsplus)) diff --git a/link/tape.fnl b/link/tape.fnl new file mode 100644 index 0000000..ac32376 --- /dev/null +++ b/link/tape.fnl @@ -0,0 +1,17 @@ +(local tapegen (require :link.tapegen)) +(local tape (require :asm.tape)) + +(local machine + {:source (love.audio.newQueueableSource tapegen.samplerate 16 1 32) + :play (fn [self sound] (self.source:queue sound)) + :stop (fn [self] (love.audio.stop)) + :upload + (fn [self prg] + (local (loader chunks) (tape.loader prg)) + (self:play (tapegen.gen-basic (. loader.org-to-block 0x801 :bytes))) + (each [_ chunk (ipairs chunks)] + (self:play (tapegen.gen-bin chunk)) + (love.audio.play self.source))) + :connected? (fn [self] true)}) + +machine diff --git a/link/tapegen.fnl b/link/tapegen.fnl new file mode 100644 index 0000000..8bed795 --- /dev/null +++ b/link/tapegen.fnl @@ -0,0 +1,100 @@ +(local util (require :lib.util)) +(local tape (require :asm.tape)) + +; https://www.apple.asimov.net/documentation/hardware/io/The%20Apple%20II%20Cassette%20Interface.txt + +; header +; ---+ +-------------+ +-----+ +; | | | | | +; +-------------+ +----+ | + +; | 1300 microseconds | 200| 250 | +; header tone | synchronous bit | + +; 0 and 1 bits +; +-----+ +----------+ + +; | | | | | +; + +-----+ +----------+ + +; | 500 usec | 1000 usec | + +(local samplerate 48000) +(fn us-to-s [us] (* (/ 1 1000000) us)) +(fn samplecount [us] (* samplerate (us-to-s us))) + +(fn checksum [bytes] + (var sum 0xff) + (for [ibyte 1 (bytes:len)] + (set sum (bit.bxor sum (: (bytes:sub ibyte ibyte) :byte)))) + sum) + +(fn data [] + {:cycles [] + :samples 0 + :cycle + (fn [self us count] + (local samples (samplecount us)) + (local prev-cycle (. self.cycles (length self.cycles))) + (local prev-samples (-?> prev-cycle (. 1))) + (if (= samples prev-samples) (tset prev-cycle 2 (+ (. prev-cycle 2) count)) + (table.insert self.cycles [samples count])) + (set self.samples (+ self.samples (* samples count)))) + :header + (fn [self ?s] + (self:cycle (/ 1300 2) (math.floor (/ (or ?s 5) (us-to-s (/ 1300 2))))) + (self:cycle 200 1) + (self:cycle 250 1)) + :bit (fn [self on] (self:cycle (if on 500 250) 2)) + :byte + (fn [self byte] + (for [ibit 7 0 -1] + (self:bit (not= (bit.band byte (bit.lshift 1 ibit)) 0)))) + :bytes + (fn [self bytes] + (for [ibyte 1 (bytes:len)] + (self:byte (: (bytes:sub ibyte ibyte) :byte)))) + :bytes-with-checksum + (fn [self bytes] + (self:bytes bytes) + (self:byte (checksum bytes))) + :to-sound + (fn [self] + (local sound (love.sound.newSoundData (+ self.samples (samplecount 8500)) samplerate 16 1)) + (var isample 0) + (var err 0) + (var on true) + (each [_ [samples count] (ipairs self.cycles)] + (for [_ 1 count] + (set err (+ err (% samples 1))) + (for [_ 1 (+ samples (math.floor err))] + (sound:setSample isample (if on 0.75 -0.75)) + (set isample (+ isample 1))) + (set err (% err 1)) + (set on (not on)))) + ; finish last bit + (set on (not on)) + (for [_ 1 (samplecount 500)] + (sound:setSample isample (if on 0.75 -0.75)) + (set isample (+ isample 1))) + ; add a little pad of zeros + (for [_ 1 (samplecount 8000)] + (sound:setSample isample 0) + (set isample (+ isample 1))) + sound)}) + +(fn gen-bin [bytes ?s-header] + (local dat (data)) + (dat:header ?s-header) + (dat:bytes-with-checksum bytes) + (dat:to-sound)) + +(fn gen-basic [bytes ?s-header] + (local dat (data)) + (dat:header ?s-header) + (dat:bytes-with-checksum + (.. (util.int16-to-bytes (+ (bytes:len) 1)) (util.int8-to-bytes 0xd5))) + (dat:header ?s-header) + (dat:bytes-with-checksum bytes) + (dat:to-sound)) + +{: gen-bin : gen-basic : checksum : data : samplerate : samplecount} diff --git a/wrap.fnl b/wrap.fnl index c1bb261..099c9b7 100644 --- a/wrap.fnl +++ b/wrap.fnl @@ -7,11 +7,12 @@ (local keymap (require "core.keymap")) (local translate (require "core.doc.translate")) -(command.add #(not= link.name :serial) { - "serial:switch-machine" #(link:switch :serial) -}) -(command.add #(not= link.name :gsplus) { - "gsplus:switch-machine" #(link:switch :gsplus) +(each [_ linktype (ipairs link.types)] + (command.add #(not= link.name linktype) { + (.. "honeylisp:switch-to-" linktype) #(link:switch linktype) + })) +(command.add #(= link.name :tape) { + "honeylisp:squelch" #(link.machine:stop) }) (command.add #(link.machine:connected?) { "honeylisp:upload" (fn []