.TITLE	FDHost2048 - Host for 2048 byte block file devs
	.IDENT	'V01-004a'
	.enable SUP	;suppress stuff not needed
evax = 1
alpha=1
bigpage=1
addressbits=32
; Uncopyright 1988, 1989, 1990 Glenn C. Everhart
; Public Domain. May be used by all for any purpose.
; Enjoy!
;
; FACILITY:
; 
; Host process for FD: unit that will provide a 512 byte block device
; "on top of" a device that does NOT have 512 byte blocks. Since DKdriver
; can allow $qio access to such gadgets, this will allow one to treat them
; as normal disks, reading or writing to them with $qio and doing the
; blocking internally. The FD.BLKSIZ parameter will determine the block
; size used. This will default to 2048 bytes, since lots of CDs with that
; block factor exist.
;
.iif ndf,FD.BLKSIZ,FD.BLKSIZ=2048
FD_BLKSIZ=FD.BLKSIZ
FD_BKFAC=FD.BLKSIZ/512
;
; Command format:
; FDHost/switches VDn: filespec
;  where a .CLD file is expected so that this can all be parsed by
;  the CLI. The legal switches will just be /KEY="charstring"
;  to specify the encryption key to use to encrypt/decrypt the data.
;  All data will be encrypted on write or decrypted on read from the
;  file so that the information will be in the clear ONLY where read. Since
;  this process handles all this operation, the key will reside in this process
;  and not in some readily-locatable system area. Therefore it will be quite
;  difficult to find a key even when it is in memory.
;
; FDHOST/CLEAR will zero the ref. count only...nothing more.
; Note deassign normally will NOT be via command (I don't see how a
; command could ever be read) but via exit AST. We could in principle arrange
; an I/O that fddrv would store somewhere, so that if this process exited the
; fddrv driver would be informed of it and could complete the I/O AND set
; itself offline, but I am uncomfortable with this kind of jiggery-pokery.
; Better to just let the ref count be zeroed, since that's the only "dirty" trace
; around. This may allow playing some games later with multiple hosts also.
;   The expectation is that an fd: unit being assigned will have FDHOST/CLEAR
; run on the FD: unit before assigning it if the unit was set incorrectly.
;
; Note: define VMS$V5 to build for Version 5.x of VMS.
;
vms$v5=0
; 
; AUTHOR:
; 
; G. EVERHART
;-- .PAGE
 .SBTTL	EXTERNAL AND LOCAL DEFINITIONS

	.LIBRARY /ALPHA$LIBRARY:LIB/
	.nocross	;save trees
; 
; EXTERNAL SYMBOLS
; 

	$ADPDEF				;DEFINE ADAPTER CONTROL BLOCK
	$CRBDEF				;DEFINE CHANNEL REQUEST BLOCK
	$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
	$IRPDEF				;DEFINE I/O REQUEST PACKET
	$PRDEF				;DEFINE PROCESSOR REGISTERS
	$PCBDEF				;DEFINE PCB OFFSETS
	$SCSDEF
	$SBDEF
	$STSDEF
	$STSDEF		; Symbols for returned status.
	$DVIDEF		; Symbols for $GETDVI service.
	$DCDEF		; Symbols for device type.
	$SSDEF				;DEFINE SYSTEM STATUS CODES
	$UCBDEF				;DEFINE UNIT CONTROL BLOCK
	$VECDEF				;DEFINE INTERRUPT VECTOR BLOCK

; 
	$ACBDEF		; Define AST Control Block offsets.
	$DYNDEF ;define dynamic data types
	$DDTDEF				; DEFINE DISPATCH TBL...
	$ptedef
	$vadef
	$irpedef
	$ipldef
	$pcbdef
	$jibdef

	.IF	DF,VMS$V5	;VMS V5 + LATER ONLY
	$cpudef		;thanks to Chris Ho for V5 fix
	$SPLCODDEF
	.ENDC

	$FIBDEF			; Symbols for file information block.
	$IODEF			; Symbols for QIO functions.
	$DVIDEF			; Symbols for $GETDVI calls.
	$TPADEF			; Symbols for LIB$TPARSE calls.
	$ATRDEF
	$FABDEF		; define lotsa' more rubbish we might want...
	$FATDEF
	$FIBDEF
	$IODEF
	$NAMDEF
	$RMSDEF
	$XABDEF
	.cross
