nolic=0
	.library /sys$share:lib/
	$wcbdef
.ntype	__,R31			;  set EVAX nonzero if R31 is a register
.if eq <__ & ^xF0> - ^x50
EVAX = 1
.iff
;EVAX = 0
.endc
	.if	df,evax
alpha=1
bigpage=1
addressbits=32
.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
	.if	ndf,step2
	.TITLE	JFCtl	;control JFdriver (fragmentation avoider driver)
	.IDENT	'V001'
;evax=0 ;define for Alpha version
;nolic=0
;
; FACILITY:
; 
;
;   This program takes a command of form
; favoid/flags JFAn: node$jban:
;  where JFAn: refers to a local unit of JFdriver, which is a dummy
; driver furnished to provide local copies of the frag avoider
; code in each node.
;
; Note: define VMS$V5 to build for Version 5.x of VMS.
VMS$V5=1
;
; 
; AUTHOR:
; 
; G. EVERHART
;
; 04-Aug-1989	D. HITTNER	Cleaned up definitions, added messages
; 29-Aug-1989   G. Everhart	Added more flexible device geometry selection
;--
	.PAGE
	.SBTTL	EXTERNAL AND LOCAL DEFINITIONS

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

	$dyndef
	$ADPDEF				;DEFINE ADAPTER CONTROL BLOCK
	$ATRDEF
	$CRBDEF				;DEFINE CHANNEL REQUEST BLOCK
	$DCDEF				;DEFINE DEVICE CLASS
	$DDBDEF				;DEFINE DEVICE DATA BLOCK
	$ddtdef				;define driver dispatch tbl
	$DEVDEF				;DEFINE DEVICE CHARACTERISTICS
	$DPTDEF				;DEFINE DRIVER PROLOGUE TABLE
	$DVIDEF				;Symbols for $GETDVI service.
	$EMBDEF				;DEFINE ERROR MESSAGE BUFFER
	$FABDEF
	$FATDEF
	$FIBDEF				;Symbols for file information block.
	$IDBDEF				;DEFINE INTERRUPT DATA BLOCK
	$IODEF				;DEFINE I/O FUNCTION CODES
	$IRPDEF				;DEFINE I/O REQUEST PACKET
	$NAMDEF
	$PRDEF				;DEFINE PROCESSOR REGISTERS
	$RMSDEF
	$SBDEF
	$SCSDEF
	$SSDEF				;DEFINE SYSTEM STATUS CODES
	$STSDEF				;Symbols for returned status.
	$TPADEF				;Symbols for LIB$TPARSE calls.
	$UCBDEF				;DEFINE UNIT CONTROL BLOCK
	$VECDEF				;DEFINE INTERRUPT VECTOR BLOCK
	$XABDEF

; 
; UCB OFFSETS WHICH FOLLOW THE STANDARD UCB FIELDS
; DEFINE THESE SO WE KNOW WHERE IN THE UCB TO ACCESS. WE MUST
; SET THE ONLINE BIT OR CLEAR IT, AND ALSO SET
; UCB$HUCB (HOST UCB ADDRESS), UCB$HFSZ (HOST FILE SIZE),
; AND UCB$HLBN (HOST LOGICAL BLOCK NUMBER OF FILE START)
;

	$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_oldfdt	.blkl	1	;fdt tbl of prior fdt chain
;
; Add other fields here if desired.
;
$def	ucb$l_ctlflgs	.blkl	1		;flags to control modes
$def	ucb$l_cbtctr	.blkl	1		;how many extents
$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
$def	ucb$JFcontfil	.blkb	80
;
$DEF	ucb$l_minxt	.blkl	1		;min. extent
$def	ucb$l_maxxt	.blkl	1		;max extent
$def	ucb$l_frac	.blkl	1		;fraction to extend by
$def	ucb$l_slop	.blkl	1		;slop blocks to leave free
; 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$L_ICPFGS	.BLKL	2	; Flags. Reserve 2 longs so we need
					; not mess with this later.
	$VIELD UCB,0,<-
		<FI8OK,,M>,-		; 1 if this intercept and all
			>		; below understand finipl8.
$def	ucb$l_ufil1	.blkl	8	; for others' intercepts if needed
$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=^xF0070000 + ddt$k_length + <256*<ucb$s_ppdend-ucb$s_ppdbgn>>
p.magic=^xF0070000 + ddt$k_length + <256*<ucb$s_ppdend-ucb$s_ppdbgn>>
				;an ACE is there or not.
	.if	df,step2
magic=^xF0070000 + ddt$k_length + <256*<ucb$s_ppdend-ucb$s_ppdbgn>>
p.magic=^xF0070000 + ddt$k_length + <256*<ucb$s_ppdend-ucb$s_ppdbgn>>
	.endc
$DEF	UCB$L_JF_HOST_DESCR	.BLKL	2	;host dvc desc.
;
; Set FDT table start mask for each unit by keeping it here.
; We need just enough to get back to user's FDTs.
	.if	ndf,step2
$def	ucb$l_fdtlgl	.blkl	2	;legal fcn msks
$def	ucb$l_fdtbuf	.blkl	2	;buffered fcn msks
$def	ucb$l_fdtmfy	.blkl	3	;modify fcn
$def	ucb$l_fdtbak	.blkl	3	;"go back" fcn
	.iff
$def	ucb$l_myfdt	.blkl	70	;copy of orig. fdt
	.endc
$def	ucb$l_vict	.blkl	1	;victim ucb for checking
$DEF	UCB$K_JF_LEN	.BLKW	1	;LENGTH OF UCB
;UCB$K_JF_LEN=.				;LENGTH OF UCB
	$DEFEND	UCB			;END OF UCB DEFINITONS
; TO SET ONLINE:
;	BISW	#UCB$M_ONLINE,UCB$W_STS(R5)  ;SET UCB STATUS ONLINE

; Macro to check return status of system calls.
;
	.MACRO	ON_ERR	THERE,?HERE
	BLBS	R0,HERE
	BRW	THERE
HERE:	.ENDM	ON_ERR

;
;
;
	.PSECT	ADVDD_DATA,RD,WRT,NOEXE,LONG

DEFAULT_DEVICE:
	.ASCID	/SYS$DISK/

	.ALIGN LONG
;
; KERNEL ARG LIST
K_ARG:
	.LONG	2			;2 ARGS: HOST-DVC NAME, VD DVC NAME
	.ADDRESS	DEV_BUF_DESC
	.ADDRESS	VDV_BUF_DESC
