.TITLE	WQDRIVER - VAX/VMS VIRT DISK DRIVER w/shadowing
	.IDENT	'V1a'
;	.link 'sys$system:sys.stb'/sel
;
; Changed by making it fd1 type and adding nodename prefix characteristic
; so that hopefully it will now work with MSCP.
;
; Added save/restore of IRP$L_MEDIA for second I/O completion (by VDDRIVER)
; so that error path code that assumes this field unaltered will work. 4/14/89
;
;md$stat=1
;x$$$dt=1	;call xdelta
; Note: define symbol VMS$V5 to assemble in VMS V5.x or later. Default
; assembly without this definition produces a VMS V4.x driver.
; Glenn C. Everhart, 2/2/1989
; Merged in some of Marty Sasaki's changes
;USAPADDR=0
;
; FACILITY:
; 
; 	VAX/VMS VIRTUAL DISK DRIVER USING CONTIGUOUS FILES.
; 
; AUTHOR:
; 
; G. EVERHART
;
; 
; ABSTRACT:
; 
; 	THIS MODULE CONTAINS THE TABLES AND ROUTINES NECESSARY TO
; 	PERFORM ALL DEVICE-DEPENDENT PROCESSING OF AN I/O REQUEST
;	FOR VMS VIRTUAL DISKS ON CONTIG FILES.
;
;	The VE: driver is intended to become a driver for software
;	shadowed virtual disks. It will have several operation modes:
;	1. Only one file specified...works like VD:
;	2. Two files specified, startup mode...reads first file
;		always, writes both files. (For the moment we leave
;		it to the assign task to set disk size to the min
;		of the two file sizes.)
;	3. Full shadow mode...reads one file or the other, depending
;		on closest last LBN; writes all writes to both.
;  In addition, to prevent errors during a "catchup" mode, a special
;	r/w logical will be implemented. This will work exactly like
;	normal r/w logical block most of the time, but when a special
;	logical read is done, a flag will be set and the block number
;	of the special read saved. When a special write is done, the
;	flag will be cleared.
;	  IF an ordinary write to this block occurs (actually, to this
;	16 blocks...assume this granularity) so that the normal disk
;	I/O may have interfered with the recovery, another flag will
;	be set, and the special write will return an error. This can
;	be used to repeat the read and try again, allowing normal
;	access in mode 2 to the disk during catchup. Once a catchup
;	has completed, the disk can be switched to mode 3 for better
;	performance. Since a shadow disk SHOULD be on a different
;	physical volume from the shadowed one, one HOPES that in
;	general this will yield performance improvements.
;
; I/O will be done by shipping off separately allocated IRPs, which
; will be sent to each shadowset member. Their I/O statuses will
; be accumulated in the original IRP and the subordinate IRPs will
; just be deallocated when done. Thus reqcom will only see the
; original IRP, but I/O will go in parallel to all shadow members.
; Copying the IRP for read/write can ignore IRPE issues for a disk.
;
; Note that ASNVD simply inserts a phony device structure for VD: units
; of 64 sectors per track, one track/cylinder, n cylinders. INIT seems
; to need this, though physical I/O is disabled.
;--
	.PAGE
	.SBTTL	EXTERNAL AND LOCAL DEFINITIONS

; 
; EXTERNAL SYMBOLS
; 
	.library /SYS$SHARE:LIB/

;	$ADPDEF				;DEFINE ADAPTER CONTROL BLOCK
	$CRBDEF				;DEFINE CHANNEL REQUEST BLOCK
	$DYNDEF ;define dynamic data types
	$DCDEF				;DEFINE DEVICE CLASS
	$DDBDEF				;DEFINE DEVICE DATA BLOCK
	$DEVDEF				;DEFINE DEVICE CHARACTERISTICS
	$DPTDEF				;DEFINE DRIVER PROLOGUE TABLE
	$EMBDEF				;DEFINE ERROR MESSAGE BUFFER
	$IDBDEF				;DEFINE INTERRUPT DATA BLOCK
	$IODEF				;DEFINE I/O FUNCTION CODES
	$DDTDEF				; DEFINE DISPATCH TBL...
	$ptedef
	$vadef
	$IRPDEF				;DEFINE I/O REQUEST PACKET
	$irpedef
	$PRDEF				;DEFINE PROCESSOR REGISTERS
	$SSDEF				;DEFINE SYSTEM STATUS CODES
	$UCBDEF				;DEFINE UNIT CONTROL BLOCK
	$VECDEF				;DEFINE INTERRUPT VECTOR BLOCK
	$pcbdef
	$jibdef
p1=0	; first qio param
p2=4
p3=8
p4=12
p5=16
p6=20	;6th qio param offsets

	.IF	DF,VMS$V5	;VMS V5 + LATER ONLY
	$SPLCODDEF
	$cpudef
	.ENDC
; 
; UCB OFFSETS WHICH FOLLOW THE STANDARD UCB FIELDS
; 
	$DEFINI	UCB			;START OF UCB DEFINITIONS

;.=UCB$W_BCR+2				;BEGIN DEFINITIONS AT END OF UCB
.=UCB$K_LCL_DISK_LENGTH	;v4 def end of ucb
; USE THESE FIELDS TO HOLD OUR LOCAL DATA FOR VIRT DISK.
$DEF	UCB$W_WQ_WPS	.BLKW	1	;Words per sector.
$DEF	UCB$W_WQ_CS	.BLKW	1	;CONTROL STATUS REGISTER
$DEF	UCB$W_WQ_DB	.BLKW	1	;UCB ADDRESS OF HOST DRIVER
$DEF	UCB$W_WQ_DPN	.BLKW	1	;(LONGWORD)
$DEF	UCB$L_WQ_DPR	.BLKL	1	;START LBN OF HOST CONTIG FILE
$DEF	UCB$L_WQ_FMPR	.BLKL	1	;
$DEF	UCB$L_WQ_PMPR	.BLKL	1	;PREVIOUS MAP REGISTER
$DEF	UCB$B_WQ_ER	.BLKB	1	;SPECIAL ERROR REGISTER
			.BLKB	1	;Reserved.
$DEF	UCB$B_WQ_LCT	.BLKB	1	;LOOP COUNTER
$DEF	UCB$B_WQ_XBA	.BLKB	1	;BUS ADDRESS EXTENSION BITS
$DEF	UCB$W_WQ_PWC	.BLKW	1	;PARTIAL WORD COUNT
$DEF	UCB$W_WQ_SBA	.BLKW	1	;SAVED BUFFER ADDRESS
$DEF	UCB$L_WQ_XFER	.BLKL	1	;TRANSFER FUNCTION CSR BITS
$DEF	UCB$L_WQ_LMEDIA	.BLKL	1	;LOGICAL MEDIA ADDRESS
$DEF	UCB$Q_WQ_EXTENDED_STATUS	; Area into which we do READ ERROR
			.BLKQ	1	;  REGISTER command.
; use following field to hold irp$l_svapte and irp$l_bcnt
; across two transfers
$DEF	UCB$Q_WQ_SVAPTETMP		; Area in which we save UCB fields -
			.BLKQ	1	;  SVAPTE, BOFF, and BCNT.
$DEF	UCB$L_WQ_MAPREGTMP		; Area in which we save CRB fields -
			.BLKL	1	;  MAPREG, NUMREG, and DATAPATH.
$DEF	UCB$L_WQ_SAVECS	.BLKL	1	; Area in which we save CS and DB regs.
; Add our stuff at the end to ensure we don't mess some fields up that some
; areas of VMS may want.
$DEF	UCB$HUCB	.BLKL	1	;ADDRESS OF HOST UCB
$DEF	UCB$HLBN	.BLKL	1	;LBN OF HOST FILE
$DEF	UCB$HFSZ	.BLKL	1	;SIZE OF HOST FILE, BLKS
$def	ucb$hucb2	.blkl	1	;host UCB of file 2
$def	ucb$hlbn2	.blkl	1	;LBN of file 2
$def	ucb$hfsz2	.blkl	1
			.blkl	12	;space for another 4 containers