; 
; UCB OFFSETS WHICH FOLLOW THE STANDARD UCB FIELDS
; 
	$DEFINI	UCB			;START OF UCB DEFINITIONS
;.=UCB$L_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.
;The following must match the same-named data in the ACB extension
	.blkl	2	;safety
$DEF	UCB_L_UCB	.BLKL	1	;Save UCB address here
$DEF	UCB_L_MEMBUF	.BLKL	1	;Address of buffer for this transfer
$DEF	UCB_L_NSPTS	.BLKL	1	;Number of SPTs required for buffer
$DEF	UCB_L_SVPN	.BLKL	1	;Starting system page number
$DEF	UCB_L_ADRSPT	.BLKL	1	;Address of first SPT used
$DEF	UCB_L_SVABUF	.BLKL	1	;System virtual address of user buffer
;
$DEF	UCB$HPID	.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 OF ORIGINAL PROCESS FROM IRP BLK
$def	ucb$irps	.BLKL	1	;IRP save area during host proc action
$def	ucb$smbx	.BLKL	1	;mailbox UCB for work notices
; Define save areas for UCB fields needed for I/O copies and used in
; driver to process copies here.
$def	ucb$lsvapte	.blkl 1    ;saves ucb$l_svapte
$def	ucb$lsts	.blkl 1     ;saves ucb$l_sts
$def	ucb$lsvpn	.blkl 1  ; similar
$def	ucb$wboff	.blkl 1  ; similar
$def	ucb$lmedia	.blkl	1
$def	ucb$irplmedia	.blkl	1	;irp$l_media save
$def	ucb$wdirseq	.blkl	1
$def	ucb$lbcr	.blkl	1
; NOTE: It is important to ENSURE that we never clobber IRP$L_PID twice!
; therefore, adopt convention that UCB$PPID is cleared whenever we put
; back the old PID value in the IRP. Only clobber the PID where
; UCB$PPID is zero!!!
$DEF	UCB$L_MEMBUF	.BLKL	1	; MEMORY AREA
$DEF	UCB$L_MEMBF	.BLKL	1	; MEMORY BUFFER FOR CONTROL PROCESS
$DEF	UCB$stats	.BLKL	1	;STATUS CODE SAVE AREA
$def	ucb$jiggery	.blkl	1	;adjust to refcnt to fix up
; 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 status
; we send to the host driver to look like physical I/O is being
; done and save the real function code here. Later when ZR: 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.
;
$def    ucb$l_blk	.blkl	1	;block i/o if nonzero
$def	ucb$l_ucbtbl	.blkl	1	;table of ucb addresses
;$def	ucb$l_bufpol	.blkl	1	;buffer addresses table
$def	ucb$l_ctlfgs	.blkl	1	;control flags
$def	ucb$l_sanity	.blkl	1	;sanity test
	.if	df,delayun
$def	ucb$l_unload	.blkl	1	;set nonzero for unload
	.endc
	.if	ndf,xcldbg
$def	ucb$l_misc	.blkl	20	;debug
	.endc
; (bit 1 set implies disallow create, delete, or extend)
$DEF	UCB$K_ZR_LEN	.BLKL	1	;LENGTH OF UCB
;UCB$K_ZR_LEN=.				;LENGTH OF UCB
	$DEFEND	UCB			;END OF UCB DEFINITONS
;
; No need for direct UCB access here; this is done via the driver
; itself. We just worry about the files, etc.
; 
; Macro to check return status of system calls.
;
	.MACRO	ON_ERR	THERE,?HERE
	BLBS	R0,HERE
	BRW	THERE
HERE:	.ENDM	ON_ERR

	.PSECT	FDHostD_DATA,RD,WRT,NOEXE,LONG

dvl:	.long	0
DESBLK:
	.LONG	0
	.ADDRESS	XITHDL		;EXIT HANDLER ADDRESS
	.long	0
	.address	dvl
	.LONG	0,0			;REST OF EXIT HANDLER CONTROL BLK
;
DEFAULT_DEVICE:
	.ASCID	/SYS$DISK/

	.ALIGN LONG