;	.ADDRESS	DDFNM
;	.ADDRESS	VDFNM
iosb:	.long	0,0
IOSTATUS: .BLKQ 1
BUFG:	.long	1		;bash flag
	.long	1000		;
DEV_BUF:			; Buffer to hold device name.
	.BLKB	40
DEV_BUF_SIZ = . - DEV_BUF
busz=.-bufg
DEV_BUF_DESC:			; Descriptor pointing to device name.
	.LONG	 DEV_BUF_SIZ
	.ADDRESS DEV_BUF

PID:				; Owner of device (if any).
	.BLKL	1
DEV_ITEM_LIST:			; Device list for $GETDVI.
	.WORD	 DEV_BUF_SIZ	; Make sure we a have a physical device name.
	.WORD	 DVI$_DEVNAM
	.ADDRESS DEV_BUF
	.ADDRESS DEV_BUF_DESC
	.WORD	 4		; See if someone has this device allocated.
	.WORD	 DVI$_PID
	.ADDRESS PID
	.LONG	 0
	.WORD	 4
	.WORD	 DVI$_DEVCLASS	; Check for a terminal.
	.ADDRESS DEV_CLASS
	.LONG	 0
	.LONG	 0		; End if item list.

DEV_CLASS:
	.LONG	1
;**
vbufg:	.long	2	;deassign bash flag. Deassign victim dvc, not jf: dvc.
	.long	1000
VDV_BUF:			; Buffer to hold VDVice name.
	.BLKB	40
VDV_BUF_SIZ = . - VDV_BUF
vbusz=.-vbufg
VDV_BUF_DESC:			; Descriptor pointing to VDVice name.
	.LONG	 VDV_BUF_SIZ
	.ADDRESS VDV_BUF

VPID:				; Owner of VDVice (if any).
	.BLKL	1

VDV_ITEM_LIST:			; VDVice list for $GETDVI.
	.WORD	 VDV_BUF_SIZ	; Make sure we a have a physical device name.
	.WORD	 DVI$_DEVNAM
	.ADDRESS VDV_BUF
	.ADDRESS VDV_BUF_DESC
	.WORD	 4		; See if someone has this device allocated.
	.WORD	 DVI$_PID
	.ADDRESS VPID
	.LONG	 0
	.WORD	 4
	.WORD	 DVI$_DEVCLASS	; Check for a terminal.
	.ADDRESS VDV_CLASS
	.LONG	 0
	.LONG	 0		; End if item list.

VDV_CLASS:
	.LONG	1
;**
DEFNAM:

WRK:	.BLKL	1	;SCRATCH INTEGER
; DESCRIPTOR FOR VDn: "FILENAME"
	.ALIGN LONG
VDFNM:	.WORD	 255.	;LENGTH
VDFTP:	.BYTE	DSC$K_DTYPE_T	;TEXT TYPE
	.BYTE	1	; STATIC STRING
	.ADDRESS	VDFNMD
VDFNMD:	.BLKB	256.	; DATA AREA
	.align long
wrkstr:	.word	255	;length
	.byte	dsc$k_dtype_t	;text
	.byte	1	;static
	.address	wrkdat
wrkdat:	.blkb	20
	.blkb	236
	.byte	0,0,0,0	;safety
;
; DESCRIPTOR FOR NODE$FWAN: DEVICE NAME
	.ALIGN LONG
DDFNM:	.WORD	 255.	;LENGTH
DDFTP:	.BYTE	DSC$K_DTYPE_T	;TEXT TYPE
	.BYTE	1	; STATIC STRING
DDFNA:	.ADDRESS	DDFNMD
DDFNMD:	.BLKB	256.	; DATA AREA
DDCHN:	.LONG	0
VDCHN:	.LONG	0	;CHANNEL HOLDERS
P1DSC:	.ASCID	/UNIT/
P2DSC:	.ASCID	/FNAM/
frcdsc:	.ascid	/FRACTION/	;fract. of file to extend by
minds:	.ascid	/MINIMUM/	;min extent
maxds:	.ascid	/MAXIMUM/	;max extent
adods:	.ascid	/ALDEFONLY/	;default-ext. mod only
deads:	.ascid	/DEASSIGN/	;deassign jf: from disk (turn off)
cbtds:	.ascid	/CBT/
	.EVEN
; UCB data area
deafg:	.long	0
cbtct:	.long	1	;/cbt:n contig best tries every n opens
frac:	.long	3
min:	.long	10
max:	.long	2000
adflg:	.long	0	;set flg if aldef only
HSTUCB:	.LONG	0	;SERVED UCB ADDRESS
VDUCB: .LONG 0		;LOCAL FW/FQ/FD UCB ADDRESS
;
;
ERROR:	.LONG	2
MESS:	.LONG	SS$_ABORT
	.LONG	0

	.PSECT	ADVDD_CODE,RD,NOWRT,EXE,LONG
	.ENTRY	ADVDD,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
	clrl	adflg
	clrl	deafg	;not deassign
	movl	#1,cbtct	;contig best try every time
	movl	#4,frac
	movl	#10,min
	movl	#2000,max
	pushab	deads
	calls	#1,g^cli$present
	cmpl	r0,#cli$_present	;there?
	bneq	100$
	incl	deafg
100$:
; contig best try
	pushab	cbtds	;/cbt:nnn contig best try open every n tries
	calls	#1,g^cli$present
	cmpl	r0,#cli$_present	;there?
	bneq	320$
	pushab	wrk	;ret len
	pushab	wrkstr	;string
	pushab	cbtds
	calls	#3,g^cli$get_value
	blbc	r0,320$
	pushl	#17	;ign. blanks
	pushl	#4	;4 byte result
	pushab	cbtct	;result in "cbtct"
	pushab	wrkstr	;string
	calls	#4,g^ots$cvt_tu_l	;convert to bin
	blbs	r0,321$
322$:	movl	#1,cbtct	;default val. if err
	brb	320$
321$:	
	tstl	cbtct		;chk lims
	bleq	322$
	cmpl	cbtct,#1000000000	;max 1,000,000,000 too
	bgtr	322$
320$:
;/aldefonly
	pushab	adods	;/aldefonly?
	calls	#1,g^cli$present
	cmpl	r0,#cli$_present	;there?
	bneq	10$
	incl	adflg
