	.TITLE	ADVD - VAX/VMS VIRT DISK DRIVER ASSIGN/DEASSIGN
	.IDENT	'V02-001'
;
; FACILITY:
; 
; ASSIGN/DEASSIGN VIRTUAL DISK TASK THAT WORKS WITH VDDRIVER
;  ESTABLISHES CONNECTION (OR BREAKS IT) BETWEEN A LUN OF
;  VD: AND A CONTIGUOUS FILE.
;
; Also this version will save the container file spec in the
; UCB area ucb$vdcontfil as a null terminated string up to 79
; bytes long. Also it will have an option to report the assigned
; file so associated.
;
; ALSO, this version will recognize a couple container file sizes.
; Specifically: a file sized 500384 to 500400 blocks long will be
; treated as an RM05, with 823 cylinders, 19 tracks/cylinder,
; and 32 sectors per track. A file under 65530 blocks long will
; get geomtery n cylinders, 1 sector/track, 1 track/cyl, and
; a file of size 131680 to 131700 blocks long will be treated as
; an RM03 with 823 cylinders, 5 tracks/cylinder, and 32 sectors
; per track. This will facilitate use for some kinds of backups.
; Other disk types can be wedged in as needed. Note the physical
; structure for small disks thus generated is DIFFERENT from the
; "standard" driver set. A /sec64 switch will allow this to be
; overridden where we need compatibility.
;
; Command format:
; ADVD/switches VDn: file
;  where a .CLD file is expected so that this can all be parsed by
;  the CLI. The legal switches will just be /ASSIGN or /DEASSIGN
;  to specify which operation is required. In the /DEASSIGN
;  case no filename is needed of course; the virtual disk must
;  however be dismounted before this utility will allow it to
;  be deassigned. The ucb$w_refc field must be zero before the
;  deassign is thus permitted.
;  We must set the UCB$L_MAXBLOCK longword to the size of the file
;  here also. This requires reading the statistics on the file to
;  discover the size if contiguous; the statistics block will
;  show zero if noncontig...
;    We also set the number of "cylinders" for a fakeout structure.
; I don't really think that physical I/O needs to even be legal, but
; for the sake of argument & trying to get SOMETHING that works,
; I've left it in for now. The driver world be simpler just
; removing readpblk and writepblk from the legal-function FDT masks
; but there's always the chance SOMETHING will need it...
;
; 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
;--
	.PAGE
	.SBTTL	EXTERNAL AND LOCAL DEFINITIONS

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

	$ADPDEF				;DEFINE ADAPTER CONTROL BLOCK
	$ATRDEF
	$CRBDEF				;DEFINE CHANNEL REQUEST BLOCK
	$DCDEF				;DEFINE DEVICE CLASS
	$DDBDEF				;DEFINE DEVICE DATA BLOCK
	$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)
;
; Note: These MUST match the definitions in VDDRIVER. Don't
; change one without changing the other to match it!!!
;	G. Everhart 9/5/1986
; 
; Since I/O postprocessing on virtual or paging I/O makes lots of
; assumptions about location of window blocks, etc., which are
; not true here (wrong UCB mainly), we'll bash the function code status
; we send to the host driver to look like logical I/O is being
; done and save the real status code here. Later when VD: does
; I/O completion processing, we'll replace the original function
; from here back in the IRP. This will be saved/restored along with
; ucb$ppid (irp$l_pid field) and so synchronization will be detected
; with ucb$ppid usage.

	$DEFINI	UCB			;START OF UCB DEFINITIONS

;.=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$W_DY_WPS	.BLKW	1	;Words per sector.
$DEF	UCB$W_DY_CS	.BLKW	1	;CONTROL STATUS REGISTER
$DEF	UCB$W_DY_DB	.BLKW	1	;UCB ADDRESS OF HOST DRIVER
$DEF	UCB$W_DY_DPN	.BLKW	1	;(LONGWORD)
$DEF	UCB$L_DY_DPR	.BLKL	1	;START LBN OF HOST CONTIG FILE
$DEF	UCB$L_DY_FMPR	.BLKL	1	;
$DEF	UCB$L_DY_PMPR	.BLKL	1	;PREVIOUS MAP REGISTER
$DEF	UCB$B_DY_ER	.BLKB	1	;SPECIAL ERROR REGISTER
			.BLKB	1	;Reserved.