$def	ucb$ncont	.blkl	1	;number containers
$DEF	UCB$PPID	.BLKL	1	;PID OF ORIGINAL PROCESS FROM IRQ BLK
; NOTE: It is important to ENSURE that we never clobber IRP$L_PID twice!
; therefore, adopt convention that UCB$PPID is cleared whenever we put
; back the old PID value in the IRP. Only clobber the PID where
; UCB$PPID is zero!!!
$DEF	UCB$stats	.BLKL	1	;STATUS CODE SAVE AREA
$DEF	UCB$OBCT	.BLKL	1	;STORE FOR IRP$L_OBCNT too
$def	ucb$lmedia	.blkl	1	;storage for IRP$L_MEDIA
$def	ucb$owind	.blkl	1	; store irp$l_wind...
$def	ucb$osegv	.blkl	1	; and irp$l_segvbn
; Since I/O postprocessing on virtual or paging I/O makes lots of
; assumptions about location of window blocks, etc., which are
; not true here (wrong UCB mainly), we'll bash the function code
; we send to the host driver to look like logical I/O is being
; done and save the real function code here. Later when VD: does
; I/O completion processing, we'll replace the original function
; from here back in the IRP. This will be saved/restored along with
; ucb$ppid (irp$l_pid field) and so synchronization will be detected
; with ucb$ppid usage.
; define extra fork blks to try to avoid double forking possibilities
$def	ucb$l_WQ_host_descr	.blkl	2	; char string descr
;
$def	ucb$vdcontfil	.blkb	80
; new structures for shadow disk operation
$def	ucb$shmd	.blkl	1	;shadow mode. 0=use file 1 only
					; 1= read file 1 always; write both
					; 2= read both (select); write both
$def	ucb$rwlk	.blkl	1	; read/write interlock. Initialize to 1
					; on special read-logical, set to 44 on
					; normal write in area of block read,
					; return as i/o status and clear on
					; special write-logical.
$def	ucb$rwlbn	.blkl	1	; LBN of first block in special read/logical
$def	ucb$rwsz	.blkl	1	; size of special transfer
$def	ucb$llbn1	.blkl	1	; last LBN of file 1
$def	ucb$llbn2	.blkl	1	; last LBN of file 2
			.blkl	4
$def	ucb$ucbos	.blkl	1	; offset to ucb/lbn/fsz in ucb to use at fin-io
$def	ucb$rwdir	.blkl	1	;read (0) or write (1) I/O
$def	ucb$er1		.blkl	1	; store for error code of 1st write of 2
;
;end new structures for shadowing
;structures for child IRPs, so we can have our I/O to subordinate devices
; running simultaneously instead of serially as in VQdriver
$def	ucb$irpcnt	.blkl	1	;IRPs currently sent
$def	ucb$byts	.blkl	1	;original bytecount
$def	ucb$sva		.blkl	1	;orig irp$l_sva
$def	ucb$vlbn	.blkl	1
$def	ucb$irps	.blkl	1	;save for original master IRP
$def	ucb$l_latch	.blkl	1	;flag that more IRPs are left.
$def	ucb$l_irplpid	.blkl	1	;save for our irp$l_pid for new irps
;
$DEF	UCB$K_WQ_LEN	.BLKW	1	;LENGTH OF UCB
;UCB$K_WQ_LEN=.				;LENGTH OF UCB

	$DEFEND	UCB			;END OF UCB DEFINITONS
 
	.SBTTL	STANDARD TABLES

; 
; DRIVER PROLOGUE TABLE
; 
; 	THE DPT DESCRIBES DRIVER PARAMETERS AND I/O DATABASE FIELDS
; 	THAT ARE TO BE INITIALIZED DURING DRIVER LOADING AND RELOADING
; 
	.PSECT	$$$105_PROLOGUE
WQ_UNITS=8
VE$DPT::
	DPTAB	-			;DPT CREATION MACRO
		END=WQ_END,-		;END OF DRIVER LABEL
		ADAPTER=NULL,-		;ADAPTER TYPE = NONE (VIRTUAL)
		DEFUNITS=2,-		;UNITS 0 THRU 1
		UCBSIZE=UCB$K_WQ_LEN,-	;LENGTH OF UCB
		MAXUNITS=WQ_UNITS,-	;FOR SANITY...CAN CHANGE
		NAME=WQDRIVER		;DRIVER NAME

	DPT_STORE INIT			;START CONTROL BLOCK INIT VALUES
	DPT_STORE DDB,DDB$L_ACPD,L,<^A\F11\>  ;DEFAULT ACP NAME
	DPT_STORE DDB,DDB$L_ACPD+3,B,DDB$K_PACK	;ACP CLASS
	.IF	NDF,VMS$V5
	DPT_STORE UCB,UCB$B_FIPL,B,8	;FORK IPL (VMS V4.X)
	.IFF	;DEFINE FOR VMS V5.X & LATER
	DPT_STORE UCB,UCB$B_FLCK,B,SPL$C_IOLOCK8  ;FORK IPL (VMS V5.X + LATER)
	.ENDC
; NOTE THESE CHARACTERISTICS HAVE TO LOOK LIKE THE "REAL" DISK.
	DPT_STORE UCB,UCB$L_DEVCHAR,L,-	;DEVICE CHARACTERISTICS
		<DEV$M_FOD-		; FILES ORIENTED
		!DEV$M_DIR-		; DIRECTORY STRUCTURED
		!DEV$M_AVL-		; AVAILABLE
		!DEV$M_SHR-		; SHAREABLE
		!DEV$M_IDV-		; INPUT DEVICE
		!DEV$M_ODV-		; OUTPUT DEVICE
		!DEV$M_RND>		; RANDOM ACCESS
	DPT_STORE UCB,UCB$L_DEVCHAR2,L,- ;DEVICE CHARACTERISTICS
		<DEV$M_NNM>		; Prefix name with "node$" (like rp06)
	DPT_STORE UCB,UCB$B_DEVCLASS,B,DC$_DISK  ;DEVICE CLASS
	DPT_STORE UCB,UCB$W_DEVBUFSIZ,W,512  ;DEFAULT BUFFER SIZE
; FOLLOWING DEFINES OUR DEVICE "PHYSICAL LAYOUT". It's faked here and
; this structure (64 sectors/trk, 1 trk/cyl, nn cylinders) forces
; VE: units to be in multiples of 64 blocks. It can be modified as
; appropriate. However, recall that one has 1 byte for sectors/trk
; and 16 bits for cylinder number and 1 byte for tracks/cylinder.
; The current structure allows vd: units as large as 65535*64 blocks
; (about 4 million blocks, or 2 gigabytes), which is probably big enough
; for most purposes. The actual size is set up in ASNVD which finds the
; number of cylinders to "fit" in the container file. For emulating other
; ODS-2 volumes, the appropriate physical structure should be emulated also.
; NO logic in this driver depends on this stuff. It just has to be there
; to keep INIT and friends happy.
;	(In fact the current ASNVD image for VD: does this. We however
; have to preset SOMETHING.)
	DPT_STORE UCB,UCB$B_TRACKS,B,1	; 1 TRK/CYL
	DPT_STORE UCB,UCB$B_SECTORS,B,64  ;NUMBER OF SECTORS PER TRACK
	DPT_STORE UCB,UCB$W_CYLINDERS,W,16  ;NUMBER OF CYLINDERS
