try$safe=0
tr$ce=0
step2=1
	.TITLE	JGDRiver	;skeleton driver implementing ucb linkage
	.IDENT	'V01h'
; Copyright 1993,1994 Glenn C. Everhart
; All rights reserved
;  Author: Glenn C. Everhart
; May be copied or used only with inclusion of the above notice.
; However may be used freely given this, for any purposes public or
; private. Commercial use specifically is permitted.
;
; JGdriver - error reduction intercept driver.
; This driver is designed to be used as a "wedge" in any VMS driver
; of standard type which will act to notice I/O errors and cause retry
; of them for a limited number of times. This should be used where it
; is desired to add extended retry because a base device type might
; in a particular case (e.g. optical disk using dkdriver) tend to have
; more errors than normal and the default error retries may not suffice.
;
; This is an example intercept driver for VMS AXP 6.1 and later (i.e., a
; step 2 driver intercept) which shows how to add FDT time intercepts
; ahead of the normal ones. It defines FDT_ACT entries here ONLY
; for those functions to be serviced in this driver and these should
; return via the PORS label, which will call the original FDT routines
; after servicing things here (unless of course local routines finish
; the I/O off locally in normal step 2 driver ways like calls to the
; finishio or abortio routines).
;
; It is expected that initially an io$_format+128 function will be
; issued with the buffer as described herein to get the driver connected
; with some other device. This calls the mung routine which actually
; intercepts the I/O in such a way that it can be cleared. The intercept
; can be removed with another io$_format+128 call with the buffer set
; to clear the connect.
;
; The IO$_FORMAT call is not assumed to be 64-bit clean but should
; use structures in 32bit space.
;
; Note that within this code one does NOT simply RETurn from the
; local FDT processing. Rather the routines should branch to the PORS
; routine to continue FDT processing using the original FDT context.
; This means that one gets cross routine entries, and it is permissible
; to make PORS a .jsb_entry call and then RET after it.
;
;
; Note too that drivers wanting to use this intercept will operate
; cleanly provided they find start_io by following the chain
; UCB$L_DDT -> DDT$L_STARTIO chain to find the start-io entry point.
; Where a driver startio routine loops back to its start for more
; work, without following the chain, this intercept cannot guarantee
; at which IRP processing will be switched. Should the chain be followed
; in all cases, however, the switch will take effect at once. In either
; case, an IRP gets processed by one path or the other, not both.
;
; The buffer to pass to connect is of form:
;buf: .long	1	;bash flag
; .long 1000	;dummy size of disk. Must be > 0
; .ascid /devicename/	;device name we should connect to
;
; The disconnect buffer is just like the connect one, except the
; buffer starts with ".long 2" instead of ".long 1"
;
;
; Some sanity checks will refuse to disconnect the intercept unless
; the right device is given and unless an intercept had been done
; in the first place. This is a shade crude, but necessary to prevent
; corruption of the I/O database. It is expected that the intercepts
; here get set up at boot time. 
;
; For an example, a little intercept of io$_modify is given which
; can allow extends to be forced to be contiguous-best-try (cbt)
; every Nth time (which tends to keep the extent caches flushed).
; Once this is set up, the FDT entry just calls the normal VMS
; modify FDT functions and lets the I/O go through. It checks that
; it is not messing with a kernel channel, nor with requests for
; contiguous extension, nor with movefile requests, but lets
; other activity go on unchanged.
;
; This is offered since the intercept I published before for intercept
; drivers got badly broken for step2 FDT intercepts. This one on the
; other hand will work.
;
; Note that by testing in the mung routine for FDT address equal to
; the local io$_format intercept fdt, it's possible also to leave
; the target disk's IO$_format FDT entry strictly alone and allow
; that to go thru unaltered. Sending IO$_format+128 to THIS driver
; controls it, but sending to the original driver in that case just
; does what the original driver likes...
;
; Glenn Everhart
; everhart@Arisia.GCE.Com
;
;
.ntype	__,R31			;  set EVAX nonzero if R31 is a register
.if eq <__ & ^xF0> - ^x50
EVAX = 1
.iff
;EVAX = 0
.endc
	.if	df,evax
evax = 1
alpha=1
bigpage=1
addressbits=32
;					;... EVAX=1 -> Step1
.iif ndf WCB$W_NMAP, evax=2		;... EVAX=2 -> Step2 (ndf as of T2.0)
.iif ndf WCB$W_NMAP, step2=1		;... EVAX=2 -> Step2 (ndf as of T2.0)
	.endc
;x$$$dt=0
; above for Alpha only.
;
; Glenn C. Everhart 1994
;
;vms$$v6=0	;add forvms v6 def'n
vms$v5=1
; define v5$picky also for SMP operation
v5$picky=1
	.SBTTL	EXTERNAL AND LOCAL DEFINITIONS

; 
; EXTERNAL SYMBOLS
; 
	.library /SYS$SHARE:LIB/
; There are lots of defs here...more than are really needed, but they
; do no harm & are likely to be useful in intercept code.
;
; Note:
; Probably the easiest way to pull code into nonpaged pool in AXP
; VMS is to build it into some sort of fake driver so the driver
; loader gets it loaded for you. In general an executive module
; loader will work, but having something that looks like a driver
; as here also provides the option of having extra controls in a
; well defined path. Hence this driver is able to (ab)use the
; io$_format opcode (to itself) to connect or disconnect to some
; victim device. A little more fiddling would allow us not to touch
; the io$_format entry for the victim device...that is left as an
; exercise for the reader...but it shows one of the conveniences
; of the technique. If a generic exec module were inserted, there'd
; still be a need to control it. The $qio technique makes it possible
; to pass buffers of commands to the code without having to muck
; with any system services, and without need of defining any new
; ones. The code doesn't have to have anything at all to do with
; what drivers normally do...it can be whatever cruft you usually
; insert in pool for Ghod knows what reason...and can be hooked in
; in ANY way convenient. You just shove it in and let it get loaded
; as you please.
;

;	$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
	$ipldef
	$DDTDEF				; DEFINE DISPATCH TBL...
	.if df,step2
	ddt$l_fdt=ddt$ps_fdt_2
	ddt$l_start=ddt$ps_start_2
	.endc
	$ptedef
	$vadef
	$IRPDEF				;DEFINE I/O REQUEST PACKET
	$irpedef
	$PRDEF				;DEFINE PROCESSOR REGISTERS
	$SSDEF				;DEFINE SYSTEM STATUS CODES
	$UCBDEF				;DEFINE UNIT CONTROL BLOCK
	$fdt_contextdef
	$fdtdef
	.if	df,step2
	$fdt_contextdef
	.endc
	$sbdef	; system blk offsets
	$psldef
	$prdef
	$acldef
	$rsndef				;define resource numbers
	$acedef
	$VECDEF				;DEFINE INTERRUPT VECTOR BLOCK
	$pcbdef
	$statedef
	$jibdef
	$acbdef
	$vcbdef
	$arbdef
	$wcbdef
	$ccbdef
	$fcbdef
	$phddef
        $RABDEF                         ; RAB structure defs
        $RMSDEF                         ; RMS constants
; defs for acl hacking
	$fibdef
	$atrdef
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.
; Add our stuff at the end to ensure we don't mess some fields up that some
; areas of VMS may want.
; Leave thisfield first so we can know all diskswill have it at the
; same offset.
;
;
$def	ucb$l_hucbs	.blkl	1	;host ucb table
;
; Add other fields here if desired.
;
$def	ucb$l_ctlflgs	.blkl	1		;flags to control modes
;
$def	ucb$l_cbtctr	.blkl	1		;How many extends done
$def	ucb$l_cbtini	.blkl	1		;init for counter
; preceding 2 fields allow specifying of contig-best-try extents
; on every Nth extend, not every one. This should still help keep
; file extensions from preferentially picking up chaff
; The following lets us remember what the original stolen device is
; so we can prevent double bashes...
$def	ucb$JGcontfil	.blkb	80
$def	ucb$l_asten	.blkl	1		;ast enable mask store
;
; DDT intercept fields
; following must be contiguous.
$def    ucb$s_ppdbgn            ;add any more prepended stuff after this
$def    ucb$l_uniqid    .blkl   1       ;driver-unique ID, gets filled in
                                        ; by DPT address for easy following
                                        ; by SDA
