.TITLE	FDHostJNL2 - VAX/VMS VIRT DISK Host Process (file disk)
;"Journalling" file disk.
; This host disk (based on fdhostboh) is a memory disk, but which
; is backed by a LAZY file disk. That is, the memory disk is current,
; but the data is backed up in bulk to the file disk every n minutes,
; n being 15 initially. This is a compromise between the normal memory
; disk and fdhostboh. The idea is the memory disk is too risky where one's
; electric power may fail, but the FDHOSTBOH variant can generate a lot
; of network traffic. By setting up bulk dumps of the memory array here
; to a disk file, we should be able to get an acceptable degradation
; of performance. The bulk dumps should just be spaced out.
; To avoid totally wasted I/O, we WILL keep track internally of
; writes, so that no dump will be done unless there has been SOMETHING
; written to the memory array since the last dump.
;
;	Because writing an entire virtual disk every 15 minutes seems
; a bit wasteful, keep track of blocks actually modified and ONLY write
; those out to the remote file. The bitmap is sized for a 500,000 block
; disk. We must assume that a larger global section than this is
; unlikely.
;
; This "version 2" mod will handle two files. The first file will
; be the container file as usual. The second will be a "journal"
; file. The idea is that incremental dumps to the data file
; will take place after the journal is written. Journal records
; will consist of 516 byte records: 4 bytes of LBN, then 512 bytes
; of the LBN contents. If a connection fails during write of the
; journal, the container will still have the last prior contents and
; be a valid filestructure. If the connection fails during an update
; of the container file, though, then the container file can be
; corrupt. However, it can be recreated by reading the journal
; file and re-applying the updates, getting to a valid disk
; configuration again. This gives a valid safeguard against power
; failures or net crashes at any time.
; A logical name is translated to get the second file spec. The
; journal file should ideally be on a local disk for speedy operation,
; but may be anywhere. Having these dual writes implies that there
; is no time point at which a crash can leave one with an unrepairable
; corrupt file structure.
;
	.IDENT	'V02-001'
;
; FACILITY:
; 
;This disk is meant as a "journaling" disk. It uses a file for storing
; a disk image, and sets up a global section to cover it, copies all
; data into the global section, and uses it as disk. Every 15 minutes
; or so it writes blocks in the global section that have been modified
; to the file, so the disk image in the file is correct.
;
; Command format:
; FDHost/switches VDn: filespec
;  where a .CLD file is expected so that this can all be parsed by
;  the CLI.
; This is a somewhat stripped down version of the FDHOST that goes to
; a file and encrypts it. No encryption is present, but the file exists
; and is treated as a disk. File is accessed as 512 byte records. Unlike
; VD: type virtual disks, these virtual disks' container files don't
; need to be contiguous since all I/O is done via RMS block I/O 512
; bytes at a time. No check is made that the disk is on the same machine
; with the driver, so virtual disks across DECnet may work. At any rate,
; nothing in here will prevent them from working.
;
; 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 vie exit AST.
;   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=1
;
; 
; AUTHOR:
; 
; G. EVERHART
;--
	.PAGE
	.SBTTL	EXTERNAL AND LOCAL DEFINITIONS

	.LIBRARY /SYS$SHARE:LIB/
; 
; 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

; 
; No need for direct UCB access here; this is done via the driver
; itself. We just worry about the files, etc.
; 

	$FIBDEF			; Symbols for file information block.
	$IODEF			; Symbols for QIO functions.
	$DVIDEF			; Symbols for $GETDVI calls.
	$TPADEF			; Symbols for LIB$TPARSE calls.
; 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/

	$ATRDEF
	$FABDEF
	$FATDEF
	$FIBDEF
	$IODEF
	$NAMDEF
	$RMSDEF
	$XABDEF
	.ALIGN LONG
DFAB_BLK: $FAB FNM=<FD0.DSK>,XAB=FNXAB,FAC=<BIO,GET,PUT>,DNM=<FDCONT.DSK>,rfm=fix,mrs=512
DRAB_BLK: $RAB FAB=DFAB_BLK,BKT=0,rbf=recbuf,UBF=RECBUF,USZ=512
	.align long
recbk:	.long	0	;block number (for journal)
RECBUF:	.BLKL	128	;512 BYTES = 128 LONGS
	.align long
bitmap:	.blkl	16384.	;giant bitmap, enough for 500000 block virtual disk.
bits:	.byte	1,2,4,8,16,32,64,128
;
	.align long
