nocompress=0
	.title	ztdriver	;... 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 => ztdriver
;	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)
;	mod 05-oct-1994 gce make multi-unit etc. Means adding unit init for
;		all units so pseudo interrupt will work...
;
	.ident	/V1.1/
;
;*****
;
;	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$l_intv	.blkl	1	;interrupt loc
$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=ztdriver,-	; Driver name		<<<<<
		adapter=NULL,-
		flags=dpt$m_svp,-	; for IOC$MOV[FR/TO]USER
		maxunits=100,-		; want lots of units max
		unitinit=zt_UNIT_INIT,-
		ucbsize=ucb_k_size,-
		end=end_of_driver
.iff
	dptab	step=1,-
		name=ztdriver,-	; Driver name		<<<<<
		adapter=NULL,-
		flags=dpt$m_svp,-	; for IOC$MOV[FR/TO]USER
		maxunits=100,-		; want lots of units max
		unitinit=zt_UNIT_INIT,-
		ucbsize=ucb_k_size,-
		end=end_of_driver
.endc
.iff
	dptab	name=ztdriver,-	; Driver name		<<<<<
		adapter=NULL,-
		flags=dpt$m_svp,-	; for IOC$MOV[FR/TO]USER
		maxunits=100,-		; want lots of units max
		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
			<mt$k_normal11@mt$v_format>!-	; format = normal11
			<mt$k_pe_1600@mt$v_density>!-	; density = 1600
			mt$m_sup_nrzi!-			; support NRZI
			mt$m_sup_pe!-			; support PE 
			mt$m_sup_gcr!-			; support GCR
			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
        DPT_STORE CRB,CRB$L_INTD+VEC$L_UNITINIT,D,- ;UNIT INIT ADDRESS
                      zt_UNIT_INIT              ;...
.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???)
		<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>

	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 **
		<erasetape,-
		writemark,-
		writeof>
	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
;
; unit init routine
.if	ne  EVAX
	.if	eq,evax-1
;step 1
zt_unit_init: .jsb_entry input=<r3,r4,r5>,output=<r0>,-
	PRESERVE=<R6,R7,R8,R9,R10,R11>,-
	 SCRATCH=<R1,R2>
	movab	pseudo_interrupt,ucb$l_intv(r5)	;store int. vector in ucb
	movab	pseudo_interrupt,ucb_l_inter(r5); constant UCB field
	movl	#1,r0
	rsb
	.iff
;step 2
zt_unit_init: $driver_unitinit_entry
	movab	pseudo_interrupt,ucb$l_intv(r5)	;store int. vector in ucb
	movab	pseudo_interrupt,ucb_l_inter(r5); constant UCB field
        movzwl  #ss$_normal,r0
        RET                             ;RETURN
	.endc
.iff
; vax init
zt_unit_init:
	movab	pseudo_interrupt,ucb$l_intv(r5)	;store int. vector in ucb
	movab	pseudo_interrupt,ucb_l_inter(r5); constant UCB field
	rsb
.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=<r3,r5>,scratch=<r0,r1,r2,r4>
;
	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,
;	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<r3,r4,r5>			;;
	movl	#zt_msglen,r3			;;
	movab	ucb_a_ztmsg(r5),r4		;;
	movl	ucb_l_ztmbx(r5),r5		;;
	jsb	g^EXE$WRTMAILBOX		;; tell the host process of work
	popr	#^m<r3,r4,r5>			;;
	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$:						;;
; Notice this unit's R5 distinguishes it from all others. Dummy interrupt 
; uses init ptr to get back; every UCB gets this vector.
; This routine just saves R3, R4, and R5 in the UCB and waits for
; something else to call the code here. Normally an interrupt service
; would "return" here but here the dummy code just JSB's here
; so the very next thing done is iofork to get into fork state
; as expected, to finish an I/O up.
;
	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$m_int>,ucb$l_sts(r5)	;; re-set interrupt expected
	bicl	#<ucb$m_timout!-		;; clear timout,
		ucb$m_tim!-			;;	timed,
		ucb$m_power>,ucb$l_sts(r5)	;;	and powerfail
.iff
	bisw	#<ucb$m_int>,ucb$w_sts(r5)	;; re-set interrupt expected
	bicw	#<ucb$m_timout!-		;; clear timout,
		ucb$m_tim!-			;;	timed,
		ucb$m_power>,ucb$w_sts(r5)	;;	and powerfail
.endc
	rsb					;; return!
;
;
; server gone
;
io_err_noserver:
.if ne EVAX
	bicl	#<ucb$m_online!ucb$m_valid>,-	;clear valid & online
		ucb$l_sts(r5)
.iff
	bicw	#<ucb$m_online!ucb$m_valid>,-	;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$m_tim!ucb$m_int!-
		ucb$m_timout!ucb$m_power!-
		ucb$m_cancel>,-
		ucb$l_sts(r5)			; cleanup some UCB flags
.iff
	bicw	#<ucb$m_tim!ucb$m_int!-
		ucb$m_timout!ucb$m_power!-
		ucb$m_cancel>,-
		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
; if writing compressed data, pretend it was all there.
; Basic problem here is that we actually put less on the tape, but
; will return as if we write it all. On read the count again is adjusted.
	movzwl	ucb_a_ztmsg+zt_l_iosts(r5),r0
	movzwl	irp$l_bcnt(r3),r4
	extzv #IRP$V_FCODE,#IRP$S_FCODE,IRP$L_FUNC(R3),R2
	insv	ucb_a_ztmsg+zt_l_iobct(r5),-
		#16,#16,r0				; 1st iosb longword
.iff
	assume	zt_w_iobct eq zt_w_iosts+2
	movzwl	irp$w_bcnt(r3),r4
	extzv #IRP$V_FCODE,#IRP$S_FCODE,IRP$W_FUNC(R3),R2
	movl	ucb_a_ztmsg+zt_w_iosts(r5),r0		; 1st iosb longword
.endc
	.if	ndf,nocompress
	cmpl	r2,#io$_writepblk	;write function?
	bneq	51$
	insv	r4,#16,#16,r0		;if write, claim it all got thru.
51$:
	.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
;	Note that the next instruction after the JSB does a fork
;	to get to proper synch state.
;
pseudo_interrupt:
.if ne EVAX
	.jsb_entry	input=r5,output=r5,scratch=<r0,r1,r2,r3,r4>
;
	bbc	#ucb$v_int,ucb$l_sts(r5),90$ ; if not waiting int., fake none
;
	bicl	#<ucb$m_int!ucb$m_tim>,-
		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$m_int!ucb$m_tim>,-
		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