DFAB_BLK: $FAB FNM=<FD0.DSK>,XAB=FNXAB,FAC=<BIO,get,put>,rfm=fix,DNM=<FDCONT.DSK>,mrs=512
DRAB_BLK: $RAB FAB=DFAB_BLK,BKT=0,RBF=RECBUF,UBF=RECBUF,USZ=512
	.align	long
RECBUF:	.BLKL	128	;512 BYTES = 128 LONGS
	.long	0,0	;safety
;
xsect:	.long	0
xtrks:	.long	0
xcyls:	.long	0

FNXAB:	$XABFHC	; XAB STUFF TO GET LBN, SIZE
	.BLKL	20 ;SAFETY
	.ALIGN LONG
IOSTATUS: .BLKQ 1
;**
VDV_BUF:			; Buffer to hold VDVice name.
	.BLKB	80
VDV_BUF_SIZ = . - VDV_BUF

VDV_BUF_DESC:			; Descriptor pointing to VDVice name.
	.LONG	 VDV_BUF_SIZ
	.ADDRESS VDV_BUF
DVC_BUF:			; Buffer to hold DVCice name.
	.BLKB	80
DVC_BUF_SIZ = . - DVC_BUF

DVC_BUF_DESC:			; Descriptor pointing to DVCice name.
	.LONG	 DVC_BUF_SIZ
	.ADDRESS DVC_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
DVCUCB:	.LONG	0		; device ucb of host dvc
vducb:	.long	0		; vd ucb
DVC_ITEM_LIST:			; DVCice list for $GETDVI.
	.WORD	 DVC_BUF_SIZ	; Make sure we a have a physical device name.
	.WORD	 DVI$_DEVNAM
	.ADDRESS DVC_BUF
	.ADDRESS DVC_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 DVC_CLASS
	.LONG	 0
	.LONG	 0		; End if item list.

DVC_CLASS:
	.LONG	1
;^^^
mbx_BUF:			; Buffer to hold mbxice name.
	.BLKB	40
mbx_BUF_SIZ = . - mbx_BUF

mbx_BUF_DESC:			; Descriptor pointing to mbxice name.
	.LONG	 mbx_BUF_SIZ
	.ADDRESS mbx_BUF

mPID:				; Owner of mbxice (if any).
	.BLKL	1

mbx_ITEM_LIST:			; mbxice list for $GETDVI.
	.WORD	 mbx_BUF_SIZ	; Make sure we a have a physical device name.
	.WORD	 DVI$_DEVNAM
	.ADDRESS mbx_BUF
	.ADDRESS mbx_BUF_DESC
	.WORD	 4		; See if someone has this device allocated.
	.WORD	 DVI$_PID
	.ADDRESS mPID
	.LONG	 0
	.WORD	 4
	.WORD	 DVI$_DEVCLASS	; Check for a terminal.
	.ADDRESS mbx_CLASS
	.LONG	 0
	.LONG	 0		; End if item list.

mbx_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
;
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.
;
MBCHN:	.long	0	; channel for mailbox
MBUCB:	.long	0	; UCB address for mailbox
weakflg: .long	0	;1 if "weak" mode used
CLRDS:	.ASCID	/CLEAR/
KEYDS:	.ASCID	/KEY/	;CRYPTO KEY
weakds:	.ascid	/WEAK/	;"weak" keyword ... compatibe with old cryptodisk.
;			; (well, not REALLY compatible. Just cruddier...)
;ASDSC:	.ASCID	/ASSIGN/
;DASDSC:	.ASCID	/DEASSIGN/
P1DSC:	.ASCID	/UNIT/
P2DSC:	.ASCID	/FNAM/
	.EVEN
; 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
;
;key descriptor
	.ALIGN LONG
KYFNM:	.WORD	 255.	;LENGTH
KYFTP:	.BYTE	DSC$K_DTYPE_T	;TEXT TYPE
	.BYTE	1	; STATIC STRING
KYFNA:	.ADDRESS	KYFNMD
KYFNMD:	.BLKB	256.	; DATA AREA
;
;
; Data area for "disk"
;
	.align long
DSKBUF:	.BLKB	FD_BLKSIZ
	.align long
	.long	0,0,0,0,0,0,0,0	;safety