10$:
	pushab	frcdsc	;/frac:n (n = 1 to 1000 ok)
	calls	#1,g^cli$present
	cmpl	r0,#cli$_present	;there?
	bneq	20$
	pushab	wrk	;ret len
	pushab	wrkstr	;string
	pushab	frcdsc	;/frac: desc
	calls	#3,g^cli$get_value
	blbc	r0,20$
	pushl	#17	;ign. blanks
	pushl	#4	;4 byte result
	pushab	frac	;result in "frac"
	pushab	wrkstr	;string
	calls	#4,g^ots$cvt_tu_l	;convert to bin
	blbs	r0,21$
22$:	movl	#4,frac	;return frac=1/4 if error
	brb	20$
21$:	
	tstl	frac		;chk lims
	bleq	22$
	cmpl	frac,#1000	
	bgtr	22$
20$:
; min
	pushab	minds	;/min:nnn min alloc to use
	calls	#1,g^cli$present
	cmpl	r0,#cli$_present	;there?
	bneq	120$
	pushab	wrk	;ret len
	pushab	wrkstr	;string
	pushab	minds
	calls	#3,g^cli$get_value
	blbc	r0,120$
	pushl	#17	;ign. blanks
	pushl	#4	;4 byte result
	pushab	min	;result in "min"
	pushab	wrkstr	;string
	calls	#4,g^ots$cvt_tu_l	;convert to bin
	blbs	r0,121$
122$:	movl	#10,min	;return min=10 if err
	brb	120$
121$:	
	tstl	min		;chk lims
	bleq	122$
	cmpl	min,#1000	;max 1000 too
	bgtr	122$
120$:
; max
	clrl	max
	pushab	maxds	;/max:nnn max alloc to use
	calls	#1,g^cli$present
	cmpl	r0,#cli$_present	;there?
	bneq	220$
	pushab	wrk	;ret len
	pushab	wrkstr	;string
	pushab	maxds
	calls	#3,g^cli$get_value
	blbc	r0,220$
	pushl	#17	;ign. blanks
	pushl	#4	;4 byte result
	pushab	max	;result in "max"
	pushab	wrkstr	;string
	calls	#4,g^ots$cvt_tu_l	;convert to bin
	blbs	r0,221$
222$:	clrl	max	;return max=10000 if err
; max=0 means 1/32 of disk size.
	brb	220$
221$:	
	tstl	max		;chk lims
	bleq	222$
	cmpl	max,#100000000	;max 100,000,000 too
	bgtr	222$
220$:
	PUSHAB	WRK		;PUSH LONGWORD ADDR FOR RETLENGTH
	PUSHAB	VDFNM		;ADDRESS OF DESCRIPTOR TO RETURN
	PUSHAB	P1DSC		; GET P1 (FDn: UNIT)
	CALLS	#3,G^CLI$GET_VALUE	;GET VALUE OF NAME TO VDFNM
	ON_ERR	ADVDD_EXIT
;	tstl	deafg		;/deas? no need for 2nd file
;	bneq	40$
	PUSHAB	WRK			; GET 2ND FILE (served unit)
	PUSHAB	DDFNM			; & ITS DESCRIPTOR
	PUSHAB	P2DSC			; & PARAMETER NAME 'P2'
	CALLS	#3,G^CLI$GET_VALUE	; GET FNM
	ON_ERR	ADVDD_EXIT
	$ASSIGN_S -			; Get a channel to the 
		DEVNAM=DDFNM,-		; device for host file
		CHAN=DDCHN
	ON_ERR	ADVDD_EXIT
; LET ERRORS BY FOR THIS SINCE WE GET OUR INFO VIA OPEN ANYWAY SO
; CHANNEL REALLY DOESN'T HAVE TO BE THERE.
; Get the physical device name, and see if this device has an owner.
; (We must do this so we can get the host UCB address)
	$GETDVI_S -
		CHAN=ddchn,-		; Command line has device name.
		ITMLST=DEV_ITEM_LIST
	BLBS	R0,40$
	BRW	advdd_EXIT
40$:
290$:
; MUST HAVE ASSIGNMENT TO VD: UNIT IN ANY CASE.
        $getdviw_s -
                devnam=vdfnm,itmlst=vdv_item_list
        $assign_s devnam=vdv_buf_desc,chan=vdchn
        blbs    r0,2295$        ;if we got the chnl, go on. Else try orig name
	$ASSIGN_S -
		DEVNAM=VDFNM,-		; GET CHANNEL FOR VDn:
		CHAN=VDCHN
	ON_ERR	ADVDD_EXIT		; SKIP OUT IF ERROR
2295$:	$GETDVI_S -
		CHAN=vdchn,-		; Command line has device name.
		ITMLST=VDV_ITEM_LIST
	BLBS	R0,140$
	BRW	advdd_EXIT
140$:
; Here do the real work in kernel mode, having now the device
; descriptions and channels to the devces even!
	tstl	deafg		;if /deas, do $qio, then knl work
	bneq	307$
	$CMKRNL_S -
		ROUTIN=BASHUCB,ARGLST=K_ARG
	CMPL	R0,#SS$_NORMAL				;Any errors?
	BEQL	300$					;No, skip error routine
	MOVL	R0,MESS					;Move error to message
;;;	BRW	300$
301$:
; ERROR RETURN ... CLOSE FAB & LEAVE
	$PUTMSG_S	MSGVEC=ERROR			;Pump out error message
; deassign logic
307$:	movl	#2,bufg	;unmung fcn
	$qiow_s chan=vdchn,efn=#4,func=#<io$_format+128>,iosb=iosb,-
	p1=bufg,p2=#busz
; after unbashing the current host, take the JF unit offline
;	$CMKRNL_S -
;		ROUTIN=BASHUCB,ARGLST=K_ARG
	$DASSGN_S CHAN=VDCHN
	ret
300$:
; Since that worked OK, send the format function to the JF unit to
; finish bashing the host disk.
	movl	#1,bufg		;set to bash device
	$qiow_s chan=vdchn,efn=#4,func=#<io$_format+128>,iosb=iosb,-
	p1=bufg,p2=#busz
; BE SURE WE DON'T LEAVE THE CHANNELS ASSIGNED TO THE DEVICES
; EITHER...
303$:	$DASSGN_S CHAN=VDCHN
	$DASSGN_S CHAN=DDCHN			;CLEAN UP I/O CHANNELS
	RET
fdhostd_exit:
advdd_exit:
	RET

; BASHUCB - AREA TO MESS UP UCB WITH OUR FILE DATA
; BEWARE BEWARE BEWARE
;  runs in KERNEL mode ... HAS to be right.
;  Saves lots of registers so they're free...
	.ENTRY	BASHUCB,^M<R2,R3,R4,R5,R6,R7,R8,r9,r10,r11>
