.TITLE	ZRHostcry - AXP/VMS VIRT DISK Host Process (crypto disk)
; Handles disk-on-noncontig file with a scramble-data option for
; some limited privacy.
	.IDENT	'V02-004a'
	.enable SUP	;whatever this does
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!
; changes :
; Mods to key generation algorithm to allow for
;  1. Longer base keys (128 blocks, not 32)
;  2. Better "confusion propagation" by not using the same CRC
;	we start with as part of what we XOR everything with.
;  3. Somewhat better confusion factor added to guard against
;	someone who tries known plaintext attack by doing a
;	better job randomizing the block number based part
;	of messing up the data.
;
;  It occurred to me that the fdhostcry2 host had a basic key generated
; from a known CRC polynomial series, modified by further XORs with
; other known CRCs and an XOR of the product of block number with
; part of the generated key, further confused by having the key order
; picked by yet another blocknumber * part of key product.
;
;   The potential codebreaker will know much of the cleartext of a valid
; ODS2 disk, so can probably figure out the cipher too easily. I don't
; know how exactly, but suspect this.
;   Therefore, the algorithm now generates a CRC of the key and uses
; parts of it for part of the CRC polynomial used to fill in 128 blocks
; worth of key xor data, and another part for the interval between
; CRC polynomials used. Thus the potential codebreaker now lacks a priori
; knowledge of the main CRC polynomial and interval used. By making the
; block number product larger, he now must handle a far larger block
; range also. I also have added another byte out of the key to the
; input block number prior to using it, so block zero is not guaranteed
; to use the first key block as before, but can use any of them.
;   This should make a cracker's life more difficult. Since this stuff
; is mainly done at setup time, the cryptodisk is still reasonably
; fast. One can of course obtain, say, a DES implementation (the Finnish
; one and variants of the 1977 ham radio one are widely available on
; networks and have appeared in the usenet) and use that. It can
; either replace these algorithms, or be used to re-encrypt the
; ciphertext. Software DES is quite slow, though, and this is probably
; NOT a good idea. That's why no special hooks are provided. Remember
; that a shared machine cannot be totally safe from people with privs
; and that the essential ingredient to using a cryptodisk is to be
; watchful of privilege use while data is in use on the cryptodisks.
;
; FACILITY:
; 
; Host process for FD: unit that uses a disk file as an encrypted virtual
; disk. The disk file and encryption key must be specified.
; The file need not be contiguous. 
;
; 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.
;
; 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
;  5/17/1989 - Added stronger encryption logic. Still not incredibly
; strong, but at least more resistant to decryption by inspection.
; Algorithm is now good enough that I can't see any easy way to break it,
; even given the code, without a very long disk and lots of time. Thus I
; now consider it adequate for protecting sensitive information.  Remember:
; your systems guy may be very very GOOD at his job, but it still might not
; be a good idea for him to be able to print out the payroll file. This
; device is designed to help you keep him from being tempted. *I* find it
; good to know that some information on the system is secure and I cannot
; be blamed for any disclosures of it.
;
; 3/29/90 - Longer keys etc.
;  Resulting cryptodisks are not compatible with the 
; fdhostcry2 versions, so don't mix them up.  
;-- .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
;
FNXAB:	$XABFHC	; XAB STUFF TO GET LBN, SIZE
	.BLKL	20 ;SAFETY
	.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:

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
fd_cyl=5		;make it 5 cyls of 64 blocks each
fd_blocks=fd_cyl*64	; blocks...
fd_longs=fd_blocks*128	; longwords needed
;fd_data::
;	.BLKL fd_longs
;	.blkl	128	;guard area for safety during debug...
; 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	2	;2 ARGS: fd device name, mb device name
	.ADDRESS	VDV_BUF_DESC
	.address	mbx_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
;	$ASSIGN_S -				; Get a channel to the 
;		DEVNAM=DDFNM,-		; device for host file
;		CHAN=DDCHN
;	ON_ERR	fdhostd_EXIT
; 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
	brb	159$
149$:	brw	fdhostd_exit
159$:
	$OPEN	FAB=DFAB_BLK
	BLBC	R0,149$		; FAILURE IF FILE WON'T OPEN
; FNXAB HAS INFO ON LBN, SIZE
;	MOVL	FNXAB+XAB$L_SBN,HSTLBN	; GET HOST'S start LBN (0 IF NON CONTIG.)
	MOVL	FNXAB+XAB$L_HBK,HSTFSZ	; GET FILE SIZE. (CHECK THAT BELOW)