DSKBKN:	.long	0	;Device block stored in dskbuf
; ucb data area
HSTUCB:	.LONG	0	;HOST UCB ADDRESS
ourpid:	.long	0	;;;store this locally
CLRCNT:	.long	0	;1 if clearing ref cnt ucb$w_refc
iosb:	.long	0,0,0,0	;iosb
ioprog:	.long	0	; i/o in progress flag if nonzero
; BUFFER FOR COPIES OF DRIVR DATA
BUFHDR:	.LONG	0,0,0,0,0
BUF:	.BLKL	8192.	; DATA AREA
	.LONG	0,0	;SAFETY BUFFERS
SETFD:	.LONG	0	;DECLARE PROCESS
	.LONG	0	;PID
HSTFZ:	.LONG	1	;DISK SIZE
	.LONG	0,0,0,0	;EXTRA STUFF FOR OTHER CALLS
SETFDL=.-SETFD
	.LONG	0,0,0,0,0	;SAFETY
HSTFSZ:	.LONG	0	;DISK SIZE
;
; KERNEL ARG LIST
K_ARG:
	.LONG	3	;3 ARGS: fd device name, mb device name, host dvc
	.ADDRESS	VDV_BUF_DESC
	.address	mbx_buf_desc
	.address	dvc_buf_desc
;;;(avoid paging problems in kernel)
	.PSECT	FDHostD_CODE,RD,WRT,EXE,LONG
	.ENTRY	FDHostD,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
; only fdn: name on command line
	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	FDHostD_EXIT
290$:
	clrl	clrcnt	;flag clear count if 1
	PUSHAB	clrds	; 'CLEAR'
	CALLS	#1,G^CLI$PRESENT	; IS /CLEAR USED?
	CMPL	R0,#CLI$_PRESENT	; IF EQ YES
	BNEQ	293$
	incl	clrcnt			; FLAG CLEARING USAGE
	BRW	295$			;ON CLEAR DON'T BOTHER WITH 2ND FILENAME
293$:
	PUSHAB	WRK		; GET 2ND FILE (REAL FILE) LONGWORD FOR LEN
	PUSHAB	DDFNM		; & ITS DESCRIPTOR
	PUSHAB	P2DSC		; & PARAMETER NAME 'P2'
	CALLS	#3,G^CLI$GET_VALUE	; GET FNM
	ON_ERR	fdhostd_EXIT
; get a channel to the host device
	$ASSIGN_S -				; Get a channel to the 
		DEVNAM=DDFNM,-		; device for host file
		CHAN=DDCHN
	ON_ERR	fdhostd_EXIT
; Load name info for the knl routine to get
	$GETDVI_S -
		CHAN=ddchn,-	; Command line has device name.
		ITMLST=DVC_ITEM_LIST
	on_err	fdhostd_exit
; Issue a packack to get the unit up & ready in case it isn't.
; (This ensures geometry is there for later too)
	qiow$s efn=#0,chan=ddchn,func=#io$_packack,iosb=iosb
; No need to decrement size, but must make it a multiple of 64
; blocks for a 64-sector geometry.
295$:
; MUST HAVE ASSIGNMENT TO VD: UNIT IN ANY CASE.
	$ASSIGN_S -
		DEVNAM=VDFNM,-	; GET CHANNEL FOR VDn:
		CHAN=VDCHN
	ON_ERR	FDHostD_EXIT	; SKIP OUT IF ERROR
	$GETDVI_S -
		CHAN=vdchn,-	; Command line has device name.
		ITMLST=VDV_ITEM_LIST
	BLBS	R0,140$
	BRW	FDHostd_EXIT
140$:
	tstl	clrcnt
	bneq	162$		;if just clearing ref count, no need for mbx
; Set up mailbox channel
	$crembx_s prmflg=#0,chan=mbchn,maxmsg=#576,bufquo=#5760,-
		promsk=#0
	On_ERR	fdhostd_exit
; need to get UCB address here somehow...
	$GETDVI_S -
		CHAN=mbchn,-	; Command line has device name.
		ITMLST=mbx_item_list
	BLBS	R0,176$
161$:	BRW	FDHostd_EXIT
176$:
; Got now the actual device name of the mailbox
; Let the kernel call perform the UCB lookup for us.
;
; FOUND A UNIT. NOW DECLARE EXIT HANDLER TO CLEAN UP
; IF WE GET A $FORCEX TO TERMINATE THE HOST PROCESS.
	PUSHAB	DESBLK		; ADDRESS OF DESBLK
	CALLS	#1,G^SYS$DCLEXH	; DECLARE EXIT HANDLER