bintm:	.long	0,0
Intvl:	.ascid	/0 ::15.00/
	.align long
FNXAB:	$XABFHC	; XAB STUFF TO GET LBN, SIZE
	.BLKL	20 ;SAFETY
astflg:	.long	0	;flag we got an ast
dmpbsy:	.long	0	;flag currently doing a dump
; we use dmpbsy to allow dumps inside an AST if possible. It is
; set and cleared inside the data dumping routine, but looked at
; by the AST routine. If the AST routine finds the dumping is
; busy, it will just exit after rescheduling the next AST and
; NOT set the astflg flag. Thus we will avoid having an AST interrupt a
; dump taken by the mainline (and vice versa).
	.ALIGN LONG
IOSTATUS: .BLKQ 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
;^^^
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:

wrkstr:	.word	20
	.byte dsc$k_dtype_t ;text
	.byte 1	;static
	.address wrkdat
wrkdat:	.blkb 20	;data for string
	.long 0 ;safety
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
WRTFG:	.LONG 0		;nonzero if we wrote since dump
CLRDS:	.ASCID	/CLEAR/
KEYDS:	.ASCID	/KEY/	;CRYPTO KEY
;ASDSC:	.ASCID	/ASSIGN/
;DASDSC:	.ASCID	/DEASSIGN/
P1DSC:	.ASCID	/UNIT/
P2DSC:	.ASCID	/FNAM/
MBKD:	.ASCID	/MNTBLK/
	.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
;
MNTBLK:	.LONG	0
;
; Data area for "disk"
;
	.align long
; ucb data area
HSTUCB:	.LONG	0	;HOST UCB ADDRESS
;OURPID:	.LONG	0	;PID OF THIS PROCESS
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
;
vmsiz:	.long	0	;# bytes for lib$get_vm
vmloadr: .long	0	;low address of region
vmhiadr: .long	0	;high addr of region
vmblks:	.long	0	;# blks in region
;
	.PSECT	FDHostD_CODE,RD,WRT,EXE,LONG
	.ENTRY	FDHostD,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
	clrl	astflg		;set up no AST yet
	clrl	dmpbsy	;dump not initially busy
; 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$:
;we want the block that gets modified on mount and dismount.
	movl	#4,mntblk	;default flag blk 4 (seen in some virt dsks)
	pushab	mbkd		;mntblk=nn descriptor
	calls	#1,g^cli$present	;was it there?
	cmpl	r0,#cli$present		;if not skip rest
	beql	291$
	brw	292$
291$:
; saw /mntblk
	pushab	wrk	;longword for ret length
	pushab	wrkstr	;place for data
	pushab	mbkd	;which value to read
	calls	#3,g^cli$get_value ;get lbn val
	on_err fdhostd_exit
;string in wrkdat
	pushl	#17	;mask...ignore blanks
	pushl	#4	;4 bytes result
	pushab	mntblk	;where to store
	pushab	wrkstr	;string desc.
	calls	#4,g^ots$cvt_tu_l ;convert to binary
	on_err fdhostd_exit
292$:
	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
; OPEN THE FILE, CHECK ITS INITIAL LBN
; SET UP FOR FILENAME WE REALLY FOUND IN FAB...
	MOVL	DDFNA,DFAB_BLK+FAB$L_FNA	;SET UP FILENAME ADDR
	brb	1865$
1864$:	brw	149$
1865$:
	MOVB	DDFNM,DFAB_BLK+FAB$B_FNS	;AND LENGTH
	$OPEN	FAB=DFAB_BLK
	BLBC	R0,1864$		; FAILURE IF FILE WON'T OPEN
; FNXAB HAS INFO ON LBN, SIZE
;	MOVL	FNXAB+XAB$L_SBN,HSTLBN	; GET HOST'S LBN (0 IF NON CONTIG.)
	MOVL	FNXAB+XAB$L_HBK,HSTFSZ	; GET FILE SIZE. (CHECK THAT BELOW)
	DECL	HSTFSZ		;;;COUNT DOWN 1 TO ACCOUNT FOR BOOT BLOCK
	BICL2	#63,HSTFSZ	;;;MAKE A MULTIPLE OF 64 BLKS
	MOVL	HSTFSZ,HSTFZ		;FILE SIZE
	$CONNECT	RAB=DRAB_BLK	;FINISH OPEN
	BLBC	R0,1864$		; FAILURE IF FILE WON'T OPEN
