.TITLE	ZRIDEHost - Alcita IDEplex host
	.IDENT	'V01-004a'
	.enable SUP	;suppress stuff not needed
; stuff to get alpha macro32 happy...
;
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 ZR: unit that will provide a 512 byte block device
; "on top of" disks hanging off an Alcita IDEplex. This configuration
; typically has not accurate enough mode page 1 and 8 support for
; DKdriver and prefers to operate in disconnect-disabled mode.
; Therefore this code is provided to give basic disk support for
; these creatures using io$_diagnose. This code will get the device
; size and take care of sending it SCSI START, create a workable
; fake geometry, and read and write blocks. If errors are seen it
; will return them. It will not support more elaborate commands like
; drive format.
;
.iif ndf,ZR.BLKSIZ,ZR.BLKSIZ=16384
ZR_BLKSIZ=ZR.BLKSIZ
ZR_BKFAC=ZR.BLKSIZ/512
;
; Command format:
; ZRHost/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.
;
; ZRHOST/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 ZRdrv would store somewhere, so that if this process exited the
; ZRdrv 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 ZR: unit being assigned will have ZRHOST/CLEAR
; run on the ZR: 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	ZRHostD_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=<ZR0.DSK>,XAB=FNXAB,FAC=<BIO,get,put>,rfm=fix,DNM=<ZRCONT.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	ZR_BLKSIZ
	.align long
	.long	0,0,0,0,0,0,0,0	;safety
dskchn:	.long	0	;scratch
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
SETZR:	.LONG	0	;DECLARE PROCESS
	.LONG	0	;PID
HSTFZ:	.LONG	1	;DISK SIZE (or blk number)
	.LONG	0,0,0,0	;EXTRA STUFF FOR OTHER CALLS
SETZRL=.-SETZR
	.LONG	0,0,0,0,0	;SAFETY
HSTFSZ:	.LONG	0	;DISK SIZE
zrbuf = 8192.	; size of our buffers in bytes
;
; KERNEL ARG LIST
K_ARG:
	.LONG	3	;3 ARGS: ZR device name, mb device name, host dvc
	.ADDRESS	VDV_BUF_DESC
	.address	mbx_buf_desc
	.address	dvc_buf_desc

	.psect	scsi_cmds,noexe,rd,wrt,long
; scsi buffer descriptors and the like
siosb:	.blkl	2		; iosb for scsi qiows
flags_write=0
flags_read=1
flags_disc=2
flags_synch=4
flags_asense=256

; buffer for io$_dsiagnose calls to VMS SCSI drivers
gkbuf:
gk_opcode:	.long	0	;opcode
gk_flags:	.long	0	;flags
gk_cmda:	.long	0	;cmd address
gk_cmdl:	.long	0	;cmd length
gk_data:	.long	0	;data address
gk_datal:	.long	0	;data length
gk_pad:		.long	0	;padding
gk_phtmo:	.long	0	;phase timeout
gk_disctmo:	.long	0	;disconnect timeout
gk_senseadr:	.long	0	;sense data addr
gk_senselen:	.long	0	;sense data length
gk_pad2:	.long	0,0,0,0
gk_len==.-gkbuf

scsistatmsk=62	;3e hex
inq_opcode=18	;12 hex inquiry opcode


; some command buffers. Note scsi commands expect quantities longer
; than bytes to be in big-endian order.
	.align long
c_inq:	.byte	18,0,0,0,36,0
	.align long
c_tur:	.byte	0,0,0,0,0,0
	.align long
c_reqs:	.byte	3,0,0,0,18,0	;req sense
	.align long
c_start: .byte	27,1,0,0,1,0	;start unit
	.align long
c_mdsns: .byte	26,0,16,0,150,0	;mode sense
	.align long
c_rdcap: .byte	37,0,0,0,0,0,0,0,0,0	;read capacity (10 byte cmd)
	.align long
c_mdsel: .byte	21,16,0,0,12,0	;mode select
	.align long
c_read:	.byte	8,0,0,0,0,0	;read data
	.align long
c_wrt:	.byte	10,0,0,0,0,0	;write data
	.align long
