cassette port support

This commit is contained in:
Jeremy Penner 2020-11-01 19:39:31 -05:00
parent e38fda0b57
commit b31465b0f9
8 changed files with 200 additions and 21 deletions

View file

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

56
asm/tape.fnl Normal file
View file

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

View file

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

View file

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

View file

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

17
link/tape.fnl Normal file
View file

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

100
link/tapegen.fnl Normal file
View file

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

View file

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