; FAKE GEOMETRY TO MAKE TRANSLATION EASIER. HAVE PRIV'D IMAGE LATER
; RESET THE UCB$W_CYLINDERS TO WHATEVER'S DESIRED. JUST MAKE SURE IT'S
; A MULTIPLE OF 64 BLOCKS IN SIZE, WHICH OUGHT TO BE GOOD ENOUGH.
	DPT_STORE UCB,UCB$B_DIPL,B,21	;DEVICE IPL
	DPT_STORE UCB,UCB$B_ERTMAX,B,10	;MAX ERROR RETRY COUNT
	DPT_STORE UCB,UCB$W_DEVSTS,W,-	;INHIBIT LOG TO PHYS CONVERSION IN FDT
		<UCB$M_NOCNVRT>		;...
;
; don't mess with LBN; leave alone so it's easier to hack on...
;
	DPT_STORE REINIT		;START CONTROL BLOCK RE-INIT VALUES
;	DPT_STORE CRB,CRB$L_INTD+VEC$L_ISR,D,WQ_INT  ;INTERRUPT SERVICE ROUTINE ADDRESS
	DPT_STORE CRB,CRB$L_INTD+VEC$L_INITIAL,-  ;CONTROLLER INIT ADDRESS
		      D,WQ_ctrl_INIT		  ;...
	DPT_STORE CRB,CRB$L_INTD+VEC$L_UNITINIT,- ;UNIT INIT ADDRESS
		      D,WQ_unit_INIT		  ;...
	DPT_STORE DDB,DDB$L_DDT,D,VE$DDT	  ;DDT ADDRESS

	DPT_STORE END			;END OF INITIALIZATION TABLE

; 
; DRIVER DISPATCH TABLE
; 
; 	THE DDT LISTS ENTRY POINTS FOR DRIVER SUBROUTINES WHICH ARE
; 	CALLED BY THE OPERATING SYSTEM.
; 
;VD$DDT:
	DDTAB	-			;DDT CREATION MACRO
		DEVNAM=VE,-		;NAME OF DEVICE
		START=WQ_STARTIO,-	;START I/O ROUTINE
		FUNCTB=WQ_FUNCTABLE,-	;FUNCTION DECISION TABLE
;		CANCEL=0,-		;CANCEL=NO-OP FOR FILES DEVICE
;		REGDMP=0,-	;REGISTER DUMP ROUTINE
;		DIAGBF=0,-  ;BYTES IN DIAG BUFFER
		ERLGBF=0	;BYTES IN
				;ERRLOG BUFFER
; 
; FUNCTION DECISION TABLE
; 
; 	THE FDT LISTS VALID FUNCTION CODES, SPECIFIES WHICH
; 	CODES ARE BUFFERED, AND DESIGNATES SUBROUTINES TO
; 	PERFORM PREPROCESSING FOR PARTICULAR FUNCTIONS.
; 

WQ_FUNCTABLE:
	FUNCTAB	,-			;LIST LEGAL FUNCTIONS
		<NOP,-			; NO-OP
		FORMAT,-		; We use format to point to file
		UNLOAD,-		; UNLOAD
		PACKACK,-		; PACK ACKNOWLEDGE
		AVAILABLE,-		; AVAILABLE
		SENSECHAR,-		; SENSE CHARACTERISTICS
		SETCHAR,-		; SET CHARACTERISTICS
		SENSEMODE,-		; SENSE MODE
		SETMODE,-		; SET MODE
		READLBLK,-		; READ LOGICAL BLOCK
		WRITELBLK,-		; WRITE LOGICAL BLOCK
;		READPBLK,-		; READ PHYSICAL BLOCK 
;		WRITEPBLK,-		; WRITE PHYSICAL BLOCK
		READVBLK,-		; READ VIRTUAL BLOCK
		WRITEVBLK,-		; WRITE VIRTUAL BLOCK
		ACCESS,-		; ACCESS FILE / FIND DIRECTORY ENTRY
		ACPCONTROL,-		; ACP CONTROL FUNCTION
		CREATE,-		; CREATE FILE AND/OR DIRECTORY ENTRY
		DEACCESS,-		; DEACCESS FILE
		DELETE,-		; DELETE FILE AND/OR DIRECTORY ENTRY
		MODIFY,-		; MODIFY FILE ATTRIBUTES
		MOUNT>			; MOUNT VOLUME
; no-op phys I/O for a test here...
	FUNCTAB	,-			;BUFFERED FUNCTIONS
		<NOP,-
		FORMAT,-		; FORMAT
		UNLOAD,-		; UNLOAD
		PACKACK,-		; PACK ACKNOWLEDGE
		AVAILABLE,-		; AVAILABLE
		SENSECHAR,-		; SENSE CHARACTERISTICS
		SETCHAR,-		; SET CHARACTERISTICS
		SENSEMODE,-		; SENSE MODE
		SETMODE,-		; SET MODE
		ACCESS,-		; ACCESS FILE / FIND DIRECTORY ENTRY
		ACPCONTROL,-		; ACP CONTROL FUNCTION
		CREATE,-		; CREATE FILE AND/OR DIRECTORY ENTRY
		DEACCESS,-		; DEACCESS FILE
		DELETE,-		; DELETE FILE AND/OR DIRECTORY ENTRY
		MODIFY,-		; MODIFY FILE ATTRIBUTES
		MOUNT>			; MOUNT VOLUME
	FUNCTAB	WQ_ALIGN,-		;TEST ALIGNMENT FUNCTIONS
		<READLBLK,-		; READ LOGICAL BLOCK
		READVBLK,-		; READ VIRTUAL BLOCK
		READPBLK,-
;		WRITEPBLK,-
		WRITELBLK,-		; WRITE LOGICAL BLOCK
		WRITEVBLK-		; WRITE VIRTUAL BLOCK
		>
	functab WQ_format,-		;point to host disk
		<format>
; NOTE SEPARATE CALL FOR PHYSICAL I/O SO WE CAN JUST CONVERT TO LOGICAL AND
; DO OUR THING... CONVERT TO A LOGICAL QIO THERE FOR "REAL" DRIVER ALSO
; SO IT CAN DO CONVERSION TO ITS IDEA OF PHYSICAL IF IT WISHES...
;
; LEAVE NORMAL ACP CALLS IN SO FILE STRUCTURED STUFF ON OUR VE: UNIT
; WILL WORK OK.
;
	Functab	WQ_rdspc,-		;read - special logic here.
		<READLBLK>
	Functab WQ_wrtspc,-		;write - special logic here.
		<WRITELBLK>
	FUNCTAB	+ACP$READBLK,-		;READ FUNCTIONS
		<READLBLK,-		; READ LOGICAL BLOCK
		READPBLK,-
		READVBLK-		; READ VIRTUAL BLOCK
		>
	FUNCTAB	+ACP$WRITEBLK,-		;WRITE FUNCTIONS
		<WRITELBLK,-		; WRITE LOGICAL BLOCK
		WRITEPBLK,-
		WRITEVBLK-		; WRITE VIRTUAL BLOCK
		>
	FUNCTAB	+ACP$ACCESS,-		;ACCESS FUNCTIONS
		<ACCESS,-		; ACCEESS FILE / FIND DIRECTORY ENTRY
		CREATE-			; CREATE FILE AND/OR DIRECTORY ENTRY
		>
	FUNCTAB	+ACP$DEACCESS,-		;DEACCESS FUNCTION
		<DEACCESS-		; DEACCESS FILE
		>
	FUNCTAB	+ACP$MODIFY,-		;MODIFY FUNCTIONS
		<ACPCONTROL,-		; ACP CONTROL FUNCTION
		DELETE,-		; DELETE FILE AND/OR DIRECTORY ENTRY
		MODIFY-			; MODIFY FILE ATTRIBUTES
		>
	FUNCTAB	+ACP$MOUNT,-		;MOUNT FUNCTION
		<MOUNT>			; MOUNT VOLUME
	FUNCTAB	+EXE$ZEROPARM,-		;ZERO PARAMETER FUNCTIONS
		<UNLOAD,-		; UNLOAD
		PACKACK,-		; PACK ACKNOWLEDGE
		AVAILABLE>		; AVAILABLE
	FUNCTAB	+EXE$ONEPARM,-		;ONE PARAMETER FUNCTION
		<FORMAT-		; FORMAT
		>
	FUNCTAB	+EXE$SENSEMODE,-	;SENSE FUNCTIONS
		<SENSECHAR,-		; SENSE CHARACTERISTICS
		SENSEMODE-		; SENSE MODE
		>
	FUNCTAB	+EXE$SETCHAR,-		;SET FUNCTIONS
		<SETCHAR,-		; SET CHARACTERISTICS
		SETMODE-		; SET MODE
		>
	.PAGE
	.SBTTL FDT Routines
