.TITLE	FQFWSrvSet	;setup FQ or FW device served databases
	.IDENT	'V03-001'
;
; FACILITY:
; 
; This program prepares for the use of MSCP served FQ/FD/FW disks
; in a mode independent of the specifics of the disk by allocating
; a new DDT (driver dispatch table) entry and filling it in for
; MSCP served copies of these devices on other nodes, and by editing
; the UCB slightly. It is not expected that this will be reversed.
;   The operation requires that the associated driver be loaded
; locally and at least one unit be defined locally. This image
; will construct a new DDT which will be identical with the old
; one save that its' FDT entries will point to the FDT entries of
; the local copy of the driver (which is why it MUST pre-exist)
; and the DDB and UCB will be pointed at this copy of the DDT. Also
; the UCB field UCB$L_MAXBCNT field will be set to match that in
; the local driver copy, which will ensure correct operation across
; a cluster. The modifications so made will by synchronized by the
; device lock, but should be done before usage is begun of the device
; from the node on which this is run. It is expected this will be used
; on each node wishing to access an FD/FQ/FW type unit remotely. Since
; this program will make no use of any UCB fields beyond the standard
; ones, it need not care about such extensions, which in the case of
; FD/FW/FQ units only are used at start-IO time anyway. For use with
; the VR driver series, this program will not be automatically adequate
; since a UCB extension will be needed and must be filled in to handle
; the fairly extensive FDT time activities it uses. The replacement of
; FDT is needed for FWdriver only to disallow deletions, which needs
; no UCB data structure support. A version of this for VRdriver would
; need to extend the UCB, probably by duplicating it into a larger
; structure, and would at least have to precede mounting, and would
; need to locate the MSCP server's pointers to the old UCB also unless
; the UCB allocated by the MSCP server is the size of the original.
; (Modified code to use other data structures instead of UCB may be
; more promising...)
;
;   This program takes a command of form
; FQFWFix FQAn: node$fqan:
;  where FQAn: refers to the local FQ device (or FW device or FD
; device) and the node$fqan: refers to the name of the FQ/FW/FD
; device on the current node as an MSCP served node. This is the
; "target" of modification.
;
; 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
; 21-Aug-1992   G. Everhart	Turned into FQFWmodifier
;--
	.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
; We actually don't use any of these extensions. Leave them for
; the present though...a few of them anyway...

;.=ucb$w_bcr+2				;BEGIN DEFINITIONS AT END OF UCB
.=ucb$k_lcl_disk_length			;vms v4, right out of the book...
					;LOCAL DATA FOR VIRT DISK.
$DEF	UCB$HUCB	.BLKL	1	;ADDRESS OF HOST UCB
$DEF	UCB$HLBN	.BLKL	1	;LBN OF HOST FILE
$DEF	UCB$HFSZ	.BLKL	1	;SIZE OF HOST FILE, BLKS
$DEF	UCB$PPID	.BLKL	1	;PID save area for active requests
$DEF	UCB$STATS	.BLKL	1	;IRP STATUS CODE SAVE AREA
$DEF	UCB$K_VD_LEN	.BLKW	1	;length
;ucb$k_dy_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
IOSTATUS: .BLKQ 1
DEV_BUF:			; Buffer to hold device name.
	.BLKB	40
DEV_BUF_SIZ = . - DEV_BUF

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
;**
VDV_BUF:			; Buffer to hold VDVice name.
	.BLKB	40
VDV_BUF_SIZ = . - VDV_BUF

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	20	;length
	.byte	dsc$k_dtype_t	;text
	.byte	1	;static
	.address	wrkdat
wrkdat:	.blkb	20
	.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/
	.EVEN
; UCB data area
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>
	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
	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
	BRB	DAS2
DAS2:
	$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.
	$ASSIGN_S -
		DEVNAM=VDFNM,-		; GET CHANNEL FOR VDn:
		CHAN=VDCHN
	ON_ERR	ADVDD_EXIT		; SKIP OUT IF ERROR
	$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!
	$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
300$:
; BE SURE WE DON'T LEAVE THE CHANNELS ASSIGNED TO THE DEVICES
; EITHER...
	$DASSGN_S CHAN=VDCHN
	$DASSGN_S CHAN=DDCHN			;CLEAN UP I/O CHANNELS
	RET
advdd_exit:
	RET
;
; 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

; 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
	MOVL	4(AP),R1		;;; ADDRESS DVC NAME DESCRIPTORS (target)
	JSB	G^IOC$SEARCHDEV		;;; GET UCB ADDRESS INTO R1 for tgt
	BLBS	R0,60$
	BRW	BSH_XIT
60$:
;
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
	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.
	cmpb	ucb$b_devclass(r5),#dc$_disk
	bneq	166$			;if not disk exit now.
	cmpb	ucb$b_devclass(r11),#dc$_disk
	bneq	166$			;if not disk exit now.
;;;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.
	devicelock savipl=-(sp),preserve=no
; 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	ndf,sav$old_ddt
ddtsize=64
	movl	#ddtsize,r1		;ask for 64 bytes
	jsb	g^exe$alonpagvar	;out of pool
	blbc	r0,1000$
	.iff
ddtsize=68
	movl	#ddtsize,r1		;ask for 64 bytes
	jsb	g^exe$alonpagvar	;out of pool
	blbc	r0,1000$
	movl	ucb$l_ddt(r11),(r2)+	;store original ddt address
					;ahead of the new DDT
; At this point r2 points to a 64 byte buffer for the DDT, but the
; original DDT is pointed to by the longword ahead of this area.
; This conditional could be used if we ever needed to be able to back
; out a change here.
	.endc
; got the memory, pointed to by r2
	movl	r2,r10			;I want the new DDT in a less
					;volatile register
	movl	ucb$l_ddt(r5),r9	;point at existing DDT
	bgeq	1000$
	pushr	#^m<r0,r1,r2,r3,r4,r5>	;preserve regs across movc3
	movc3	#64,(r9),(r10)		;copy the DDT
	popr	#^m<r0,r1,r2,r3,r4,r5>	;preserve regs across movc3
; now locate local driver's FDT table
	movl	ucb$l_ddt(r5),r7	;local driver's DDT area
	movl	ddt$l_fdt(r7),r3	;fdt address
	movl	r3,ddt$l_fdt(r10)	;fill in host's FDT table address
					;in the new copy of the DDT.
; From this point, the new DDT can serve as well as the old.
	movl	ucb$l_ddb(r11),r9	;locate DDB also
	movl	r10,ddb$l_ddt(r9)	;and replace its' DDT pointer
	movl	r10,ucb$l_ddt(r11)	;and replace UCB DDT pointer in victim
					;UCB.
; Now the DDT pointer is replaced so the FDT table used will be that of
; the local driver, not the one in the class driver that the MSCP server
; would otherwise use. This presumes the changes will not be reversed
; and drivers not reloaded (which would tend to lose the memory for
; the DDT copy). This procedure should only be used for like drivers,
; so that an FQ: or FW: unit that is MSCP served may be made to work
; properly using the same FQdriver or FWdriver locally. Attempting to
; make the FDT tables of, say, FQdriver work with something like a
; DK unit could cause weird behavior problems.
1000$:
	deviceunlock newipl=(sp)+,preserve=no
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
	.END ADVDD