title	crypt

	search	monsym,macsym
	.requi	des
	extern	des,sed,setkey
	.requi	hax:error
	extern	fatal


;;; Version marker (for .fbusw).
mark:	exp	<sixbit /CRYPT />	; Our name
ver:	exp	1			; Current version


;;; Registers.
;;; We know that AC15 and AC16 are safe the from des library routines.

;;; Chose one of 'ptr' and 'addr'.
;;; 'ptr' use 4-bit byte pointers to fetch and restore the 64-bit
;;; sequences and is four times slower than 'addr', which uses
;;; move/shift/mask instructions. This should make the choice easy but
;;; since 99% of the running time is spent in the dec/sed routines
;;; the actual speed profit is 5-10% (and 'addr' about 200 words longer).

;ptr=15				; A little smaller
addr=15				; A little faster

count=16			; Loop counter for encr
p=17				; PDL as usual


;;; Flags in AC0.
$encr=1				; We are encrypting
$decr=2				; We are decrypting


;;; Useful instructions.

;;; Minimum.
define	min (ac,e) <
	camle	ac,e
	 move	ac,e
	>

;;; Minimum immediate.
define	mini (ac,e) <
	caile	ac,e
	 movei	ac,e
	>


;;; Varia.

ijfn:	block	1		; Input file.
ojfn:	block	1		; Output file.
cryp:	block	1		; Address to des or sed.
pdl:	block	<pdlen=20>
key:	block	2		; For rkey.
keytab:	block	40		; The keytable, set up by setkey.


;;; Paging stuff.

fpag=5				; First page # in process
pspc=<770-fpag+1>		; # of pages available (leave some to DDT)
pim:	block	1		; # pages currently in map
pcnt:	block	1		; # of crypted pages so far
filep:	block	1		; # of first mapped file page


;;; FDB stuff.

fdbfst=.fbbyv			; First word of FDB
fdb:	block	<fdbsz=<.fbusw-fdbfst+1>>

define	fbpgc (ac) < hrrz ac,fdb >	; Get page count
define	fbsiz (ac) < move ac,fdb+1 >	; Get byte count
define	fbbsz (ac) < move ac,fdb >	; Get byte size word
define	fbusw (ac) < move ac,fdb+fdbsz-1>	; Get user-settable word



;;; Main entry.

crypt:	reset%
	move	p,[iowd pdlen,pdl]
	;; Get encryption/decryption option.
	setzm	0
	hrroi	1,[asciz /e or d :/]
	psout%
	pbin%
	cain	1,"e"
	 tro	$encr
	cain	1,"d"
	 tro	$decr
	trnn	$encr
	 movei	2,des
	trnn	$decr
	 movei	2,sed
	movem	2,cryp
	pbin%			;cr
	pbin%			;lf
	;; Input file.
	hrroi	1,[asciz /Input: /]
	psout%
	move	1,[gj%old!gj%fns!gj%sht]
	move	2,[.priin,,.priou]
	gtjfn%			; Get input file.
	 ercal	fatal
	hrrzm	1,ijfn
	move	2,[of%rd!of%nwt]
	openf%			; Open it.
	 ercal	fatal
	call	ifdb

	;; Output file
	hrroi	1,[asciz /Output: /]
	psout%
	move	1,[gj%fou!gj%fns!gj%sht]
	move	2,[.priin,,.priou]
	gtjfn%
	 ercal	fatal
	hrrzm	1,ojfn
	move	2,[of%wr!of%nwt]
	openf%
	 ercal	fatal

	call	rkey		; Get the key
	dmove	1,key
	movei	3,keytab
	call	setkey		; Set up the keytable
	call	encr		; {En,De}crypt

	;; Set the output file bytesize and bytecount, and close the files.
	move	1,ijfn
	closf%			; Close input file
	 ercal	fatal
	move	1,ojfn
	hll	1,[co%nrj]
	closf%			; Close output file but keep JFN
	 ercal	fatal
	call	ofdb		; Set FDB data in for output file.
	move	1,ojfn
	rljfn%			; Release the output JFN.
	 ercal	fatal

	haltf%
	jrst	.-1


;;; The {En,De}cryption loop.
encr:	setzm	pcnt		; Clear page count
	setzm	filep		; Clear file page #
encr1:	call	mfil		; Map part of the file
	 ret			; Nothing more
ifdef ptr  <move  ptr,[point 4,<fpag*1000>]>
ifdef addr <movei addr,<fpag*1000>>
	move	count,pim
	imuli	count,440		; # of 64-bit seqs