$def    ucb$l_intcddt   .blkl   1       ; Our interceptor's DDT address if
                                        ; we are intercepted
$def    ucb$l_prevddt   .blkl   1       ; previous DDT address
$def    ucb$l_icsign    .blkl   1       ; unique pattern that identifies
                                        ; this as a DDT intercept block
; NOTE: Jon Pinkley suggests that the DDT size should be encoded in part of this
; unique ID so that incompatible future versions will be guarded against.
$def    ucb$s_ppdend
$def    ucb$a_vicddt    .blkb   ddt$k_length
                                        ; space for victim's DDT
			.blkl	4	;safety
$def	ucb$l_backlk	.blkl	1	;backlink to victim ucb
; Make the "unique magic number" depend on the DDT length, and on the
; length of the prepended material. If anything new is added, be sure that
; this magic number value changes.
magic=^xF013F000 + ddt$k_length + <256*<ucb$s_ppdend-ucb$s_ppdbgn-16>>
p.magic=^xF013F000 + ddt$k_length + <256*<ucb$s_ppdend-ucb$s_ppdbgn-16>>
$DEF	UCB$L_JG_HOST_DESCR	.BLKL	2	;host dvc desc.
;
; Store copy of victim FDT table here for step 2 Alpha driver.
; assumes FDT table is 64+2 longs long
;
; This layout is much easier to deal with than the VAX or STEP1 one...
; fdt$k_length should be 68 longwords for the 64bit case, 66 longs for
; vms 6.1. The code even for 6.1 copied an extra quadword to be certain
; it got everything, so it actually requires no mods for 64 bit FDTs.
; It is essential that the complete FDT and DDT get copied. which
; symbolic use of length symbols will now assure.
$def	ucb$l_myfdt	.blkl	<<FDT$K_LENGTH/4>+4>;user FDT tbl copy + slop for safety
$def	ucb$l_oldfdt	.blkl	1	;fdt tbl of prior fdt chain
$def	ucb$l_vict	.blkl	1	;victim ucb, for unmung check
$def	ucb$l_mungd	.blkl	1	;munged flag, 1 if numg'd
; The following lets us steal start-io and add error retries
$def    ucb$l_omedia    .blkl   1       ;storage of orig. irp$l_media
$def    ucb$l_ppid      .blkl   1       ;store for irp$l_pid contents
$def    ucb$l_retries   .blkl   1       ;counter for i/o retries
$def    ucb$l_hstartio  .blkl   1       ;host driver start-io loc.
$def    ucb$l_hstucb    .blkl   1       ;host ucb (quick ref)
	.if	df,tr$ce
$def	ucb$l_where	.blkl	1	;where we are
	.endc
;
$DEF	UCB$K_JG_LEN	.BLKW	1	;LENGTH OF UCB
;UCB$K_JG_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
; 
	driver_data
JG_UNITS=500
JG$DPT::
.iif ndf,spt$m_xpamod,dpt$m_xpamod=0
	DPTAB	-			;DPT CREATION MACRO
		END=JG_END,-		;END OF DRIVER LABEL
		ADAPTER=NULL,-		;ADAPTER TYPE = NONE (VIRTUAL)
		FLAGS=DPT$M_SMPMOD!dpt$m_xpamod!DPT$M_NOUNLOAD, - ;SET TO USE SMP,xa
		DEFUNITS=2,-		;UNITS 0 THRU 1 thru 31
		step=2,-
		UCBSIZE=UCB$K_JG_LEN,-	;LENGTH OF UCB
		MAXUNITS=JG_UNITS,-	;FOR SANITY...CAN CHANGE
		NAME=JGDRIVER		;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
; make OUR fork IPL not have bit 5 set, to tell fork dispatcher NOT to get
; a spinlock for OUR fork (so as not to interfere with any locks by having
; the fork dispatch return clear a lock out from under a driver!)
	DPT_STORE UCB,UCB$B_FLCK,B,SPL$C_IOLOCK8  ;FORK IPL (VMS V5.X + LATER)
; These characteristics for an intercept driver shouldn't look just
; like a real disk unless it is prepared to handle being mounted, etc.
; Therefore comment a couple of them out. Thus it won't look file oriented
; nor directory structured. The actual characteristics don't matter much,
; just so the device is not picked up by anything as "interesting".
	DPT_STORE UCB,UCB$L_DEVCHAR,L,-	;DEVICE CHARACTERISTICS
		<DEV$M_SHR-		; SHAREABLE
;		!DEV$M_DIR-		; DIRECTORY STRUCTURED
		!DEV$M_AVL-		; AVAILABLE
;		!DEV$M_FOD-		; FILES ORIENTED
		!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$_MISC  ;DEVICE CLASS
	DPT_STORE UCB,UCB$W_DEVBUFSIZ,W,512  ;DEFAULT BUFFER SIZE
; FOLLOWING DEFINES OUR DEVICE "PHYSICAL LAYOUT". It's faked here.
	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
	DPT_STORE UCB,UCB$B_DIPL,B,8	;DEVICE IPL
;	DPT_STORE UCB,UCB$B_ERTMAX,B,10	;MAX ERROR RETRY COUNT
	DPT_STORE UCB,UCB$L_DEVSTS,L,-	;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,JG_INT  ;INTERRUPT SERVICE ROUTINE ADDRESS
	DPT_STORE DDB,DDB$L_DDT,D,JG$DDT	  ;DDT ADDRESS
        DPT_STORE UCB,UCB$L_UNIQID,D,DRIVER$DPT    ;store DPT address
                                                ; (change "XX" to device
                                                ; mnemonic correct values)
        DPT_STORE UCB,UCB$L_ICSIGN,L,magic      ; Add unique pattern (that might
                                                ; bring back some memories in
                                                ; DOS-11 users)

; HISTORICAL NOTE: under DOS-11, one would get F012 and F024 errors
; on odd address and illegal instruction traps. If we don't have
; this magic number HERE, on the other hand, we're likely to see
; bugchecks in VMS due to uncontrolled bashing of UCB fields!
	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.
; 
;JG$DDT:
; Actually the presence of fastio in the intercept driver is of
; no importance either since it isn't really a disk...
	.if	df,irp$q_qio_p1
	DDTAB	-			;DDT CREATION MACRO
		DEVNAM=JG,-		;NAME OF DEVICE
		START=JG_STARTIO,-	;START I/O ROUTINE
		FUNCTB=JG_FUNCTABLE,-	;FUNCTION DECISION TABLE
		CTRLINIT=JG_CTRL_INIT,-
		UNITINIT=JG_UNIT_INIT,-
		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
		FAST_FDT=ACP_STD$FASTIO_BLOCK	; Fast-IO FAST_FDT routine
	.iff
	DDTAB	-			;DDT CREATION MACRO
		DEVNAM=JG,-		;NAME OF DEVICE
		START=JG_STARTIO,-	;START I/O ROUTINE
		FUNCTB=JG_FUNCTABLE,-	;FUNCTION DECISION TABLE
		CTRLINIT=JG_CTRL_INIT,-
		UNITINIT=JG_UNIT_INIT,-
		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
	.endc
; 
; FUNCTION DECISION TABLE
; 
; 	THE FDT LISTS VALID FUNCTION CODES, SPECIFIES WHICH
; 	CODES ARE BUFFERED, AND DESIGNATES SUBROUTINES TO
; 	PERFORM PREPROCESSING FOR PARTICULAR FUNCTIONS.
; 
; NOTE: Be sure the FDT table is 8 byte aligned!!!! The addins below are
; 4 longwords which will not screw up quad alignment...
	.align quad
chnflg:	.long	0	;chain or use our FDT chain flag...use ours if 0
myonoff:
fdtonoff: .long 0	;switch my fdt stuff off if non-0
	.ascii	/dflg/	;define your own unique flag here; just leave it 4 bytes long!
	.long 0		;fdt tbl from before patch
fdt_chn  = -12
fdt_prev = -4
fdt_idnt = -8
;	.align quad
JG_FUNCTABLE:
	FDT_INI
	FDT_BUF -	; 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
	.if	df,irp$q_qio_p1