$DEF	UCB$B_DY_LCT	.BLKB	1	;LOOP COUNTER
$DEF	UCB$B_DY_XBA	.BLKB	1	;BUS ADDRESS EXTENSION BITS
$DEF	UCB$W_DY_PWC	.BLKW	1	;PARTIAL WORD COUNT
$DEF	UCB$W_DY_SBA	.BLKW	1	;SAVED BUFFER ADDRESS
$DEF	UCB$L_DY_XFER	.BLKL	1	;TRANSFER FUNCTION CSR BITS
$DEF	UCB$L_DY_LMEDIA	.BLKL	1	;LOGICAL MEDIA ADDRESS
$DEF	UCB$Q_DY_EXTENDED_STATUS	; Area into which we do READ ERROR
			.BLKQ	1	;  REGISTER command.
$DEF	UCB$Q_DY_SVAPTETMP		; Area in which we save UCB fields -
			.BLKQ	1	;  SVAPTE, BOFF, and BCNT.
$DEF	UCB$L_DY_MAPREGTMP		; Area in which we save CRB fields -
			.BLKL	1	;  MAPREG, NUMREG, and DATAPATH.
$DEF	UCB$L_DY_SAVECS	.BLKL	1	; Area in which we save CS and DB regs.
$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$OBCT	.BLKL	1	;STORE FOR IRP$L_OBCNT too
$DEF	UCB$LMEDIA	.BLKL	1	;irp$l_media store
$DEF	UCB$OWIND	.BLKL	1	; store irp$l_wind...
$DEF	UCB$OSEGV	.BLKL	1	; and irp$l_segvbn
$DEF	UCB$L_VD_HOST_DESCR
			.BLKL	2
$DEF	UCB$VDCONTFIL	.BLKB	80	;container file spec, 0 term'd
$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
DFAB_BLK: $FAB FNM=<VD0.DSK>,XAB=FNXAB,FAC=<GET,PUT>,DNM=<VDCONT.DSK>
;
FNXAB:	$XABFHC	; XAB STUFF TO GET LBN, SIZE
	.BLKL	20 ;SAFETY
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
;
; DESCRIPTOR FOR DVn:DSKFIL "FILENAME"
	.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
;
; FOR initial use, don't bother allocating the file. Assume the
; user can somehow allocate a contiguous file of the size he wants
; for himself.
;
repdsc:	.ascid	/REPORT/	;report associated file
repflg:	.long	0		;1 if reporting, 0 otherwise
reptxt:	.word	80		;80 byte long
	.byte dsc$k_dtype_t	;static, fixed length string of text
	.byte 1
	.address	repwrk	;data pointer is repwrk's address
repwrk:	.blkb	80		;copy of filespec
s64dsc:	.ascid	/SEC64/		;flag this if 64 sectors/trk geometry needed
ASDSC:	.ASCID	/ASSIGN/
DASDSC:	.ASCID	/DEASSIGN/
P1DSC:	.ASCID	/UNIT/
P2DSC:	.ASCID	/FNAM/
	.EVEN
ASDAS:	.LONG	0	;DEFAULT DEASSIGN
vSec64:	.long	0	;1 if using /sec64 geometry
;
; ucb data area
HSTUCB:	.LONG	0	;HOST UCB ADDRESS
HSTLBN:	.LONG	0	;LBN OF 1ST BLK OF HOST FILE
HSTFSZ:	.LONG	0	;LENGTH IN BLOCKS OF HOST FILE
; debug words
vducb: .long 0
vdsts:	.long 0
vdsts2:	.long 0
vdsts3:	.long 0
vdcyl:	.long 0
vdprog:	.long 0	;counts where we've been
;
;
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	repflg		;say not reporting initially
	movab	repwrk,r0	;clear work string initially
	movl	#80,r1
1$:	clrb	(r0)+
	sobgtr	r1,1$		;zero the array out

	MOVL	#1,ASDAS	;SET ASSIGN
	PUSHAB	WRK		;PUSH LONGWORD ADDR FOR RETLENGTH
	PUSHAB	VDFNM		;ADDRESS OF DESCRIPTOR TO RETURN
	PUSHAB	P1DSC		; GET P1 (VDn: UNIT)
	CALLS	#3,G^CLI$GET_VALUE	;GET VALUE OF NAME TO VDFNM
	ON_ERR	ADVDD_EXIT
	clrl	vsec64		;zero s64 flag
	pushab	s64dsc
	calls	#1,g^cli$present	;see if /sec64 specified
	cmpl	r0,#cli$_present
	bneq	503$			;if neq not there
	incl	vsec64