;++
;
; WQ_format - point to proper location on the host disk
;
; With no function modifiers, this routine takes as arguments the name
; of the host disk (the real disk where the virtual disk will exist),
; the size of the virtual disk, and the LBN where the virtual disk
; will start. After these are set up, the device is put online and is
; software enabled.
;
; This routine does virtually no checking, so the parameters must be
; correct.
;
; Inputs:
;	p1 - pointer to buffer. The buffer has the following format:
;	     longword 0 - starting LBN, where the virtual disk starts
;	     		  on the real disk.
;	     longword 1 - virtual disk length, the number of blocks in
;			  the virtual disk.
;	     longword 2 through the end of the buffer, the name of the
;			  virtual disk. This buffer must be blank
;			  padded if padding is necessary
;
;	p2 - size of the above buffer
;--
WQ_format:
	bicw3	#io$m_fcode,irp$w_func(r3),r0	;mask off function code
	bneq	20$			;branch if modifiers, special
;thus, normal io$_format will do nothing.
	rsb				;regular processing
10$:
	movzwl	#SS$_BADPARAM,r0	;illegal parameter
	clrl	r1
	jmp	g^exe$abortio
20$:
	movl	p1(ap),r0		;buffer address
	movl	p2(ap),r1		;length of buffer
	jsb	g^exe$writechk		;read access? doesn't return on error
	clrl	irp$l_bcnt		;paranoia, don't need to do this...
	movl	p1(ap),r0		;get buffer address
	movl	(r0)+,-			;move starting lbn
		ucb$hlbn(r5)
	blss	10$
	movl	(r0)+,-			;size of virtual disk
		ucb$hfsz(r5)
	bleq	10$
	movl	(r0),-			;name of "real" disk
		ucb$l_WQ_host_descr+4(r5)
	subl3	#8,p2(ap),-		;set length of name in descriptor
		ucb$l_WQ_host_descr(r5)
	bleq	10$			;bad length
	moval	ucb$l_WQ_host_descr(r5),r1	;descriptor for...
	jsb	g^ioc$searchdev		;search for host device
	blbs	r0,30$			;branch on success
	movzwl	#ss$_nosuchdev+2,r0	;make an error, usually a warning
	clrl	r1
	jmp	g^exe$abortio		;exit with error
30$:
	addl3	ucb$hfsz(r5),- 	;end of virtual device
		ucb$hlbn(r5),r0
	cmpl	ucb$l_maxblock(r1),r0		; < end of real disk?
	blss	10$
	movl	r1,ucb$hucb(r5)	;stash the ucb
	clrl	ucb$ppid(r5)		; mark driver free of old pids
	bisw	#ucb$m_valid,ucb$w_sts(r5)	;set volume valid
	bisw	#ucb$m_online,ucb$w_sts(r5)	;set unit online
	movl	ucb$l_irp(r5),r3		;restore r3, neatness counts
	movzwl	#ss$_normal,r0			;success
	jmp	g^exe$finishioc			;wrap things up.

; Read-special logic
WQ_rdspc:
	bitw	#128,irp$w_func(r3)	;mask off function code
	bneq	20$			;branch if modifiers, special
; normal read-logical just returns
	rsb				;regular processing
20$:
	movl	#1,ucb$rwlk(r5)		;set up special interlock
	movl	irp$l_media(r3),ucb$rwlbn(r5)	;store LBN we're writing at (start)
	movl	irp$l_bcnt(r3),r0	;get transfer size in bytes
	addl2	#511,r0			;add blksize - 1 byte
	ashl	#-9,r0,r0		;get number blks in transfer
	movl	r0,ucb$rwsz(r5)		;store size in blocks of transfer
	rsb				; and exit...
;
; write-special logic
WQ_wrtspc:
; check only 128 and 256 bits.
	bitw	#128,irp$w_func(r3)	;mask off function code
	bneq	20$			;branch if modifiers, special
; This is a NORMAL write-logical-block. Therefore, check if it overlaps
; a special read area just handled.
	jsb	ovlpchk			; do the overlap check
					; ucb$rwlk returns 44 if fails.
					; assumes r3 -> IRP, r5 -> UCB
; normal write-logical just returns
	rsb				;regular processing
20$:
	blbc	ucb$rwlk(r5),30$	; on error, abort the I/O
	clrl	ucb$rwlk(r5)		; reset the special mode flag
	rsb				; and exit...
30$:					; normal I/O interfered with the
					; interlocked r/w. Return an error.
; pick random error 44 as our signal that the I/O failed. 
	clrl	ucb$rwlk(r5)		; reset the special mode flag
	movzwl	#44,r0			;make an error. Catchup prog needs to re-read.
	clrl	r1
	jmp	g^exe$abortio		;exit with error
; Note we have a back-up check of this stuff in the start-io entry area
; in case anything slips by due to nonzero queue length for the ve: 
; driver.

; ovlpchk - check for overlap of write with what was read
; assumes r5 is UCB address, r3 is IRP address and that it is
; a write-logical IRP.
ovlpchk:
	tstl	ucb$rwlk(r5)		; special read done?
	beql	99$			; if not, just return.
	pushl	r0
	pushl	r1
	pushl	r2
	pushl	r3			; need a few regs
	movl	irp$l_media(r3),r1	; LBN we're writing at (start)
	movl	irp$l_bcnt(r3),r0	;get transfer size in bytes
	addl2	#511,r0			;add blksize - 1 byte
	ashl	#-9,r0,r0		;get number blks in transfer
					; r0 now is # blks we have
	addl2	r1,r0			; r0 is now end LBN of this request
; r1 = start LBN of request, r0 = end LBN
	movl	ucb$rwlbn(r5),r2	; low LBN of read-special
	addl3	ucb$rwsz(r5),r2,r3	; r3 = high LBN of read-special
; if our high LBN is below the low LBN of the r-s we don't overlap.
; If our low LBN is above the high LBN of the r-s we don't overlap.
; Otherwise we overlap.
	cmpl	r0,r2			;our high less than r-s low?
	blssu	99$			; if so nothing to do
	cmpl	r1,r3			;our low greater than r-s high?
	bgtru	99$			; if so nothing to do
	movl	#44,ucb$rwlk(r5)	;if OVERLAP then flag error for w-s next/
	popl	r3
	popl	r2
	popl	r1
	popl	r0
99$:
	rsb

	.SBTTL	CONTROLLER INITIALIZATION ROUTINE
; ++
; 
; WQ_ctrl_INIT - CONTROLLER INITIALIZATION ROUTINE
; 
; FUNCTIONAL DESCRIPTION:
; noop
; INPUTS:
; R4 - CSR ADDRESS
; R5 - IDB ADDRESS
; R6 - DDB ADDRESS
; R8 - CRB ADDRESS
; 
; 	THE OPERATING SYSTEM CALLS THIS ROUTINE:
; 		- AT SYSTEM STARTUP
; 		- DURING DRIVER LOADING
; 		- DURING RECOVERY FROM POWER FAILURE
; 	THE DRIVER CALLS THIS ROUTINE TO INIT AFTER AN NXM ERROR.
;--
	.PSECT	$$$115_DRIVER