encr2:	sojl	count,[	call	ufil	; Done. Map onto output file
			jrst	encr1	]
	call	gett			; Get 64 bits
	movei	3,keytab
	call	@cryp		; {En,De}crypt
	call	putt		; Write the scrambled bits back
	jrst	encr2


;;; Read up to 9 7-bit characters into key.
rkey:	hrroi	1,[asciz /Key: /]
	psout%
	move	2,[point 7,key]
	movei	3,^d9
	setzm	key		; Padded with zero
	setzm	key+1
rkey1:	pbin%
	cain	1,.chcrt
	 jrst	rkey2
	idpb	1,2
	sojg	3,rkey1
rkey2:	pbin%
	caie	1,.chlfd
	 jrst	rkey2
	ret


;;; Get 64 bits from ptr/addr into AC1-AC2.

;;; Fast and hairy version.
ifdef addr <
;;; A short get.
define getsht(l,a) <
	lshc	1,l
	ret
	>
;;; A long get.
define getlng(l1,l2) <
	lshc	1,l1
	move	3,2(addr)
	lsh	3,l2
	ior	2,3
	ret
	>
;;; The get.
gett:	dmove	1,(addr)
	move	3,addr
	andi	3,17
	jrst @[	get00
		get01
		getzz
		get03
		getzz
		get05
		getzz
		get07
		get10
		getzz
		get12
		getzz
		get14
		getzz
		get16
		getzz	](3)
get00:	ret
get01:	getlng(34,-10)
get03:	getlng(24,-20)
get05:	getlng(14,-30)
get07:	getsht(04,1)
get10:	getlng(40,-04)
get12:	getlng(30,-14)
get14:	getlng(20,-24)
get16:	getsht(10,2)
getzz:	hrroi	1,[asciz /Impossible dispatch in get
/]
	psout%
	haltf%
	jrst	.-1
>

;;; A slow and simple version.
ifdef ptr <
gett:	movei	3,^d16
	move	4,[point 4,1]
	move	5,ptr
get1:	ildb	6,5
	idpb	6,4
	sojg	3,get1
	ret
>


;;; Put 64 bits at ptr/addr from AC1-AC2.

;;; A fast and hairy version.
ifdef addr <
;;; A long put.
define putlng(l1,m1,l2,m2) <
	move	3,2
	lsh	3,l2
	move	4,2(addr)
	and	4,[m2]
	ior	3,4
	movem	3,2(addr)
	lshc	1,l1
	move	4,0(addr)
	and	4,[m1]
	ior	1,4
	dmovem	1,0(addr)
	addi	addr,2
	ret
	>
;;; The put.
putt:	move	3,addr
	andi	3,17
	jrst @[	put00
		put01
		putzz
		put03
		putzz
		put05
		putzz
		put07
		put10
		putzz
		put12
		putzz
		put14
		putzz
		put16
		putzz	](3)
put00:	move	3,1(addr)
	andi	3,377
	ior	2,3
	dmovem	1,0(addr)
	addi	addr,1
	ret
put01:	putlng(-34,<777777,,777400>,10,<000000,,177777>)
put03:	putlng(-24,<777777,,600000>,20,<000077,,777777>)
put05:	putlng(-14,<777700,,000000>,30,<037777,,777777>)
put07:	lshc	1,-04
	move	3,0(addr)
	and	3,[740000,,000000]
	ior	1,3
	move	3,1(addr)
	andi	3,17
	ior	2,3
	dmovem	1,0(addr)
	addi	addr,1
	ret
put10:	putlng(-40,<777777,,777760>,04,<000000,,007777>)
put12:	putlng(-30,<777777,,770000>,14,<000003,,777777>)
put14:	putlng(-20,<777774,,000000>,24,<001777,,777777>)
put16:	lshc	1,-10
	move	3,0(addr)
	and	3,[776000,,000000]
	ior	1,3
	dmovem	1,0(addr)
	addi	addr,2
	ret
putzz:	hrroi	1,[asciz /Impossible dispatch in put
/]
	psout%
	haltf%
	jrst	.-1
>

;;; A slow and simple version.
ifdef ptr <
putt:	movei	3,^d16
	move	4,[point 4,1]
put1:	ildb	5,4
	idpb	5,ptr
	sojg	3,put1
	ret
>