;c_rdcap: .byte	37,0,0,0,0,0	;read capacity (reads 8 bytes data in)
;	.align long

; macro to zero an area
        .macro  zapz    addr,size
        pushr   #^m<r0,r1,r2,r3,r4,r5>  ;save regs from movc5
        movc5   #0,addr,#0,size,addr
        popr    #^m<r0,r1,r2,r3,r4,r5>  ;save regs from movc5
        .endm
s_buf:	.blkb	2048		; data area
s_bufnum:
blksz:	.long	512		; size of a disk block
s_bufno: .long	0		; blk number of buffer (2048 byte based)
s_snsb:	.blkb	512		; sense data if any

; macro to issue a scsi command
	.macro	docmd chan,cmd,cmdlen,data,datalen,?s1
	movab	s_snsb,r0
        pushr   #^m<r0,r1,r2,r3,r4,r5>  ;save regs from movc5
        movc5   #0,(R0),#0,#512,(R0)
        popr    #^m<r0,r1,r2,r3,r4,r5>  ;save regs from movc5
	movab	gkbuf,r0	; zero buffer reserved stuff too
        pushr   #^m<r0,r1,r2,r3,r4,r5>  ;save regs from movc5
        movc5   #0,(R0),#0,#gk_len,(R0)
        popr    #^m<r0,r1,r2,r3,r4,r5>  ;save regs from movc5
	movl	#1,gk_opcode	; diagnose opcode
	movl	#<7+256>,gk_flags ;read,disc, synch, autosense
	movab	cmd,gk_cmda	; store cmd address
	movl	cmdlen,gk_cmdl
	movab	data,gk_data	;data address
	movl	datalen,gk_datal ; data length in bytes
	movl	#25,gk_phtmo	; phase timeout and 
	movl	#25,gk_disctmo	; disconnect timeout both 25 sec.
	movab	s_snsb,gk_senseadr
	movl	#200,gk_senselen	;don't overdo sense length!
;
; things are set up.
;
; now do the io$_diagnose $qiow. Use event flag 23
	clrl	-(sp)		;p6
	clrl	-(sp)		;p5
	clrl	-(sp)		;p4
	clrl	-(sp)		;p3
	movl	#gk_len,-(sp)	;p2
	movab	gkbuf,-(sp)	;p1
	clrl	-(sp)		;astprm
	clrl	-(sp)		;astadr
	movab	s_iosb,-(sp)	;iosb address
	movl	#io$_diagnose,-(sp)	; function
	movzwl	chan,-(sp)	; channel
 .iif ndf,s_efn, s_efn=23
	movl	#s_efn,-(sp)	; event flag
	movl	sp,r1		; cmd blk address in r1
	calls	#12,g^sys$qiow	; issue qiow$s call
; on return r0 has status
	blbc	r0,s1		; if it fails signal caller in r0
; qio looked ok. check status
	movzbl	s_iosb+3,r1	; get scsi status
	bicl	#^Cscsistatmsk,r1	; zap out all but bad bits
; nonzero means some kind of error
	beql	s1
; nonzero scsi status so return in r0
	movl	r1,r0
s1:
	.endm


;;;(avoid paging problems in kernel)
	.PSECT	ZRHostD_CODE,RD,WRT,EXE,LONG
	.ENTRY	ZRHostD,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
; only ZRn: 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	ZRHostD_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	ZRhostd_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	ZRhostd_EXIT
; Load name info for the knl routine to get
	$GETDVIW_S -
		CHAN=ddchn,-	; Command line has device name.
		ITMLST=DVC_ITEM_LIST
	on_err	ZRhostd_exit

; Issue a scsi start on the device to get it going.
; call dsk_setup(chan, maxblk, cyl, sect, trk, blksz)
	movab	blksz,-(sp)	; block size of device
        movab	xtrks,-(sp)	
        movab	xsect,-(sp)	; (faked but workable)
        movab	xcyls,-(sp)	; to get geometry after start
        movab	hstfsz,-(sp)	; set up args
        movzwl	ddchn,-(sp)
	calls	#6,g^dsk_setup	; go start disk and read size, get geom.
	ON_ERR zrhostd_exit
	movl	hstfsz,hstfz
	bleq	zrhostd_exit	;lose if 0 or negative.