WQ_ctrl_INIT:				;vd CONTROLLER INITIALIZATION
	CLRL	CRB$L_AUXSTRUC(R8)	; SAY NO AUX MEM
	RSB				;RETURN
	.PAGE
	.SBTTL	INTERNAL CONTROLLER RE-INITIALIZATION
;
; INPUTS:
;	R4 => controller CSR (dummy)
;	R5 => UCB
;
ctrl_REINIT:
	RSB		; RETURN TO CALLER
	.PAGE
	.SBTTL	UNIT INITIALIZATION ROUTINE
;++
; 
; WQ_unit_INIT - UNIT INITIALIZATION ROUTINE
; 
; FUNCTIONAL DESCRIPTION:
; 
; 	THIS ROUTINE SETS THE VD: ONLINE.
; 
; 	THE OPERATING SYSTEM CALLS THIS ROUTINE:
; 		- AT SYSTEM STARTUP
; 		- DURING DRIVER LOADING
; 		- DURING RECOVERY FROM POWER FAILURE
; 
; INPUTS:
; 
; 	R4	- CSR ADDRESS (CONTROLLER STATUS REGISTER)
; 	R5	- UCB ADDRESS (UNIT CONTROL BLOCK)
;	R8	- CRB ADDRESS
; 
; OUTPUTS:
; 
; 	THE UNIT IS SET ONLINE.
; 	ALL GENERAL REGISTERS (R0-R15) ARE PRESERVED.
; 
;--

WQ_unit_INIT:				;vd UNIT INITIALIZATION
; Don't set unit online here. Priv'd task that assigns VD unit
; to a file does this to ensure only assigned VDn: get used.
;	BISW	#UCB$M_ONLINE,UCB$W_STS(R5)  ;SET UCB STATUS ONLINE
;limit size of VD: data buffers
WQ_bufsiz=8192
; (asnWQ will set this to same as host...)
	movl	#WQ_bufsiz,ucb$l_maxbcnt(r5)	;limit transfers to 8k
	MOVB	#DC$_DISK,UCB$B_DEVCLASS(R5) ;SET DISK DEVICE CLASS