; TAKEN LOOSELY FROM ZERO.MAR
	.if	ndf,vms$v5
	MOVL	G^SCH$GL_CURPCB,R4	;;; NEED OUR PCB
	.iff
	MOVL	G^CTL$GL_PCB,R4		;;; NEED OUR PCB (VMS V5)
	.endc
	clrl	hstucb
	JSB	G^SCH$IOLOCKW		;;; LOCK I/O DATABASE
	tstl	deafg	;/deas needs no 2nd assign
	bneq	90$
	MOVL	4(AP),R1		;;; ADDRESS DVC NAME DESCRIPTORS (target)
	JSB	G^IOC$SEARCHDEV		;;; GET UCB ADDRESS INTO R1 for tgt
	BLBS	R0,660$
	BRW	BSH_XIT
660$:
;
80$:
	MOVL	R1,HSTUCB		;;; SAVE HOST UCB ADDRESS
	movl	r1,r11			;use r11 for target UCB
	BEQL	166$			;;; ... BUT ZERO UCB ADDRESS LOOKS BAAAAD
90$:
	MOVL	8(AP),R1		;;; ADDRESS VDn NAME DESCRIPTORS
	JSB	G^IOC$SEARCHDEV		;;; GET UCB ADDRESS INTO R1
	BLBS	R0,160$
	BRW	BSH_XIT
160$:
	movl	r1,vducb		;;; store vd ucb
	movl	r1,r5			;use r5 for local ucb (JF dvc)
	beql	166$			;fail if no ucb...