; NOW GET OUR PID FOR USE LATER
;
162$:
	$CMKRNL_S -
		ROUTIN=BASHUCB,ARGLST=K_ARG
; Now we have the PID for our process in OURPID and are ready to tell
; the driver we're here!
	tstl	clrcnt
	bneq	161$		;exit now if just zeroing count
	MOVL	OURPID,SETFD+4	;STORE PID (IPID!!!)
	movl	HSTFSZ,setfd+8	;size of disk (preset also)
	movl	mbucb,setfd+12		; Comm mailbox UCB address
	CLRL	SETFD		; flag that this is the setup
	movl	xtrks,setfd+16
	movl	xsect,setfd+20
	movl	xcyls,setfd+24	;replicate desired geometry as well as size
	movl	#setfdl,r4	; length of buffer
; Note we must modified func code from io$_format to something with
; a modifier bit set so FDDRV will treat this as OUR special QIO.
	$qiow_s efn=#1,chan=vdchn, -
	iosb=iosb,func=#<io$_format+128>,p1=setfd,p2=R4
	ON_ERR	FDHostD_EXIT	; SKIP OUT IF ERROR
	clrl	ioprog		; no i/o in progress yet
; now we're ready to await work from the driver
EVTLOOP:
; When FDDRV has work, it sends the buffer header it has via a
; mailbox message. Read that here to get our indication there
; is something to do, and incidentally to get initial info on I/O
; direction and size.
;
; Read the mailbox to get our data
; Use QIOW$ to assure that we don't do anything until there is work.
; (this also avoids having to use internal routines to control
;  host execution.)
	$qiow_s efn=#10,chan=mbchn,-
	iosb=iosb,func=#io$_readlblk,p1=bufhdr,p2=#20
	ON_ERR	FDHostD_EXIT	; SKIP OUT IF ERROR
;	$qiow_s efn=#1,chan=vdchn,func=#io$_format,p1=#setfd,p2=#setfdl
;SHOULD NOW HAVE HEADER...
; check for io$_available (ignore here) or io$_unload (so we exit)
        cmpl    bufhdr,#512     ;got it?
        bneq    643$            ;if neq br
        cmpl    bufhdr+4,#1024
        bneq    643$
        cmpl    bufhdr+8,#2048
        bneq    643$
        cmpl    bufhdr+12,#4096
        bneq    643$
;if we get here, user just issued io$_available or io$_unload so is dismounting
; the disk. Therefore call the bufdmo function
; If this is an unload, by the way, bufhdr+16 will be 14747 (decimal)
;
; 014747 in octal is pdp11 mov -(pc),-(pc) instruction, one of the more
; amusing pdp11 instructions...runs backwards.
;
        cmpl    bufhdr+16,#14747        ;unload magic number?
        bneq    654$
        brw     awscram         ;unload flag seen
654$:
644$:   brw     evtloop         ;then look for more to do
643$:
; Check call is not spurious. Driver sets 255 in buffer header when it
; gets done an i/o for client, and puts 0 or 1 there for a real
; transfer.
	cmpl	bufhdr,#2
	bgtru	644$		;if not really doing i/o, spurious ef
				; set, just ignore
	MOVL	#1,IOPROG	;FLAG AN I/O IN PROGRESS THAT NEEDS TO
				;BE COMPLETED
	CMPL	BUFHDR,#1	;1=WRITE, SOMETHING'S WAITING IN THE DRIVER
	beql	writeop
	jmp	readop
;	BNEQ	READOP
WRITEOP:
; BUFHDR+8 CONTAINS BYTECOUNT FOR DATA PART OF TRANSFER
	MOVL	#20,SETFD+8	;BUFFER HEADER size
	ADDL2	BUFHDR+8,SETFD+8	;SO ADD HEADER SIZE
	MOVL	#3,SETFD	;GET DATA
	MOVL	#BUFHDR,SETFD+4	;BUFFER HDR ADDRESS
	movl	#1,setfd+12	;success indicator
	movl	#setfdl,r4
	$qiow_s efn=#1,chan=vdchn, -
	iosb=iosb,func=#<io$_format+128>,p1=setfd,p2=R4
	ON_ERR	FDHostD_EXIT	; SKIP OUT IF ERROR