; Note that as an intercept driver we copy the target FDT and actually don't 
; need this, but do it for beauty.
	FDT_64	<-				; Functions supporting 64-bit addresses
		AVAILABLE,-			; Available (rewind/nowait clear valid)
		NOP,-				; No operation
		PACKACK,-			; Pack acknowledge
		READLBLK,-			; Read logical block forward
		READPBLK,-			; Read physical block forward
		READVBLK,-			; Read virtual block
		SENSECHAR,-			; Sense characteristics
		SENSEMODE,-			; Sense mode
		SETCHAR,-			; Set characterisitics 
		SETMODE,-			; Set mode
		UNLOAD,-			; Unload volume
		WRITECHECK,-			; Write check
		WRITELBLK,-			; Write LOGICAL Block
		WRITEPBLK,-			; Write Physical Block
		WRITEVBLK>			; Write VIRTUAL Block
	.endc
myfdtstart:
; io$_format + modifiers (e.g. io$_format+128) as function code
; allows one to associate a JG unit and some other device; see
; the JG_format code comments for description of buffer to be passed.
	fdt_act JG_format,-		;point to host disk
		<format>
;
; First our very own filter routines
;
; Following FDT function should cover every function in the local
; FDT entries between "myfdtbgn" and "myfdtend", in this case just
; mount and modify. Its function is to switch these off or on at
; need.
myfdtbgn=.
; Leave a couple of these in place as an illustration. You would of course
; need to insert your own if you're messing with FDT code, or remove these if
; you don't want to. The FDT switch logic is a waste of time and space if
; you do nothing with them...
; They don't actually do anything here, but could be added to. Throw in one
; to call some daemon at various points and it can act as a second ACP
; when control is inserted at FDT time (ahead of the DEC ACP/XQP code!)
	.if	eq,1
	fdt_act MFYFilt,-
		<MODIFY>		;modify filter (e.g. extend)
	.endc
myfdtend=.
vd_ucbtbl:
JG_ucb:
JG_utb:
	.rept	JG_units
	.long	0
	.endr
	.long	0,0,0,0,0,0,0,0,0,0
; offset address table
v_unm=0
; Note: code elsewhere assumes that the xxvc macro generates 8 bytes.
; If .address generates more than 4, it breaks as coded here!!!
        .macro xxvc lblct
        .address        vd_fxs'lblct
        .globl  vd_fxs'lblct
        .long   0
        .endm
VD_VOADT::
        .rept   <jg_units+4>
        xxvc    \v_unm
v_unm = <v_unm+1>
        .endr

	driver_code
;
; GETJGUCB - Find JG: UCB address, given r5 points to UCB of the patched
; device. Return the UCB in R0, which should return 0 if we can't find
; it.
;   This routine is called a lot and therefore is made as quick as
; it well can be, especially for the usual case.
;
; The trick that we have the victim DDT in our intercept UCB and thus can
; find the intercept UCB relatively fast is the best feature here.
; This gives simple lookup of victim driver from intercept code.
; If we can be sure that the intercept situation is static, we can
; avoid a couple PAL calls here that do synch. stuff, but for this
; example, leave 'em in.
;
getJGucb: .jsb_entry output=<r0>
;	clrl	r0	;no UCB initially found
	pushl	r10
	pushl	r11	;faster than pushr supposedly
;	pushr	#^m<r10,r11>
; Assumes that R5 is the UCB address of the device that has had some
; code intercepted and that we are in some bit of code that knows
; it is in an intercept driver. Also assumes R11 may be used as
; scratch registers (as is true in FDT routines). Control returns at
; label "err" if the DDT appears to have been clobbered by
; something not following this standard, if conditional "chk.err"
; is defined.
;       Entry: R5 - victim device UCB address
;       Exit: R11 - intercept driver UCB address
chk.err=0
        movl    ucb$l_ddt(r5),r10       ;get the DDT we currently have
; note we know our virtual driver's DPT address!!!
        movab   DRIVER$dpt,r11              ;magic pattern is DPT addr.