; BUGGER THE UCB
; ASSUMES FILE LBN AND SIZE ALREADY RECORDED
; ALSO ASSUMES THAT ZERO LBN OR SIZE MEANS THIS ENTRY NEVER CALLED.
; (REALLY ONLY WORRY ABOUT ZERO SIZE; IF WE OVERMAP A REAL DEVICE
; THEN ZERO INITIAL LBN COULD BE OK.)
;
; CHECK REF COUNT FIRST... ONLY CAN GET AWAY WITH THIS ON DEVICE
; NOBODY'S USING...
; .. fake this since device may have count messed by advd somehow
; but will be allocated if mounted.
; ... for now ...
554$:
;	CMPW	UCB$W_REFC(R1),#1	;;; CHECK COUNT VS 1 FOR THIS
;	blssu	164$		;if 1 or less, go on.
	brb	164$	;(it doersn't matter ifthe local disk is in
			; use...we don't bother it.)
166$:	brw	165$
164$:
; check that both UCBs are disk devices at least!
; We can't be sure all the device characteristics will be the
; same for the local device and the MSCP served remote one (and
; in fact they are not all alike!) but at least they had better
; both be disks or this function is not even approximately
; correct and will probably be quickly fatal to the system.
	tstl	deafg	;/deas? r11 invalid.
	beql	1164$
; for deassign, must set JF offline so it can be turned on again
; but just do all work here & scram.
	cmpl	ucb$l_icsign(r5),#magic	;got right magic no.?
	bneq	1176$		;if not then not JFdriver
5164$:
; clear online & valid on JF dvc for next time
	.if	df,evax
	bicl	#ucb$m_online,ucb$l_sts(r5)	;set jf unit online
	bicl	#ucb$m_valid,ucb$l_sts(r5)	; & valid
	.iff
	bicw	#ucb$m_online,ucb$w_sts(r5)	;set jf unit online
	bicw	#ucb$m_valid,ucb$w_sts(r5)	; & valid
	.endc
1166$:	movl	#1,r0
	brw	bsh_xit		;unlock & leave
1176$:	movl	#ss$_drverr,r0
	brw	bsh_xit
1164$:
	cmpb	ucb$b_devclass(r11),#dc$_disk
	bneq	1176$			;if not disk exit now.
	cmpl	ucb$l_icsign(r5),#magic	;got right magic no.?
	bneq	1176$		;if not then not JFdriver
; Be sure the unit is not online yet. If it is, someone else will
; be using its UCB so we don't want to screw this up.
	.if	df,evax
	bitl	#ucb$m_online,ucb$l_sts(r5)	;set jf unit online
	bneq	166$
	.iff
	bitw	#ucb$m_online,ucb$w_sts(r5)	;set jf unit online
	bneq	166$
	.endc
; Looks like we're gonna do the assign. Store backpointer for driver to
; check before unmung.
	movl	r11,ucb$l_vict(r5)		;store ucb of victim in JF ucb
;;;must make maxbcnt and fipl match!!!
; Fork IPL will be same but maxbcnt often will not. Fix that here.
;	movb	ucb$b_fipl(r5),ucb$b_fipl(r11)	;;;ensure fork levels match
;	movl	ucb$l_maxbcnt(r5),ucb$l_maxbcnt(r11) ;;;store max bytes as a word
; Now get on with the tricky part, replacing the DDT. Do this
; at device IPL so we have reasonable certainty nobody will mess with
; these structures until we get them all put into proper order.
; The DDT structure is 64 bytes long, so grab a block of pool of 64 bytes
; size and copy the existing DDT into it.
; (it is possible to save the old address if the conditional is used)
	.if	df,evax
	bisl	#ucb$m_online,ucb$l_sts(r5)	;set jf unit online
	bisl	#ucb$m_valid,ucb$l_sts(r5)	; & valid
	.iff
	bisw	#ucb$m_online,ucb$w_sts(r5)	;set jf unit online
	bisw	#ucb$m_valid,ucb$w_sts(r5)	; & valid
	.endc
	movl	ucb$l_maxblock(r11),ucb$l_maxblock(r5)	;copy geom for luck
	movw	ucb$w_cylinders(r11),ucb$w_cylinders(r5)
	movb	ucb$b_sectors(r11),ucb$b_sectors(r5)
	movb	ucb$b_tracks(r11),ucb$b_tracks(r5)
	movl	cbtct,ucb$l_cbtini(r5)	;set CBT opens every time
	movl	#34,ucb$l_ctlflgs(r5)	;set to look at modify
	tstl	adflg		;/aldefonly?
	beql	60$
	bisl	#4,ucb$l_ctlflgs(r5)	;set driver thus
60$:
; note 4 bit only extends if aldef is set. Don't set that just now.
	movl	min,ucb$l_minxt(r5)	;min extent = 10
	movl	ucb$l_maxblock(r11),r0
	tstl	max			;user set max?
	beql	65$
	movl	max,r0			;if so use his unless 0
	brb	4$
65$:
	ashl	#-5,r0,r0		; default max = 1/32 of disk size
	cmpl	r0,#2000		;but 2000 at least
	bgtr	4$
	movl	#2000,r0		;max=0 => 1/32 of disksize or 2000
4$:
	movl	r0,ucb$l_maxxt(r5)	;max extent
	movl	frac,ucb$l_frac(r5)	;extend by 1/4 of file size
	movl	cbtct,ucb$l_cbtctr(r5)
165$:
	MOVL	#SS$_NORMAL,R0
BSH_XIT:
	PUSHL	R0
	JSB	G^SCH$IOUNLOCK		;;; UNLOCK I/O DATABASE (DROP IPL)
	POPL	R0			;;; REMEMBER R0
	RET	;;; BACK TO USER MODE NOW
	.iff	;step2
	.TITLE	JFCtl	;control JFdriver (fragmentation avoider driver) step2
	.IDENT	'V001'
evax=0
nolic=0
;
; FACILITY:
; 
;
;   This program takes a command of form
; favoid/flags JFAn: node$jban:
;  where JFAn: refers to a local unit of JFdriver, which is a dummy
; driver furnished to provide local copies of the frag avoider
; code in each node.
;
; Note: define VMS$V5 to build for Version 5.x of VMS.
VMS$V5=1
;
; 
; AUTHOR:
; 
; G. EVERHART
;
; 04-Aug-1989	D. HITTNER	Cleaned up definitions, added messages
; 29-Aug-1989   G. Everhart	Added more flexible device geometry selection
;--
	.PAGE
	.SBTTL	EXTERNAL AND LOCAL DEFINITIONS

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

	$dyndef
	$ADPDEF				;DEFINE ADAPTER CONTROL BLOCK
	$ATRDEF
	$CRBDEF				;DEFINE CHANNEL REQUEST BLOCK
	$DCDEF				;DEFINE DEVICE CLASS
	$DDBDEF				;DEFINE DEVICE DATA BLOCK
	$ddtdef				;define driver dispatch tbl
	$DEVDEF				;DEFINE DEVICE CHARACTERISTICS
	$DPTDEF				;DEFINE DRIVER PROLOGUE TABLE
	$DVIDEF				;Symbols for $GETDVI service.
	$EMBDEF				;DEFINE ERROR MESSAGE BUFFER
	$FABDEF
	$FATDEF
	$FIBDEF				;Symbols for file information block.
	$IDBDEF				;DEFINE INTERRUPT DATA BLOCK
	$IODEF				;DEFINE I/O FUNCTION CODES
	$IRPDEF				;DEFINE I/O REQUEST PACKET
	$NAMDEF
	$PRDEF				;DEFINE PROCESSOR REGISTERS
	$RMSDEF
	$SBDEF
	$SCSDEF
	$SSDEF				;DEFINE SYSTEM STATUS CODES
	$STSDEF				;Symbols for returned status.
	$TPADEF				;Symbols for LIB$TPARSE calls.
	$UCBDEF				;DEFINE UNIT CONTROL BLOCK
	$VECDEF				;DEFINE INTERRUPT VECTOR BLOCK
	$XABDEF

; 
; UCB OFFSETS WHICH FOLLOW THE STANDARD UCB FIELDS
; DEFINE THESE SO WE KNOW WHERE IN THE UCB TO ACCESS. WE MUST
; SET THE ONLINE BIT OR CLEAR IT, AND ALSO SET
; UCB$HUCB (HOST UCB ADDRESS), UCB$HFSZ (HOST FILE SIZE),
; AND UCB$HLBN (HOST LOGICAL BLOCK NUMBER OF FILE START)
;

	$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 extents
$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
$def	ucb$JFcontfil	.blkb	80
$def	ucb$l_asten	.blkl	1		;ast enable mask store
;
$DEF	ucb$l_minxt	.blkl	1		;min. extent
$def	ucb$l_maxxt	.blkl	1		;max extent
$def	ucb$l_frac	.blkl	1		;fraction to extend by
$def	ucb$l_slop	.blkl	1		;slop blocks to leave free
; 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$L_ICPFGS	.BLKL	2	; Flags. Reserve 2 longs so we need
					; not mess with this later.
	$VIELD UCB,0,<-
		<FI8OK,,M>,-		; 1 if this intercept and all
			>		; below understand finipl8.
$def	ucb$l_ufl2	.blkl	8
$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=^xF0070000 + ddt$k_length + <256*<ucb$s_ppdend-ucb$s_ppdbgn>>
p.magic=^xF0070000 + ddt$k_length + <256*<ucb$s_ppdend-ucb$s_ppdbgn>>
$DEF	UCB$L_JF_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
$def	ucb$l_myfdt	.blkl	70	;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
$def	ucb$l_exempt	.blkl	4	;exempt PIDs
$DEF	UCB$K_JF_LEN	.BLKW	1	;LENGTH OF UCB
;UCB$K_JF_LEN=.				;LENGTH OF UCB
	$DEFEND	UCB			;END OF UCB DEFINITONS

; TO SET ONLINE:
;	BISW	#UCB$M_ONLINE,UCB$W_STS(R5)  ;SET UCB STATUS ONLINE

; Macro to check return status of system calls.
;
	.MACRO	ON_ERR	THERE,?HERE
	BLBS	R0,HERE
	BRW	THERE
HERE:	.ENDM	ON_ERR
;
	.PSECT	ADVDD_DATA,RD,WRT,NOEXE,LONG

DEFAULT_DEVICE:
	.ASCID	/SYS$DISK/

	.ALIGN LONG
;
; KERNEL ARG LIST
K_ARG:
	.LONG	2			;2 ARGS: HOST-DVC NAME, VD DVC NAME
	.ADDRESS	DEV_BUF_DESC
	.ADDRESS	VDV_BUF_DESC
;	.ADDRESS	DDFNM
;	.ADDRESS	VDFNM
iosb:	.long	0,0
IOSTATUS: .BLKQ 1
BUFG:	.long	1		;bash flag
	.long	1000		;
DEV_BUF:			; Buffer to hold device name.
	.BLKB	40
DEV_BUF_SIZ = . - DEV_BUF
busz=.-bufg
DEV_BUF_DESC:			; Descriptor pointing to device name.
	.LONG	 DEV_BUF_SIZ
	.ADDRESS DEV_BUF

PID:				; Owner of device (if any).
	.BLKL	1
DEV_ITEM_LIST:			; Device list for $GETDVI.
	.WORD	 DEV_BUF_SIZ	; Make sure we a have a physical device name.
	.WORD	 DVI$_DEVNAM
	.ADDRESS DEV_BUF
	.ADDRESS DEV_BUF_DESC
	.WORD	 4		; See if someone has this device allocated.
	.WORD	 DVI$_PID
	.ADDRESS PID
	.LONG	 0
	.WORD	 4
	.WORD	 DVI$_DEVCLASS	; Check for a terminal.
	.ADDRESS DEV_CLASS
	.LONG	 0
	.LONG	 0		; End if item list.

DEV_CLASS:
	.LONG	1
;**
vbufg:	.long	2	;deassign bash flag. Deassign victim dvc, not jf: dvc.
	.long	1000
VDV_BUF:			; Buffer to hold VDVice name.
	.BLKB	40
VDV_BUF_SIZ = . - VDV_BUF
vbusz=.-vbufg
VDV_BUF_DESC:			; Descriptor pointing to VDVice name.
	.LONG	 VDV_BUF_SIZ
	.ADDRESS VDV_BUF

VPID:				; Owner of VDVice (if any).
	.BLKL	1

VDV_ITEM_LIST:			; VDVice list for $GETDVI.
	.WORD	 VDV_BUF_SIZ	; Make sure we a have a physical device name.
	.WORD	 DVI$_DEVNAM
	.ADDRESS VDV_BUF
	.ADDRESS VDV_BUF_DESC
	.WORD	 4		; See if someone has this device allocated.
	.WORD	 DVI$_PID
	.ADDRESS VPID
	.LONG	 0
	.WORD	 4
	.WORD	 DVI$_DEVCLASS	; Check for a terminal.
	.ADDRESS VDV_CLASS
	.LONG	 0
	.LONG	 0		; End if item list.

VDV_CLASS:
	.LONG	1
;**
DEFNAM:

WRK:	.BLKL	1	;SCRATCH INTEGER
; DESCRIPTOR FOR VDn: "FILENAME"
	.ALIGN LONG
VDFNM:	.WORD	 255.	;LENGTH
VDFTP:	.BYTE	DSC$K_DTYPE_T	;TEXT TYPE
	.BYTE	1	; STATIC STRING
	.ADDRESS	VDFNMD
VDFNMD:	.BLKB	256.	; DATA AREA
	.align long
wrkstr:	.word	255	;length
	.byte	dsc$k_dtype_t	;text
	.byte	1	;static
	.address	wrkdat
wrkdat:	.blkb	20
	.blkb	236
	.byte	0,0,0,0	;safety
;
; DESCRIPTOR FOR NODE$FWAN: DEVICE NAME
	.ALIGN LONG
DDFNM:	.WORD	 255.	;LENGTH
DDFTP:	.BYTE	DSC$K_DTYPE_T	;TEXT TYPE
	.BYTE	1	; STATIC STRING
DDFNA:	.ADDRESS	DDFNMD
DDFNMD:	.BLKB	256.	; DATA AREA
DDCHN:	.LONG	0
VDCHN:	.LONG	0	;CHANNEL HOLDERS
P1DSC:	.ASCID	/UNIT/
P2DSC:	.ASCID	/FNAM/
frcdsc:	.ascid	/FRACTION/	;fract. of file to extend by
minds:	.ascid	/MINIMUM/	;min extent
maxds:	.ascid	/MAXIMUM/	;max extent
adods:	.ascid	/ALDEFONLY/	;default-ext. mod only
deads:	.ascid	/DEASSIGN/	;deassign jf: from disk (turn off)
cbtds:	.ascid	/CBT/
	.EVEN
; UCB data area
deafg:	.long	0
cbtct:	.long	1	;/cbt:n contig best tries every n opens
frac:	.long	3
min:	.long	10
max:	.long	2000
adflg:	.long	0	;set flg if aldef only
HSTUCB:	.LONG	0	;SERVED UCB ADDRESS
VDUCB: .LONG 0		;LOCAL FW/FQ/FD UCB ADDRESS
;
;
ERROR:	.LONG	2
MESS:	.LONG	SS$_ABORT
	.LONG	0

	.PSECT	ADVDD_CODE,RD,NOWRT,EXE,LONG
	.ENTRY	ADVDD,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
	clrl	adflg
	clrl	deafg	;not deassign
	movl	#1,cbtct	;contig best try every time
	movl	#4,frac
	movl	#10,min
	movl	#2000,max
	pushab	deads
	calls	#1,g^cli$present
	cmpl	r0,#cli$_present	;there?
	bneq	100$
	incl	deafg
100$:
; contig best try
	pushab	cbtds	;/cbt:nnn contig best try open every n tries
	calls	#1,g^cli$present
	cmpl	r0,#cli$_present	;there?
	bneq	320$
	pushab	wrk	;ret len
	pushab	wrkstr	;string
	pushab	cbtds
	calls	#3,g^cli$get_value
	blbc	r0,320$
	pushl	#17	;ign. blanks
	pushl	#4	;4 byte result
	pushab	cbtct	;result in "cbtct"
	pushab	wrkstr	;string
	calls	#4,g^ots$cvt_tu_l	;convert to bin
	blbs	r0,321$
322$:	movl	#1,cbtct	;default val. if err
	brb	320$
321$:	
	tstl	cbtct		;chk lims
	bleq	322$
	cmpl	cbtct,#1000000000	;max 1,000,000,000 too
	bgtr	322$
320$:
;/aldefonly
	pushab	adods	;/aldefonly?
	calls	#1,g^cli$present
	cmpl	r0,#cli$_present	;there?
	bneq	10$
	incl	adflg
10$:
	pushab	frcdsc	;/frac:n (n = 1 to 1000 ok)
	calls	#1,g^cli$present
	cmpl	r0,#cli$_present	;there?
	bneq	20$
	pushab	wrk	;ret len
	pushab	wrkstr	;string
	pushab	frcdsc	;/frac: desc
	calls	#3,g^cli$get_value
	blbc	r0,20$
	pushl	#17	;ign. blanks
	pushl	#4	;4 byte result
	pushab	frac	;result in "frac"
	pushab	wrkstr	;string
	calls	#4,g^ots$cvt_tu_l	;convert to bin
	blbs	r0,21$
22$:	movl	#4,frac	;return frac=1/4 if error
	brb	20$
21$:	
	tstl	frac		;chk lims
	bleq	22$
	cmpl	frac,#1000	
	bgtr	22$
20$:
; min
	pushab	minds	;/min:nnn min alloc to use
	calls	#1,g^cli$present
	cmpl	r0,#cli$_present	;there?
	bneq	120$
	pushab	wrk	;ret len
	pushab	wrkstr	;string
	pushab	minds
	calls	#3,g^cli$get_value
	blbc	r0,120$
	pushl	#17	;ign. blanks
	pushl	#4	;4 byte result
	pushab	min	;result in "min"
	pushab	wrkstr	;string
	calls	#4,g^ots$cvt_tu_l	;convert to bin
	blbs	r0,121$
122$:	movl	#10,min	;return min=10 if err
	brb	120$
121$:	
	tstl	min		;chk lims
	bleq	122$
	cmpl	min,#1000	;max 1000 too
	bgtr	122$
120$:
; max
	clrl	max
	pushab	maxds	;/max:nnn max alloc to use
	calls	#1,g^cli$present
	cmpl	r0,#cli$_present	;there?
	bneq	220$
	pushab	wrk	;ret len
	pushab	wrkstr	;string
	pushab	maxds
	calls	#3,g^cli$get_value
	blbc	r0,220$
	pushl	#17	;ign. blanks
	pushl	#4	;4 byte result
	pushab	max	;result in "max"
	pushab	wrkstr	;string
	calls	#4,g^ots$cvt_tu_l	;convert to bin
	blbs	r0,221$
222$:	clrl	max	;return max=10000 if err
; max=0 means 1/32 of disk size.
	brb	220$
221$:	
	tstl	max		;chk lims
	bleq	222$
	cmpl	max,#100000000	;max 100,000,000 too
	bgtr	222$
220$:
	PUSHAB	WRK		;PUSH LONGWORD ADDR FOR RETLENGTH
	PUSHAB	VDFNM		;ADDRESS OF DESCRIPTOR TO RETURN
	PUSHAB	P1DSC		; GET P1 (FDn: UNIT)
	CALLS	#3,G^CLI$GET_VALUE	;GET VALUE OF NAME TO VDFNM
	ON_ERR	ADVDD_EXIT
;	tstl	deafg		;/deas? no need for 2nd file
;	bneq	40$
	PUSHAB	WRK			; GET 2ND FILE (served unit)
	PUSHAB	DDFNM			; & ITS DESCRIPTOR
	PUSHAB	P2DSC			; & PARAMETER NAME 'P2'
	CALLS	#3,G^CLI$GET_VALUE	; GET FNM
	ON_ERR	ADVDD_EXIT
	$ASSIGN_S -			; Get a channel to the 
		DEVNAM=DDFNM,-		; device for host file
		CHAN=DDCHN
	ON_ERR	ADVDD_EXIT
; LET ERRORS BY FOR THIS SINCE WE GET OUR INFO VIA OPEN ANYWAY SO
; CHANNEL REALLY DOESN'T HAVE TO BE THERE.
; Get the physical device name, and see if this device has an owner.
; (We must do this so we can get the host UCB address)
	$GETDVI_S -
		CHAN=ddchn,-		; Command line has device name.
		ITMLST=DEV_ITEM_LIST
	BLBS	R0,40$
	BRW	advdd_EXIT
40$:
290$:
; MUST HAVE ASSIGNMENT TO VD: UNIT IN ANY CASE.
        $getdviw_s -
                devnam=vdfnm,itmlst=vdv_item_list
        $assign_s devnam=vdv_buf_desc,chan=vdchn
        blbs    r0,2295$        ;if we got the chnl, go on. Else try orig name
	$ASSIGN_S -
		DEVNAM=VDFNM,-		; GET CHANNEL FOR VDn:
		CHAN=VDCHN
	ON_ERR	ADVDD_EXIT		; SKIP OUT IF ERROR
2295$:	$GETDVI_S -
		CHAN=vdchn,-		; Command line has device name.
		ITMLST=VDV_ITEM_LIST
	BLBS	R0,140$
	BRW	advdd_EXIT
140$:
; Here do the real work in kernel mode, having now the device
; descriptions and channels to the devces even!
	tstl	deafg		;if /deas, do $qio, then knl work
	bneq	307$
	$CMKRNL_S -
		ROUTIN=BASHUCB,ARGLST=K_ARG
	CMPL	R0,#SS$_NORMAL				;Any errors?
	BEQL	300$					;No, skip error routine
	MOVL	R0,MESS					;Move error to message
;;;	BRW	300$
301$:
; ERROR RETURN ... CLOSE FAB & LEAVE
	$PUTMSG_S	MSGVEC=ERROR			;Pump out error message
; deassign logic
307$:	movl	#2,bufg	;unmung fcn
	$qiow_s chan=vdchn,efn=#4,func=#<io$_format+128>,iosb=iosb,-
	p1=bufg,p2=#busz
; after unbashing the current host, take the JF unit offline
;	$CMKRNL_S -
;		ROUTIN=BASHUCB,ARGLST=K_ARG
	$DASSGN_S CHAN=VDCHN
	ret
300$:
; Since that worked OK, send the format function to the JF unit to
; finish bashing the host disk.
	movl	#1,bufg		;set to bash device
	$qiow_s chan=vdchn,efn=#4,func=#<io$_format+128>,iosb=iosb,-
	p1=bufg,p2=#busz
; BE SURE WE DON'T LEAVE THE CHANNELS ASSIGNED TO THE DEVICES
; EITHER...
303$:	$DASSGN_S CHAN=VDCHN
	$DASSGN_S CHAN=DDCHN			;CLEAN UP I/O CHANNELS
	RET
fdhostd_exit:
advdd_exit:
	RET

; BASHUCB - AREA TO MESS UP UCB WITH OUR FILE DATA
; BEWARE BEWARE BEWARE
;  runs in KERNEL mode ... HAS to be right.
;  Saves lots of registers so they're free...
	.ENTRY	BASHUCB,^M<R2,R3,R4,R5,R6,R7,R8,r9,r10,r11>
; TAKEN LOOSELY FROM ZERO.MAR
	.if	ndf,vms$v5
	MOVL	G^SCH$GL_CURPCB,R4	;;; NEED OUR PCB
	.iff
	MOVL	G^CTL$GL_PCB,R4		;;; NEED OUR PCB (VMS V5)
	.endc
	clrl	hstucb
	JSB	G^SCH$IOLOCKW		;;; LOCK I/O DATABASE
	tstl	deafg	;/deas needs no 2nd assign
	bneq	90$
	MOVL	4(AP),R1		;;; ADDRESS DVC NAME DESCRIPTORS (target)
	JSB	G^IOC$SEARCHDEV		;;; GET UCB ADDRESS INTO R1 for tgt
	BLBS	R0,660$
	BRW	BSH_XIT
660$:
;
80$:
	MOVL	R1,HSTUCB		;;; SAVE HOST UCB ADDRESS
	movl	r1,r11			;use r11 for target UCB
	BEQL	166$			;;; ... BUT ZERO UCB ADDRESS LOOKS BAAAAD
90$:
	MOVL	8(AP),R1		;;; ADDRESS VDn NAME DESCRIPTORS
	JSB	G^IOC$SEARCHDEV		;;; GET UCB ADDRESS INTO R1
	BLBS	R0,160$
	BRW	BSH_XIT
160$:
	movl	r1,vducb		;;; store vd ucb
	movl	r1,r5			;use r5 for local ucb (JF dvc)
	beql	166$			;fail if no ucb...
; BUGGER THE UCB
; ASSUMES FILE LBN AND SIZE ALREADY RECORDED
; ALSO ASSUMES THAT ZERO LBN OR SIZE MEANS THIS ENTRY NEVER CALLED.
; (REALLY ONLY WORRY ABOUT ZERO SIZE; IF WE OVERMAP A REAL DEVICE
; THEN ZERO INITIAL LBN COULD BE OK.)
;
; CHECK REF COUNT FIRST... ONLY CAN GET AWAY WITH THIS ON DEVICE
; NOBODY'S USING...
; .. fake this since device may have count messed by advd somehow
; but will be allocated if mounted.
; ... for now ...
554$:
;	CMPW	UCB$W_REFC(R1),#1	;;; CHECK COUNT VS 1 FOR THIS
;	blssu	164$		;if 1 or less, go on.
	brb	164$	;(it doersn't matter ifthe local disk is in
			; use...we don't bother it.)
166$:	brw	165$
164$:
; check that both UCBs are disk devices at least!
; We can't be sure all the device characteristics will be the
; same for the local device and the MSCP served remote one (and
; in fact they are not all alike!) but at least they had better
; both be disks or this function is not even approximately
; correct and will probably be quickly fatal to the system.
	tstl	deafg	;/deas? r11 invalid.
	beql	1164$
; for deassign, must set JF offline so it can be turned on again
; but just do all work here & scram.
	cmpl	ucb$l_icsign(r5),#magic	;got right magic no.?
	bneq	1176$		;if not then not JFdriver
5164$:
; clear online & valid on JF dvc for next time
	.if	df,evax
	bicl	#ucb$m_online,ucb$l_sts(r5)	;set jf unit online
	bicl	#ucb$m_valid,ucb$l_sts(r5)	; & valid
	.iff
	bicw	#ucb$m_online,ucb$w_sts(r5)	;set jf unit online
	bicw	#ucb$m_valid,ucb$w_sts(r5)	; & valid
	.endc
1166$:	movl	#1,r0
	brw	bsh_xit		;unlock & leave
1176$:	movl	#ss$_drverr,r0
	brw	bsh_xit
1164$:
	cmpb	ucb$b_devclass(r11),#dc$_disk
	bneq	1176$			;if not disk exit now.
	cmpl	ucb$l_icsign(r5),#magic	;got right magic no.?
	bneq	1176$		;if not then not JFdriver
; Be sure the unit is not online yet. If it is, someone else will
; be using its UCB so we don't want to screw this up.
	.if	df,evax
	bitl	#ucb$m_online,ucb$l_sts(r5)	;set jf unit online
	bneq	166$
	.iff
	bitw	#ucb$m_online,ucb$w_sts(r5)	;set jf unit online
	bneq	166$
	.endc
; Looks like we're gonna do the assign. Store backpointer for driver to
; check before unmung.
	movl	r11,ucb$l_vict(r5)		;store ucb of victim in JF ucb
;;;must make maxbcnt and fipl match!!!
; Fork IPL will be same but maxbcnt often will not. Fix that here.
;	movb	ucb$b_fipl(r5),ucb$b_fipl(r11)	;;;ensure fork levels match
;	movl	ucb$l_maxbcnt(r5),ucb$l_maxbcnt(r11) ;;;store max bytes as a word
; Now get on with the tricky part, replacing the DDT. Do this
; at device IPL so we have reasonable certainty nobody will mess with
; these structures until we get them all put into proper order.
; The DDT structure is 64 bytes long, so grab a block of pool of 64 bytes
; size and copy the existing DDT into it.
; (it is possible to save the old address if the conditional is used)
	.if	df,evax
	bisl	#ucb$m_online,ucb$l_sts(r5)	;set jf unit online
	bisl	#ucb$m_valid,ucb$l_sts(r5)	; & valid
	.iff
	bisw	#ucb$m_online,ucb$w_sts(r5)	;set jf unit online
	bisw	#ucb$m_valid,ucb$w_sts(r5)	; & valid
	.endc
	movl	ucb$l_maxblock(r11),ucb$l_maxblock(r5)	;copy geom for luck
	movw	ucb$w_cylinders(r11),ucb$w_cylinders(r5)
	movb	ucb$b_sectors(r11),ucb$b_sectors(r5)
	movb	ucb$b_tracks(r11),ucb$b_tracks(r5)
	movl	cbtct,ucb$l_cbtini(r5)	;set CBT opens every time
	movl	#34,ucb$l_ctlflgs(r5)	;set to look at modify
	tstl	adflg		;/aldefonly?
	beql	60$
	bisl	#4,ucb$l_ctlflgs(r5)	;set driver thus
60$:
; note 4 bit only extends if aldef is set. Don't set that just now.
	movl	min,ucb$l_minxt(r5)	;min extent = 10
	movl	ucb$l_maxblock(r11),r0
	tstl	max			;user set max?
	beql	65$
	movl	max,r0			;if so use his unless 0
	brb	4$
65$:
	ashl	#-5,r0,r0		; default max = 1/32 of disk size
	cmpl	r0,#2000		;but 2000 at least
	bgtr	4$
	movl	#2000,r0		;max=0 => 1/32 of disksize or 2000
4$:
	movl	r0,ucb$l_maxxt(r5)	;max extent
	movl	frac,ucb$l_frac(r5)	;extend by 1/4 of file size
	movl	cbtct,ucb$l_cbtctr(r5)
165$:
	MOVL	#SS$_NORMAL,R0
BSH_XIT:
	PUSHL	R0
	JSB	G^SCH$IOUNLOCK		;;; UNLOCK I/O DATABASE (DROP IPL)
	POPL	R0			;;; REMEMBER R0
	RET	;;; BACK TO USER MODE NOW
	.endc ;step2
	.END ADVDD