;	$qiow_s efn=#1,chan=vdchn,func=#io$_format,p1=#setfd,p2=#setfdl
; LOADS DATA INTO LOCAL BUFFER FROM DRIVER
; NOW HAVE TO MOVE IT INTO STORAGE HERE
	MOVL	BUFHDR+4,R0	;GET BLOCK NUMBER
	INCL	R0		;MAP TO VBN
	MOVL	R0,DRAB_BLK+RAB$L_BKT	;SET IT UP
	movw	#512.,drab_blk+rab$w_rsz ;512 byte blks
; LOOP OVER BLKS IN REQUEST
	movl	bufhdr+8,r6	;get bytecount to move
	addl2	#511,r6		;round up
	ashl	#-9,r6,r6	;convert to blks
; r6 is not messed up by movc3...
	movab	buf,r7		;scratch buffer address
15$:
	movab	recbuf,r9	;data to here
	movl	r7,r8		;data from here
	MOVC3	#512,(r8),(R9)	; STORE THE DATA IN OUR SPACE
	$write rab=drab_blk
	ON_ERR	FDHostD_EXIT	; SKIP OUT IF ERROR
	addl2	#512,r7		;pass this blk's data
	incl	drab_blk+rab$l_bkt ;pass this blk in file too
	decl	r6		;count down blks to do
	bgtr	15$		;copy all blks
	JMP	COMMON
READOP:
; READING DATA TO CLIENT. MUST GET DATA, THEN SEND TO DRIVER.
	MOVL	BUFHDR+4,R0	;GET BLOCK NUMBER
	INCL	R0		;MAP TO VBN
	MOVL	R0,DRAB_BLK+RAB$L_BKT	;SET IT UP
	movw	#512.,drab_blk+rab$w_rsz ;512 byte blks
; LOOP OVER BLKS IN REQUEST
	movl	bufhdr+8,r6	;get bytecount to move
	addl2	#511,r6		;round up
	ashl	#-9,r6,r6		;convert to blks
; r6 is not messed up by movc3...
	movab	buf,r7		;scratch buffer address
				;(8K + header)
16$:
	$read	rab=drab_blk
	ON_ERR	FDHostD_EXIT	; SKIP OUT IF ERROR
	movab	recbuf,r9	;data from here
	movl	r7,r8		;data to here
	MOVC3	#512,(r9),(R8)	; STORE THE DATA IN OUR SPACE
	addl2	#512,r7		;pass this blk's data
	incl	drab_blk+rab$l_bkt ;pass this blk in file too
	decl	r6		;count down blks to do
	bgtr	16$		;copy all blks
	movab	buf,r2
	ADDL3	#20,BUFHDR+8,SETFD+8	; GET LENGTH TO XFER
	MOVL	#BUFHDR,SETFD+4	;BUFFER HDR ADDRESS
	MOVL	#2,SETFD	;HOST TO DRIVER COPY
	movl	#setfdl,r4
	movl	#1,setfd+12	;success...
	movl	bufhdr+8,setfd+16	;/length sent
	$qiow_s efn=#1,chan=vdchn, -
	iosb=iosb,func=#<io$_format+128>,p1=setfd,p2=R4
	ON_ERR	FDHostD_EXIT	; SKIP OUT IF ERROR
; NOW DATA IS IN DRIVER SPACE AS REQUIRED
COMMON:
; NOW TERMINATE THE I/O AND AWAIT MORE WORK.
	MOVL	#1,SETFD	;TERMINATE I/O PACKET
	MOVL	BUFHDR,SETFD+4	;SAVE TRANSFER DIRECTION
	MOVL	BUFHDR+4,SETFD+8	; BLOCK #
	MOVL	BUFHDR+8,SETFD+12	; NO. BYTES IN BUFFER
	MOVZWL	#SS$_NORMAL,SETFD+16	; IOSB 1
	CLRL	SETFD+20	; IOSB 2	; ALWAYS SUCCESS
	movl	#setfdl,r4
	$qiow_s efn=#1,chan=vdchn, -
	iosb=iosb,func=#<io$_format+128>,p1=setfd,p2=R4
	ON_ERR	FDHostD_EXIT	; SKIP OUT IF ERROR