;
295$:
; MUST HAVE ASSIGNMENT TO VD: UNIT IN ANY CASE. (Actually, ZR unit here)
	$ASSIGN_S -
		DEVNAM=VDFNM,-	; GET CHANNEL FOR VDn:
		CHAN=VDCHN
	ON_ERR	ZRHostD_EXIT	; SKIP OUT IF ERROR
	$GETDVIW_S -
		CHAN=vdchn,-	; Command line has device name.
		ITMLST=VDV_ITEM_LIST
	BLBS	R0,140$
	BRW	ZRHostd_EXIT
140$:
	tstl	clrcnt
	bneq	162$		;if just clearing ref count, no need for mbx
; We communicate with the virt disk device with a mailbox which we had better
; set up!!!
; Set up mailbox channel
	$crembx_s prmflg=#0,chan=mbchn,maxmsg=#32000,bufquo=#64000,-
		promsk=#0
	On_ERR	ZRhostd_exit
; need to get UCB address here somehow...
	$GETDVIW_S -
		CHAN=mbchn,-	; Command line has device name.
		ITMLST=mbx_item_list
	BLBS	R0,176$
161$:	BRW	ZRHostd_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,SETZR+4	;STORE PID (IPID!!!)
	movl	HSTFSZ,setZR+8	;size of disk (preset also)
	movl	mbucb,setZR+12		; Comm mailbox UCB address
	CLRL	SETZR		; flag that this is the setup
	movl	xtrks,setZR+16
	movl	xsect,setZR+20
	movl	xcyls,setZR+24	;replicate desired geometry as well as size
	movl	#setZRl,r4	; length of buffer
; Note we must modified func code from io$_format to something with
; a modifier bit set so ZRDRV will treat this as OUR special QIO.
	$qiow_s efn=#1,chan=vdchn, -
	iosb=iosb,func=#<io$_format+128>,p1=setZR,p2=R4
	ON_ERR	ZRHostD_EXIT	; SKIP OUT IF ERROR
	clrl	ioprog		; no i/o in progress yet
	movl	#-1,s_bufnum	; be sure we read initial buffer
; now we're ready to await work from the driver
EVTLOOP:
; When ZRDRV 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	ZRHostD_EXIT	; SKIP OUT IF ERROR
;	$qiow_s efn=#1,chan=vdchn,func=#io$_format,p1=#setZR,p2=#setZRl
;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
; First, get the data from the user buffer which zrdriver has copied for us.
; zrdriver is pointed to by vdchn here. It has a buffer for its data and will
; have copied the user data for us into it. We use this FDT-time function to
; get it to give us a copy of this. Essentially we should never get errors
; on this $qio.
	.if	ndf,xcldbg
	cmpl	#2000,bufhdr+4
	bneq	701$
	movl	bufhdr+8,r4 ;something to break on
701$:
	.endc
	MOVL	#20,SETZR+8	;BUFFER HEADER size
	ADDL2	BUFHDR+8,SETZR+8	;SO ADD HEADER SIZE
	MOVL	#3,SETZR	;GET DATA
	MOVL	#BUFHDR,SETZR+4	;BUFFER HDR ADDRESS
	movl	#1,setZR+12	;success indicator
	movl	#setZRl,r4
	$qiow_s efn=#1,chan=vdchn, -
	iosb=iosb,func=#<io$_format+128>,p1=setZR,p2=R4
	ON_ERR	wrterr	; SKIP OUT IF ERROR
;;;;	$qiow_s efn=#1,chan=vdchn,func=#io$_format,p1=#setZR,p2=#setZRl
; LOADS DATA INTO LOCAL BUFFER FROM DRIVER
; NOW HAVE TO MOVE IT INTO STORAGE HERE
 	MOVL	BUFHDR+4,R8	;GET BLOCK NUMBER
;	movw	#512.,drab_blk+rab$w_rsz ;512 byte blks (leftover code; dyke it out.)
; Buffer brought in from driver to "buf" here in our space,
; so now write to the actual disk.
	movl	bufhdr+8,r6	;get bytecount to move
	movab	buf,r7		;scratch buffer address
