.title ZT_driver ... pseudo tape ... ; ; w.j.m. jun 1989 (after ZXdriver 0.2 ...) ; documentation fixed 3-jul-1989 ; mod 18-aug-1989 wjm (0.9): support SMP, i.e. VMS V5 ; mod 14-oct-1992 wjm (0.99): change driver name ZTDRIVER => ZT_DRIVER ; mod 22-oct-1993 wjm (0.99A): port to AXP VMS 1.5 (needs EVAX defined) ; mod 29-jan-1994 wjm (0.99B): small fixes, automatically defined EVAX ; mod 18-mar-1994 wjm (0.99FT): port to AXP VMS T2.0 (heuristic) ; .ident /0.99FT/ ; ;***** ; ; This driver attempts to do the minimum necessary; ; all the 'real' work, including data transfer, ; is done by a (suitably privileged) server process. ; ; Communication: ; driver->server - driver activates server via mailbox message, ; then waits for pseudo-interrupt. ; server->driver - server (possibly) manipulates UCB, ; in particular copies back the ; 'message' area (*); ; then it activates the driver via ; pseudo-interrupt. ; ; (*) Only the following fields are taken from the message area: ; ucb$l_record ; ucb$v_valid (in ucb$w_sts) ; ucb$l_devdepend (from 2nd iosb longword) ; ; It is the server's responsibility to set the device 'ONLINE' ; and to clean up and set the device 'OFFLINE' before terminating. ; ;***** ; ; .ntype __,R31 ; set EVAX nonzero if R31 is a register .if eq <__ & ^xF0> - ^x50 EVAX = 1 .iff EVAX = 0 .endc ; ; .if ne EVAX .library "SYS$LIBRARY:LIB" .library "SYS$DISK:[]ZT" .iff .link "SYS$SYSTEM:SYS.STB"/SELECTIVE_SEARCH .library "SYS$LIBRARY:LIB" .library "ZT" .endc ; $crbdef $dcdef $ddbdef $devdef $dptdef $dyndef $idbdef $iodef $ipldef $irpdef $mtdef $prdef $ssdef $ucbdef $vecdef $wcbdef ; smp_code=0 ;VMS V4 or earlier .iif df UCB$L_DLCK, smp_code=1 ;VMS V5 ; .if ne smp_code $spldef .endc ; .if ne EVAX ;AXP ... ; ;... EVAX=1 -> Step1 .iif ndf WCB$W_NMAP, EVAX=2 ;... EVAX=2 -> Step2 (ndf as of T2.0) .endc ; ; ztdef ; ZT definitions - need $ucbdef ; ; private UCB fields not in ZTDEF ; $defini UCB,dot=ucb_k_ztend $def ucb_q_spare .blkq ; reserve for UCB expansion $def ucb_k_size ; end of UCB $defend UCB ; .page ;***** driver prologue table ; .if ne EVAX ; driver_data ; .if eq EVAX-2 dptab step=2,- name=ZT_DRIVER,- ; Driver name <<<<< adapter=NULL,- flags=dpt$m_svp,- ; for IOC$MOV[FR/TO]USER maxunits=1,- ; want 1 unit only (no UNITINIT) ucbsize=ucb_k_size,- end=end_of_driver .iff dptab step=1,- name=ZT_DRIVER,- ; Driver name <<<<< adapter=NULL,- flags=dpt$m_svp,- ; for IOC$MOV[FR/TO]USER maxunits=1,- ; want 1 unit only (no UNITINIT) ucbsize=ucb_k_size,- end=end_of_driver .endc .iff dptab name=ZT_DRIVER,- ; Driver name <<<<< adapter=NULL,- flags=dpt$m_svp,- ; for IOC$MOV[FR/TO]USER maxunits=1,- ; want 1 unit only (no UNITINIT) ucbsize=ucb_k_size,- end=end_of_driver .endc ; dpt_store INIT ; .if eq smp_code dpt_store UCB,ucb$b_fipl,B,- ipl$_synch ; fork IPL dpt_store UCB,ucb$b_dipl,B,- ipl$_synch ; device IPL = same assume ipl$_synch lt ipl$_mailbox ;note: writing to MBX ; is done at device IPL .iff dpt_store UCB,ucb$b_flck,B,- spl$c_iolock8 ; fork lock index dpt_store UCB,ucb$b_dipl,B,- ipl$_iolock8 ; device IPL = fork IPL assume ipl$_iolock8 lt ipl$_mailbox ;note: writing to MBX ; is done at device IPL .endc dpt_store UCB,ucb$b_devclass,B,- dc$_tape ; device class dpt_store UCB,ucb$b_devtype,B,- dt$_te16 ; device type = TE16 dpt_store UCB,ucb$l_devchar,L,<- ; device characteristics dev$m_avl!- ; available dev$m_idv!- ; input device dev$m_odv!- ; output device dev$m_fod!- ; file oriented dev$m_dir!- ; directory structured dev$m_sdi!- ; single directory dev$m_sqd> ; sequential dpt_store UCB,ucb$l_devchar2,L,- ; (cont'd) dev$m_nnm ; "node$" prefix dpt_store DDB,ddb$l_acpd,L,- ; default ACP <^a"MTA"> ; = MTAACP dpt_store UCB,ucb$w_devbufsiz,W,- ; default buffer size 2048 ; = 2048 dpt_store UCB,ucb$l_media_id,L,- ; media i.d. <^x6D285010> ; media id - TE16 dpt_store REINIT ; dpt_store UCB,ucb$l_devdepend,L,<- ; tape characteristics !- ; format = normal11 !- ; density = 1600 mt$m_sup_pe!- ; support PE only mt$m_lost> ; "position lost" dpt_store UCB,ucb$l_record,L,- ;current tape position 0 ; i.e. BOT dpt_store DDB,ddb$l_ddt,D,- ZT$DDT ; address of DDT <<<<< .if ne EVAX dpt_store UCB,ucb_l_inter,D,- pseudo_interrupt ; (no more controller_init) .iff dpt_store CRB,crb$l_intd+vec$l_initial,D,- controller_init ; controller initialization .endc ; ; dpt_store END ; ; ;***** driver dispatch table ; ;; EVAX note: since we don't need a ctrlinit routine, VAX ddtab is still valid ; ddtab devnam=ZT,- ; device name functb=fdt_table,- start=start_io,- cancel=+IOC$CANCELIO ;cancel: just set flag ; ; ;***** function dispatch table ; .if eq EVAX-2 fdt_ini fdt=fdt_table fdt_buf - ; buffered functions ... - ;... all but data transfer & AVAILABLE (WHY???) fdt_act ACP_STD$READBLK,<- ; read functions => ACP => ... readpblk,- readlblk,- readvblk> fdt_act ACP_STD$WRITEBLK,<- ; write functions => ACP => ... writecheck,- writepblk,- writelblk,- writevblk> fdt_act ACP_STD$ACCESS,<- ; access => ACP only access,- create> fdt_act ACP_STD$DEACCESS,<- ; deaccess => ACP only deaccess> fdt_act ACP_STD$MODIFY,<- ; control => ACP only delete,- modify,- acpcontrol> fdt_act ACP_STD$MOUNT,<- ; mount => ACP only mount> fdt_act MT_STD$CHECK_ACCESS,- ; ** also does EXE$ZEROPARM ** fdt_act EXE_STD$ZEROPARM,<- ; (final) functions with 0 par. nop,- unload,- recal,- drvclr,- packack,- available,- sensechar,- ;(!) rewindoff,- rewind,- sensemode> ;(!) fdt_act EXE_STD$ONEPARM,<- ; (final) functions with 1 par. spacefile,- spacerecord,- skipfile,- skiprecord> fdt_act EXE_STD$SETMODE,<- ; (final) set mode setchar,- setmode> .iff fdt_table: functab ,<- ; valid functions - ;physical: nop,- ;nop (status check only) unload,- ;unload (=rewindoff) spacefile,- ;(=skipfile) recal,- ;'recalibrate' (=rewind) drvclr,- ;'drive clear' erasetape,- ;write extended gap packack,- ;set valid spacerecord,- ;(=skiprecord) writecheck,- ;compare writepblk,- ;write readpblk,- ;read available,- ;unload & clear valid setchar,- ; sensechar,- ; writemark,- ;(=writeof) - ;logical: writelblk,- ;write readlblk,- ;read rewindoff,- ;rewind & unload setmode,- ; rewind,- ; skipfile,- ; skiprecord,- ; sensemode,- ; writeof,- ;write tape mark - ;virtual (ACP only) writevblk,- ;write readvblk,- ;read access,- ; create,- ; deaccess,- ; delete,- ;(???) modify,- ;(???) acpcontrol,- ; mount> ; functab ,<- ; buffered functions ... - ;... all but data transfer & AVAILABLE (WHY???) nop,- unload,- spacefile,- recal,- drvclr,- erasetape,- packack,- spacerecord,- setchar,- sensechar,- writemark,- rewindoff,- setmode,- rewind,- skipfile,- skiprecord,- sensemode,- writeof,- access,- create,- deaccess,- delete,- modify,- acpcontrol,- mount> functab +ACP$READBLK,<- ; read functions => ACP => ... readpblk,- readlblk,- readvblk> functab +ACP$WRITEBLK,<- ; write functions => ACP => ... writecheck,- writepblk,- writelblk,- writevblk> functab +ACP$ACCESS,<- ; access => ACP only access,- create> functab +ACP$DEACCESS,<- ; deaccess => ACP only deaccess> functab +ACP$MODIFY,<- ; control => ACP only delete,- modify,- acpcontrol> functab +ACP$MOUNT,<- ; mount => ACP only mount> functab +MT$CHECK_ACCESS,<- ; check access for - ; functions not handled by ACP erasetape,- writemark,- writeof> functab +EXE$ZEROPARM,<- ; (final) functions with 0 par. nop,- unload,- recal,- drvclr,- erasetape,- packack,- available,- sensechar,- ;(!) writemark,- rewindoff,- rewind,- sensemode,- ;(!) writeof> functab +EXE$ONEPARM,<- ; (final) functions with 1 par. spacefile,- spacerecord,- skipfile,- skiprecord> functab +EXE$SETMODE,<- ; (final) set mode setchar,- setmode> .endc ; .page ; .iif ne EVAX, driver_code ; .if eq EVAX ; ;***** controller initialization ; ; called (1) after loading the driver (not after RELOAD !?) ; (2) after a power failure ; ; r4 - csr ; r5 - idb ; r6 - ddb ; r8 - crb ; r0..r2 - free for use ; ; idb$l_ucblst - ucb (since there is only 1 unit) ; ; ipl: ipl$_power ; ;***** ; controller_init: .if ne EVAX*0 ;; example only .jsb_entry input=r5,output=r0 ;; ; ;; movl #ss$_normal,r0 ; no-op! ;; ; ;; rsb ;; .iff ; movl idb$l_ucblst(r5),r0 ; r0 -> ucb (NOTE: maxunits=1) ; ;;; setting device on-line is left to server program! ;;; bisw #ucb$m_online,- ; set device status "on_line" ;;; ucb$w_sts(r0) ; movl r0,idb$l_owner(r5) ; set permanent controller owner ; movab pseudo_interrupt,ucb_l_inter(r0) ; constant UCB field ; rsb .endc ; .endc ; ; .page ;***** start I/O routine ; ; r3 - IRP ; r5 - UCB ; r0..r2, r4 - free (only r3..r5 saved across WFI) ; ; ipl: ucb$b_fipl, SMP lock: ucb$b_flck ; ; irp$w_func - io function (logical or physical) ; irp$l_media - parameter(s) ; ucb$w_bcnt, ucb$w_boff, ucb$l_svapte describe buffer ; ; ;***** ; start_io: .if ne EVAX .jsb_entry input=,scratch= ; movl irp$l_func(r3),r2 ;IO function + modifiers movl r2,ucb$l_func(r5) ; save function in UCB .iff movzwl irp$w_func(r3),r2 ;IO function + modifiers movw r2,ucb$w_func(r5) ; save function in UCB .endc ; ; set up mailbox request ; .if ne EVAX movl r2,ucb_a_ztmsg+zt_l_func(r5) ; fill in 'function' movl ucb$l_bcnt(r5),- ; ditto for bytecount ucb_a_ztmsg+zt_l_bcnt(r5) .iff movw r2,ucb_a_ztmsg+zt_w_func(r5) ; fill in 'function' movw ucb$w_bcnt(r5),- ; ditto for bytecount ucb_a_ztmsg+zt_w_bcnt(r5) .endc movq irp$l_media(r3),- ; ditto for parameter(s) ucb_a_ztmsg+zt_l_media(r5) .if ne EVAX movl ucb$l_sts(r5),- ; ditto for ucb$l_sts ucb_a_ztmsg+zt_l_ucbsts(r5) .iff movw ucb$w_sts(r5),- ; ditto for ucb$w_sts ucb_a_ztmsg+zt_w_ucbsts(r5) .endc movl ucb$l_record(r5),- ; ditto for ucb$l_record ucb_a_ztmsg+zt_l_record(r5) movl ucb$l_devdepend(r5),- ; ditto for ucb$l_devdepend ucb_a_ztmsg+zt_l_devdepend(r5) movl ucb$l_devchar(r5),- ; ditto for ucb$l_devchar ucb_a_ztmsg+zt_l_devchar(r5) ; .if ne EVAX movl #ss$_devoffline,- ucb_a_ztmsg+zt_l_iosts(r5) clrl ucb_a_ztmsg+zt_l_iobct(r5) ; default 1st iosb longword .iff assume zt_w_iobct eq zt_w_iosts+2 movl #ss$_devoffline,- ucb_a_ztmsg+zt_w_iosts(r5) ; default 1st iosb longword .endc ; ; server there? ; tstl ucb_l_ztmbx(r5) ; server mailbox there? blss 1$ ; br if yes (S0 space!) brw io_err_noserver ; server disappeared ; 1$: ; ; check for special action(s) ; .if ne EVAX extzv #irp$v_fcode,#irp$s_fcode,- ;get major function irp$l_func(r3),r2 .iff extzv #irp$v_fcode,#irp$s_fcode,- ;get major function irp$w_func(r3),r2 .endc ; cmpw r2,#io$_setchar beql 150$ cmpw r2,#io$_setmode beql 160$ cmpw r2,#io$_available beql 175$ brw 20$ ; ; set char/mode ; 150$: ;io$_setchar assume ucb$b_devtype eq ucb$b_devclass+1 movw irp$l_media(r3),- ucb$b_devclass(r5) 160$: ;io$_setmode movw irp$l_media+2(r3),- ucb$w_devbufsiz(r5) brw 20$ ; ; available ; 175$: .if ne EVAX bicl #ucb$m_valid,ucb$l_sts(r5) ;set invalid now bicl #ucb$m_valid,- ucb_a_ztmsg+zt_l_ucbsts(r5) ;also update in message (!) .iff bicw #ucb$m_valid,ucb$w_sts(r5) ;set invalid now bicw #ucb$m_valid,- ucb_a_ztmsg+zt_w_ucbsts(r5) ;also update in message (!) .endc brw 20$ ; ; ; check if i/o is permitted ; 20$: .if ne EVAX bbs #irp$v_physio,irp$l_sts(r3),30$ ; o.k. if physical bbs #ucb$v_valid,ucb$l_sts(r5),30$ ; o.k. if volume valid movl #ss$_volinv,- ucb_a_ztmsg+zt_l_iosts(r5) ; else error: volume invalid .iff bbs #irp$v_physio,irp$w_sts(r3),30$ ; o.k. if physical bbs #ucb$v_valid,ucb$w_sts(r5),30$ ; o.k. if volume valid movw #ss$_volinv,- ucb_a_ztmsg+zt_w_iosts(r5) ; else error: volume invalid .endc brw io_complete ; ; have server do the rest ... ; 30$: ; ; SMP note: postprocessing of the mailbox i/o is done on "this" processor, ; *** I think ***. ; Therefore the mailbox msg will be delivered (by KAST) ; only AFTER ipl drops to ASTDEL, i.e. after wfikpch ; .if eq smp_code dsbint ucb$b_dipl(r5) ;; .iff ;; devicelock - ;; lockaddr=ucb$l_dlck(r5),- ;; lockipl=ucb$b_dipl(r5),- ;; savipl=-(sp),- ;; preserve=NO ;; .endc ;; ;; .if ne EVAX ;; bitl #ucb$m_cancel,ucb$l_sts(r5) ;; I/O to be aborted? .iff ;; bitw #ucb$m_cancel,ucb$w_sts(r5) ;; I/O to be aborted? .endc ;; beql 21$ ;; brw io_cancelled ;; br if yes, do it now! 21$: ;; pushr #^m ;; movl #zt_msglen,r3 ;; movab ucb_a_ztmsg(r5),r4 ;; movl ucb_l_ztmbx(r5),r5 ;; jsb g^EXE$WRTMAILBOX ;; popr #^m ;; blbs r0,23$ ;; br if o.k. ;; .if eq smp_code ;; enbint ;; .iff ;; deviceunlock - ;; lockaddr=ucb$l_dlck(r5),- ;; newipl=(sp)+,- ;; preserve=NO ;; .endc brw io_err_noserver 23$: ;; wfikpch io_timeout ;; (dummy timeout) ; ;; here with device lock only iofork ; here with fork lock only ; server replied ... ; brw io_complete ;o.k., all done ; ; ; i/o cancelled ... ; ipl: _dipl with _fipl on stack ; io_cancelled: ;; .if eq smp_code ;; enbint ;; lower IPL (to _fipl) .iff ;; deviceunlock - ;; lockaddr=ucb$l_dlck(r5),- ;; newipl=(sp)+,- ;; preserve=NO ;; .endc ; .if ne EVAX movl #ss$_cancel,- ucb_a_ztmsg+zt_l_iosts(r5) ; set status clrl ucb_a_ztmsg+zt_l_iobct(r5) ; clear byte count .iff assume zt_w_iobct eq zt_w_iosts+2 movzwl #ss$_cancel,- ucb_a_ztmsg+zt_w_iosts(r5) ; set status .endc brw io_complete ; ; ; i/o timeout - we cannot allow for an asynchronous event ; ipl: ucb$b_dipl, SMP locks: ucb$l_dlck + ucb$b_flck ; io_timeout: ;; .if ne EVAX bisl #,ucb$l_sts(r5) ;; re-set interrupt expected bicl #,ucb$l_sts(r5) ;; and powerfail .iff bisw #,ucb$w_sts(r5) ;; re-set interrupt expected bicw #,ucb$w_sts(r5) ;; and powerfail .endc rsb ;; return! ; ; ; server gone ; io_err_noserver: .if ne EVAX bicl #,- ;clear valid & online ucb$l_sts(r5) .iff bicw #,- ;clear valid & online ucb$w_sts(r5) .endc clrl ucb_l_ztmbx(r5) ;clear our indicator brb io_complete ;default values still o.k. ; ; ; i/o completed (normally by server) ; io_complete: .if ne EVAX bicl #,- ucb$l_sts(r5) ; cleanup some UCB flags .iff bicw #,- ucb$w_sts(r5) ; cleanup some UCB flags .endc ; movl ucb_a_ztmsg+zt_l_record(r5),- ;care for ... ucb$l_record(r5) ; ucb$l_record ... .if ne EVAX extzv #ucb$v_valid,#1,- ucb_a_ztmsg+zt_l_ucbsts(r5),r2 ; ucb$v_valid ... insv r2,#ucb$v_valid,#1,ucb$l_sts(r5) .iff extzv #ucb$v_valid,#1,- ucb_a_ztmsg+zt_w_ucbsts(r5),r2 ; ucb$v_valid ... insv r2,#ucb$v_valid,#1,ucb$w_sts(r5) .endc movl ucb_a_ztmsg+zt_l_devdepend(r5),r1 ; 2nd iosb longword ... movl r1,ucb$l_devdepend(r5) ; ucb$l_devdepend ... .if ne EVAX movzwl ucb_a_ztmsg+zt_l_iosts(r5),r0 insv ucb_a_ztmsg+zt_l_iobct(r5),- #16,#16,r0 ; 1st iosb longword .iff assume zt_w_iobct eq zt_w_iosts+2 movl ucb_a_ztmsg+zt_w_iosts(r5),r0 ; 1st iosb longword .endc ; ; ; special ACP-related cleanup on error (... from DEC ...) ; ... destroys r2 and r4 !! ; blbs r0,done ;br if no error .if ne EVAX bbc #irp$v_virtual,irp$l_sts(r3),- ;br if not virtual done .iff bbc #irp$v_virtual,irp$w_sts(r3),- ;br if not virtual done .endc ; movq r0,-(sp) ;save r0,r1 movl irp$l_wind(r3),r4 ;... .if eq EVAX-2 clrl wcb$l_nmap(r4) ;... .iff clrw wcb$w_nmap(r4) ;... .endc movl ucb$l_vcb(r5),r4 ;r4=vcb movab ucb$l_ioqfl(r5),r2 ;r2=i/o queue listhead (end of list) movl r2,r0 ;r0=IRP pointer 70$: movl (r0),r0 ;get next IRP cmpl r0,r2 ;end of list? beql 79$ ;br if yes .if ne EVAX bbc #irp$v_virtual,- irp$l_sts(r0),70$ ;skip IRP if not virtual .iff bbc #irp$v_virtual,- irp$w_sts(r0),70$ ;skip IRP if not virtual .endc movl 4(r0),r0 ;back up r0 remque @0(r0),r1 ;remove IRP from I/O queue insque (r1),@4(r4) ;insert it into blocked queue (in VCB) brb 70$ 79$: movq (sp)+,r0 ;note: r2 & r4 destroyed ; done: reqcom ; .page ;***** ZT pseudo-interrupt ; ; r0 ... r4 free ; r5 -> UCB ; ipl = ucb$b_dipl, SMP lock: ucb$l_dlck ; ; function: ; on any expected "interrupt", the driver is called back. ; we also clear ucb$m_int and ucb$m_tim ; ; pseudo_interrupt: .if ne EVAX .jsb_entry input=r5,output=r5,scratch= ; bbc #ucb$v_int,ucb$l_sts(r5),90$ ; bicl #,- ucb$l_sts(r5) ; no more interrupts desired ; evax_ldq r3,ucb$q_fr3(r5) evax_ldq r4,ucb$q_fr4(r5) .iff bbc #ucb$v_int,ucb$w_sts(r5),90$ ; bicw #,- ucb$w_sts(r5) ; no more interrupts desired assume ucb$l_fr4 eq ucb$l_fr3+4 movq ucb$l_fr3(r5),r3 .endc jsb @ucb$l_fpc(r5) ; call driver 90$: rsb ; ; ;***** end of driver ; end_of_driver: ; .end