; NOW DONE TRANSFER
	CLRL	IOPROG	; SAY NO I/O IN PROCESS IF WE ARE FORCED TO EXIT
	JMP	EVTLOOP
; Come here to exit when we see io$_unload (i.e., dism/unload)
; Note we terminate the i/o so the driver cleans up too & is marked offline
awscram:
; exiting, so mark disk offline first
; First deassign the mailbox so the driver won't send us any more
; operations
        $dassgn_s chan=mbchn
; Now terminate the I/O for the user
        MOVL    #1,SETFD        ;TERMINATE I/O PACKET
        MOVL    BUFHDR+4,SETFD+8        ; BLOCK #
        MOVL    #1,SETFD+4      ;Set transfer direction=1, write, so
                                ;there will be no data copy needed at done
                                ; processing. For a real write the
                                ; data will have been copied in startio. Here
                                ; there's none to copy; we just want the
                                ; IRP to be returned.
        MOVL    #0,SETFD+12     ; NO. BYTES IN BUFFER
        MOVZWL  #SS$_NORMAL,SETFD+16    ; IOSB 1
        CLRL    SETFD+20        ; IOSB 2        ; ALWAYS SUCCESS
        movl    #setFDL,r4
        $qiow_s efn=#1,chan=vdchn, -
        iosb=iosb,func=#<io$_format+128>,p1=setFD,p2=R4
	CLRL	SETFD	;DECLARE/UNDECLARE
	PUSHAB	DESBLK		; ADDRESS OF DESBLK
	CALLS	#1,G^SYS$CANEXH	; CANCEL EXIT HANDLER
	clrl	setFD+4	;FLAG NOBODY HOME NOW
	clrl	setFD+8
	movl	#setFDL,r4
	$qiow_s efn=#1,chan=vdchn, -
	iosb=iosb,func=#<io$_format+128>,p1=setFD,p2=R4
	$DASSGN_S CHAN=VDCHN
	RET
; BE SURE WE DON'T LEAVE THE CHANNELS ASSIGNED TO THE DEVICES
; EITHER...
FDHostd_exit:
	tstl	ioprog		;i/o going on to fd:?
	beql	1$		;if not, just return
	brw	ioxit		;else clean up
1$:
	RET
;

; 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
; Obtains host's PID, and also sets up correct size in driver UCB
; both by cylinder and by block.
	.if	df,$$xdt
	jsb	g^ini$brk	;call xdt
	.endc
	.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)
;;; (gets it in internal form, just as needed)
	.endc
;;; NEED IPID FOR DRIVER'S CALL TO SCH$POSTEF TO THIS HOST!!
	MOVL	PCB$L_PID(R4),OURPID	;;;SAVE OUR PID IN INTERNAL FORM
	JSB	G^SCH$IOLOCKW		;;; LOCK I/O DATABASE
	CLRL	HSTUCB			;;; ZERO "HOST" UCB
	tstl	clrcnt		;;;just zeroing count?
	bneq	126$
	movl	8(ap),r1		;;;get mailbox info first
	jsb	g^ioc$searchdev
	blbc	r0,59$			;;;on failure, give up
	movl	r1,mbucb		;;;store away mailbox UCB
126$:	MOVL	4(AP),R1		;;; ADDRESS VD NAME DESCRIPTORS
	JSB	G^IOC$SEARCHDEV		;;; GET UCB ADDRESS INTO R1
	BLBS	R0,60$
59$:	BRW	BSH_XIT
60$:
	movl	r1,vducb
	movl	12(ap),r1		; get host device ucb now
	jsb	g^ioc$searchdev		; look it up
	blbc	r0,59$			; bail out if none
	movl	r1,dvcucb		; else save it
	movl	r1,hstucb
	movl	ucb$l_maxblock(r1),hstfsz	;get device size
	incl	hstfsz			; store size for mainline
	mull2	#fd_bkfac,hstfsz	; make block count bigger by blkfac
	movl	hstfsz,hstfz
