.enabl lc .title SC Handler - Spectrum Cartridge Tape Handler .ident /01.7/ .globl fsmdis,fsmabt,fsmdon,fsmerr,restor,code,dvtbl .globl fsmsiz,$fkptr .if ne mmg$t .mcall .synch .globl oldba,extadr,jobnm,synblk,temp,sink,erbsav .globl $mpptr .endc ;debug = 0 ;debug flag, comment out for nodebug .sbttl Documentation .if ne 0 Author: Peter Miedecke Webster Electronics 17 Malvern Street Bayswater, Victoria 3153 Australia (03)729-8444 Modification History. --------------------- 1.00 Oct-82 PBM/ Initial version 1.1 Jun-83 PBM/ Make space forward actually space rather than read into space behind I/O page. 1.2 Jul-83 PBM/ Did not detect physical end-of-cartridge properly. 1.3 Sep-83 PBM/ Would not wild copy under TSX-Plus caused by S & H, bless their little hearts, making a small mod to the magtape drivers see "determine job number", following sc1: 1.4 Oct-83 PBM/ REGDEF file definitions incorporated, 'Continuation' as,done in the RSX driver, included to stop the occasional hang 1.5 Jan-84 PBM/ Support for 11/73, by flushing the cache, added 1.6 Jan-85 TAE/ Disable cache flush for V.4 uCode MFU Add SNITCH Debug to say what's happening Change c1.ser to c0.dat in read error routine c1.ser is ">8 retries on a block since last read-status command. Causes unnecessarry failures Changed fsmsc.mac to allow 65535 block space forwards 1.7 Jan-85 CEC/ Abort writes past eot for SAVRES to work Alter c0.dat interpretation in read error routine so that copies to tape will work Assembly options:- SC=SYCND,SC for RT-11 SC=SYCND,XM,SC for RT-11 XM and TSX-Plus .endc .page .if ne 0 This driver handles the Archive Corporation 'Sidewinder' 1/4 inch Streaming Cartridge Tape Drive, model 9020 I. It is designed to emulate, as far as possible, a magnetic tape. As such it has all the features of the magtape hardware handler, and as such can be interfaced to the File Structured Mag-Tape handler, FSM. ( I Hope). These SPFUNs are supported:- 365 re-tension tape 366 initialize tape 367 Return current status block ( 6 words) 370 Read variable length block 371 Write variable length block 372 Rewind and offline the cartridge - Offline is not supported. 373 Rewind to BOT. 374 Write with extended inter record gap - simulated by ordinary write 375 Backspace - NOT SUPPORTED 376 Forward space. 377 Write file mark .endc .page .sbttl ;Cartridge Tape Definitions ;Register set c.csr =177340 ;control and status register c.wc =c.csr+2 ;transfer count c.ba =c.wc+2 ;bus address c.bax =c.ba+2 ;bus address extension ;Status bits, in c.csr cs.ned = 1 ;drive offline cs.wle = 2 ;drive write locked cs.par = 4 ;write parity error cs.exc = 10 ;exception - next command MUST BE read status cs.ie = 100 ;interrupt enable cs.rdy = 200 ;drive ready ;Command types, bits 5-7 of c.csr, high byte cc.sel = 0*40 ;select cc.pos = 1*40 ;position cc.wrt = 2*40 ;write cc.wfm = 3*40 ;write file mark cc.rd = 4*40 ;read cc.rfm = 5*40 ;read file mark cc.rst = 6*40 ;read status ;Command data, bits 0-4 of c.csr, high byte ;for Select command cd.sl0 = 1 ;select drive zero ;cd.sl1 = 2 ; one ;cd.sl2 = 4 ; two cd.con = 10 ;continue previous read or write cd.lit = 20 ;drive selected light ;for position command cd.bot = 1 ;beginning-of-tape cd.erz = 2 ;erase tape cd.ret = 4 ;retension tape ; ;The Read Status command returns 6 words of status ;the word definitions c.0wrd = 0 ;status word 0 c.1wrd = 1 ; 1 c.2wrd = 2 ; 2 c.3wrd = 3 ; 3 c.4wrd = 4 ; 4 c.5wrd = 5 ; 5 ;c0wrd status c0.eof = 1*400 ;file mark detected c0.fil = 2*400 ;data was filler - ???? c0.dat = 4*400 ;data error c0.eot = 10*400 ;end-of-tape detected - 2 more block may be written c0.wpr = 20*400 ;write protect error c0.nod = 40*400 ;no drive c0.noc = 100*400 ;no cartridge c0.set = 200*400 ;some bits in this status byte are set ;c1wrd status c1.rst = 1 ;reset has occurred c1.bot = 10 ;at beginning of tape c1.ser = 20 ;serious, but recoverable, error occurred c1.dnf = 40 ;data not found c1.ill = 100 ;illegal command c1.set = 200 ;some bits in this status byte are set ;words 2 and 3 make up soft error count, for read or writes c.serr = c.2wrd ;16 bits ;words 4 and 5 are the underrun count, for read and write c.ucnt = c.4wrd ;16 bits ; Symbols and Definitions $retn = -13 $erz = -12 $gstat = -11 $read = -10 $write = -7 $rwoff = -6 $rwd = -5 $wrext = -4 $bksp = -3 $fwdsp = -2 $wrfm = -1 $rdwt = 0 $close = 1 $delet = 2 $lookup = 3 $enter = 4 $rename = 5 dummy = 0 ;monitor symbols illarg = 5 devinuse= 2 spusr = 272 monlow = 54 qcomp = 270 ;fsm error codes noqual = 0 drivegone = 1 poserr = 2 memerr = 3 writelok= 4 recerr = 5 smlrec = 6 eofcode = 1 eotcode = 2 eofeot = 3 botcode = 4 endcode = 10 cswherr = 1 csweof = 20000 ;queue element symbols q.csw = -2 q.blk = 0 q.func = 2 q.jnun = 3 q.buf = 4 q.wcnt = 6 ;Macro to initiate i/o and set up interrupt dispatch address .macro execute command mov command,-(sp) call execute .endm ;Macro to set up relocated address .macro movrel p1,p2 mov pc,-(sp) add #p1-.,(sp) mov (sp)+,p2 .endm .mcall .drdef,.fork ;define the driver .drdef sc,11,spfun$!specl$!hndlr$,0,c.csr,214 ;driver status bits s.rco = 1 ;in 'read-continuation' mode s.wco = 2 ; 'write-continuation' .page .sbttl i/o initiation section .drbeg sc sc: .if ne mmg$t mov sccqe,r5 ;point at queue element cmp (r5)+,(r5)+ ;correct pointer jsr pc,@$mpptr ;get buffer addresses mov (sp)+,oldba ;bus address mov (sp)+,r0 ;extended memory address ash #-4,r0 ;shift to correct position mov r0,extadr .endc jmp fsmdis ;call the files service manager $sc:: ;see if initialization needed mov #c.csr,r5 ;set up csr address tstb init ;first time through? bne schk ;no captain! clrb @#c.bax+1 ;force reset on drive comb init ;now not first time through mov @#4,-(sp) ;save nxm trap catcher mov pc,r0 ;compute address add #nxmkdj-.,r0 mov r0,@#4 ;set up in nxm trap tst @#177746 ;cache exist? bcs 10$ ;no mov #nop,exkdj ;enable kdj cache flush 10$: mov (sp)+,@#4 ;restore nxm catcher 20$: bit #cs.exc,@r5 ;has exception come up yet? beq 20$ ;wait for it... ;see that all is ok. schk: tst (r3)+ ;point at q$func bit #cs.rdy,@r5 ;ready? beq scerr ;no bit #cs.ned,@r5 ;drive online? beq sc0 ;yes scerr: jmp error sc0: bit #cs.exc,@r5 ;exception? beq sc1 ;no mov r3,(pc)+ ;save queue element pointer scblok:: .word 0 ; .if df debug jsr r5,snitch .byte 'x,0 ;report exception forced read status .endc jsr pc,rdstat ;read status (this must be done) sc01: execute #;select the drive mov scblok,r3 ;and restore r3 sc1: bit #c0.eot,scstat beq sc001 mov r3,(pc)+ sc0001: .word 0 jsr pc,rdstat mov sc0001,r3 sc001: mov @r3,r0 ;get job num/drive and func movb r0,r4 ;set up function bic #^c<3400>,r0 ;isolate unit bne scerr ;error! clr nfsread ;reset file structured read indicator ;determine job number mov @r3,r0 ;get word swab r0 ;set up properly asr r0 asr r0 asr r0 ;*********************************************************** bic #177740,r0 ;mod necessary for TSX-Plus .if ne mmg$t movb r0,jobnm .endc ;*********************************************************** movrel $tbl,r5 ;point at drive table cmp #$lookup,r4 ;lookup? bne 10$ ;no ;see if drive available tst @2(r3) ;any file name? beq 1$ ;no jmp error ;yes - not allowed 1$: cmpb #-1,@r5 ;drive available? beq 5$ ;yes cmpb r0,@r5 ;is it ours? beq 5$ ;yes ;say drive in use mov @#monlow,r1 ;point at monitor mov #devinuse,spusr(r1) ;say "in use" jsr pc,restor ;restore registers jmp $done ;take completion return ;drive available 5$: clr 4(r3) ;clear word count movb r0,@r5 ;indicate we own it jmp return ;and return ;function other than lookup 10$: cmp #$close,r4 ;close? bne 20$ ;no movb #-1,@r5 ;drive available jmp return ;and return ;at last, a function that uses the cartridge! 20$: cmp #$retn,r4 ;good spfun? blos 40$ ;yes set up tst r4 ;read or write? beq 22$ jmp error ;no - error 22$: mov r3,r1 ;point at queue element clr -2(r1) ;clear block number cmp (r1)+,(r1)+ ;point at word count mov #$read,r4 ;assume read tst @r1 ;is it a read? bpl 25$ ;yes neg @r1 ;write - correct count inc r4 ;make write spfun br 30$ 25$: com nfsread ;say file structured read 30$: mov r4,code ;save function ;set up for i/o 40$: add #funtab-table,r4 ;point at function table mov r4,lastcom ;save as last command tst (r3)+ ;point at q$buf .if ne mmg$t ;if memory management mov oldba,@#c.ba ;low order.... mov extadr,@#c.bax ;and high order addresses tst (r3)+ ;ensure queue pointer correct .iff mov (r3)+,@#c.ba ;low order clr @#c.bax ;ensure high order clear .endc mov (r3),r1 ;get word count mov r1,scblok ;and save in case block count neg r1 ;make negative mov r1,@#c.wc ;and set up .iif df debug mov #'F,ffwrep ;Set f.fwsp report to 'F' redo: jsr pc,dispat ;and dispatch table: .byte f.ret-table ;re-tension tape .byte f.erz-table ;erase (zero) the cartridge .byte f.gst-table ;get status .byte f.read-table ;read .byte f.writ-table ;write .byte f.rwdo-table ;rewind and offline .byte f.rwd-table ;rewind .byte f.wrig-table ;write extended irg .byte f.bksp-table ;backspace .byte f.fwsp-table ;forward space .byte f.wrtm-table ;write tape mark funtab: .byte cc.pos!cd.ret ;retension .byte cc.pos!cd.erz ;erase .byte cc.rst ;get status .byte cc.rd ;read .byte cc.wrt ;write .byte cc.pos!cd.bot ;rewind .byte cc.pos!cd.bot ;rewind .byte cc.wrt ;write, extended irg .byte 0 ;no backspace fwscmd: .byte cc.rd ;space forward .byte cc.wfm ;write file mark .even .page ;execute the command ;forward space is read with zero transfer count f.fwsp: .if df debug jsr r5,snitch ffwrep: .byte 'F,0 ;forward space mov #'.,ffwrep ;change report .endc clr @#c.wc ;no blocks to transfer dec scblok ;decrement block count tst eoflag ;eof this time? bne 10$ br fread2 10$: jmp sbcnt ;yes - exit properly f.read: .if df debug jsr r5,snitch .byte 'R,0 .endc tst eoflag ;did eof occur last time? beq fread2 gueof: jmp ueof ;yes fread2: bit #s.rco,status ;continuation mode? beq 10$ ;no bis #cd.con*400,r5 ;set up continuation 10$: bis #s.rco,status ;now in continuation mode exkdj: br dofunc ;this branch is a nop if running ;on kdj-11 bis #400,@#177746 ;flush the cache br dofunc ;and go f.wrig: .if df debug jsr r5,snitch .byte 'G,0 br fwrit2 .endc f.writ: .if df debug jsr r5,snitch .byte 'W,0 .endc fwrit2: bit #c0.eot,scstat bne gueof bit #s.wco,status ;continuation mode beq 10$ ;no bis #cd.con*400,r5 ;set up continuation 10$: bis #s.wco,status ;now in continuation mode br dofunc ;and go f.gst: .if df debug jsr r5,snitch .byte 'S,0 br ferz2 .endc f.rwd: .if df debug jsr r5,snitch .byte 'B,0 br ferz2 .endc f.rwdo: .if df debug jsr r5,snitch .byte 'O,0 br ferz2 .endc f.wrtm: .if df debug jsr r5,snitch .byte 'M,0 br ferz2 .endc f.ret: .if df debug jsr r5,snitch .byte 'T,0 br ferz2 .endc f.erz: .if df debug jsr r5,snitch .byte 'Z,0 .endc ferz2: bic #s.wco!s.rco,status ;not in continuation mode dofunc: bis #cs.ie,r5 ;enable interrupts execute r5 ;commence i/o bcs errdis ;error dispatch routine ;check if forward space fwdchk: cmp #fwscmd-funtab,lastcom ;is it? bne finish ;no tst scblok ;more to space? beq finish ;no - finish up mov lastcom,r4 ;set up command br redo ;and re-do ;backspace - just say done f.bksp: .if df debug jsr r5,snitch .byte 'K,0 .endc ;I/O completion return finish: jmp fsmdon ;via file service manager .page .sbttl error routines ;fatal i/o error error: clr status ;reset status mov sccqe,r4 ;point at i/o packet bis #hderr$,@-(r4) ;set hard error bit mov #-1,$tbl ;indicate drive available ;return to the file service manager return: jsr pc,restore ;restore registers jmp fsmdon ;error dispatcher errdis: mov lastcom,r4 ;get last command jsr pc,abochk ;set up status .if df debug jsr pc,snitr3 ;print out contents of r3 .endc jsr pc,dispat ; taberr: .byte e.ret-taberr .byte e.erz-taberr .byte e.gst-taberr .byte e.rd-taberr .byte e.wrt-taberr .byte e.rwd-taberr .byte e.rwd-taberr .byte e.wrt-taberr .byte 0 ;backspace not allowed .byte e.fwd-taberr .byte e.wfm-taberr tabere = . ;end of error dispatch table .even ;space forward error e.fwd: ;read error e.rd: bit #c1.dnf,r3 bne 10$ ;maybe found erased tape, logical eof bit #c0.dat,r3 ;irrecoverable data error? bne retbad ;yes - immediatley return error bit #c0.eot,r3 ;physical end-of-tape? bne reteot ;yes - return eot bit #c0.eof,r3 ;eof or eot? beq 10$ ;no tst swc ;data transfer finish? bne 20$ ;no - real eof com eoflag ;say eof next time br fwdchk ;and treat as ok 10$: bit #c0.dat,r3 ;run into blank tape? beq retbad ;no 20$: cmp #fwscmd-funtab,lastcom ;forward space? bne reteof ;no - just eof ;set up block count in users status block sbcnt: .if eq mmg$t mov @sccq,r5 ;point at queue element beq 5$ ;no status block definied mov scblok,2(r5) ;set up remaining blocks in users ;status block .iff mov scblok,errbl2 ;set up for exit .endc 5$: tst eoflag ;at user level? bne ueof ;yes - ensure user flag set br reteof ;just return eof ;erase tape, write error and write file mark e.erz: e.wfm: e.wrt: bit #cs.wle,@#c.csr ;write lock? beq 10$ ;no mov #writelok,r5 ;say write-locked br abort 10$: bit #c0.dat,r3 ;fatal? can't happen during write but? bne retbad ;yes bit #c0.eot,r3 ;eot error? beq retbad ;no, return with error up tst swc bne reteot br fwdchk ;rewind error e.rwd: bit #c1.bot!c1.ill,r3 ;at bot? bne finish ;that's ok then br retbad ;read status and others e.ret: e.gst: br retbad ;return eot status reteot: mov #eotcode,r4 br ret1 ;return eof status from user level ueof: .iif ne mmg$t com $uflag ;say at user level ;return eof status reteof: mov #eofcode,r4 ret1: mov #csweof,-(sp) br excep .page ;abort check routine - set up registers, abort if serious error abochk: mov scstat,-(sp) ;get first word of status bic #377,@sp ;drop bottom bits mov scstat+2,r3 ;get second word bic #177400,r3 ;drop top bits bis (sp)+,r3 ;and so set up r3 with status bit #c0.nod!c0.noc,r3 ;serious error? beq 10$ ;no .if df debug jsr r5,snitch .byte 'a,0 .endc tst (sp)+ ;fix up stack mov #drivegone,r4 ;say drive gone br abort 10$: rts pc ;error - just abort ; retbad: clr r4 ;no error number abort: mov #cswherr,-(sp) excep: mov (sp)+,r5 mov #-1,$tbl ;say drive now available clr eoflag ;and down eof flag .if df debug jsr r5,snitch .byte 'e,0 .endc jmp fsmerr ;nxm catcher for kdj test nxmkdj: bis #1,2(sp) ;just return with carry set rti .page .sbttl Command Execution execute: bit #cs.rdy,@#c.csr ;drive ready? bne 10$ ;yes halt ;NOOOOOOOOOOO! 10$: mov (sp)+,reent+2 ;set up interrupt dispatch address mov (sp)+,@#c.csr ;initiate command execution jsr pc,restore ;restore registers rts pc ;and wait completion ;command dispatcher DISPAT: ADD @SP,R4 MOVB FUNTAB-TABLE(R4),R5 swab r5 ;position command in high byte bic #377,r5 ;kill all lower bits MOVB @R4,R4 ;get offset (with sign extend) bic #177400,r4 ;kill the sign extend, Peter ADD (SP)+,R4 JMP @R4 ;Snitch Routine, reports commands to 1st. serial terminal ;Call convention is JSR R5,SNITCH..... .WORD ',0 .if df debug sncsr = 176504 ;CSR we will use snitch: clr @#sncsr ;NO Interrupts to host! 5$: tstb @#sncsr ;see if ready bpl 5$ ;wait till it is mov (r5)+,@#sncsr+2 ;send information rts r5 snitr3: jsr r5,snitch ;make it pretty .byte '<,0 mov #6,-(sp) ;counter mov r3,-(sp) ;data asl (sp) ;rol down 1st bit adc (sp) ;silly bloody processor mov (sp),-(sp) ;get the copy bic #177776,(sp) ;isolate lsB br 20$ ;to print 1st digit 10$: asl (sp) ;get msd to lsd adc (sp) asl (sp) ;get msd to lsd adc (sp) asl (sp) ;get msd to lsd adc (sp) mov (sp),-(sp) ;take a working copy bic #177770,(sp) ;isolate lsd 20$: add #'0,(sp) ;make numeral mov (sp)+,30$ ;put in right place jsr r5,snitch ;print it 30$: .word 0 ;data to print dec 2(sp) ;downcount bne 10$ ;next digit tst (sp)+ ;pop data tst (sp)+ ;pop counter jsr r5,snitch ;cleanup .byte '>,0 rts pc .endc .page .sbttl Interrupt routine .drast sc,5,abt .fork scfblk ;fork bit #cs.exc!cs.wle,@#c.csr ;any status from i/o? beq 10$ .if df debug jsr r5,snitch .byte 'i,0 ;exception forced stat. rd. .endc br gstatus ;yes - get it 10$: clc ;ensure carry not set reent: jmp @#0 ;and return to user ;Status was returned from i/o. Get it and set it up for i/o routine gstatus: mov reent+2,stret+2 ;set up status return address gstat: movrel scstat,@#c.ba ;status block address bic #s.rco!s.wco,status ;cant now be in continuation mode clr @#c.bax ;ensure no memory extension mov @#c.wc,(pc)+ ;save word count for error checks swc: .word 0 mov #-6,@#c.wc ;and 3 words, 6 bytes execute # ;read in status sec ;say we have got status stret: jmp @#0 ;dispatch to users routine ;read status rdstat: mov (sp)+,stret+2 br gstat .page .SBTTL INTERRUPT HANDLER AND ABORT ENTRY POINTS ;for the time being, does nothing abt: mov r3,-(sp) ;get a register mov sccqe,r3 ;get i/o request beq 50$ ;none outstanding movb q.jnun(r3),-(sp) ;get job number movb (sp)+,r3 asr r3 asr r3 asr r3 bic #177740,r3 ;phew... cmp r3,r4 ;abort for this job? bne 50$ ;no mov #1,scblok ;stop any positioning a.s.a.p mov dvtbl,r3 ;get address of drive info beq 50$ ;none there! mov #-1,(r3)+ ;file seq num mov #-1,(r3)+ ;current block mov #-1,(r3)+ ;desirec block clr (r3)+ ;file tape and tape posn clr (r3)+ ;file name start 50$: mov (sp)+,r3 rts pc rts pc ;completion routine. includes check for interrupt level $done:: .IF NE MMG$T MOV PC,R4 ADD #sccqe-.,R4 MOV @#MONLOW,R5 TST SINK BNE 1$ JMP @QCOMP(R5) 1$: CLR SINK JSR PC,@QCOMP(R5) tst $uflag ;at user level? beq 2$ ;no mov temp,r0 ;so ignore all the '.SYNCH' junk clr $uflag ;reset flag br 3$ 2$: MOV PC,R4 ADD #SYNBLK-.,R4 .SYNCH BR BADSYN 3$: MOV ERBSAV,R1 BIS #30000,@#177776 MOV R0,-(SP) nop MTPI (R1)+ MOV ERRBL2,-(SP) MTPI (R1)+ BADSYN: RTS PC .iff .drfin sc .ENDC sccq:: .WORD DUMMY DRIVEN==1 DVINFO::.REPT DRIVEN .WORD -1 ;file sequence number .WORD -1 ;current block number .WORD -1 ;? block number .BYTE DUMMY ;file type .BYTE 0 ;tape position indicator .WORD DUMMY,DUMMY,DUMMY ;file name, in rad50 .word 0 ;saved last tranfer size, in blocks .ENDR .page .sbttl miscellanesous data areas ;fork block ; scfblk: .blkw 5. ;status block scstat: .blkw 6. ;6 words long ;driver status status: .word 0 nfsread:.word 0 ;-1 if file structured read $tbl: .word -1 ;owner of drive eoflag: .word 0 ;-1 if eof occurred on last read lastcom: .word 0 ;last command, for error recovery .IF NE MMG$T $uflag: .word 0 ;set if at USER level oldba: .word 0 ;bus address extadr: .word 0 ;extended memory address SYNBLK: .WORD DUMMY JOBNM: .WORD DUMMY .WORD DUMMY,DUMMY TEMP: .WORD DUMMY .WORD -1,0 SINK: .WORD DUMMY ERBSAV: .WORD DUMMY ERRBL2: .WORD DUMMY .ENDC init: .byte 0 ;zero only if first time through .end