; Get the region and if successful fill it in
	movl	hstfsz,r0	;size of disk
	ashl	#9,r0,r0	;shift over 9 bits for bytecount
	addl2	#1024,r0	;add a blk for good luck
	movl	r0,vmsiz	;save size needed
;	clrl	-(sp)
;	pushab	vmloadr		;return virt addresses
;	pushab	vmsiz		;length needed
;	calls	#3,g^lib$get_vm	;allocate mem
;lib$get_vm isn't designed for thousands of pages.
;use $expreg directly instead.
	clrl	-(sp)	;region 0 (p0 space)
	clrl	-(sp)	;access mode
	moval	vmloadr,-(sp)	;low/high address area
	movl	hstfsz,-(sp)	;size to cover
	addl2	#2,(sp)		;(+2 for safety)
	calls	#4,g^sys$expreg	;get some space
	BLBC	R0,1884$		; FAILURE If no region available
	subl3	vmloadr,vmhiadr,r0	;get address delta
	ashl	#-9,r0,r0	;convert to blocks
	cmpl	r0,hstfsz	;ensure we got enough
	bgtr	1866$
1884$:	brw	149$		; if less or =, too small
1866$:
; looks like adequate mem. obtained. Now fill it in initially with the
; contents of our backing file.
; (This avoids issues of catch-up mode)
; n.b. - The file operations would probably be faster if a virtual section were
; mapped to the file. However, this method uses less virtual page count and also
; is less likely to break over a network. A faster file access version may be
; forthcoming later.
	clrl	r10
	movl	vmloadr,r9	;start address of vm area
	movl	hstfsz,r8	;blocks in file
2950$:
	INCL	R10		;MAP TO VBN
	MOVL	R10,DRAB_BLK+RAB$L_BKT	;SET IT UP
	movw	#512.,drab_blk+rab$w_rsz ;512 byte blks
; LOOP OVER BLKS IN REQUEST
	$read	rab=drab_blk
	ON_ERR	FDHostD_EXIT	; SKIP OUT IF ERROR
; now move the data block to our buffer from recbuf
	movab	recbuf,r7
	movc3	#512,(r7),(r9)	;copy a block to vm area from record buffer
	addl2	#512,r9			;pass it
	sobgtr	r8,2950$		;do all blks
295$:
	clrl	wrtfg		;flag no writes yet
; 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$
149$:	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	#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
	calls	#0,g^setast1	; start up xx (nominal 15) min timer
; 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.)
;we don't write data direct from inside an AST to avoid possible
;race conditions with mainline. Always call disk writer from non
;AST level.
	tstl	astflg		;an AST seen?
	beql	1867$		;if none, go ahead and do next op.
	tstl	dmpbsy		;dumping already?
	bneq	1869$		;if so, skip another
	calls	#0,g^dump_dsk	;go dump out data to back store
1869$:	calls	#0,g^setast	;re-arm AST (even if dumping now)
1867$:	clrl	astflg
	$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 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	evtloop		;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	#1,wrtfg	;flag we have a write
	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
;	MOVAB	RECBUF,R4	;
; Code to allow dump of which block is written
; Condition IN to find which block is being modified on mount/dismount
; so you can thereafter set the modflg block to that.
	.if	df,blkprt
	tstl	dmpbsy		;don't re-enter fortran runtime
	bneq	1888$
;I don't see any way we could interrupt a dump, but an AST dump
; could try to interrupt this type-out. Since there's no
; guarantee the runtime system can handle that, inhibit AST
; from screwing around until this is done.
; NOTE this option should NEVER be conditioned in for a production
; use!
	movl	#3,dmpbsy	;flag no ast re-entry here please
	moval	bufhdr+4,-(sp)	;point at lbn data
	calls	#1,g^lbntyp	;call external sub to type the LBN
	clrl	dmpbsy
1888$:
	.endc	;blkprt
	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$:
; set bit for this block
	extzv	#3,#16,drab_blk+rab$l_bkt,r0	;get blk no.
	extzv	#0,#3,drab_blk+rab$l_bkt,r1	;get bit number
	bisb2	bits(r1),bitmap(r0)		;flag the bit on.
	movab	recbuf,r9	;data to here
	movl	r7,r8		;data from here
	.if	eq,1
	MOVC3	#512,(r8),(R9)	; STORE THE DATA IN OUR SPACE
	.endc