; lock this section with forklock so we can safely remove
; entries at fork also. Use victim device forklock.
; (don't preserve r0 since we clobber it anyway.)
        forklock lock=ucb$b_flck(r5),savipl=-(sp),preserve=NO
2$:     cmpl    <ucb$l_uniqid-ucb$a_vicddt>(r10),R11
                                        ;this our own driver?
;        beql    1$                      ;if eql yes, end search
;
; The somewhat odd layout here removes extra branches in the
; most common case, i.e., finding our driver the very first time
; through. The "bneq" branch next time is usually NOT taken.
;
	.branch_unlikely
	bneq	5$			;check next in chain if not us
; At this point R10 contains the DDT address within the intercept
; driver's UCB. Return the address of the intercept driver's UCB next.
        movab   <0-ucb$a_vicddt>(r10),r11       ;point R11 at the intercept UCB
;	brb	4$	; note in this layout we can comment this out.
4$:
        forkunlock lock=ucb$b_flck(r5),newipl=(sp)+,condition=RESTORE,preserve=NO
; NOW clobber r0 and put things back.
	movl	r11,r0
;	popr	#^m<r10,r11>
	popl	r11
	popl	r10	;supposedly faster than popr
	rsb
; Make very sure this DDT is inside a UCB bashed according to our
; specs. The "p.magic" number reflects some version info too.
; If this is not so, not much sense searching more.
;
; If we get here and the DDT points now to someone ELSE'S UCB instead
; of ours, we must keep looking to find OUR UCB. This is done by
; searching the chain we establish so this intercept driver can
; find its own UCB in a finite search. If of course it is the only
; intercept, it gets it right away.
5$:     cmpl    <ucb$l_icsign-ucb$a_vicddt>(r10),#p.magic
        bneq    3$                     ;exit if this is nonstd bash
; follow DDT block chain to next saved DDT.
        movl    <ucb$l_prevddt-ucb$a_vicddt>(r10),r10
                                        ;point R10 at the next DDT in the
					;chain
        bgeq    3$                     ; (error check if not negative)
        brb     2$                      ;then check again
;1$:
3$:
	clrl	r11	;return 0 if nothing found
	brb	4$
;
; Few macros for long distance branches...
;
	.macro	beqlw	lbl,?lbl2
	bneq	lbl2
	brw	lbl
lbl2:
	.endm
	.macro	bneqw	lbl,?lbl2
	beql	lbl2
	brw	lbl
lbl2:
	.endm
	.macro	bleqw	lbl,?lbl2
	bgtr	lbl2
	brw	lbl
lbl2:
	.endm
	.macro	bgeqw	lbl,?lbl2
	blss	lbl2
	brw	lbl
lbl2:
	.endm
; allocate does not zero its result area.
; This macro makes it easy to zero an allocated area before using it.
; Leaves no side effects...just zeroes the area for "size" bytes
; starting at "addr".
	.macro	zapz	addr,size
	pushr	#^m<r0,r1,r2,r3,r4,r5>	;save regs from movc5
	movc5	#0,addr,#0,size,addr
	popr	#^m<r0,r1,r2,r3,r4,r5>	;save regs from movc5
	.endm
;
	.SBTTL Our FDT Filter Routines
; These routines are edited from the JGDRiver versions to call
; getJGucb, assuming they are called with R5 pointing at the patched
; driver's UCB.
; 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
; 	(AP)	- ADDRESS OF FIRST QIO PARAMETER
; Filter routines.
; These do the interesting stuff.
;
PopOut:
	popr	#^m<r0,r5>
pors:
; Here need to return to the "standard" FDT routine. Do so by computing
; the address in the FDT table of the normal host and calling that, then
; returning. Thus the only FDT routines in THIS driver are the ones
; it needs for its own work, not any standard ones. This calls those.
; Thus, any "continue" returns of our code must wind up calling "pors"
; instead of doing a RET. This will pass the call control along.
        EXTZV   #IRP$V_FCODE,#IRP$S_FCODE,IRP$L_FUNC(R3),R1     ; GET FCN CODE
	pushr	#^m<r6,r7,r8,r9,r10>
	movl	r1,r10
	jsb	getJGucb		;find JG UCB checking for extra links
	tstl	r0			;got it?
	bgeq	199$			;if not skip out
	movl	ucb$l_oldfdt(r0),r7	;get address of previous FDT
	bgeq	199$			;ensure ok...
;	movl	ucb$l_ddt(r5),r7	;find FDT
; Here rely on the fact that we got here via our modified FDT call and that
; the orig. FDT is stored just a bit past the current one.
;	movl	<ucb$l_oldfdt-ucb$l_myfdt>(r7),r7	;point at orig. FDT
	addl2	#8,r7			;point at one of 64 fdt addresses
	movl	(r7)[r10],r8		;r7 is desired routine address
;now call the "official" FDT code...or the next intercept's down anyhow.
	pushl	r6	;ccb
	pushl	r5	;ucb
	pushl	r4	;pcb
	pushl	r3	;irp
	calls	#4,(r8)			;Call the original routine
	popr	#^m<r6,r7,r8,r9,r10>
; Now return as the original routine would.
	ret
199$:
	popr	#^m<r6,r7,r8,r9,r10>
	movl	#16,r0
	call_abortio 
	ret
;	rsb

	.if	eq,1	;condition this out
mfyfilt: $driver_fdt_entry	;filter on MODIFY requests (e.g. extend)
; First do some preliminary checks for sanity.
; 1. Channel must NOT be kernel mode
; 2. Not a movefile
	tstl	r6		;is there a CCB (must be +)
	bleq	pors		;if not skip out
	cmpb	ccb$b_amod(r6),#1	;knl mode access?
	bleq	pors		;leave knl mode chnls alone!
;funct modifiers are bits 6-15
; this is hex ffc0
; Normal io$_modify should have no modifiers, so if it has it's
; for something else; leave that alone.
	.if	ndf,evax
	bitw	#^x1FC0,irp$w_func(r3) ;this a movefile or other modifier?
	.iff
	bitl	#^xDFC0,irp$l_func(r3) ;this a movefile or other modifier?
	.endc
	bneq	pors		;if so ignore it here.
	pushr	#^m<r0,r5>
; original r5 now at 4(sp). Must get that to continue the ops.
	jsb	getJGucb		;find JGDRiver ucb
	tstl	r0
	bgeqw	popout
	movl	r5,ucb$l_backlk(r0)	;save link'd ucb in ours too.
	movl	r0,r5			;point R5 at JG UCB
;make sure not a knl mode channel (leave the XQP channel alone!!!)
	cmpb	ccb$b_amod(r6),#1	;this the XQP's chnl?
	bleqw	popout			; if so scram NOW.
; Now ensure that this call is not in the same JOB as the daemon.
; (This lets the daemon spawn processes to do some work.)
	bitl	i^#2,ucb$l_ctlflgs(r5)	;look at mfy?
	bneqw	mfycmn			;if neq yes
; (test later will see about space control if doing this)
701$:
	popr	#^m<r0,r5>
	brw	pors
mspcj:	popl	r0
	brw	popout
mfycmn:
; here we can modify request fields in the FIB the user supplies to reduce
; fragmentation...e.g. set fib$l_exsz bigger or set fib$m_alconb bit
; in fib$w_exctl IFF fib$m_alcon is not set & set fib$m_aldef.
;
	pushl	r0
	.if	ndf,evax
	movl	p1(ap),r0	;get fib
	.iff
	movl	irp$l_qio_p1(r3),r0
	.endc
xx$nor=0
	.iif df,xx$nor,ifnord #4,4(r0),mspcj
	movl	4(r0),r0	;...from descriptor
	.iif df,xx$nor,ifnord #4,fib$w_exctl(r0),mspcj
	bitw	#fib$m_extend,fib$w_exctl(r0)	;extending at all?
	beqlw	mspc			;if no extend, leave fib alone
; Because contiguous best try allocation flushes the entire extend cache,
; it can cause a tremendous performance hit. Therefore allow it to be
; separately switched so that the benefits of longer extents can be had
; if desired without forcing this flushing every time a file is extended.
	bitl	i^#32,ucb$l_ctlflgs(r5)		;separate control for setting contig best try
	beql	1$
; leave contig and contig-best-try alone
	bitw	#<fib$m_alcon!fib$m_alconb>,fib$w_exctl(r0)	;contig alloc?
	bneq	1$		;if contig leave it alone
; allow this on every nth extend.
; This will allow periodic flushes of the extent cache but will let
; it not be made totally useless. By flushing the extent cache periodically
; we can try to reduce the fragmentation it induces.
; if bit 16384 is not set, do not set aldef.
	decl	ucb$l_cbtctr(r5)	;count down
	bgtr	1$			;and if >0 don't set cbt yet
	movl	ucb$l_cbtini(r5),ucb$l_cbtctr(r5)	;else reset counter
	bisw	#<fib$m_alconb>,fib$w_exctl(r0) ;else turn on contig best
					;try and turn on use of
					;system default extension if
					;larger than program default
1$:
mspc:	popl	r0
	popr	#^m<r0,r5>
	movl	#1,r0
	brw	pors
	.endc	;eq,1
;++
;
; JG_format - bash host disk tables to point at ours.
;
; 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 - (was hlbn) - flag for function. 1 to bash
;			  the targetted disk, 2 to unbash it, else
;			  illegal.
;	     longword 1 - virtual disk length, the number of blocks in
;			  the virtual disk. If negative disables
;			  FDT chaining; otherwise ignored.
;	     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
;--
JG_format: $driver_fdt_entry
	bicw3	#io$m_fcode,irp$l_func(r3),r0	;mask off function code
	bneq	20$			;branch if modifiers, special
;thus, normal io$_format will do nothing.
	brw pors			;regular processing
100$:
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
10$:
	movzwl	#SS$_BADPARAM,r0	;illegal parameter
	clrl	r1
	call_abortio
	ret
;	jmp	g^exe$abortio
20$:
        movl    irp$l_qio_p1(r3),r0     ;buff address
        movl    irp$l_qio_p2(r3),r1     ;buff length
	call_writechk
;	jsb	g^exe$writechk		;read access? doesn't return on error
;	clrl	irp$l_bcnt(r3)		;paranoia, don't need to do this...
	pushr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movl	irp$l_qio_p1(r3),r0
	movl	(r0)+,r7		;get option code
	bleq	100$			;0 or negative illegal
	cmpl	r7,#2			;3 and up illegal too
	bgtr	100$
	incl	chnflg
	movl	(r0)+,r6		;size of virtual disk (ignored)
	bleq	70$
	clrl	chnflg			;if 0 or neg. size don't chain...
70$:
	movab	(r0),-			;name of "real" disk
		ucb$l_JG_host_descr+4(r5)
        subl3   #8,irp$l_qio_p2(r3),-
                ucb$l_JG_host_descr(r5)
	bleq	100$			;bad length
	movab	ucb$l_JG_host_descr(r5),r1	;descriptor for...
	jsb	g^ioc$searchdev		;search for host device
	blbs	r0,30$			;branch on success
; fail the associate...
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movzwl	#ss$_nosuchdev+2,r0	;make an error, usually a warning
	clrl	r1
	call_abortio
	ret
;	jmp	g^exe$abortio		;exit with error
30$:	;found the device
; r1 is target ucb address...
; move it to r11 to be less volatile
	movl	r1,r11
	cmpl	r7,#1		;bashing the target UCB?
	bneq	31$
	jsb	mung		;go mung target...
	brb	32$
31$:
; Be sure we unmung the correct disk or we can really screw up a system.
	cmpl	r11,ucb$l_vict(r5)	;undoing right disk?
	bneq	32$			;if not skip out, do nothing.
	jsb	umung		;unmung target
32$:
;	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
	popr	#^m<r0,r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movzwl	#ss$_normal,r0			;success
	call_finishioc do_ret=yes
;	jmp	g^exe$finishioc			;wrap things up.
mung: .jsb_entry
; steal DDT from host. Assumes that the intercept UCB address
; is in R5 (that is, the UCB in which we will place the DDT copy),
; and that the UCB of the device whose DDT we are stealing is
; pointed to by R11. All registers are preserved explicitly so that
; surrounding code cannot be clobbered. R0 is returned as a status
; code so that if it returns with low bit clear, it means something
; went wrong so the bash did NOT occur. This generally means some other
; code that does not follow this standard has grabbed the DDT already.
; The following example assumes the code lives in a driver so the
; unique ID field and magic number are set already.
	tstl	ucb$l_mungd(r5)		;already munged/not deassigned?
	beql	6$
	rsb				;no dbl bash
6$:
        pushr   #^m<r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
; Acquire victim's fork lock to synchronize all this.
        movl    #ss$_normal,r0          ;assume success
        forklock ucb$b_flck(r11),-
	savipl=-(sp),preserve=YES
; find the current DDT address from the UCB (leaving the copy in
; the DDB alone)
        movl    ucb$l_ddt(r11),r10      ;point at victim's DDB
; fill in host ucb tbl (makes chnl handling faster)
; This allows us to create fake channels to nla0: and bash them to channels
; to the host devices associated if we need to...stuff like that.
	movab	JG_ucb,ucb$l_hucbs(r5)
	movl	ucb$l_hucbs(r5),r9	;get ucb table
	movzwl	ucb$w_unit(r5),r0	;get unit no.
	moval	(r9)[r0],r9		;point into tbl
	movl	r11,(r9)		;save target ucb addr in tbl
; see if this DDT is the same as the original
        movl    ucb$l_ddb(r11),r9       ;the ddb$l_ddt is the original
        cmpl    ddb$l_ddt(r9),r10       ;bashing driver the first time?
        beql    1$                      ;if eql yes
; driver was bashed already. Check that the current basher followed the
; standard. Then continue if it looks OK.
        cmpl    <ucb$l_icsign-ucb$a_vicddt>(r10),#p.magic
                                        ;does the magic pattern exist?
; if magic pattern is missing things are badly messed.
        beql    2$                      ;if eql looks like all's well
        movl    #2,r0                   ;say things failed
        brw     100$                    ;(brb might work too)
2$:
; set our new ddt address in the previous interceptor's slot
        movab   ucb$a_vicddt(r5),<ucb$l_intcddt-ucb$a_vicddt>(r10)
                                        ;store next-DDT address relative
                                        ;to the original victim one
1$:
	movl	#1,ucb$l_mungd(r5)	;say we munged JG
        movl    r10,ucb$l_prevddt(r5)   ;set previous DDT address up
        clrl    ucb$l_intcddt(r5)       ;clear intercepting DDT initially
3$:
        pushl   r5
; copy a little extra for good luck...
        movc3   #<ddt$k_length+12>,(r10),ucb$a_vicddt(r5)    ;copy the DDT
        popl    r5                      ;get UCB pointer back (movc3 bashes it)
;
; Here make whatever mods to the DDT you need to.
;
; FOR EXAMPLE make the following mods to the FDT pointer
; (These assume the standard proposed for FDT pointers)
        movab   ucb$a_vicddt(r5),r8     ;get a base register for the DDT
        movl    r5,JG_functable+fdt_prev    ;save old FDT ucb address
	movl	ddt$l_fdt(r10),ucb$l_oldfdt(r5)
        movl    ucb$l_uniqid(r5),JG_functable+fdt_idnt ;save unique ID also
; copy legal and buffered entry masks of original driver.
; HOWEVER, set mask for format entry to be nonbuffered here since
; we deal with it.
	pushr	#^m<r6,r7,r8,r9,r10,r11>
	movab	ucb$l_myfdt(r5),r9	;our function table dummy in UCB
	movl	ddt$l_fdt(r10),r7	;victim's FDT table
; We want all functions legal in the victim's FDT table to be legal
; here.
	pushr	#^m<r0,r1,r2,r3,r4,r5>	;preserve regs from movc
;actually with 64 bits the FDT length is 64 longs for function addresses,
; 2 longs for buffered, 2 longs for 64 bit mask
; Add a quadword slop to ensure we're long enough.
;	movl	#<70*4>,r0		;byte count of a step 2 FDT + slop
	movl	#<FDT$K_LENGTH+8>,r0	;byte count of a step 2 FDT + slop
	movc3	r0,(r7),(r9)		;copy his FDT to ours
	popr	#^m<r0,r1,r2,r3,r4,r5>	;preserve regs from movc
; Now copy in our modify & back-to-original FDT cells.
; We will do this in our FDT table by having FDT definitions only
; for those functions in JGDRiver that we service locally. Thus
; all entry cells for the rest will point in the JG FDT to
; exe$illiofunc.
	movab	g^exe$illiofunc,r8	;get the magic address
	movab	JG_functable,r10	;r10 becomes JG FDT tbl
	addl2	#8,r10			;point at functions
	addl2	#8,r9			;his new FDT...
	movl	#64,r11			;64 functions
; The code below will let the victim driver's IO$_format FDT entry not be
; messed with...
        .if     ndf,b$fmt$
        pushl   r7
        movab   JG_format,r7            ; let victim's format fdt by
        .endc
75$:	cmpl	(r10),r8		;this function hadled in JG?
	beql	76$			;if eql no, skip
	movl	(r10),(r9)		;if we do it point his fdt at our fcn
        .if     ndf,b$fmt$
        cmpl    (r10),r7                ;this our io$_format
        beql    76$                     ;if so leave victim's alone
        .endc
; (NOTE: our functions MUST therefore call the previous FDT's functions at
;  end of their processing.)
76$:	cmpl	(r10)+,(r9)+		;pass the entry
	sobgtr	r11,75$			;do all functions
        .if     ndf,b$fmt$
        popl    r7                      ;get back victim fdt
        .endc
; JGDRiver FDT table. Last entry goes to user's original FDT chain.
;
; Thus we simply insert our FDT processing ahead of normal stuff, but
; all fcn msks & functions will work for any driver.
	popr	#^m<r6,r7,r8,r9,r10,r11>
; Now point the user's FDT at our bugger'd copy.
        movab	ucb$l_myfdt(r5),ddt$l_fdt(r8) ;point at our FDT table
        clrl    myonoff                 ;turn my FDTs on
;
; Set up victim's startio toour steal-startio after saving the address here
        movl    ddt$l_start(r8),ucb$l_hstartio(r5)      ;save host start-io
        movl    r11,ucb$l_hstucb(r5)    ;save backpointer too
        movab   stealstart,ddt$l_start(r8)      ;point at our startio
;
; Finally clobber the victim device's DDT pointer to point to our new
; one.
        movab   ucb$a_vicddt(r5),ucb$l_ddt(r11)
; Now the DDT used for the victim device unit is that of our UCB
; and will invoke whatever special processing we need. This processing in
; the example here causes the intercept driver's FDT routines to be
; used ahead of whatever was in the original driver's FDTs. Because
; the DDT is modified using the UCB pointer only, target device units
; that have not been patched in this way continue to use their old
; DDTs and FDTs unaltered.
;
; Processing complete; release victim's fork lock
100$:
        forkunlock lock=ucb$b_flck(r11),newipl=(sp)+,-
         condition=RESTORE,preserve=YES
        popr    #^m<r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	rsb
umung: .jsb_entry
;
; Entry: R11 points at victim device UCB and current driver is the one
; desiring to remove its entry from the DDT chain. Thus its xx$dpt: address
; is the one being sought. ("Current driver" here means the intercept
; driver.)
;   It is assumed that the driver knows that the DDT chain was patched
; so that its UCB contains an entry in the DDT chain
        pushr   #^m<r0,r1,r2,r3,r4,r5,r10,r11>
	movl	r11,r5			;hereafter use r5 as victim's UCB
        movl    ucb$l_ddt(r5),r10       ;get the DDT we currently have
        movl    ucb$l_ddb(r5),r1        ;get ddb of victim
        movl    ddb$l_ddt(r1),r1        ;and real original DDT
        movl    r10,r0                  ;save ucb$l_ddt addr for later
        movab   DRIVER$DPT,r11             ;magic pattern is DPT addr.
; lock this section with forklock so we can safely remove
; entries at fork also. Use victim device forklock.
        forklock lock=ucb$b_flck(r5),savipl=-(sp),preserve=YES
2$:     cmpl    <ucb$l_uniqid-ucb$a_vicddt>(r10),R11
                                        ;this our own driver?
        beql    1$                      ;if eql yes, end search
        .if     df,chk.err
        cmpl    <ucb$l_icsign-ucb$a_vicddt>(r10),#p.magic
        bneqw    4$                     ;exit if this is nonstd bash
        .endc   ;chk.err
; follow DDT block chain to next saved DDT.
        movl    <ucb$l_prevddt-ucb$a_vicddt>(r10),r10
                                        ;point R10 at the next DDT in the
                                        ;chain
        .if     df,chk.err
        bgeqw   4$                     ; (error check if not negative)
        .endc   ;chk.err
        brb     2$                      ;then check again
1$:
; At this point R10 contains the DDT address within the intercept
; driver's UCB. Return the address of the intercept driver's UCB next.
        tstl    <ucb$l_intcddt-ucb$a_vicddt>(r10)       ;were we intercepted?
        bgeq    3$                      ;if geq no, skip back-fixup
; we were intercepted. Fix up next guy in line.
        movl    <ucb$l_intcddt-ucb$a_vicddt>(r10),r11  ;point at interceptor
        movl    <ucb$l_prevddt-ucb$a_vicddt>(r10),<ucb$l_prevddt-ucb$a_vicddt>(r11)
3$:
; if we intercepted someone, fix up our intercepted victim to skip by
; us also.
        movl    <ucb$l_prevddt-ucb$a_vicddt>(r10),r2    ;did we intercept
                                        ;original driver?
        cmpl    r2,r1                   ;test if this is original
        beql    5$                      ;if eql yes, no bash
; replace previous intercept address by ours (which might be zero)
        movl    <ucb$l_intcddt-ucb$a_vicddt>(r10),<ucb$l_intcddt-ucb$a_vicddt>(r2)
5$:
; Here remove FDT entries from the list if they were modified.
; This needs a scan of the FDT chain starting at the victim's
; ddt$l_fdt pointer and skipping around any entry that has address
; JG_functable:
;  The FDT chain is singly linked. The code here assumes everybody
; plays by the same rules!
; NOTE: Omit this code if we didn't insert our FDT code in the chain!!!
        movl    ddt$l_fdt(r0),r1        ;start of FDT chain
        movab   JG_functable,r2         ;address of our FDT table
        clrl    r3
	movab	<0-ucb$a_vicddt>(r10),r4 ;initially point at our ucb
; Also set the JG device offline when we unbash it. This is a simple
; flag that ctl prog. can use to tell if it's been used already.
	bicl	#<ucb$m_valid!ucb$m_online>,ucb$l_sts(r4)
6$:     cmpl    r1,r2                   ;current fdt point at us?
        beql    7$                      ;if eql yes, fix up chain
        movl    r1,r3                   ;else store last pointer
        movl    fdt_prev(r1),r4         ;and point at next
	bgeq	8$
	movl	ucb$l_oldfdt(r4),r1	;where last FDT pointer is in the ucb
;;;BUT not all UCBs will have the fdt offset at the same place!!!
;;;HOWEVER we will leave this in, putting the oldfdt field first after
;;;the regular UCB things.
        bgeq    8$                      ;if not sys addr, no messin'
        brb     6$                      ;look till we find one.
7$:
;r3 is 0 or fdt pointing to our block next
;r1 points at our fdt block
        tstl    r3                      ;if r3=0 nobody points at us
        bgeq    8$                      ;so nothing to do
	movl	fdt_prev(r1),r4
	bgeq	17$
	movl	ucb$l_oldfdt(r4),-(sp)	;save old fdt loc
	movl	fdt_prev(r3),r4
	blss	18$
	tstl	(sp)+
	brb	17$
18$:	movl	(sp)+,ucb$l_oldfdt(r4)
17$:    movl    fdt_prev(r1),fdt_prev(r3)  ;else point our next-fdt pointer at
                                        ;last fdt addr.
8$:
;
; Finally if the victim UCB DDT entry points at ours, make it point at
; our predecessor. If it points at a successor, we can leave it alone.
        cmpl    r10,r0                  ;does victim ucb point at our DDT?
        bneq    4$                      ;if not cannot replace it
        movl    <ucb$l_prevddt-ucb$a_vicddt>(r10),ucb$l_ddt(r5)
	clrl	<ucb$l_mungd-ucb$a_vicddt>(r10)	;zero JG munged flag
4$:
        forkunlock lock=ucb$b_flck(r5),newipl=(sp)+,condition=RESTORE,preserve=YES
       popr    #^m<r0,r1,r2,r3,r4,r5,r10,r11>
                                        ;copy our prior DDT ptr to next one
	rsb
;
; Steal-startio. We get here first, and must arrange initial setup here
; so we can check I/O errors and handle them. Do this via stealing the
; irp$l_pid entry. On VAX we had to grab a special bit of pool to do this,
; but on AXP, by this point the irp$q_qio_p1 to _p6 are free to use, so just
; use the last ones there.
toorgj: brw     toorg
awab:   brw     away
; on entry R3=IRP, r5=host UCB
stealstart: $driver_start_entry
	jsb	getjgucb		;find intercept UCB
	tstl	r0			;did we find it?
        bgeq    awab            ;no, scram, but probably hang.
        movl    r5,ucb$l_hstucb(r0)     ;else put it in now
	pushl	r5
        movl    r0,r5           ;point at intercept ucb now
; allow external control over error reduction
        bitl    #1048576,ucb$l_ctlflgs(r5)      ;user want error reduction?
        beql    toorgj          ;if not skip out
; be sure this is read or write, else just start orig. one
; Thus we don't mess with ANYTHING except read or write. Thus packack etc.
; would also go through basically unaltered.
	.if	ndf,evax
        EXTZV   #IRP$V_FCODE,-          ; Extract I/O function code
                #IRP$S_FCODE,-          ;
                IRP$W_FUNC(R3),R0
	.iff
        EXTZV   #IRP$V_FCODE,-          ; Extract I/O function code
                #IRP$S_FCODE,-          ;
                IRP$L_FUNC(R3),R0
	.endc
        ASSUME  IRP$S_FCODE LE 7        ; Allow byte mode dispatch
; io$_writecheck is 10
; io$_writepblk is 11
; io$_readpblk is 12
; allow checks on all 3
        cmpl    r0,#io$_writecheck       ;too low?
        blss    toorgj
        cmpl    r0,#io$_readpblk
        bgtr    toorgj
; gotta arrange to get back after done the I/O and to reissue it if
; errors happened and we're not out of count...
        .iif ndf,maxtries,maxtries=8
;We'll keep the info in the UCB for debugging, but when the host driver
; that we're intercepting does a request completion, it will unbusy itself
; and dequeue anything else that was in the device queue. As a result, we need
; to track when an IRP has already been modified in this pass, and must
; also just go directly to the original code where that should happen.
; To accomplish this we need storage for:
;  1. Original irp$l_pid
;  2. Original irp$l_media
;  3. Current retry count (and maybe use hi word as a flag that we have this
;                       IRP)
;
; Since I don't want to mess anything up in the regular IRP, just allocate
; a buffer and use the keydesc slot to point at it. If user has a key,
; we let the i/o by and he takes his chances with device errors. Advertise
; that opticals don't support dec encryption.
;
; start at irp$q_qio_p5 with this so ASSUME that we have 4 longs
; to work with. We start as low in the arg list as possible to not disturb
; anything needed for disks ordinarily for r/w blocks.
vv.magic=0
val.magic=^x76543210
vv.retries=4
vv.media=8
vv.pid=12
16$:
        pushl	r2
	movab	irp$q_qio_p5(r3),r2	;get location for our stuff
vv.magic=0
val.magic=^x76543210
vv.retries=4
vv.media=8
vv.pid=12
vv.bash=16
; Must save irp$l_media every time thru so split I/O won't get
; messed...
; Also if this is a second time thru, we must ensure that OUR
; postprocessing happens.
	movl    irp$l_media(r3),vv.media(r2)    ;save original media address
	cmpl	#val.magic,vv.magic(r2)	;already modified this IRP?
	bneq	18$
119$:
	popl	r2
	brw	toorg			;already modified this irp. No dbl bash
18$:
;	pushl	r11
;	pushl	r10
; Before we modify the IRP, check AGAIN by seeing if irp$l_pid is
; clobbered to our value. If so, we grabbed it and should not mess
; with it again.
;        movzwl  ucb$w_unit(r5),r11      ; get our JG unit number
; Each linkage pair is 8 bytes long...
; Thus shift 3 bits to multiply by 8
;        ashl    #3,r11,r11              ; Make an offset to the linkage area
;        movab   vd_voadt,r10            ; get the table base
;        addl2   r10,r11                 ; r11 now points at the link addr
;	cmpl    (r11),irp$l_pid(r3)     ; Now point irp$l_pid at a proper
;	bneq	118$			; if IRP already bashed skip
;	popl	r10
;	popl	r11
;	brw	119$
;118$:
;	popl	r10
;	popl	r11
        movl    #val.magic,vv.magic(r2) ;flag we got it
        movl    i^#maxtries,vv.retries(r2)      ;save retry count
        movl    irp$l_media(r3),vv.media(r2)    ;save original media address
        movl    irp$l_pid(r3),vv.pid(r2)        ;save original pid addr too.
        popl	r2
; now set up IRP, then call the previous start-io point at
; ucb$l_hstartio(r5) to do the work with registers put back.
; For Alpha, the stack manipulation here is messy to track in machine
; code, so do it in a register.
        movl    r11,-(sp)               ; Free up ol' reliable R11 as scratch
        movl    r10,-(sp)               ; Free R10 also
        movzwl  ucb$w_unit(r5),r11      ; Need address cell
; following assumes that addresses are 32 bits long so shift by 2 gets us
; to an address offset.
        ashl    #2,r11,r11              ; to get ucb address back at i/o done
        movab   vd_ucbtbl,r10           ; Base of table of UCB addresses
        addl2   r11,r10                 ; Make R10 point to cell for THIS UCB
        movl    r5,(r10)                ; Now save our UCB address there
; (THIS ALLOWS US TO GET IT BACK...)
; This trick allows us to leave the rest of the IRP alone.
; Now the tricky bit.
; We must fill the appropriate address into IRP$L_PID for a call at
; I/O completion. We use a table of such routines, one per unit,
; all of the same size so we can calculate the address of the
; routines. However, since the routine addresses can be almost
; anywhere when the compiler gets done with them, we will
; use a table constructed BY the compiler of pointers to them all and
; access via that instead of just forming the address directly. The table
; entries will be left 2 longs in size each.
; Table VD_VOADT is what we need. Note however that the .address operators
; there probably need to change to some more general .linkage directive.
        movzwl  ucb$w_unit(r5),r11      ; get our JG unit number
; Each linkage pair is 8 bytes long...
; Thus shift 3 bits to multiply by 8
        ashl    #3,r11,r11              ; Make an offset to the linkage area
        movab   vd_voadt,r10            ; get the table base
        addl2   r10,r11                 ; r11 now points at the link addr
        movl    (r11),irp$l_pid(r3)     ; Now point irp$l_pid at a proper
        .if     ndf,evax
; must add vjg$dpt address to this IF VAX
; (for AXP the address is ok as is. The difference has to do with the way
; driver loading differs on the 2 machines.)
        movab   jg$dpt,r10     ;start of driver
        addl2   r10,irp$l_pid(r3)       ;now pid should get back ok
        .endc
;
; Now save our "intercept posting" address for later possible use
;
        movab	irp$q_qio_p5(r3),r0	;get address of our bash area
        movl    irp$l_pid(r3),vv.bash(r0)       ;save pid field we need
                                        ; pointer to the desired procedure
;                               ; GET BACK CONTROL AT VD_FIXSPLIT (VIA JSB)
;                               ; WHEN HOST'S I/O IS DONE.
        movl    (sp)+,r10               ; Restore R10
        movl    (sp)+,r11               ; get r11 back & clean stack now
; Now restore registers and go to the original routine.
; This is also where we come to try again.
; Assumes host ucb address on stack, JG ucb address in R5, IRP address in R3
steal2:
toorg:  movl    ucb$l_hstartio(r5),r1   ;address of original routine
        bgeq    awa2            ; if none, things are messed...probably will crash
        popl    r5              ; get back original UCB
        movl    #1,r0           ; set ok status for now
; call original start-io (to ensure high regs are passed correctly)
	pushl	r5		; ucb arg
	pushl	r3		; irp arg
	calls	#2,(r1)		; call the original startio
	brb	away
awa2:	popl	r5
away:
; Should get here only after original startio has been called & returned.
	ret


	.SBTTL	CONTROLLER INITIALIZATION ROUTINE
; ++
; 
; JG_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.
;--
JG_ctrl_INIT: $driver_ctrlinit_entry
;	CLRL	CRB$L_AUXSTRUC(R8)	; SAY NO AUX MEM
	movl	#1,r0
	Ret				;RETURN
	.SBTTL	INTERNAL CONTROLLER RE-INITIALIZATION
;
; INPUTS:
;	R4 => controller CSR (dummy)
;	R5 => UCB
;
	.SBTTL	UNIT INITIALIZATION ROUTINE
;++
; 
; JG_unit_INIT - UNIT INITIALIZATION ROUTINE
; 
; FUNCTIONAL DESCRIPTION:
; 
; 	THIS ROUTINE SETS THE JG: 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.
; 
;--

JG_unit_INIT: $driver_unitinit_entry
; Don't set unit online here. Priv'd task that assigns JG unit
; to a file does this to ensure only assigned JGn: get used.
;	BISW	#UCB$M_ONLINE,UCB$W_STS(R5)  ;SET UCB STATUS ONLINE
;limit size of JG: data buffers
JG_bufsiz=8192
	movl	#JG_bufsiz,ucb$l_maxbcnt(r5)	;limit transfers to 8k
	MOVB	#DC$_MISC,UCB$B_DEVCLASS(R5) ;SET DISK DEVICE CLASS
	clrl	ucb$l_mungd(r5)			;not mung'd yet
; 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!!!)
	movab	DRIVER$DPT,ucb$l_uniqid(r5)
	movl	#^Xb22d4001,ucb$l_media_id(r5)	; set media id as JG