; NOTE: we may want to set this as something other than an RX class
; disk if MSCP is to use it. MSCP explicitly will NOT serve an
; RX type device. For now leave it in, but others can alter.
; (There's no GOOD reason to disable MSCP, but care!!!)
	movl	#^Xb12d5001,ucb$l_media_id(r5)	; set media id as VE
; (note the id might be wrong but is attempt to get it.) (used only for
; MSCP serving.)
	MOVB	#DT$_FD1,UCB$B_DEVTYPE(R5)  ;Make it foreign disk type 1
; (dt$_rp06 works but may confuse analyze/disk)
;;; NOTE: changed from fd1 type so MSCP will know it's a local disk and
;;; attempt no weird jiggery-pokery with the VD: device.
; MSCP may still refuse to do a foreign drive too; jiggery-pokery later
; to test if there's occasion to do so.
	RSB				;RETURN 
	.PAGE
	.SBTTL	FDT ROUTINES 
;++
; 
; WQ_ALIGN - FDT ROUTINE TO TEST XFER BYTE COUNT
; 
; FUNCTIONAL DESCRIPTION:
; 
; 	THIS ROUTINE IS CALLED FROM THE FUNCTION DECISION TABLE DISPATCHER
; 	TO CHECK THE BYTE COUNT PARAMETER SPECIFIED BY THE USER PROCESS
; 	FOR AN EVEN NUMBER OF BYTES (WORD BOUNDARY).
; 
; INPUTS:
; 
; 	R3	- IRP ADDRESS (I/O REQUEST PACKET)
; 	R4	- PCB ADDRESS (PROCESS CONTROL BLOCK)
; 	R5	- UCB ADDRESS (UNIT CONTROL BLOCK)
; 	R6	- CCB ADDRESS (CHANNEL CONTROL BLOCK)
; 	R7	- BIT NUMBER OF THE I/O FUNCTION CODE
; 	R8	- ADDRESS OF FDT TABLE ENTRY FOR THIS ROUTINE
; 	4(AP)	- ADDRESS OF FIRST FUNCTION DEPENDENT QIO PARAMETER
; 
; OUTPUTS:
; 
; 	IF THE QIO BYTE COUNT PARAMETER IS ODD, THE I/O OPERATION IS
; 	TERMINATED WITH AN ERROR. IF IT IS EVEN, CONTROL IS RETURNED
; 	TO THE FDT DISPATCHER.
; 
;--
nolchk=1
WQ_ALIGN:				;CHECK BYTE COUNT AT P1(AP)
	.if	ndf,nolchk
; note: not fully tested but a MINOR mod... therefore conditioned.
	tstw	6(ap)			;test high order half of
					; byte count specified
	bneq	10$			; if bigger than 65k call error
	.endc
	BLBS	4(AP),10$		;IF LBS - ODD BYTE COUNT
	RSB				;EVEN - RETURN TO CALLER
10$:	MOVZWL	#SS$_IVBUFLEN,R0	;SET BUFFER ALIGNMENT STATUS
	JMP	G^EXE$ABORTIO		;ABORT I/O
	.PAGE
	.SBTTL	START I/O ROUTINE
;++
; 
; WQ_STARTIO - START I/O ROUTINE
; 
; FUNCTIONAL DESCRIPTION:
; 
; 	THIS FORK PROCESS IS ENTERED FROM THE EXECUTIVE AFTER AN I/O REQUEST
; 	PACKET HAS BEEN DEQUEUED.
; 
; INPUTS:
; 
; 	R3		- IRP ADDRESS (I/O REQUEST PACKET)
; 	R5		- UCB ADDRESS (UNIT CONTROL BLOCK)
; 	IRP$L_MEDIA	- PARAMETER LONGWORD (LOGICAL BLOCK NUMBER)
; 
; OUTPUTS:
; 
; 	R0	- FIRST I/O STATUS LONGWORD: STATUS CODE & BYTES XFERED
; 	R1	- SECOND I/O STATUS LONGWORD: 0 FOR DISKS
; 
; 	THE I/O FUNCTION IS EXECUTED.
; 
; 	ALL REGISTERS EXCEPT R0-R4 ARE PRESERVED.
; 
;--
	.if df,x$$$dt
rwflg:	.long	0
	.endc
; In fact, using XDelta, I have *never* seen requeue called.
REQUEUE:
	.if	df,x$$$dt
	jsb	g^ini$brk
	.endc
	JMP	EXE$INSIOQ		; REQUEUE packet to ourselves
; return to our caller direct from insioq.
; (note this also sets busy, so it will NOT loop forever.)
WQ_STARTIO:				;START I/O OPERATION
; 
; 	PREPROCESS UCB FIELDS
; 
;	ASSUME	RY_EXTENDED_STATUS_LENGTH  EQ  8
;	CLRQ	UCB$Q_WQ_EXTENDED_STATUS(R5)	; Zero READ ERROR REGISTER area.
; 
; 	BRANCH TO FUNCTION EXECUTION
	bbs	#ucb$v_online,-	; if online set software valid
		ucb$w_sts(r5),210$
216$:	movzwl	#ss$_volinv,r0	; else set volume invalid
	brw	resetxfr	; reset byte count & exit
210$:
	tstl	ucb$hucb(r5)	; do we have any host device?
	beql	216$		; if eql no, flag invalid volume.
			; THIS IS SAFETY FROM CONFIGURING FROM OUTSIDE
; BEFORE GOING ON, WE WANT TO ENSURE THE UCB IS FREE.
	TSTL	UCB$PPID(R5)		; MAKE SURE we haven't got
					; a packet in process
	BNEQ	REQUEUE			; IF a packet's in process, requeue
					; back to this driver; do NOT process
					; immediately!
; Note...never seems to get to requeue (xdelta would catch it!)
; (that's a good sign; should never get there.)
	bisw	#ucb$m_online,ucb$w_sts(r5)	; set online
	bisw	#ucb$m_valid,ucb$w_sts(r5)	;set valid
; set ourselves as owners of channel for VD:
	movl	ucb$l_crb(r5),r0
	movl	crb$l_intd+vec$l_idb(r0),r0	;get idb address
;	cmpl	r5,idb$l_owner(r0)		;are we owners?
;	beql	214$			; if eql yes, all's well
;	REQPCHAN	; gain access to controller in "standard" way
214$:
;
10$:;	BBS	#IRP$V_PHYSIO,-		;IF SET - PHYSICAL I/O FUNCTION
;		IRP$W_STS(R3),20$	;...
	BBS	#UCB$V_VALID,-		;IF SET - VOLUME SOFTWARE VALID
		UCB$W_STS(R5),20$	;...
	MOVZWL	#SS$_VOLINV,R0		;SET VOLUME INVALID STATUS
	BRW	RESETXFR		;RESET BYTE COUNT AND EXIT
20$:
; IF WE GET A SEGMENT TRANSFER HERE (LOGICAL I/O)
; IT MUST BE UPDATED FOR HOST AND SHIPPED OUT.
; OUR UCB HAS BLOCK NUMBER INFO...
; FIND OUT IF THIS IS LOGICAL OR PHYSICAL I/O FIRST. THEN IF IT IS BUGGER
; THE I/O PACKET USING UCB INFO AND SEND TO THE REAL DRIVER...
; ALSO ENSURE WE ARE UNBUSIED...
;
; Sanity check for assignments: hucb2 field zero implies shmd must be
; zero.
	tstl	ucb$hucb2(r5)		;second UCB there?
	bneq	21$			;if neq yes
	clrl	ucb$shmd(r5)		;if not, ensure in single-file mode
21$:
;
	EXTZV	#IRP$V_FCODE,#IRP$S_FCODE,IRP$W_FUNC(R3),R1	; GET FCN CODE
	case	r1,<-			; Dispatch to function handling routine
		unload,-		; Unload
		nop,-			; Seek
		NOP,-			; Recalibrate(unsupported)
		nop,-			; Drive clear
		NOP,-			; Release port(unsupported)
		NOP,-			; Offset heads(unsupported)
		NOP,-			; Return to center
		nop,-			; Pack acknowledge
		NOP,-			; Search(unsupported)
		NOP,-			; Write check(unsupported)
		WRITEDATA,-		; Write data
		READDATA,-		; Read data
		NOP,-			; Write header(unsupported)
		NOP,-			; Read header(unsupported)
		NOP,-			; Place holder
		NOP,-			; Place holder
		available,-		; Available (17)
		NOP,NOP,NOP,-		; 18-20
		NOP,NOP,NOP,NOP,nop,nop,nop,NOP,NOP,nop,- ;21-30
		NOP,NOP,NOP,NOP,nop,NOP,nop,nop,nop,NOP,- ;31-40
		NOP,NOP,NOP,NOP,NOP,NOP,NOP,NOP,NOP,nop,- ;41-50
		NOP,NOP,NOP,NOP,nop,NOP,NOP,NOP,NOP,NOP,- ;51-60
		nop,-					  ;61
		>,LIMIT=#1

nop:				;unimplemented function
	brw	fexl
rwcmnj:	brw	rwcmn
readdata:
; Read just comes from ONE drive so just use original IRP for that.
	movl	#ucb$hucb,ucb$ucbos(r5)	;store address of file 1
	clrl	ucb$rwdir(r5)	;set read
	cmpl	ucb$shmd(r5),#1	;in single disk mode or single read mode?
	bleq	rwcmnj
;find which file to use for read.
; set up ucbos field to offset for that file.
	pushl	r0
	pushl	r1
	movl	irp$l_media(r3),r0	;get proposed lbn 
	movl	r0,r1
	subl2	ucb$llbn1(r5),r0	;get diffs of (new LBN) - (last LBNi)
	subl2	ucb$llbn2(r5),r1
;now get abs values
	tstl	r0
	bgeq	1$		;if positive leave alone
	mnegl	r0,r0
1$:	tstl	r1
	bgeq	2$
	mnegl	r1,r1		;negate if neg.
2$:
; now r0 = "distance" on file 1, r1 = "distance" on file 2
	cmpl	r0,r1		;which is greater?
	blssu	3$		;if file 1 is less, leave file 1 in ucbos field
	movl	#ucb$hucb2,ucb$ucbos(r5)	;if file 2 less, set that.
	movl	irp$l_media(r3),ucb$llbn2(r5)	;store last LBN as this one, file 2
	brb	4$
3$:
	movl	irp$l_media(r3),ucb$llbn1(r5)	;store last LBN as this one, file 1
4$:
	movl	r3,ucb$irps(r5)		;save orig irp pointer
	popl	r1
	popl	r0
	brw	rwcmn
writedata:
	.if	df,x$$$dt
	jsb g^ini$brk
	.endc
	movl	r3,ucb$irps(r5)		;save orig irp pointer
	movl	#ucb$hucb,ucb$ucbos(r5)	;store address of file 1
	movl	#1,ucb$rwdir(r5)	;set write
	movl	irp$l_media(r3),ucb$llbn1(r5)	;store current as last LBN of both
	movl	irp$l_media(r3),ucb$llbn2(r5)	;files for write since both get used
; Now one of the key parts:
; Check to see if this write is a NORMAL access that overlaps data set
; in rwlbn/rwsz. If so, set rwlk field to 44 so we can flag that a write
; has interfered with the data being caught-up.
;  To avoid possible other holes, an FDT time check will also exist so that a
; user write that would invalidate the special write will be caught at FDT
; time also.
	bitw	#128,irp$w_func(r3)	;mask off function code
; Check only 128 and 256 bits for function modifiers.
; Asnve and Asnwq use 128 bit only.
		;this a normal write-logical?
	bneq	rwcmn2				;if modified, no overlap chk
						;since this IS our write-special.
	jsb	ovlpchk			; do the overlap check
	brb	rwcmn
rwcmn2:
; look over write-special HERE also to ensure that if we (somehow) get
; by the FDT time check, we don't let this by if we've had an overlapped
; normal write.
; (It suffices to check the ucb$rwlk field to see if it's low bit is clear)
	tstl	ucb$rwlk(r5)		;special read done?
	beql	rwcmn			;if eq no, no check needed
	cmpl	ucb$rwlk(r5),#44	;error flagged?
	bneq	RWCMN			;if not, go ahead and finish it
; oops... 
; We flagged an error. DON'T let this write go through!
	MOVZWL	#44,R0		;SET VOLUME INVALID STATUS
	clrl	ucb$rwlk(r5)	;clear special field for next time
	BRW	RESETXFR		;RESET BYTE COUNT AND EXIT
rwcmn:
; debug using sda to peek
; NOW VALIDATED I/O FCN... MODIFY AND SEND OFF
	CMPL	IRP$L_MEDIA(R3),UCB$HFSZ(R5)	;BE SURE LBN OK
	blequ	65$
	brw	Fatalerr	;dismiss I/o if not ok block number
65$:
; HAVE TO BE CAREFUL WHAT WE SHIP TO REAL DRIVER
; Now that we know IRP$L_MEDIA is ok in IRP, save it for restore at
; I/O completion by VDDRIVER
; (This also facilitates remodification for second pass on writes)
	movl	irp$l_media(r3),ucb$lmedia(r5)
	; Prepare to enter another context.
; SEND PKT OFF TO REAL DRIVER...
; First get address stuff to bash PID with
	MOVL	IRP$L_PID(R3),UCB$PPID(R5)	; SAVE PROCESS ID IN VD: UCB
	movzwl	irp$w_sts(r3),ucb$stats(r5)	;save original fcn code
	movl	irp$l_obcnt(r3),ucb$obct(r5)	;store obcnt field
	movl	irp$l_svapte(r3),ucb$q_WQ_svaptetmp(r5) ;save svapte
	movl	irp$l_bcnt(r3),ucb$q_WQ_svaptetmp+4(r5) ;and orig bcnt
; (actually shouldn't need to worry about driver post processing...
;  we do all that here via hack to change irp$l_pid field....)
;	movl	irp$l_bcnt(r3),irp$l_obcnt(r3)	;and reset to actual
					; requested so driver NEVER sees
					; need to do postprocessing requeues
					; in host context. (we do that in OUR
					; context.)
	movl	irp$l_wind(r3),ucb$owind(r5)	;store window ptr
	movl	irp$l_segvbn(r3),ucb$osegv(r5)	;store segment vbn also
	MOVZWL	UCB$W_UNIT(R5),-(SP)	; BUILD ADDRESS OF UCB STORE
	ASHL	#2,(SP),(SP)		; WITH OFFSET * 4

	MOVAB	WQ_UCBTBL,-(SP)		; GET TBL BASE IN STACK
	ADDL2	(SP)+,(SP)		; NOW ADD BASE + OFFSET
	MOVL	R5,@(SP)+		; AND STORE UCB ADDRESS IN WQ_UCBTBL
; (THIS ALLOWS US TO GET IT BACK...)
	MOVZWL	UCB$W_UNIT(R5),-(SP)	; BUILD ADDRESS OF ENTRY NOW
	MULL2	#WQ_FXPL,(SP)		; MULTIPLY OFFSET BY SIZE OF ENTRY
	MOVAB	WQ_FXS0,ucb$l_irplpid(r5)	;AND BASH PID IN IRP SO WE
				; GET BACK CONTROL AT WQ_FIXSPLIT (VIA JSB)
				; WHEN HOST'S I/O IS DONE.
	ADDL2	(SP)+,ucb$l_irplpid(r5)	;SET TO ENTER IN CORRECT
					; UNIT'S ENTRY
	clrl	ucb$irpcnt(r5)	;no extra irps yet
	pushr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10>
	clrl	r10
strlop:
; grab a new IRP
	movl	#irp$c_length,r1	;size
	jsb	g^exe$alononpaged	;get our irp
	blbs	r0,70$			;if all well continue
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10>
	brw	fatalerr
70$:
	movw	r1,irp$w_size(r2)	;fill prefix in
	movb	#dyn$c_irp,irp$b_type(r2)
	movl	r2,r6			;save irp addr
	movl	r1,r7			;+ size
	pushr   #^m<r0,r1,r2,r3,r4,r5>
	movl	r3,r8			;save irp addr
	movc3	r7,(r8),(r6)		;copy orig irp
	popr    #^m<r0,r1,r2,r3,r4,r5>
	movl	ucb$l_irplpid(r5),irp$l_pid(r6)	;set to do completion
;at completion count irpcnt up, compare vs ucb$ncont to see when to
;finish.
	pushr   #^m<r0,r1,r2,r3,r4,r5>
	movl	r6,r3			;work with clone irp now
	bgtr	90$
	movl	r10,r9
	mull2	#<ucb$hucb2-ucb$hucb>,r9	;get offset
	addl3	r5,r9,r7		;r7 now points at block for
					;this container.
	movl	ucb$hucb(r7),irp$l_ucb(r3)	;fill in to irp
	addl2	ucb$hlbn(r7),irp$l_media(r3)
	movl	irp$l_media(r3),r0	;now get lbn
	movl	ucb$hucb(r7),r5		;point at host in r5 too
	bgeq	90$
	JSB	G^IOC$CVTLOGPHY		; LET THE EXEC DO convert log->phy
	jsb	g^exe$insioqc		; then call host driver
90$:
	popr   #^m<r0,r1,r2,r3,r4,r5>
;now loop if we need to
	incl	r10
	tstl	ucb$shmd(r5)		;dual cont or more?
	beql	98$			;if 0, no, only one container
	cmpl	r10,ucb$ncont(r5)	;done all?
	blss	strlop			;if lss no, do next
98$:
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10>
	rsb
402$:
	BRW	FEXL			;Else, branch to execute function.
;
;	UNLOAD and AVAILABLE Functions
;	Clear UCB$V_VALID in UCB$W_STS
;
UNLOAD:
AVAILABLE:
;	BICW	#UCB$M_VALID, -		;Clear sofware volume valid bit.
;		UCB$W_STS(R5)
;	BRB	NORMAL			;Then complete the operation.
; 
; 	OPERATON COMPLETION
; 
FEXL:	; dummy entry ... should never get here
NORMAL:					;SUCCESSFUL OPERATION COMPLETE
	MOVZWL	#SS$_NORMAL,R0		;ASSUME NORMAL COMPLETION STATUS
	BRB	FUNCXT			;FUNCTION EXIT

FATALERR:				;UNRECOVERABLE ERROR
	MOVZWL	#SS$_DRVERR,R0		;ASSUME DRIVE ERROR STATUS

RESETXFR:	; dummy entry ... should never really get here
	MOVL	UCB$L_IRP(R5),R3	;GET I/O PKT
	MNEGW	IRP$W_BCNT(R3),UCB$W_BCR(R5) ; RESET BYTECOUNT
;	BRW	FUNCXT
FUNCXT:					;FUNCTION EXIT
	CLRL	R1			;CLEAR 2ND LONGWORD OF IOSB
	REQCOM				; COMPLETE REQUEST
	.PAGE
; 
PWRFAIL:				;POWER FAILURE
	BICW	#UCB$M_POWER,UCB$W_STS(R5)  ;CLEAR POWER FAILURE BIT
	MOVL	UCB$L_IRP(R5),R3	;GET ADDRESS OF I/O PACKET
	MOVQ	IRP$L_SVAPTE(R3),-	;RESTORE TRANSFER PARAMETERS
		UCB$L_SVAPTE(R5)	;...
	BRW	WQ_STARTIO		;START REQUEST OVER
WQ_INT::
WQ_UNSOLNT::
	POPR	#^M<R0,R1,R2,R3,R4,R5>
	REI	;DUMMY RETURN FROM ANY INTERRUPT
	;;
; FIX SPLITS...
; RETURN IRP TO OUR UCB ADDRESS
; THEN REQCOM
;
; TRICK IS TO GET OUR UCB ADDRESS BACK WHEN WE REGAIN CONTROL. DO SO VIA
; JIGGERY-POKERY WITH THE ADDRESS WE CALL. STORE UCB ADDRESSES IN A TABLE
; INTERNALLY AND USE THE CALL ADDRESS TO GET WHERE WE ARE BACK AGAIN.
;
; Note: On entry, r5 points at the IRP we're to handle. We bash this
; information and regenerate it, since irp$l_ucb has already been
; bashed and can't locate our UCB anyway. Therefore we let the return
; address give us the VE: UCB address implicitly via local save and
; restore; each VE: unit returns to a different entry point which preloads
; r5 with a different offset. Once the ucb is located, ucb$l_irp gets
; back the IRP address. This is possibly extra work; one can imagine
; that some IRP fields like SEGVBN could be used to hold the VE: ucb
; address temporarily, since they are saved/restored internally. This
; would allow some address arithmetic to be dispensed with. The current
; method is merely intended to work and NOT force us to let the host driver
; (and maybe other host software) look at bogus IRP fields, and also
; let us remain blissfully ignorant of how VMS handles IRPEs for purposes
; of this driver. (ecch...having to figure out a way to keep i/o post
; processing out of OUR IRPEs (for sure) while using them for temporary
; storage... what a thought!)
;
; NOTE FOLLOWING CODE ASSUMES WQ_UNITS IS 2 OR MORE.
V_UNIT=0
V_UNM=1
WQ_FXS0::
	MOVL	I^#V_UNIT,R4
	BRW	WQ_FIXSPLIT	;GO HANDLE
WQ_FXPL==.-WQ_FXS0	;LENGTH IN BYTES OF THIS LITTLE CODE SEGMENT
V_UNIT=V_UNIT+4		;PASS TO NEXT UNIT
	.MACRO	XVEC LBLC
WQ_FXS'LBLC:
	MOVL	I^#V_UNIT,R4
	BRW	WQ_FIXSPLIT
	.ENDM
	.REPEAT	<WQ_UNITS-1>
	XVEC	\V_UNM
V_UNIT=V_UNIT+4		;PASS TO NEXT UNIT
V_UNM=V_UNM+1
	.ENDR
WQ_FIXSPLIT:
; GET OLD PID..
; IN OUR UCB$PPID LONGWORD...
; NOTE!!! PROBABLY NEEDS MODS FOR VMS V5!!!
;some cleanup for host needed here. Note that r5 enters as IRP address.
; Use initial R5 to help reset host's system...
	movl	irp$l_ucb(r5),r3	;get host's UCB addr
	movl	r5,r2		;store entry IRP address for check later
	PUSHL	R4	;NEED TO WORK IN R5
	MOVAB	WQ_UCBTBL,R5
	ADDL2	(SP)+,R5	;R5 NOW POINTS AT UCB ADDRESS
	MOVL	(R5),R5		;NOW HAVE OUR UCB ADDRESS IN R5
	decw	ucb$w_qlen(r3)	;cleanup host's q len as ioc$iopost would have
	bgeq	6$
	clrw	ucb$w_qlen(r3)	;force queue length zero
6$:
	cmpl	r2,ucb$l_irp(r5)	;got the correct IRP???
	beql	7$		;if eql yes
; MUST avoid screwup where we don't have the correct IRP since there's
; no connection directly between IRP and UCB. VD: unit being busy should
; avoid this error, BUT we have no way to be certain of this w/o exhaustive
; system code checks.
	.if	df,x$$$dt
; oops! wrong IRP. major screwup...
	jsb g^ini$brk
	.endc
	rsb			;else wrong IRP, don't do more damage.
7$:
; notice stack is now clean too.
	movl	r5,r4
	FORK			;go fork on our UCB now (VE: ucb)
	movl	r4,r5
	MOVL	UCB$L_IRP(R5),R3	; POINT R3 AT IRP AGAIN
; Now ensure we can get to a second container IF we are in multi-
; container mode AND IF this is warranted by current state of
; our I/O...
	brb	4300$
4301$:	brw	300$	;if eql no, normal processing
4300$:
; doing dual shadowing. We must check write...
; (If doing write, we ALWAYS have to write both files (assuming we
; are shadowing at all). If doing read, we just go on and finish
; since we only read from ONE file, never both.
	tstl	ucb$rwdir(r5)	; 0 = read direction; also no problem.
	beql	4301$		; if reading, normal processing.
; ok,. writing here.
; Gotta finish the dummy IRPs up & accumulate status in original one.
; Also must detect done and if so handle it.
301$:
; merge error codes of two writes
	movl	ucb$irps(r5),r2	;get original IRP
	movq	irp$l_media(r3),r0	;get i/o status
	bisw	r0,irp$l_media(r2)	;OR in result status
	addl2	r1,irp$l_media+4(r2)	;add rest
	ashl	#-16,r0,r0		;get bytes sent
	addw2	r0,irp$l_media+2(r2)	;add in
	movl	r3,r0			;pointer this IRP
	jsb	g^com$drvdealmem	;free the memory
;now see if we are done.
	tstl	ucb$shmd(r5)		;1 container mode if 0?
	beql	300$
	incl	ucb$irpcnt(r5)		;count IRPs done
	cmpl	ucb$irpcnt(r5),ucb$ncont(r5)	;got all yet?
	bgeq	304$			;if eql yes
; more are awaiting, so just exit this time, leaving orig. IRP there.
	rsb
304$:	movl	r2,r3			;point at original IRP now
300$:
	TSTL	UCB$PPID(R5)	; ENSURE PID IS NONZERO AS SAVED
	BEQL	15$		; SKIP BASH IF NOT
	MOVL	UCB$PPID(R5),IRP$L_PID(R3)	;RESTORE THE OLD PID
	movl	ucb$osegv(r5),irp$l_segvbn(r3)	;restore segment vbn also
	brb	1501$
15$:
	.if	df,x$$$dt
	jsb g^ini$brk
	.endc
	clrl	irp$l_pid(r3)	;make sure we DON'T get back here anyway!
; this is actually an error condition and should NEVER occur...
;	movl	ucb$obct(r5),irp$l_obcnt(r3)	;restore orig byte cnt
1501$:
	CLRL	UCB$PPID(R5)	; ZERO SAVED PID FIELD FOR CLEANLINESS
	MOVL	R5,IRP$L_UCB(R3)	;RESTORE VE: AS UCB IN IRP TOO
; GRAB R0 AND R1 AS REQCOM IN HOST DRIVER LEFT THEM...
	MOVL	IRP$L_MEDIA(R3),R0	;GET BACK R0
	MOVL	IRP$L_MEDIA+4(R3),R1	;AND R1
; R0, R1 ARE AS HOST DRIVER LEFT THEM. R5 POINTS TO CORRECT UCB.
;  ===> GO FOR IT !!!
;
; Now restore the original IRP$L_MEDIA field of the IRP in case error
; paths in IOC$REQCOM ever need it. Some very low XQP cache situations
; may occasionally need this, though in reasonable sysgen configs it
; should never be needed. This is the one area that got bashed during
; the earlier I/O completion processing in the host driver.
;
	MOVL	UCB$LMEDIA(R5),IRP$L_MEDIA(R3)
;
; notice that for virtual I/O, the IRP's IRP$L_SEGVBN longword still
; has the starting VIRTUAL block number of the I/O request in the context
; of the virtual disk. This must be present as any second and later parts
; of the I/O request modify that field to compute where to go for the
; next I/O. Due to getting back here, the host driver need never know
; about this; it is basically doing ONLY physical and logical I/O where
; this sort of completion jiggery-pokery does not occur.
;		- GCE
; Now go REALLY complete the I/O (possibly causing more I/O and certainly
; ensuring the VE: I/O queue is emptied and VE: unbusied after all is done.)
	JSB	@#IOC$REQCOM	; GO COMPLETE THE I/O REQUEST IN VE: CONTEXT
; (OR DO I/O SPLIT NEXT PART IN VE: CONTEXT!)
; ALSO, RETURN **HERE**, SO WE CAN WRAP UP ALL ELSE.
;	.IF	NDF,VMS$V5
;	ENBINT		; RESTORE IPL TO IPL$_IOPOST
;	.IFF
;	FORKUNLOCK	NEWIPL=(SP)+
;	.ENDC
; rsb exits the fork level.
; IPL4 level exited at fork above, with stack intact at that point.
; iopost saves/restores regs, so r5 bash is ok.
	RSB	; GET BACK TO HOST SOMETIME
; BLOCK OF UCB ADDRESSES
WQ_UCBTBL::
	.BLKL	WQ_UNITS
	.LONG 0,0	;SAFETY
WQ_END:					;ADDRESS OF LAST LOCATION IN DRIVER
	.END