; write-thru cache... copy data to our memory area and file
	movl	vmloadr,r0	; data to here + blk#
	movl	drab_blk+rab$l_bkt,r3
	decl	r3		;memory offset starts at 0, not 1
	ashl	#9,r3,r3	;convert to offset
	addl2	r3,r0		;r0 is now addr to go to
	movl	r7,r8		;data from here
	movl	r0,r9
	movc3	#512,(r8),(r9)	;copy data to vm area
	.if	eq,1	;omit write to disk here
	$write rab=drab_blk
	ON_ERR	FDHostD_EXIT	; SKIP OUT IF ERROR
	.endc	;end of disk writing stuff
	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
;Test for write to blocks 0 or 1, in which case we dump all data.
; This should normally allow all data to be dumped in cases where
; the disk is (correctly) dismounted.
; (Note that by now the write is done to memory area.)
; Since the home block isn't where we flag, let that be a runtime
;determined thing, in mntblk. Default is 4.
	cmpl	bufhdr+4,mntblk	;this block 1 or less? (still LBN here)
	bneq	1420$		;if gtr no, normal operation
;aha...writing block 1 (done on mount or dismount for ODS2)
	tstl	dmpbsy		;dump busy now?
	bneq	1420$		;if so, skip reentering code
	calls	#0,g^dump_dsk	;flush everything to file
1420$:	JMP	COMMON
READOP:
; READING DATA TO CLIENT. MUST GET DATA, THEN SEND TO DRIVER.
	MOVL	BUFHDR+4,R0	;GET BLOCK NUMBER
	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
16$:
; performance win here... get data out of memory, not disk file.
	ashl	#9,r6,r6	;get bytes to move, rounded to blk boundary
	movl	vmloadr,r8	;start of vm region
	ashl	#9,r0,r4	;convert blk # to bytes
	addl2	r4,r8		;r5 now is area we're getting
	movc3	r6,(r8),(r7)	;copy the data to scratch buff
; (note: intermediate buffer used because of header...could be faster otherwise.)
	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
; BE SURE WE DON'T LEAVE THE CHANNELS ASSIGNED TO THE DEVICES
; EITHER...
	$DASSGN_S CHAN=VDCHN
	RET
FDHostd_exit:
	RET
	.globl	dump_memdsk
j1149$:	brw	k1149$
	.entry dump_memdsk,^M<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
; dump memory disk to file.
; Entered at AST level.
	movl	#1,astflg	;flag we got an AST
	tstl	dmpbsy		;is dumping going on?
	bneq	1871$		;if dumping, don't start another
	calls	#0,g^dump_dsk	;but if not, do one.
; This is done to allow a quiescent disk to be dumped at least
; once after the last activity.
1871$:	ret
	.entry dump_dsk,^M<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movl	#1,dmpbsy	;flag we're dumping
	tstl	wrtfg		;any writes?
	beql	j1149$		;no, skip dump
; do the dump
	clrl	r10
	clrl	r11		;r11 = phase (0=jnl write, 1=update)
	movl	vmloadr,r9	;start address of vm area
	movl	hstfsz,r8	;blocks in file
	calls	#0,g^opnjnl	;open journal file (in Fortran sub)
	movl	hstfsz,r0	;size of disk
	brb	3950$
6950$:	incl	r11
	movl	vmloadr,r9	;start address of vm area
	movl	hstfsz,r8	;blocks in file
	clrl	r10
	calls	#0,g^clsjnl	;close journal file
	movl	hstfsz,r0	;size of disk
3950$:
	INCL	R10		;MAP TO VBN
	MOVL	R10,DRAB_BLK+RAB$L_BKT	;SET IT UP
; set bit for this block
	extzv	#3,#16,drab_blk+rab$l_bkt,r0	;get blk no.
	extzv	#0,#3,drab_blk+rab$l_bkt,r1	;get bit number
	bitb	bits(r1),bitmap(r0)		;see if the bit is set
	beql	5149$		;if not, skip write
	tstl	r11		;pass 1? If so, don't clear bits.
	beql	6953$
	bicb2	bits(r1),bitmap(r0)		;clear this bit
6953$:
	movw	#512,drab_blk+rab$w_rsz ;512 byte blks