; 
; Add a bit of check for too-large writes
	cmpl	r6,#zrbuf	; is the write too large for us?
	bleq	1$		; if leq no, all looks ok
	brw	wrterr		; if gtr yes, write is too big, flag error!!!
1$:
	movab	dskchn,-(sp)	; scratch
	movl	r8,-(sp)	; LBN
	movl	r6,-(sp)	; bytes to move (glue code converts to blks)
	movab	buf,-(sp)	; where data to write is
	movzwl	ddchn,-(sp)	; pass host device channel
; now send the data to the device. Code will handle large buffers but cannot go
; beyond what we have stored. CARE.
	calls	#5,g^write_gk_blk
	on_err	wrterr		; if write fails act like it is writelock

	JMP	COMMON
READOP:
; READING DATA TO CLIENT. MUST GET DATA, THEN SEND TO DRIVER.
; Presume we limit read/write to 16KB in the driver and handle that
; much or less here.
	MOVL	BUFHDR+4,R8	;GET BLOCK NUMBER
	movl	bufhdr+8,r6	;get bytecount to move
; read into "buf" which has 32k bytes and send to driver
; note we transfer 1 block at a time.
	movab	dskchn,-(sp)	; use as loc for transfer length
	movl	r8,-(sp)	; start LBN
	movl	r6,-(sp)	; bytes to move
	movab	buf,-(sp)	; data area
	movzwl	ddchn,-(sp)	; pass channel by value
	calls	#5,g^read_gk_blk

; on error...

	ON_ERR	ZRHostD_EXIT	; SKIP OUT IF ERROR
	movab	buf,r2
	ADDL3	#20,BUFHDR+8,SETZR+8	; GET LENGTH TO XFER
	MOVL	#BUFHDR,SETZR+4	;BUFFER HDR ADDRESS
	MOVL	#2,SETZR	;HOST TO DRIVER COPY
	movl	#setZRl,r4
	movl	#1,setZR+12	;success...
	movl	bufhdr+8,setZR+16	;/length sent
	$qiow_s efn=#1,chan=vdchn, -
	iosb=iosb,func=#<io$_format+128>,p1=setZR,p2=R4
	ON_ERR	ZRHostD_EXIT	; SKIP OUT IF ERROR
; NOW DATA IS IN DRIVER SPACE AS REQUIRED
COMMON:
; NOW TERMINATE THE I/O AND AWAIT MORE WORK.
; This frees the buffer in zrdriver and lets the next operation begin.
	MOVL	#1,SETZR	;TERMINATE I/O PACKET
	MOVL	BUFHDR,SETZR+4	;SAVE TRANSFER DIRECTION
	MOVL	BUFHDR+4,SETZR+8	; BLOCK #
	MOVL	BUFHDR+8,SETZR+12	; NO. BYTES IN BUFFER
	MOVZWL	#SS$_NORMAL,SETZR+16	; IOSB 1
; store bytes we transferred in iosb also.
	movw	bufhdr+8,setzr+18	; fill in byte count as word
; NOTE we assume never to have more than a word of bytecount here!!!
	CLRL	SETZR+20	; IOSB 2	; ALWAYS SUCCESS
	movl	#setZRl,r4
	$qiow_s efn=#1,chan=vdchn, -
	iosb=iosb,func=#<io$_format+128>,p1=setZR,p2=R4
	ON_ERR	ZRHostD_EXIT	; SKIP OUT IF ERROR
; NOW DONE TRANSFER
	CLRL	IOPROG	; SAY NO I/O IN PROCESS IF WE ARE FORCED TO EXIT
	JMP	EVTLOOP