503$:
	pushab	repdsc
	calls	#1,g^cli$present	;/report used?
	cmpl	r0,#cli$_present
	bneq	103$			;if not there, skip...
	movl	#1,repflg
	jmp	das1			;if there, no need for 2nd file either
;
; IF "DEASSIGN" WE DON'T NEED 2ND ARG... SEE...
;
103$:
	PUSHAB	DASDSC			; 'DEASSIGN'
	CALLS	#1,G^CLI$PRESENT	; IS /DEASSIGN USED?
	CMPL	R0,#CLI$_PRESENT	; IF EQ YES
	BEQL	DAS1

	PUSHAB	WRK			; GET 2ND FILE (REAL FILE)
	PUSHAB	DDFNM			; & ITS DESCRIPTOR
	PUSHAB	P2DSC			; & PARAMETER NAME 'P2'
	CALLS	#3,G^CLI$GET_VALUE	; GET FNM
	ON_ERR	ADVDD_EXIT
	BRB	DAS2
DAS1:	CLRL	ASDAS			; FLAG /DEAS
DAS2:

	TSTL	ASDAS			; IF 0, DEASSIGNING SO NO CHNL FOR HOST
					; FILE
	BEQL	290$
	tstl	repflg
	bneq	290$			;/report doesn't need file either
	$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$:
;
; NOW LOCATE THE FILE AND VERIFY IT'S REALLY CONTIGUOUS, AND FIND
; OUT HOW BIG IT IS. STORE RESULTS IN HSTLBN AND HSTFSZ AND
; CALL KERNEL ROUTINE TO BASH THE VDn: UCB APPROPRIATELY.
;
; DON'T NEED TO DO THIS FOR DEASSIGN SO CHECK THAT FIRST...
	TSTL	ASDAS			; IF ZERO WE DEASSIGN
	BEQL	296$
	tstl	repflg
	bneq	296$			;forget file open if /report only
; OPEN THE FILE, CHECK ITS INITIAL LBN
; IF ERROR OR NOT CONTIG, EXIT...
; DO VIA OPENING FILE AND READING ITS' STATBLOCK VIA
; QIO...
; SET UP FOR FILENAME WE REALLY FOUND IN FAB...
	MOVL	DDFNA,DFAB_BLK+FAB$L_FNA	;SET UP FILENAME ADDR
	MOVB	DDFNM,DFAB_BLK+FAB$B_FNS	;AND LENGTH
	$OPEN	FAB=DFAB_BLK
	BLBC	R0,300$			; FAILURE IF FILE WON'T OPEN
; FNXAB HAS INFO ON LBN, SIZE
	MOVL	FNXAB+XAB$L_SBN,HSTLBN	; GET HOST'S LBN
	BEQL	301$			;;; RESTRICTION FOR NOW ...
					;;; IF ZERO, FILE NONCONTIG
					;;; SO FORGET IT...
	MOVL	FNXAB+XAB$L_HBK,HSTFSZ	; GET FILE SIZE. (CHECK THAT BELOW)
	.if	ndf,phy$io
	tstl	vsec64
	beql	784$
	BICL2	#63,HSTFSZ		;;;MAKE A MULTIPLE OF 64 BLKS
;;; As long as the driver doesn't do physical I/O we can omit this...
;;; except INIT seems unhappy then
	brb	785$
784$:
	cmpl	hstfsz,#65530		;big disk?
	blss	785$			;if not leave size alone.
;	bicl2	#31,hstfsz		;else make granular to 32 sectors anyhow
785$:
	.endc
;;;HAS TO BE A MULTIPLE OF 64 BLKS DUE TO FAKED-OUT PHYSICAL DRIVE
;;; STRUCTURE OF 64 SECTORS/TRACK, 1 TRACK/CYL, NNN CYLINDERS...

	TSTL	HSTFSZ			; HOST SIZE POSITIVE
	BLSS	301$			; IF <0 OR =0 THEN ILLEGAL; BUG OUT
					; ELSE ISSUE THE REQUESTS TO GET THE
					; DEVICES...
296$:

	$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
	$CLOSE FAB=DFAB_BLK
300$:
; BE SURE WE DON'T LEAVE THE CHANNELS ASSIGNED TO THE DEVICES
; EITHER...
	$DASSGN_S CHAN=VDCHN
	tstl	repflg
	bneq	550$
	TSTL	ASDAS				; IF ZERO WE DEASSIGN
	beql	540$				; if zero, no file chnl to deass
	$DASSGN_S CHAN=DDCHN			;CLEAN UP I/O CHANNELS
