* * IEC32 * * 1990-03-13 Johann at Klasek . AT * * Serial IEC-625 Bus-Driver with * Extended Color Basic integration * for Dragon 32 platforms * * 2016-11-14 JK: Source code fully commented * *** systemtype syssim set 0 sysdragon set 1 syscoco set 2 # für Dragon 32 mit Color Basic 1.0 systype set sysdragon # für Coco 2 mit Extended Color Basic 1.2 ;systype set syscoco *** constants cr equ $0d ; control character carriage return ocjsr equ $7e ; opcode: jsr ocrts equ $39 ; opcode: rts occmpximm equ $8c ; opcode: cmpx # *** BASIC direct page bstart equ $19 ; BASIC program start bvar equ $1b ; BASIC variable area start (program end) bstr equ $21 ; BASIC string heap limit (strings above) bmem equ $27 ; BASIC end of memory btemp equ $41 ; BASIC temporary pointer/word bint equ $52 ; BASIC integer (word), part for floating ; point accu blinenum equ $68 ; BASIC current line number bdev equ $6f ; BASIC device number bprintwidth equ $9b ; printer line width bprinthead equ $9c ; printer head position bchget equ $9f ; BASIC text char get routine bchargot equ $a5 ; BASIC text char got entry btext equ $a6 ; BASIC text pointer *** IEC variables & constants start equ $ea ; data start address iecstatus equ $f0 ; IEC status ; Bit 7654210 ; || | || ; || | |+- read/write ; || | +-- timeout ; || +---- verify error ; |+------ EOF ; +------- device not present stwrite equ $01 ; IEC status: read/write sttimeout equ $02 ; IEC status: timeout stvererr equ $10 ; IEC status: verify error steof equ $40 ; IEC status: EOF stdevnp equ $80 ; IEC status: device not present ieceoiflag equ $f1 ; IEC end of input flag iecbyte equ $f2 ; IEC input byte iecready equ $f4 ; IEC byte in ready iecbuffer equ $f5 ; IEC byte in buffer iecbitcount equ $f6 ; IEC bit counter iecmode equ $f7 ; IEC load mode: load to ; 0 | 1 ... disk addr. | given addr. iecverify equ $f8 ; IEC verify ; 0 | 1 ... load | verify iecsa equ $f9 ; IEC secondary address iecdev equ $fa ; IEC device number iecfnlen equ $fb ; IEC filename length iecfnaddr equ $fc ; IEC filename address iecend equ $fe ; IEC temporary end address iecdata equ iecstatus *** BASIC hooks hout equ $0167 ; BASIC hook: out hparse equ $0179 ; BASIC hook: parse statement herror equ $0191 ; BASIC hook: system error trap *** BASIC ROM entries if systype = sysdragon bmemreset equ $8424 ; part of NEW: reset BASIC memory besyntax equ $89b4 ; syntax error bexpr equ $8887 ; eval expression bchkstr equ $8d9a ; check for string, result in B/X bexprstr equ $9B7E ; bexpr+bchkstr bsout equ $b54a ; byte out on standard device bkeyin equ $851b ; check key in (for break) bchkcomma equ $89aa ; check for comma in BASIC text bsoutstr equ $90e8 ; print string addr. X, len. B bgetval16 equ $8e83 ; get 16 bit value in X bprintcr equ $90a1 ; print CR bprintnum equ $957a ; print unsigned number in D bclear equ $83e7 ; clear variables and reset stack & cmd ptr bhexstr equ $a011 ; 16 bit value to hex string (BASIC HEX$() ; caller address is dropped(!), call through ; wrapper like bsout16bit bstar equ $84e3 ; "*" in ROM endif if systype = syscoco bmemreset equ $ad26 ; part of NEW: reset BASIC memory besyntax equ $8168 ; syntax error bexpr equ $b156 ; eval expression bchkstr equ $b654 ; check for string, result in B/X bexprstr equ $8748 ; bexpr+bchkstr bsout equ $a282 ; byte out on standard device bkeyin equ $adeb ; check key in (for break) bchkcomma equ $b26d ; check for comma in BASIC text bsoutstr equ $b99f ; print string addr. X, len. B bgetval16 equ $b73d ; get 16 bit value in X bprintcr equ $b958 ; print CR bprintnum equ $bdcc ; print unsigned number in D bclear equ $ace9 ; clear variables and reset stack & cmd ptr bhexstr equ $8be0 ; 16 bit value to hex string (BASIC HEX$() ; caller address is dropped(!), call through ; wrapper like bsout16bit bstar equ $adca ; "*" in ROM endif *** I/O port equ $ff40 ; PIA Port A, selected by /IO2 signal datain equ $80 ; DATA in (inverted DATA out, unless pulled to 0 by an other device) clockin equ $40 ; CLOCK in (inverted CLOCK out, unless pulled to 0 by an other device) dataout equ $20 ; DATA inverted (= /DATA) clockout equ $10 ; CLOCK inverted (= /CLOCK) atnsig equ $08 ; /ATN inverted (= ATN) ************************************************************* org $7792 prg ; prg file intro: load address in CBM style (little endian) fcb begin & $00ff fcb begin >> 8 begin ************************************************************* ; ; in: - ; out: a read byte ; iecstatus IEC state ; used: - iecin orcc #$50 ; interrupts off pshs b,x ldx #port ; PIA port clr iecbitcount ; as error state flag bsr CLOCK1 rbloop1 bsr getdc ; get DATA/CLOCK bpl rbloop1 ; wait CLOCK raising edge rbagain ldb #8 ; initial try count bsr DATA1 rbnxtry decb ; count down tries beq rbcheckto ; out of tries bsr getdc ; get DATA/CLOCK bmi rbnxtry ; wait CLOCK falling edge bpl rbdata ; sync ok, get byte data rbcheckto lda iecbitcount ; error state flag beq rbstart ; on start? -> EOF lda #sttimeout ; else bra exitstatus ; timeout rbstart bsr DATA0 bsr CLOCK1 lda #steof ; set EOF status bsr setstatus inc iecbitcount ; next time: flag for timeout bra rbagain ; restart rbdata lda #8 ; read 8 bit sta iecbitcount rbloop lda ,x ; stable signals cmpa ,x bne rbloop lsla ; DATA in CF, CLOCK in NF bpl rbloop ; wait CLOCK raising edge ror iecbyte ; data bit rbwait1 lda ,x ; stable signals cmpa ,x bne rbwait1 lsla ; DATA in CF, CLOCK in NF bmi rbwait1 ; wait CLOCK falling edge dec iecbitcount ; bit count bne rbloop ; byte finished? bsr DATA0 lda iecstatus ; status lsla ; bit 6 -> NF bpl rbexit ; eof? ldb #10 ; yes, eof rbloop2 decb ; delay 72 usec bne rbloop2 bsr CLOCK1 ; detach bus signals bsr DATA1 ; with high (open collector) rbexit lda iecbyte ; result byte andcc #$ae puls b,x,pc nop nop nop nop nop nop nop nop nop nop ************************************************************* ; ; in: x ; PIA port ; out: a ; port written value ; used: - CLOCK1 lda ,x ; PIA port anda #~clockout ; set CLOCK to 1 sta ,x rts ************************************************************* ; ; in: x ; PIA port ; out: a ; port written value ; used: - CLOCK0 lda ,x ; PIA port ora #clockout ; set CLOCK to 0 sta ,x rts ************************************************************* ; ; in: x ; PIA port ; out: a ; port written value ; used: - DATA1 lda ,x ; PIA port anda #~dataout ; set DATA to 1 sta ,x rts ************************************************************* ; ; in: x ; PIA port ; out: a ; port written value ; used: - DATA0 lda ,x ; PIA port ora #dataout ; set DATA to 0 sta ,x rts ************************************************************* ; ; in: x ; PIA port ; out: a ; CF ; DATA ; NF ; CLOCK ; used: - getdc lda ,x ; read port DATA+CLOCK cmpa ,x ; if changing bne getdc ; wait until stable lsla ; carry = DATA, negative = CLOCK rts ************************************************************* ; ; in: a ; out: iecstatus ; used: - setstatus ora iecstatus ; set addition satus bits sta iecstatus rts ************************************************************* ; ; in: - ; out: - ; used: a delay lda #$b8 ; wait 1 ms dloop deca bne dloop rts ************************************************************* ; ; in: a ; stack frame: b,x,pc ; out: iecstatus ; used: - ; context: iecout,iecin errdnp lda #stdevnp ; device not present error bra eskip errto lda #sttimeout+stwrite ; write timeout error eskip puls x ; remove caller exitstatus bsr setstatus bra iecfinal nop ************************************************************* ; ; in: iecbuffer read byte ; out: iecstatus IEC state ; used: a iecout orcc #$50 ; disable interrupts iecout2 bsr DATA1 ; DATA 1 bsr getdc ; get DATA/CLOCK bcs errdnp ; DATA = 1 -> device not present bsr CLOCK1 ; CLOCK 1 tst ieceoiflag ; flag set? bpl wbnormal ; no, normal transfer wbloop1 bsr getdc ; get DATA/CLOCK bcc wbloop1 ; DATA raising edge wbloop2 bsr getdc ; get DATA/CLOCK bcs wbloop2 ; DATA falling edge wbnormal wbloop3 bsr getdc ; get DATA/CLOCK bcc wbloop3 ; DATA raising edge bsr CLOCK0 ; CLOCK 0 lda #8 sta iecbitcount wbloop lda ,x ; stable signals cmpa ,x bne wbloop lsla ; DATA in CF, CLOCK in NF bcc errto ; DATA = 0 -> timeout ror iecbuffer ; get data bit in CF lda ,x bcs wbbit1 ; bit = 1 -> DATA 1 & CLOCK 1 ora #dataout ; bit = 0 -> DATA 0 & CLOCK 1 bra wbclock wbbit1 anda #~dataout ; DATA 1 wbclock anda #~clockout ; CLOCK 1 sta ,x exg a,b ; small delay exg a,b lda ,x anda #~dataout ; DATA 1 & CLOCK 0 ora #clockout sta ,x dec iecbitcount ; all bits? bne wbloop ; wbloop4 bsr getdc ; get DATA/CLOCK bcs wbloop4 ; DATA falling edge rts ************************************************************* ; ; in: stack frame: x,b ; out: iecstatus IEC state ; used: x ; context: errdnp, errto, exitstatus iecfinal ldx #port lbra enduntalklisten nop ************************************************************* ; ; in: a byte to output ; out: iecstatus IEC state ; used: iecready, iecbuffer out tst iecready ; buffer empty? bmi ofull ; yes com iecready ; flag as full, bra oempty ; was empty ofull pshs b,x ; write buffer ldx #port ; PIA port tfr a,b ; save current byte bsr iecout ; write buffer tfr b,a ; restore current byte puls b,x ; restore registers oempty sta iecbuffer ; store into buffer andcc #$ae rts nop nop nop nop nop nop nop ************************************************************* ; ; in: a IEC device number ; out: iecstatus IEC state ; used: iecready, iecbuffer listen ora #$20 ; listen code fcb occmpximm ; cmpx # talk ora #$40 ; talk code sendlistentalk pshs b,x ; save registers ldx #port ; PIA port tfr a,b ; save out byte tst iecready ; iec buffer full? bpl tempty ; no com ieceoiflag ; set flag lbsr iecout ; address device lsr iecready ; clear flag lsr ieceoiflag ; clear flag tfr b,a ; restore out byte tempty sta iecbuffer ; to buffer orcc #$50 ; interrupt disable lbsr DATA1 ; release DATA bus signal ;+BUG ; ora #$07 ; force unused bits to 1 cmpa #$3f ; bus held by other? ; 0011 1111 ; dcDC A--- ; CLOCK/DATA set to 0, /ATN active? ; but read as 1 ; signals held down by other ; bit 0-2 bne treleased ; no, bus is released lbsr CLOCK1 ; yes, release CLOCK bus signal, too treleased lda ,x ; PIA port ora #atnsig ; /ATN active sta ,x endlistentalk orcc #$50 ; interrupt disable lbsr CLOCK0 lbsr DATA1 lbsr delay ; wait 1 ms lbsr iecout2 ; (interrupt off) andcc #$ae ; enable interrupt puls b,x,pc nop nop nop nop nop nop ************************************************************* ; ; in: - ; out: iecstatus IEC state ; used: a untalk orcc #$50 pshs b,x ldx #port ; PIA lbsr CLOCK0 lda ,x ; PIA port ora #atnsig ; /ATN active sta ,x lda #$5f ; Untalk command bra untalk2 unlisten2 lda #$3f ; Unlisten command untalk2 bsr sendlistentalk ; send command orcc #$50 enduntalklisten lda ,x ; PIA port anda #~atnsig ; /ATN inactive sta ,x lda #$0a ; wait 45 usec uwait deca bne uwait lbsr CLOCK1 ; release bus signals lbsr DATA1 ; CLOCK and DATA andcc #$ae ; enable interrupts puls b,x,pc ************************************************************* ; ; in: - ; out: iecstatus IEC state ; used: a unlisten orcc #$50 ; disable interrupts pshs b,x ldx #port ; PIA bra unlisten2 ; continue with unliste ************************************************************* ; ; in: a IEC secondary address ; out: - ; used: a seclisten pshs x ; save x leax start address ldx end address + 1 lda #',' ; start addr. parameter? cmpa [>btext] bne dosave ; no (take BASIC program addresses) jsr bchget ; get jsr bgetval16 ; unsigned 16 bit value stx start ; store new start addr. jsr bchkcomma ; get comma jsr bgetval16 ; unsigned 16 bit value stx iecend ; store new end addr. dosave lda #$01 ; secondary addr. 1 sta iecsa ldx iecfnaddr ; open filename ldb iecfnlen bsr open lda iecdev ; device should listen for data lbsr listen lda iecsa ora #$60 ; internal SA 0 + $60 lbsr seclisten lda iecstatus ; error? beq sok ; no error serror lbra unlisten ; save finished in error sok lda start+1 ; load addr. low byte first lbsr out lda start ; load addr. high byte lbsr out ldx start ; data block start ... bra scheck sloop lda ,x+ ; program byte lbsr out ; write to disk lda iecstatus bne serror ; exit jsr bkeyin ; break? scheck cmpx iecend ; first byte after last one blo sloop ; all bytes? closelisten lbsr unlisten ; continue with close ************************************************************* ; ; in: iecdev current IEC device ; iecsa current IEC secondary ; out: iecstatus IEC state ; used: a close lda iecdev lbsr listen lda iecsa anda #$EF ; xxx0 xxxx ora #$E0 ; 1110 xxxx lbsr seclisten lbsr unlisten andcc #$fe rts ************************************************************* ; ; in: iecdev current IEC device ; BASIC parameter: Filename[,Start,End] ; out: iecstatus IEC state ; iecend data end address + 1 ; used: a, iecfnaddr, iecfnlen, iecmode, iecdev, iecsa ; save lbsr setup ; i/o setup lbra save1 ; continue real save nop nop ************************************************************* ; ; in: $52/$53 (bint) 16 bit unsigned integer ; out: - (output device) ; used: a,b,x,($03d9)... ; $58/$59 string addr ; $0d/$0e pointer to string descriptor ; $52/$53 pointer to string descriptor bsout16bit jsr bhexstr ; 16 bit unsigned integer to hex string ; never returns here, caller address is dumped, ; back to bsout16bit caller! nop nop nop nop nop nop nop ************************************************************* ; ; in: iecdev current IEC device ; iecverify 0 | 1 ... load | verify ; blinenum command mode status ; BASIC parameter: [Filename[,Start]] ; out: iecstatus IEC state ; message to current BASIC device: SSSS-EEEE ; only if in command mode, ; SSSS start address hex, ; EEEE end address + 1 hex ; iecend data end address + 1 ; used: a, iecfnaddr, iecfnlen, iecmode, iecdev, iecsa load1 jsr bchargot ; parameter? bne ldpara ; yes ldstar ldb #$01 ; filename length ldx #bstar ; points to "*" in ROM ldname clr iecmode ; load addr. from disk stb iecfnlen stx iecfnaddr bra ldstart ; do load action nop nop ldpara jsr bexpr ; expression evaluation jsr bchkstr ; check string as filename lda #',' cmpa [>btext] ; followed by comma? beq ldaddr tstb ; filename length beq ldstar ; = 0 ("") -> use "*" bne ldname ; non-empty filename string ldaddr inc iecmode ; flag new loading address stb iecfnlen ; store filename length stx iecfnaddr ; and addresse jsr bchget ; skip comma jsr bgetval16 ; get unsigned integer stx start ; as new loading address ldstart clr iecsa ; SA=0 ldx iecfnaddr ldb iecfnlen lbsr open ; open filename lda iecdev ; on device lbsr talk lda iecsa ora #$60 ; SA offset for internal usage sta iecsa lbsr sectalk lbsr iecin ; load address from disk, low byte sta iecend+1 ; store temporary lda #sttimeout bita iecstatus ; check timeout status bne closetalk ; yes, timeout (file not found?) lbsr iecin ; load address from disk, high byte sta iecend ; store temporary ldd iecend ; get 16 bit as whole tst iecmode ; loading address? beq lddisk ; =0 -> from disk ldd start ; otherwise from parameter lddisk std start std bint ; 16 bit integer ldu blinenum ; current BASIC line cmpu #$ffff ; command mode? bne ldskip1 bsr bsout16bit ; start addr. to hex jsr bsoutstr ; print it lda #'-' ; to ... jsr bsout ldskip1 lda iecstatus anda #~sttimeout sta iecstatus ldx start ldloop jsr bkeyin ; break? lbsr iecin ldb iecstatus andb #sttimeout bne closetalk ; timeout ldb iecverify ; verify/load? beq ldload ; to load ldverify cmpa ,x+ ; verify action beq ldcheck lda #stvererr lbsr setstatus fcb occmpximm ; cmpx # ldload sta ,x+ ; load action ldcheck lda iecstatus lsla ; bit 6 -> NF bpl ldloop ; loop until eof stx bint ; end address for output stx iecend ldu blinenum ; current BASIC line cmpu #$ffff ; command mode? bne ldskip2 lbsr bsout16bit ; end addr. to hex jsr bsoutstr ; print it lda #cr ; end of line jsr bsout ldskip2 ldx start ; start address from BASIC? cmpx bstart bne closetalk ldx iecend ; end addr. is new BASIC stx bvar ; program end bsr closetalk jmp bclear ; BASIC pointer setup closetalk lbsr untalk lbra close nop nop nop nop nop L7BDC brn L7BDC L7BDE brn L7BDE ************************************************************* ; ; in: iecdev current IEC device ; blinenum command mode status ; BASIC parameter: [Filename[,Start]] ; out: iecstatus IEC state ; message to current BASIC device: SSSS-EEEE ; only if in command mode, ; SSSS start address hex, ; EEEE end address + 1 hex ; iecend data end address + 1 ; used: a, iecfnaddr, iecfnlen, iecverify, iecmode, iecdev, iecsa load clra ; entry point from statement parser bra ldbase verify lda #$01 ; set verify mode ldbase sta iecverify clr iecmode ; load addr (from disk) lbsr setup ; i/o setup lbra load1 sync ************************************************************* ; ; in: btext current BASIC text position ; out: - ; used: a,b,x parse cmpa #'@' ; new command prefix beq pnew rts ; back from hook pnew leas 2,s ; remove caller address from stack jsr bchget ; get command character leax B/X tstb ; length beq fleave ; =0 -> exit lda iecdev ; current device lbsr listen lda #$6f ; channel 15 (error/command) lbsr seclisten fnext lda ,x+ ; all command bytes lbsr out ; byte to channel decb bne fnext lbsr unlisten ; done fleave rts nop nop ************************************************************* ; ; in: - ; out: hparse statement parser hook ; herror system error hook ; BASIC init BASIC pointer, environment ; used: a,b,x init ldx #hparse ; hook statement parser lda #ocjsr sta ,x+ leau parse,pcr stu ,x ldx #herror ; hook system error handler leau bprintwidth rts ************************************************************* ; ; in: - ; out: hout ; output hook ; used: a,b,x console lda hout cmpa #ocrts beq conothooked lda #-2 ; set printer sta bdev ; BASIC device number jsr bprintcr ; out CR (on printer) lda #ocrts ; remove output hook sta hout conothooked clr bdev ; console BASIC device lbsr untalk ; reset IEC lbsr unlisten lbra setup ; i/o, IEC variables nop nop