; LOOP OVER BLKS IN REQUEST
	movab	recbuf,r7
	movc3	#512,(r9),(r7)	;copy a block to record buffer from vm area
	tstl	r11		;phase I or II?
	bneq	4151$		;on pass II update the container file.
;phase I - write journal
	movl	r10,recbk	;stash block number just before data
	moval	recbk,-(sp)	;put address of block out
	calls	#1,g^wrtjnl	;write the journal file out
	brb	5149$		;skip container file update this pass
4151$:	$write	rab=drab_blk
	ON_ERR	K1149$	; SKIP OUT IF ERROR
; now move the data block to our buffer from recbuf
5149$:	addl2	#512,r9			;pass block we just wrote
	sobgtr	r8,7950$		;do all blks (goes to 3950$ via brw)
	tstl	r11
;	beql	6950$		;go to phase II if done phase I
	bneq	k1149$
	brw	6950$	;off to phase II when done phase I
7950$:	brw	3950$	;transfer point
k1149$:; calls	#0,g^setast	;re-arm AST (Nope; all calls from main lvl)
	clrl	wrtfg		;say no writes since this op (yet)
	clrl	dmpbsy		;not dumping any more
	RET
;
; KERNEL ARG LIST
K_ARG:
	.LONG	2	;2 ARGS: fd device name, mb device name
	.ADDRESS	VDV_BUF_DESC
	.address	mbx_buf_desc

; 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 DVC NAME DESCRIPTORS
	JSB	G^IOC$SEARCHDEV		;;; GET UCB ADDRESS INTO R1
	BLBS	R0,60$
59$:	BRW	BSH_XIT
60$:
; 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.
	tstl	clrcnt		;;;just zeroing use count
	beql	127$		;;;if eql, no, normal ops
	movw	#1,ucb$w_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.)
	BICW	#UCB$M_ONLINE,UCB$W_STS(R1) ;;; FLAG OFFLINE
	BICW	#UCB$M_VALID,UCB$W_STS(R1) ;;; AND VOL INVALID
	brb	128$		;;;exit, success
127$:
;
	tstw	ucb$w_refc(r1)	;;;fix up stray ref counts
	bneq	140$		;;;
142$:	movw	#1,ucb$w_refc(r1)	;;;if it was 0, keep from getting 65535
	brb	141$
140$:
	cmpw	ucb$w_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	HSTFSZ,R0		;;; GET HOST SIZE IN CYLINDERS
	ASHL	#-6,R0,R0		;;; GET # CYLINDERS IN SIZE NOW
	MOVW	R0,UCB$W_CYLINDERS(R1)	;;; SAVE IN UCB FOR REST OF VMS
; This computation is redone in fddrv itself, but do it here also.
; It assumes in fddrv that there are 64 sectors/cylinder.
	BISW	#UCB$M_ONLINE,UCB$W_STS(R1) ;;; FLAG ONLINE NOW
	BISW	#UCB$M_VALID,UCB$W_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
ourpid:	.long	0	;;;store this locally
CLRCNT:	.long	0	;1 if clearing ref cnt ucb$w_refc
;;;(avoid paging problems in kernel)
; EXIT HANDLER
; CLEARS I/O ASSIGNMENT TO FD: UNIT
;
	.ENTRY	XITHDL,^M<R2,R3,R4,R5,R6>
	TSTL	IOPROG
	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
	.globl	sys$bintim
	.entry SETAST1,^m<r2,r3,r4,r5,r6,r7,r8,r9,r10>
; Convert ascii interval time Intvl to binary bintm
	pushab	bintm		;address of binary time
	pushab	intvl		;address of string
	calls	#2,g^sys$bintim	;convert ascii time to binary
	tstl	bintm		;ensure not zero
	bneq	2$
	tstl	bintm+4
	beql	1$
2$:	calls #0,g^setast	;now setup the AST
1$:	Ret
	.globl sys$setimr
	.entry SETAST,^m<r2,r3,r4,r5,r6,r7,r8,r9,r10>
; set up AST for dump_memdsk using EFN 10
; if zero timer interval, don't set the AST up.
	tstl	bintm		;ensure not zero
	bneq	2$
	tstl	bintm+4
	beql	1$
2$:
	pushl	#10
	pushab	dump_memdsk
	pushab	bintm	;address of binary time
	clrl	-(sp)	;zero last word on stack
	calls	#4,g^sys$setimr	;set timer AST up
1$:	Ret
	.END FDHostD