540$:	; skip deassign file chnl on advd/deassign
	; to avoid final error msg
	RET
550$:
; print out the filespec
	tstb	repwrk				;got any file assigned?
	beql	552$				;if not, don't emit name
	pushab	reptxt				;text descr. of filename
	calls	#1,g^lib$put_output		;emit same
552$:
	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.

	.ENTRY	BASHUCB,^M<R2,R3,R4,R5,R6,R7,R8>
; 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
	JSB	G^SCH$IOLOCKW		;;; LOCK I/O DATABASE
	CLRL	HSTUCB			;;; ZERO "HOST" UCB
	movl	#1,vdprog		;;; got to start
	tstl	repflg
	bneq	90$			;;;no host lookup on /report
	TSTL	ASDAS			;;; IF DEASSIGN, ZERO
	BEQL	90$			;;; SO IF EQUAL SKIP LOCATE HOST UCB
	MOVL	4(AP),R1		;;; ADDRESS DVC NAME DESCRIPTORS
	JSB	G^IOC$SEARCHDEV		;;; GET UCB ADDRESS INTO R1
	BLBS	R0,60$
	BRW	BSH_XIT
60$:
;	TSTL	UCB$L_PID(R1)		;;; ENSURE DVC NOT ALLOCATED
;	BEQL	80$
;	MOVL	#SS$_DEVALLOC,R0
;	BRW	BSH_XIT
; ALLOCATED OK SINCE IT COULD JUST BE PRIVATE MOUNT...
;
80$:
	movl	#2,vdprog		;;; got host ucb ok
	MOVL	R1,HSTUCB		;;; SAVE HOST UCB ADDRESS
	BEQL	167$			;;; ... BUT ZERO UCB ADDRESS LOOKS BAAAAD
90$:
	MOVL	8(AP),R1		;;; ADDRESS VDn NAME DESCRIPTORS
	movl	#3,vdprog		;;; got vdn: descriptor
	JSB	G^IOC$SEARCHDEV		;;; GET UCB ADDRESS INTO R1
	BLBS	R0,160$
	BRW	BSH_XIT
160$:
	movl	r1,vducb		;;; store vd ucb
	movl	#4,vdprog		;;; got vd ucb
	tstl	repflg
	bneq	168$			;;;on /report don't mess ucb up
	TSTL	UCB$L_PID(R1)		;;; ENSURE DVC NOT ALLOCATED
	BEQL	180$
165$:
	MOVL	#SS$_DEVALLOC,R0
167$:	BRW	BSH_XIT
168$:	brw	455$
180$:
	movl	#5,vdprog		;;; not allocated yet
; 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$:
	movzwl  ucb$w_refc(r1),vdsts2	;;; save status for debug
	CMPW	UCB$W_REFC(R1),#1	;;; CHECK COUNT VS 1 FOR THIS
	BGTRU	165$
;	TSTW	UCB$W_REFC(R1)		;;; IF MOUNTED DON'T TOUCH
;	BNEQ	165$			;;; IF NEQ IT'S ACCESSED...
	movl	#6,vdprog		;;; not mounted either
	MOVL	HSTUCB,UCB$HUCB(R1)	;;; SAVE HOST UCB OR 0
	BNEQ	184$			;;; IF NE, OK NOW
;;; ZERO -- DEASSIGNING. FLAG VOLUME INVALID
	BICW	#UCB$M_ONLINE,UCB$W_STS(R1) ;;; FLAG OFFLINE
	BICW	#UCB$M_VALID,UCB$W_STS(R1) ;;; AND INVALID
	clrb	ucb$vdcontfil(r1)	;;;clr container file name
	BRW	200$