; No need to decrement size, but must make it a multiple of 64
; blocks for a 64-sector geometry.
;	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,149$		; FAILURE IF FILE WON'T OPEN
	PUSHAB	keyds	; 'KEY'
	clrl	kyfnmd	;zero out key info initially
	clrq	binkey	;null binary key also
	clrl	weakflg	;zero "weak" flag
	CALLS	#1,G^CLI$PRESENT	; IS /KEY USED?
	CMPL	R0,#CLI$_PRESENT	; IF EQ YES
	bneq	295$			; if no /key given, ignore
	PUSHAB	WRK		; GET LONGWORD FOR LEN of key
	PUSHAB	KYFNM		; & ITS DESCRIPTOR
	PUSHAB	KEYDS		; & PARAMETER NAME 'KEY'
	CALLS	#3,G^CLI$GET_VALUE	; GET FNM
	ON_ERR	fdhostd_EXIT
; now kyfnmd should contain data of key string as text
	movl	wrk,kyfnm	;store data length of returned string
	jsb	keyset		;set up key binary
; Now test for possible specified "weak" flag and save the info for our crypt/decrypt
; routines.
	pushab	weakds	;'weak'
	calls	#1,g^cli$present	;did user say /weak ?
	cmpl	r0,#cli$_present	;if neql no
	bneq	295$			; so branch if no /weak seen
	incl	weakflg
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	#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 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	#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
	pushl	r6
	movl	drab_blk+rab$l_bkt,r6	;pass block number to crypt
	jsb	crypt		;encrypt recbuf
	popl	r6		;don't bash r6
	$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
	pushl	r6
	movl	drab_blk+rab$l_bkt,r6	;pass block number to crypt
	jsb	decrypt		; decrypt recbuf
	popl	r6
	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
; BE SURE WE DON'T LEAVE THE CHANNELS ASSIGNED TO THE DEVICES
; EITHER...
	$DASSGN_S CHAN=VDCHN
	RET
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 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.
	cmpl	#^xA9876543,ucb$l_sanity(r1)	;check we really have zrdriver
	beql	56$
	movl	#ss$_illiofunc,r0
	brw	bsh_xit
56$:
	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	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.
	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
	.PSECT	CRY_DATA,RD,WRT,NOEXE,LONG

;
; Encrypt / Decrypt routines
; Inputs:
;  Key string in KYFNMD, length in KYFNM
;  3 entries:
;
; KEYSET builds a binary key from the data entered
; Crypt encrypts 512 byte RECBUF in place
; Decrypt decrypts 512 byte RECBUF in place
;
; All are called by JSB and assume registers saved/restored as used.
polygw:	.long	2	;2 args
	.address	polyw
wta:	.address	crcwrk
polyw:	.long	0		;scratch copy of crc poly
crcwrk:	.blkl	16		;crc working table
binkey:	.long	0,0
jkkey:	.long	0	;junk key
jkadd:	.long	0	;amt to add to polynomials
crcjk:	.long ^XDE683251	; random poly
crcpo:	.long ^XEDB88320	;AUTODIN POLY
;crcta:	.address	crcpo
crcp1:	.long ^XBACC8010
;CRCTB:	.ADDRESS	CRCP1
crck:	.long ^xf03ba241	;random crc
crcv:	.long ^xf03ba200
;crcvt:	.address	crcv
crctab:	.blkl	128	;storage for "variable" crc xor
	.blkl	3968	;total 4096 longs = 32 blocks
	.blkl	12288	;another 96 blocks worth (total 128)
	.long	0	;safety
crcblk:	.long	0
keyblk:	.long	0
	.PSECT	Cry_CODE,RD,WRT,EXE,LONG
Keyset: .jsb_entry
	pushr	#^M<r0,r1,r2,r3,r4,r5,r6,r7,r8,r11>
	clrq	binkey