; 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.)
;
; Set device size. Since this is true of any disk, just use the offsets.
; No need for duplicating the UCB defs here.
	movl	vducb,r1
	tstl	clrcnt		;;;just zeroing use count
	beql	127$		;;;if eql, no, normal ops
	movl	#1,ucb$l_refc(r1)	;;;zero ref count (in case it got set -1)
;;; (note we set it to 1 so it decrements to 0 on our exit.)

; reset the buffer size so fddriver's internal buffer is matched
fdbuf=8192.
	movl	#fdbuf,ucb$l_maxbcnt(r1)	;;;reset max byte cnt
	tstl	ucb$irps(r1)	;;;is an I/O hanging and uncompleted?
	beql	159$		;;;if eql no
	incl	ioprog		;;;flag cleanup needed
	BISL	#UCB$M_ONLINE,UCB$L_STS(R1) ;;; FLAG ONLINE
	BISL	#UCB$M_VALID,UCB$L_STS(R1) ;;; AND VOL VALID
	brb	128$		;;; and do NOT leave offline yet
159$:	BICL	#UCB$M_ONLINE,UCB$L_STS(R1) ;;; FLAG OFFLINE
	BICL	#UCB$M_VALID,UCB$L_STS(R1) ;;; AND VOL INVALID
	brb	128$		;;;exit, success
127$:
;
	tstl	ucb$l_refc(r1)	;;;fix up stray ref counts
	bneq	140$		;;;
142$:	movl	#1,ucb$l_refc(r1)	;;;if it was 0, keep from getting 65535
	brb	141$
140$:
	cmpw	ucb$l_refc(r1),#65533	;;;small neg numbers also look bugus
	bgtru	142$			;;;so fix these up also
141$:
	MOVL	HSTFSZ,UCB$L_MAXBLOCK(R1) ;;; (SAVE SIZE TWICE, FOR RMS
	movl	dvcucb,r0
	movw	ucb$w_cylinders(r0),ucb$w_cylinders(r1)	;copy geom
	movb	ucb$b_tracks(r0),ucb$b_tracks(r1)
	movzbl	ucb$b_sectors(r0),r2
	mull2	#FD_BKFAC,r2		;multiply # sectors by blk factor
; hope that it never overflows.
	movb	r2,ucb$b_sectors(r1)
	movzbl	ucb$b_tracks(r1),xtrks
	movzbl	ucb$b_sectors(r1),xsect
	movzwl	ucb$w_cylinders(r1),xcyls
	BISL	#UCB$M_ONLINE,UCB$L_STS(R1) ;;; FLAG ONLINE NOW
	BISL	#UCB$M_VALID,UCB$L_STS(R1) ;;; AND VOL VALID
;;; THAT'S IT... SHOULD BE OK NOW.
128$:	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
; EXIT HANDLER
; CLEARS I/O ASSIGNMENT TO FD: UNIT
;
	.ENTRY	XITHDL,^M<R2,R3,R4,R5,R6>
ioxit:	TSTL	IOPROG
; Clean out any existing pending I/O with special call to FDdrv to
; finish it off.
	BEQL	1$
	MOVL	#1,SETFD	;TERMINATE I/O PACKET
	MOVL	BUFHDR,SETFD+4	;SAVE TRANSFER DIRECTION
	MOVL	BUFHDR+4,SETFD+8	; BLOCK #
	MOVL	BUFHDR+8,SETFD+12	; NO. BYTES IN BUFFER
	MOVZWL	#SS$_ACCVIO,SETFD+16	; IOSB 1
	CLRL	SETFD+20	; IOSB 2	; FAILURE
	movl	#setfdl,r4
	$qiow_s efn=#1,chan=vdchn, -
	iosb=iosb,func=#<io$_format+128>,p1=setfd,p2=R4
1$:
	CLRL	SETFD	;DECLARE/UNDECLARE
	PUSHAB	DESBLK		; ADDRESS OF DESBLK
	CALLS	#1,G^SYS$CANEXH	; CANCEL EXIT HANDLER
	clrl	setfd+4	;FLAG NOBODY HOME NOW
	clrl	setfd+8
	movl	#setfdl,r4
	$qiow_s efn=#1,chan=vdchn, -
	iosb=iosb,func=#<io$_format+128>,p1=setfd,p2=R4
; declare host no longer is home.
	RET			; FINISH EXIT
	.END FDHostD