184$:	MOVL	HSTLBN,UCB$HLBN(R1)	;;; SAVE HOST'S LBN
	MOVL	HSTFSZ,UCB$HFSZ(R1)	;;; AND FILE SIZE
	MOVL	HSTFSZ,UCB$L_MAXBLOCK(R1) ;;; (SAVE SIZE TWICE, FOR RMS
	clrl	ucb$ppid(r1)		;;;zero original PID
	movl	r4,-(sp)
	movl	hstucb,r4		;;;get host UCB
	beql	189$			;;;forget it if none
;;;must make maxbcnt and fipl match!!!
	movb	ucb$b_fipl(r4),ucb$b_fipl(r1)	;;;ensure fork levels match
	movl	ucb$l_maxbcnt(r4),ucb$l_maxbcnt(r1) ;;;store max bytes as a word
189$:
	movl	(sp)+,r4
	movl	#7,vdprog		;;; filled in stuff
					;;; AND QIO CHECKS, AND OUR SAFETY
					;;; ONES)
	MOVL	HSTFSZ,R0		;;; GET HOST SIZE
	ASHL	#-6,R0,R0		;;; GET # CYLINDERS IN SIZE NOW
	MOVW	R0,UCB$W_CYLINDERS(R1)	;;; SAVE IN UCB FOR REST OF VMS
	movl	r0,vdcyl		;;; store cylinders for debug
	movb	#64,ucb$b_sectors(r1)	;;;init sectors to 64 always
	tstl	vsec64		;;;did user say he needs 64 sector geometry?
	beql	6843$			;;;if eql no, do tests
	brw	6841$			;;;if neql leave geometry alone...
6843$:
; test for small files
	cmpl	hstfsz,#65530		;"small" disks?
	bgtr	685$
	movw	hstfsz,ucb$w_cylinders(r1)	;yep...save size in cyl
	movb	#1,ucb$b_sectors(r1)		;and set 1 sector/trk
	movb	#1,ucb$b_tracks(r1)		;and 1 track/cyl (should be ok already)
	brw	684$				;done with geometry
685$:
; check for RM05
	cmpl	hstfsz,#500384			;ensure big enough
	blss	686$				;if less than min, not enough blocks
	cmpl	hstfsz,#500460			;see if too big (allow slop)
	bgtr	686$				;if too big, not an RM05 lookalike either
;looks like RM05. Set up that way.
	movw	#823,ucb$w_cylinders(r1)	;823 cyls
	movb	#32,ucb$b_sectors(r1)		;32 sectors/trk
	movb	#19,ucb$b_tracks(r1)		;19 tracks/cyl
	movl	#500384,ucb$l_maxblock(r1)	;correct the size to exactly RM05 size
	brw	684$
686$:
; Check for RM03
	cmpl	hstfsz,#131680			;ensure big enough
	blss	687$				;if less than min, not enough blocks
	cmpl	hstfsz,#131760			;see if too big (allow slop)
	bgtr	687$				;if too big, not an RM03 lookalike either
;looks like RM05. Set up that way.
	movw	#823,ucb$w_cylinders(r1)	;823 cyls
	movb	#32,ucb$b_sectors(r1)		;32 sectors/trk
	movb	#5,ucb$b_tracks(r1)		;5 tracks/cyl
	movl	#131680,ucb$l_maxblock(r1)	;correct the size to exactly RM03 size
	brw	684$
687$:
; Add other checks here

;	brb	6841$				;at last check, if we fail, reset size
;						;for default 64 sect/cyl geometry
6841$:
; If here, we are using the 64 sector/track geometry
	bicl2	#63,ucb$l_maxblock(r1)		;make disk size a multiple of sect/trk
684$:
	movl	#8,vdprog
	pushl	r0
	pushl	r1
	pushl	r2
; Fill in filename as 1st 79 chars of what user sent us
	movab	ddfnmd,r0		;data address
	movl	#79,r2			;copy 79 bytes
	addl	#ucb$vdcontfil,r1	;point at ucb offset
457$:	movb	(r0)+,(r1)+
	sobgtr	r2,457$			;copy the data
	clrb	(r0)+			;null terminate
	popl	r2
	popl	r1
	popl	r0
	BISW	#UCB$M_ONLINE,UCB$W_STS(R1) ;;; FLAG ONLINE NOW
	BISW	#UCB$M_VALID,UCB$W_STS(R1) ;;; AND VOL VALID
	movzwl	ucb$w_sts(r1),vdsts	;;; save VD status
;;; THAT'S IT... SHOULD BE OK NOW.
	brb	200$
455$:
; copy vd: stored name into prog area
	pushl	r1
	pushl	r2
	movab	repwrk,r0		;;;get report area
	movl	#80,r2			;;;80 bytes max
	addl2	#ucb$vdcontfil,r1	;;;point at in area
456$:	movb	(r1)+,(r0)+
	beql	458$			;;;on null terminator stop copy
					;;;(keeps old name junk from reappearing)
	sobgtr	r2,456$			;;;copy the data
458$:
	popl	r2
	popl	r1
200$:
	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