;just for now, assume data's numeric ascii & convert to
;CRC
; Use autodin CRC and another random CRC to get 64 bits from the key
; entered. This allows a fairly fast crypt/decrypt operation though
; security is not high. Nevertheless, it should keep random browsers
; out, even with privs, unless they enjoy lots of decrypting.
; If the user specified "/WEAK", the algorithm will use a simple XOR
; derived from the key. However, if not, this routine will compute another
; 512 bytes of random CRCs of the key and the crypt and decrypt routines
; will XOR with these also. This will mean that in general the same data
; quadword in the data buffer will crypt to something different. To further
; prevent decryption-by-inspection, the block number will be passed to the
; crypt and decrypt routines in r6. This will be multiplied by a constant (that
; depends on the key so that the pattern will be obscured a bit) and the data will
; again be XORed with the (block # * const) product. This means that identical
; blocks will NOT have identical ciphertext. The resulting cipher should be
; adequate against folks who don't know the algorithm. Given the algorithm and
; enough time, one could probably figure out the key to the file, but it will
; be quite difficult. To make matters even harder, the key table will be made
; 32 blocks long and the block used on each disk block will derive from the disk
; block number times ANOTHER constant which depends on the key.
;
	movab	crcwrk,r11
	clrl	binkey
	clrl	binkey+4
	movl	crcjk,polyw	;set up 1st poly
	callg	g^polygw,g^lib$crc_table
	movl	kyfnm,r5
	beql	1$
	movab	kyfnmd,r6	;data addr
	crc	(r11),#-1,r5,(r6)
	movl	r0,jkkey	;save crc from nonstd poly.
	movl	crcpo,polyw	;set up 1st poly
	callg	g^polygw,g^lib$crc_table
	movl	kyfnm,r5
	beql	1$
	movab	kyfnmd,r6	;data addr
	crc	(r11),#-1,r5,(r6)
	movl	r0,binkey
	movl	crcp1,polyw	;next poly to make tbl for
	callg	g^polygw,g^lib$crc_table
	crc	(r11),#-1,r5,(r6)	;another crc
	movl	r0,binkey+4
1$:
	movab	crctab,r6
	addl2	#32768,r6
	clrl	r7
	clrl	(r6)
	movc5	#0,(r6),r7,#32768,(r6)	;zero xor key area out
	movab	crctab,r6
	clrl	r7
	clrl	(r6)
	movc5	#0,(r6),r7,#32768,(r6)	;zero xor key area out
	tstl	weakflg		;/weak key?
	bneq	4$		;if so use weak algorithm
	movl	#16384,r7
	movab	crctab,r6		;fill in tbl of crc's
; It is barely conceivable someone might be able to find and filter
; out the "weak" key CRCs and filter that stuff out of the data here.
; The 32 block values all derive from the same initial CRC polynomial,
; so this seems like a possible weakness. Therefore, we generated a
; CRC which is never used in the actual XOR'd pattern, but parts of the
; result are used to generate some of the CRC polynomial that IS used
; to produce each CRC, and another bit of it is used to generate the
; interval between these generating polynomials. Thus an error in the
; initial CRC cascades in uncertainty faster than if the CRCs here
; all were made from a known polynomial series. Not being a cryptologist,
; I have no idea how one might penetrate even the old cipher, but
; it seems good to deny a code cracker even the knowledge of the
; initial polynomials being used.
	movl	crck,crcv		;init crc tbl
	movw	jkkey+1,crcv+1		;replace middle 16 bits of
				; crc polynomial with 16 bits of CRC from
				; our key, so the new polynomials all depend
				; on the key also.
	movzbl	jkkey,jkadd	; get amount to add to our next CRC polynomial
	addl2	#5,jkadd	; and make sure it is never zero
2$:	movl	crcv,polyw		;make next crctbl
	callg	g^polygw,g^lib$crc_table
;now wrk tbl reflects this polynomial
	movl	kyfnm,r5
	beql	4$
	movab	kyfnmd,r8
	crc	(r11),#-1,r5,(r8)
	movl	r0,(r6)+
	addl2	jkadd,crcv		;bump crc polynomial by some amount
				; derived from original key.
	sobgtr	r7,2$		;do 4096 of them (32 blocks altogether)
; now have 512 bytes of crc.
4$:
	;v004a mod
; NOW for safety zero out the key area
; that way nobody can peer into our address space and find the originally
; entered key.
	clrl	r7
	movab	kyfnmd,r6
	movc5	#0,(r6),r7,#255,(r6)	; zero 255 bytes of key
	;end v004a mod
	popr	#^M<r0,r1,r2,r3,r4,r5,r6,r7,r8,r11>
	rsb
; at entry to crypt, block number is in r6
Crypt: .jsb_entry
	pushr	#^M<r0,r1,r2,r3,r4,r5,r6>
; sneaky... don't use blk number, but multiply it first. Ignore overflow
	movzbl	crctab+184,r5
	addl2	r5,r6		; add something to blk # first so blk 0 is
				; not known either
	movzbl	crctab,r5	;get byte out of keytbl
	bneq	7$
	movl	#211,r5
7$:
	mull3	r6,r5,crcblk
; get some multiple of the block
; now extract a bit of it and xor the block with the CRC code so
; that we are not doing anything affine and hence readily
; invertible.
	movl	crcblk,r5
	bicl2	#^xffff0003,r5	;make a longword offset
; get crctab
	movl	crctab(r5),r5	;get crc table info
	xorl3	r5,crctab+202,r5	;xor with something
	xorl3	crcblk,r5,crcblk	;xor crcblk with both
; now crcblk is not just const + n*blk number
; (WHICH is affine). Rather it is fairly well randomized. The
; xor with a constant here is to scramble the result so that
; the whole transform won't be affine and therefore it'll be harder
; even with known plaintext to figure out the working key (i.e., the
; 128 blocks worth of key).
	movzbl	crctab+514,r5
	bneq	8$	;don't mult by zero
	movl	#51,r5
8$:
	mull3	r6,r5,r5	;convert blk# to hashcode
	bicl2	#^xffffff80,r5	;zero all but low 7 bits (now 0-127)
	ashl	#9,r5,r5	;convert to byte offset in long table (now 0-15872 in 512 incr.)
	movl	r5,keyblk	;store offset into crctab here
	tstl	weakflg		;/weak algorithm?
	beql	5$		;if eql no
	clrl	crcblk		;if weak, noblock number dependency
5$:
	movl	#64,r6		;64 * 8 = 512 bytes
	movab	recbuf,r1	;address to start with
	movl	binkey,r2	;1st half of key
	movl	binkey+4,r3	;2nd half of key
	movab	crctab,r4	;variable crc tbl (or 0's)
	addl2	keyblk,r4	;add offset to block of keys to use
	movl	crcblk,r5	;get blk*const which serves to obscure what's going on
2$:	xorl3	(r1),(r4)+,(r1)
	xorl3	(r1),r5,(r1)
	xorl3	(r1),r2,(r1)+	;xor 1st half
	xorl3	(r1),(r4)+,(r1)
	xorl3	(r1),r5,(r1)
	xorl3	(r1),r3,(r1)+
	sobgtr	r6,2$
; buffer now transformed.
	popr	#^M<r0,r1,r2,r3,r4,r5,r6>
	rsb
; at entry to decrypt, block number is in r6
Decrypt: .jsb_entry
	pushr	#^M<r0,r1,r2,r3,r4,r5,r6>
	movzbl	crctab+184,r5
	addl2	r5,r6		; add something to blk # first so blk 0 is
				; not known either
	movzbl	crctab,r5
	bneq	7$
	movl	#211,r5		;ensure we don't multiply blk# by 0
;211 is prime.
7$:
	mull3	r6,r5,crcblk
; get some multiple of the block
; now extract a bit of it and xor the block with the CRC code so
; that we are not doing anything affine and hence readily
; invertible.
	movl	crcblk,r5
	bicl2	#^xffff0003,r5	;make a longword offset
; get crctab
	movl	crctab(r5),r5	;get crc table info
	xorl3	r5,crctab+202,r5	;xor with something
; Notice the crctab+202 is a halfword (16 bit) offset, not a
; longword aligned offset. This increases randomness a bit
; when we xor this with the crctab(r5) offset.
	xorl3	crcblk,r5,crcblk	;xor crcblk with both
; now crcblk is not just const + n*blk number
; (WHICH is affine). Rather it is fairly well randomized. The
; xor with a constant here is to scramble the result so that
; the whole transform won't be affine and therefore it'll be harder
; even with known plaintext to figure out the working key (i.e., the
; 128 blocks worth of key).
	movzbl	crctab+514,r5
	bneq	8$	;don't mult by zero
	movl	#51,r5
8$:
	mull3	r6,r5,r5	;convert blk# to hashcode
	bicl2	#^xffffff80,r5	;zero all but low 7 bits (now 0-127)
	ashl	#9,r5,r5	;convert to byte offset in long table (now 0-15872 in 512 incr.)
	movl	r5,keyblk	;store offset into crctab here
	tstl	weakflg		;/weak algorithm?
	beql	5$		;if eql no
	clrl	crcblk
5$:
	movl	#64,r6		;64 * 8 = 512 bytes
	movab	recbuf,r1	;address to start with
	movl	binkey,r2	;1st half of key
	movl	binkey+4,r3	;2nd half of key
	movab	crctab,r4	;variable crc tbl (or 0's)
	addl2	keyblk,r4	;add offset to block of keys to use
	movl	crcblk,r5
3$:	xorl3	(r1),(r4)+,(r1)
	xorl3	(r1),r5,(r1)
	xorl3	(r1),r2,(r1)+	;xor 1st half
	xorl3	(r1),(r4)+,(r1)
	xorl3	(r1),r5,(r1)
	xorl3	(r1),r3,(r1)+
	sobgtr	r6,3$
; buffer now transformed.
;note this is (for now) identical to crypt logic. Keep the routine
;separate however in case we decide to alter this later.
; (1st cut would be to add something to the buffer on encrypt and
; subtract it again on decrypt. If we added yet another CRC of the
; key, it would make decoding a cryptodisk noticeably harder.)
	popr	#^M<r0,r1,r2,r3,r4,r5,r6>
	rsb
	.END FDHostD