; (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 JG: device.
; MSCP may still refuse to do a foreign drive too; jiggery-pokery later
; to test if there's occasion to do so.
; Set up crc polynomial
	movab	JG_utb,ucb$l_hucbs(r5)	;host ucb table
	clrl	chnflg		;initially set to use our chain of FDTs
	BICL	#UCB$M_ONLINE,UCB$L_STS(R5)  ;SET UCB STATUS OFFLINE
	movl	#1,r0
	ret
;++
; 
; JG_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.
; 
;--
JG_STARTIO: $driver_start_entry
; 
; 	PREPROCESS UCB FIELDS
; 
;	ASSUME	RY_EXTENDED_STATUS_LENGTH  EQ  8
;	CLRQ	UCB$Q_JG_EXTENDED_STATUS(R5)	; Zero READ ERROR REGISTER area.
; 
; 	BRANCH TO FUNCTION EXECUTION
	bbs	#ucb$v_online,-	; if online set software valid
		ucb$l_sts(r5),210$
216$:	movzwl	#ss$_volinv,r0	; else set volume invalid
	brw	resetxfr	; reset byte count & exit
210$:
; Unless we use this entry, we want to junk any calls here.
	brb	216$		;just always say invalid volume.

; Get here for other start-io entries if the virtual disk code is
; commented out also, as it must be.
;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,environment=call		; COMPLETE REQUEST
; 
;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	JG_STARTIO		;START REQUEST OVER
;JG_INT::
;JG_UNSOLNT::
;	POPR	#^M<R0,R1,R2,R3,R4,R5>
;	REI	;DUMMY RETURN FROM ANY INTERRUPT
	;;
V_UNIT=0
V_UNM=1
	.if	df,evax
VD_FXS0:: .jsb_entry input=<r5>
	.iff
VD_FXS0::
	.endc
	MOVL	I^#V_UNIT,R4
	BSBW	VD_FIXSPLIT	;GO HANDLE
	RSB
VD_FXPL==<.-VD_FXS0>	;LENGTH IN BYTES OF THIS LITTLE CODE SEGMENT
V_UNIT=V_UNIT+4		;PASS TO NEXT UNIT
	.MACRO	XVEC LBLC
	.if	df,evax
VD_FXS'LBLC: .jsb_entry input=<r5>
	.iff
VD_FXS'LBLC:
	.endc
	MOVL	I^#V_UNIT,R4
	BSBW	VD_FIXSPLIT
	RSB
	.ENDM
	.REPEAT	<JG_UNITS+4>	; some extra for safety
	XVEC	\V_UNM
V_UNIT=V_UNIT+4		;PASS TO NEXT UNIT
V_UNM=V_UNM+1
	.ENDR

	.if	df,evax
VD_FIXSPLIT: .jsb_entry
	.iff
VD_FIXSPLIT:
	.endc
; GET OLD PID..
; IN OUR UCB$PPID LONGWORD...
;some cleanup for host needed here. Note that r5 enters as IRP address.
; Use initial R5 to help reset host's system...
	PUSHL	R4		;r4 enters with JG unit number
	movl	r5,r3		;put entering IRP addr in std place
	MOVAB	VD_UCBTBL,R5
	ADDL2	(SP)+,R5	;R5 NOW POINTS AT UCB ADDRESS
	MOVL	(R5),R5		;NOW HAVE JG UCB ADDRESS IN R5
; notice stack is now clean too.
	movl	r5,r4		;we need the jg ucb at fork level
; set lock not releaseable by fastio code here as a precaution
; This may inhibit fastpath code from releasing locks on subsequent
; cycles for split I/O.
	BBSS	#IRP$V_LOCK_RELEASEABLE,IRP$L_STS(R3),20$
20$:
;Now we either restart the i/o if an error occurred, or go ahead and
; complete it. In either case we must fork. Also we must fork on
; the JG UCB since the host driver has no idea we might use its
; fork and can conflict. We will get the host UCB in the fork
; itself.
; Therefore get host ucb again and fork on that.
	.iif df,tr$ce,movl	#1,ucb$l_where(r5)
;;;	movl	ucb$l_hstucb(r5),r5	;note jg ucb still in r4
	.if	df,frk$do
	.if	df,try$safe
        dsbint ipl=#ipl$_synch,environ=uniprocessor
        FORK routine=87$,continue=77$   ;go fork on our UCB now (vd: ucb)
77$:    enbint
        rsb
87$:    fork_routine,environment=jsb
	.iff
	fork environment=jsb
	.endc
	.iff
	devicelock savipl=-(sp),preserve=yes
	.endc
	movl	ucb$l_hstucb(r5),r5	;note jg ucb still in r4
	.iif df,tr$ce,movl	#2,ucb$l_where(r4)
; Now see if we need to reissue the I/O. If so, go do it.
; r4 should still be jg ucb, r5=host ucb, r3=irp
	movq	irp$l_media(r3),r0	;get i/o status
	blbs	r0,40$			;if status is OK, just finish up here.
	movab	irp$q_qio_p5(r3),r0	;get our buffer area
	bgeq	40$
	decl	vv.retries(r0)		;count retries down
	bleq	40$			;if so also finish now
;looks like we need to continue. Therefore go do so.
; Note that at this point the stack is clean and r3 and r5 are irp and ucb
; of host as his start-io will expect.
; (This will nead some tweaks for axp procedure nesting. OK on Vax though.)
; r5 points at host UCB now.
; Now reset the media field so the IRP will work next time
	.iif df,tr$ce,movl	#3,ucb$l_where(r4)

	movl	vv.media(r0),irp$l_media(r3)

; If the host driver clobbered this field, we must ensure we get back
; here as soon as we hit the next start-io for this driver. Actually it should
; be fixed like so now or we wouldn't be here...but be safe anyway.

	movl	vv.bash(r0),irp$l_pid(r3)	;arrange us to get back

; can't just call the original code since the driver may be busy with
; something else. Our fork synch doesn't completely prevent this, since
; the relevant test is whether the driver is busy. Therefore call exe$insioqc
; to do it instead, relying on our tests in stealstart to detect
; that this IRP has already been set up.
; Note that we have left the irp$l_pid address still unchanged so that it
; still will get back here next time around, so again we can check it.
; For this we insert in the original device queue so leave
; r5 pointing at it. Note that steal2 entry wants original R5 on
; the stack but no longer requires R5 pointing at JG UCB.
	pushr	#^m<r1,r2,r3,r4,r5>
;	movzbl	ucb$b_flck(r5),r2	;get lock
;	.iif df,tr$ce,movl	#4,ucb$l_where(r4)
;	verify_lock_ownership lockindex=r2	;do we still have iolock8?
;	blbs	r0,2240$		;if we have lock, proceed
;	.iif df,tr$ce,movl	#5,ucb$l_where(r4)
;	forklock preserve=YES		;get lock back for fork routine exit
;2240$:
	.iif df,tr$ce,movl	#6,ucb$l_where(r4)
	.iif	df,x$$$dt,jsb g^ini$brk

	call_insioqc		;get host to work again

	.iif df,tr$ce,movl	#7,ucb$l_where(r4)
	.iif	df,x$$$dt,jsb g^ini$brk
;	movzbl	ucb$b_flck(r5),r2	;get lock
;	verify_lock_ownership lockindex=r2	;do we still have iolock8?
;	blbs	r0,240$		;if we have lock, proceed
;	.iif df,tr$ce,movl	#8,ucb$l_where(r4)
;	forklock preserve=YES		;get lock back for fork routine exit
;240$:
	popr	#^m<r1,r2,r3,r4,r5>
	movl	#1,r0		;flag all seems well
	.iif df,tr$ce,movl	#9,ucb$l_where(r4)
	.if	ndf,frk$do
	movl	r4,r5		;we use pseudo dvc devicelock,not target's
	deviceunlock newipl=(sp)+,preserve=yes
	movl	ucb$l_hstucb(r5),r5	;note jg ucb still in r4
	.endc
	rsb			;return when done.
;
40$:
; Reset the IRP to have the original return
; Thus the IRP will really complete next, not come back here.
1501$:
;; 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.
	.iif df,tr$ce,movl	#10,ucb$l_where(r4)
;
; 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.
;
; This will then appear to be coming from the original driver.
	pushl	r4
; Restore media and pid fields and deallocate the extra field.
	movab	irp$q_qio_p5(r3),r4		;get our buffer
; for com$post use must leave status in IRP so we do NOT restore irp$l_media
; at this time.
;
; Do however restore irp$l_pid to its original value and ensure the IRP
; is marked as "not bashed" in case there is a next time through.
	movl	vv.pid(r4),irp$l_pid(r3)	;restore pid so post is normal
; By clearing the "bashed" area every time, when we get a successful I/O we
; arrange that the error count restarts as it should if thei/o is split.
	clrl	vv.magic(r4)			;set to re-bash next time
	popl	r4
;(this may be the problem area; what unbusies the host driver & when?
; Host driver called reqcom to get here which cleared his unit busy.
; If his unit is not busy now, this isn't really a problem. If it IS busy
; however, this IS a problem, as we really have no business touching
; the host's UCB busy bit from here. Let's try using com$post instead
; to finish things up.)
        forklock ucb$b_flck(r5),-
	savipl=-(sp),preserve=YES
	pushl	r4
	pushl	r5
	pushl	r5		; ucb
	pushl	r3		; irp
	.iif df,tr$ce,movl	#11,ucb$l_where(r4)
	calls	#2,g^com_std$post	;com$post replacement
;;;	jsb	g^com$post	; complete the request but leave busy ALONE
	popl	r5
	popl	r4
        forkunlock lock=ucb$b_flck(r5),newipl=(sp)+,-
         condition=RESTORE,preserve=YES
	.iif df,tr$ce,movl	#12,ucb$l_where(r4)
;	pushl	r2
;	movzbl	ucb$b_flck(r5),r2	;get lock
;	verify_lock_ownership lockindex=r2	;do we still have iolock8?
;	blbs	r0,1601$	;if we do, branch
;; someone (driver maybe?) freed iolock8. get back so fork exit can release
;	.iif df,tr$ce,movl	#12,ucb$l_where(r4)
;	forklock preserve=YES
;1601$:	popl	r2
	.iif df,tr$ce,movl	#13,ucb$l_where(r4)
	movl	#ss$_normal,r0
	.if	ndf,frk$do
	movl	r4,r5		;we use pseudo dvc devicelock,not target's
	deviceunlock newipl=(sp)+,preserve=yes
	movl	ucb$l_hstucb(r5),r5	;note jg ucb still in r4
	.endc
	RSB	; GET BACK TO HOST SOMETIME

JG_END:					;ADDRESS OF LAST LOCATION IN DRIVER
	.END