; wrterr is called when errors occur on write. It reports these as write-lock
; errors (the most common case) and tries to continue.
wrterr:
	movl #1,setzr
        MOVL    BUFHDR,SETZR+4  ;SAVE TRANSFER DIRECTION
        MOVL    BUFHDR+4,SETZR+8        ; BLOCK #
        MOVL    BUFHDR+8,SETZR+12       ; NO. BYTES IN BUFFER
        MOVZWL  #SS$_WRITLCK,SETZR+16    ; IOSB 1
        CLRL    SETZR+20        ; IOSB 2        ; ALWAYS write-lock
        movl    #setZRl,r4
        $qiow_s efn=#1,chan=vdchn, -
        iosb=iosb,func=#<io$_format+128>,p1=setZR,p2=R4
        ON_ERR  ZRHostD_EXIT    ; SKIP OUT IF ERROR
        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,SETZR        ;TERMINATE I/O PACKET
        MOVL    BUFHDR+4,SETZR+8        ; BLOCK #
        MOVL    #1,SETZR+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,SETZR+12     ; NO. BYTES IN BUFFER
        MOVZWL  #SS$_NORMAL,SETZR+16    ; IOSB 1
        CLRL    SETZR+20        ; IOSB 2        ; ALWAYS SUCCESS
        movl    #setZRL,r4
        $qiow_s efn=#1,chan=vdchn, -
        iosb=iosb,func=#<io$_format+128>,p1=setZR,p2=R4
	CLRL	SETZR	;DECLARE/UNDECLARE
	PUSHAB	DESBLK		; ADDRESS OF DESBLK
	CALLS	#1,G^SYS$CANEXH	; CANCEL EXIT HANDLER
	clrl	setZR+4	;FLAG NOBODY HOME NOW
	clrl	setZR+8
	movl	#setZRL,r4
	$qiow_s efn=#1,chan=vdchn, -
	iosb=iosb,func=#<io$_format+128>,p1=setZR,p2=R4
	$DASSGN_S CHAN=VDCHN
	RET
; BE SURE WE DON'T LEAVE THE CHANNELS ASSIGNED TO THE DEVICES
; EITHER...
ZRHostd_exit:
	tstl	ioprog		;i/o going on to ZR:?
	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	#ZR_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 ZRdriver's internal buffer is matched
ZRbuf=8192.
	movl	#ZRbuf,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$:
; reset the buffer size so ZRdriver's internal buffer is matched
ZRbuf=8192.
	MOVL	HSTFSZ,UCB$L_MAXBLOCK(R1) ;;; (SAVE SIZE TWICE, FOR RMS
	movl	dvcucb,r0
; leave geom alone here. We get it explicitly.
;	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	#ZR_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
	cmpl	ucb$l_maxbcnt(r1),#zrbuf	; set max bytecount small enough
	bleq	2141$				; for us to use if not ok now
	movl	#zrbuf,ucb$l_maxbcnt(r1)
2141$:
	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 ZR: UNIT
;
	.ENTRY	XITHDL,^M<R2,R3,R4,R5,R6>
ioxit:	TSTL	IOPROG
; Clean out any existing pending I/O with special call to ZRdrv to
; finish it off.
	BEQL	1$
	MOVL	#1,SETZR	;TERMINATE I/O PACKET
	MOVL	BUFHDR,SETZR+4	;SAVE TRANSFER DIRECTION
	MOVL	BUFHDR+4,SETZR+8	; BLOCK #
	MOVL	BUFHDR+8,SETZR+12	; NO. BYTES IN BUFFER
	MOVZWL	#SS$_ACCVIO,SETZR+16	; IOSB 1
	CLRL	SETZR+20	; IOSB 2	; FAILURE
	movl	#setZRl,r4
	$qiow_s efn=#1,chan=vdchn, -
	iosb=iosb,func=#<io$_format+128>,p1=setZR,p2=R4
1$:
	CLRL	SETZR	;DECLARE/UNDECLARE
	PUSHAB	DESBLK		; ADDRESS OF DESBLK
	CALLS	#1,G^SYS$CANEXH	; CANCEL EXIT HANDLER
	clrl	setZR+4	;FLAG NOBODY HOME NOW
	clrl	setZR+8
	movl	#setZRl,r4
	$qiow_s efn=#1,chan=vdchn, -
	iosb=iosb,func=#<io$_format+128>,p1=setZR,p2=R4
; declare host no longer is home.
	RET			; FINISH EXIT
	.END ZRHostD