;;; Map file.
mfil:	fbpgc	3		; # of pages in file
	camg	3,pcnt
	 ret			; Return +1 if nothing more
	mini	3,pspc		; # of free pages in process
	move	1,filep
	hrl	1,ijfn
	ffufp%			; Find first used file page
	 ercal	fatal
	hrrzm	1,filep
	movs	1,1
	ffffp%			; Find first free file page
	hrrz	1,1
	sub	1,filep		; # of contiguous pages
	min	3,1
	movem	3,pim
	hll	3,[pm%cnt!pm%rd!pm%wr!pm%cpy]
	move	2,[.fhslf,,fpag]
	move	1,filep
	hrl	1,ijfn
	pmap%
	aos	(p)		; Return +2 if mapped
	ret


;;; Map onto file.
ufil:	move	1,[.fhslf,,fpag]
	movs	2,ojfn
	hrr	2,filep		; File's starting page
	move	3,pim		; # of pages currently in process
	addm	3,pcnt		; Update # of (soon) finished pages
	addm	3,filep
	hll	3,[pm%cnt]
	pmap%
	ret


;;; Get some info about the input file and check the user-setable word.
ifdb:	move	1,ijfn
	move	2,[fdbsz,,fdbfst]
	movei	3,fdb
	gtfdb%
	trnn	$decr
	 jrst [	fbusw	1	; Encrypting
		skipn	1
		 ret
		trz	1,77	; Ignore version #
		camn	1,mark
		 jrst [	hrroi	1,[asciz /?File is already encrypted/]
			hrroi	3,[asciz /?Continue to encrypt anyway/]
			call	iferrs
			haltf%
			ret	]
		hrroi	1,[asciz /?File's .fbusw is already set to: /]
		fbusw	2
		hrroi	3,[asciz /?Continue will not keep this in the output file/]
		call	iferru
		haltf%
		ret	]
	fbusw	1		; Decrypting
	trz	1,77		; Ignore version #
	came	1,mark
	 jrst [	hrroi	1,[asciz /?File is not marked as encrypted/]
		hrroi	3,[asciz /?Continue to decrypt anyway/]
		call	iferrs
		haltf%
		ret	]
	fbusw	1
	andi	1,77		; Check version #
	came	1,ver
	 jrst [ move	2,1
		hrroi	1,[asciz /?File is encrypted with another version of crypt: /]
		hrroi	3,[asciz /?Continue to decrypt anyway/]
		call	iferrv
		haltf%
		ret	]
	ret


;;; Set some data on the output file and check and set the user-settabel word.
ofdb:	move	1,ojfn
	hll	1,[fld(.fbbyv,cf%dsp)]
	move	2,[fb%bsz]
	fbbsz	3
	chfdb%			; Set byte size
	hll	1,[fld(.fbsiz,cf%dsp)]
	setom	2
	fbsiz	3
	chfdb%			; Set byte count
	trnn	$encr
	 ret			; Decrypting, don't set .fbusw
	hll	1,[fld(.fbusw,cf%dsp)]
	setom	2
	move	3,mark		; Merge our name...
	ior	3,ver		; ...and version #
	chfdb%
	ret


;;; Print error messages for ifdb.
;;; AC1: Byte pointer to string1 (iferrs,iferru,iferrv)
;;; AC2: Number (iferru,iferrv)
;;; AC3: Byte pointer to string2 (iferrs,iferru,iferrv)
iferrs:	psout%			; String1
	call	crlf
	move	1,3
	psout%			; String2
	jrst	crlf

iferru:	psout%			; String1
	move	4,2
	move	5,3
	movei	1,.priou	; Octal,,Octal #
	hlrz	2,2
	move	3,[no%mag!no%lfl!no%zro!fld(6,no%col)!fld(^d8,no%rdx)]
	nout%
	 ercal	fatal
	movei	1,","
	pbout%
	pbout%
	movei	1,.priou
	hrrz	2,4
	nout%
	 ercal	fatal
	call	crlf
	move	1,5
	psout%			; String2
	jrst	crlf

iferrv:	psout%			; String1
	move	4,3
	movei	1,.priou	; Decimal #
	move	3,[no%mag!fld(3,no%col)!fld(^d10,no%rdx)]
	nout%
	 ercal	fatal
	call	crlf
	move	1,4
	psout%			; String2
	jrst	crlf


;;; Print a CRLF on .priou .
crlf:	push	p,1
	movei	1,.chcrt
	pbout%
	movei	1,.chlfd
	pbout%
	pop	p,1
	ret


	end	crypt
.../PEM