;;;
;;;
;;;	DES - Library for encryption/decryption with the DES algorithm.
;;;
;;;
;;; Author:
;;;
;;;  Per-Erik Martin,  ZYX Sweden AB.
;;;  Email: pem@zyx.SE or pem@aida.UU.SE
;;;
;;;
;;; Description:
;;;
;;;  This implementation is based on the algorithm described in Tanenbaum,
;;;  Computer Networks, but differs in some details. Especially, the
;;;  S-Boxes are rearranged so we can use the 6-bit index without the
;;;  rather pointless bitfiddling as described in Computer Networks.
;;;  See the literature for a detailed description of the algorithm.
;;;
;;;  The three subroutines use (too) many accumulators. It is possible
;;;  to make them use memory locations or the stack, but it's probably
;;;  better for performance if the caller pushes accumulators at the top,
;;;  rather than have this library pushing them in the inner loops.
;;;  Currently AC1 through AC14 (12 AC's) are used. We also assume that
;;;  AC17 is the stack pointer (we use the CALL and RET macros).
;;;
;;;
;;; Synopsis:
;;;
;;;  SETKEY initializes a table with keys used in each iteration by Des.
;;;
;;;  Calling sequence:
;;;   AC1:	Left 36 bits of original key.
;;;   AC2:	Right 28 bits of original key (left adjusted).
;;;   AC3:	Address to the key table (32 words).
;;;
;;;  Returns:	+1:	Always, with
;;;			AC3:	Address to the key table.
;;;			AC1 and AC2 through AC12 are destroyed.
;;;
;;;
;;;  DES encrypts a 64-bit block with the DES algorithm.
;;;
;;;  Calling sequence:
;;;   AC1:	Left 36 bits of the block
;;;   AC2:	Right 28 bits left adjusted.
;;;   AC3:	Address to key table.
;;;
;;;  Returns:	+1:	Always, with
;;;			AC1:	Left 36 bits of encrypted block.
;;;			AC2:	Right 28 bits of encrypted block
;;;				(left adjusted). The 8 LSB are cleared.
;;;			AC3:	Address to key table.
;;;			AC4 through AC14 are destroyed.
;;;
;;;
;;;  SED decrypts a 64-bit block.
;;;
;;;  Calling sequence:
;;;   AC1:	Left 36 bits of the cipher block
;;;   AC2:	Right 28 bits left adjusted.
;;;   AC3:	Address to key table.
;;;
;;;  Returns:	+1:	Always, with
;;;			AC1:	Left 36 bits of decrypted block.
;;;			AC2:	Right 28 bits of decrypted block
;;;				(left adjusted). The 8 LSB are cleared.
;;;			AC3:	Address to key table.
;;;			AC4 through AC14 are destroyed.
;;;
;;;
;;; Sample usage:
;;;
;;;		.requi	des
;;;		extern	setkey,des,sed
;;;		...
;;;  keytab:	block	<^d16*2>	; Keytable.
;;;		...
;;;		dmove	1,[ascii /64bitkey/]
;;;		movei	3,keytab
;;;		call	setkey		; Initialize keytable.
;;;		...
;;;		dmove	1,[ascii /SomeText/]
;;;		movei	3,keytab
;;;		call	des		; Encrypt.
;;;		call	sed		; Decrypt.
;;;
 

	title	des
	search	monsym,macsym


textl=1
textr=2
keyp=3
w1=4
w2=5
w3=6
w4=7
w5=10
w6=11
w7=12
w8=13
w9=14



;;;
;;;  Some handy macros.
;;;


;;; See TRANSP.
define trans(p,o,n)<
	move	w1,p
	movei	w2,o
	movei	w3,n
	call	transp
	>


;;; See TRANSP.
define transi(p,o,n)<
	movei	w1,p
	movei	w2,o
	movei	w3,n
	call	transp
	>


;;; SPLIT splits the 64 bits left adjusted in AC/AC+1 into 32 bits 
;;; left adjusted in AC/AC+1 respectively,
;;; ie. 777777,,777777 777777,,600000  =>  777777,,7777400 777777,,7777400

define split(ac)<
	lshc	ac,-4
	lsh	ac,4
	>


;;; MERGE is the inverse of SPLIT,
;;; ie. 777777,,7777400 777777,,7777400  =>  777777,,777777 777777,,600000
define merge(ac)<
	lsh	ac,-4
	lshc	ac,4
	>


;;; SETKEY initializes a table with keys used in each iteration by Des.
;;;
;;; Calling sequence:
;;;  TEXTL:	Left 36 bits of original key.
;;;  TEXTR:	Right 28 bits of original key (left adjusted).
;;;  KEYP:	Address to a 32 word table.
;;;
;;; Returns:	+1:	Always, with
;;;			KEYP:	Address to the key table.
;;;			TEXTL, TEXTR and W1 through W7 are destroyed.

setkey::transi(textl,keytr1,^d56)	; Mix up key and reduce to 56 bits.
	movei	w7,rots
setk0:	move	w1,(w7)		; Get rot count.

	;; Rotate 28-bit units.
	lshc	textl,-10
	lsh	textl,1
	tlze	textl,002000
	 tro	textl,000001
	rot	textr,1
	trze	textr,000001
	 tro	textr,000400
	lshc	textl,10

	sojg	w1,setk0+1	; Rotate again?
	dmovem	textl,(keyp)	; Store the key in table.
	trans(keyp,keytr2,^d48)	; Transpose the key in the table.
	addi	keyp,2
	caie	w7,<rots+20-1>
	 aoja	w7,setk0
	subi	keyp,40		; Restore keyp.
	ret


;;; DES encrypts a 64-bit block with the DES algorithm.
;;;
;;; Calling sequence:
;;;  TEXTL:	Left 36 bits of the block
;;;  TEXTR:	Right 28 bits left adjusted.
;;;  KEYP:	Address to key table.
;;;
;;; Returns:	+1:	Always, with
;;;			TEXTL:	Left 36 bits of encrypted block.
;;;			TEXTR:	Right 28 bits of encrypted block
;;;				(left adjusted).
;;;			KEYP:	Address to key table.
;;;			W1 through W9 are destroyed.

des::	transi(textl,initr,^d64)	; Initial transpose.
	split(textl)		; Split into 32 bits per word.
	movei	w1,40(keyp)	; End of key table.
	move	w9,w1		; Save it.
	move	w1,textr	; W1 is current right.
des0:	call	fun
	xor	w1,textl
	move	textl,textr	; New left from old right.
	move	textr,w1	; Old right from current.
	addi	keyp,2
	came	keyp,w9		; End of table?
	 jrst	des0
	exch	textl,textr	; The resulting left and right halves swapped.
	merge(textl)
	transi(textl,fintr,^d64)	; Final transpose.
	subi	keyp,40		; Restore table pointer.
	trz	textr,377	; Clear garbage at the end.
	ret


;;; SED decrypts a 64-bit block.
;;;
;;; Calling sequence:
;;;  TEXTL:	Left 36 bits of the cipher block
;;;  TEXTR:	Right 28 bits left adjusted.
;;;  KEYP:	Address to key table.
;;;
;;; Returns:	+1:	Always, with
;;;			TEXTL:	Left 36 bits of decrypted block.
;;;			TEXTR:	Right 28 bits of decrypted block
;;;				(left adjusted).
;;;			KEYP:	Address to key table.
;;;			W1 through W9 are destroyed.

sed::	transi(textl,initr,^d64)	; Initial transpose.
	split(textl)		; Split into 32 bits per word.
	move	w9,keyp		; Save beginning of key table.
	movei	keyp,36(keyp)
	move	w1,textr	; W1 is current right.
sed0:	call	fun
	xor	w1,textl
	move	textl,textr	; New left from old right.
	move	textr,w1	; Old right from current.
	subi	keyp,2
	caml	keyp,w9		; Beginning of table?
	 jrst	sed0
	exch	textl,textr	; The resulting left and right halves swapped.
	merge(textl)
	transi(textl,fintr,^d64)	; Final transpose.
	move	keyp,w9		; Restore key table pointer.
	trz	textr,377	; Clear garbage at the end.
	ret


;;; FUN substitutes a half block from the s-boxes.
;;;
;;; Calling sequence:
;;;  KEYP:	Address to a two-word key (56 bits left adjusted).
;;;  W1:	32 bits left adjusted.
;;;
;;; Returns:	+1	Always,
;;;			W1:	Substituted left adjusted 32 bits.
;;;			W2 through W8 are destroyed.

fun:	move	w7,w1		; Will use W8 too.
	transi(w7,etr,^d48)	; Expand W7/W8 to 48 bits.
	dmove	w1,(keyp)
	xor	w1,w7
	xor	w2,w8
	move	w3,[point 6,w1]
	move	w4,[point 4,w7]
	movei	w5,0		; Row index to sbox.
fun0:	ildb	w6,w3		; Get 6-bit byte (column index).
	ior	w6,w5		; Merge the indicies.
	move	w6,sbox(w6)	; Get the 4-bit byte from a sbox.
	idpb	w6,w4		; Store it.
	addi	w5,^d64
	caie	w5,<^d64*^d8>
	 jrst	fun0
	transi(w7,ptr,^d32)	; Back to 32 bits again.
	move	w1,w7		; Return result in W1.
	ret


;;; TRANSP transposes up to 72 bits accordingly to a table of 1-bit
;;; bytepointers.
;;;
;;; Calling sequence:
;;;  W1:	Address to (left adjusted) bit-array to transpose.
;;;  W2:	Address to an ordering table.
;;;  W3:	Size of bit field to transpose.
;;;
;;; Returns:	+1	Always, with
;;;			W1:	Still pointing to the now transposed field.
;;;			W2 through W6 are destroyed.

transp:	dmove	w5,(w1)		; Copy box to W5/W6.
	hrli	w1,440100	; Make W1 to a 1-bit byte pointer.
trans0:	sojl	w3,[ ret ]	; Finished?
	ldb	w4,(w2)		; Get bit from W5/W6.
	idpb	w4,w1		; Clobber the original box with it.
	aoja	w2,trans0



;;;
;;; The ordering tables, s-boxes and rots table.
;;;

;;; Align to page.
;reloc	<<<.-1>_-9>+1>_9

radix ^d10

initr:	exp	<point 1,w6,21>,<point 1,w6,13>,<point 1,w6,05>,<point 1,w5,33>
	exp	<point 1,w5,25>,<point 1,w5,17>,<point 1,w5,09>,<point 1,w5,01>
	exp	<point 1,w6,23>,<point 1,w6,15>,<point 1,w6,07>,<point 1,w5,35>
	exp	<point 1,w5,27>,<point 1,w5,19>,<point 1,w5,11>,<point 1,w5,03>
	exp	<point 1,w6,25>,<point 1,w6,17>,<point 1,w6,09>,<point 1,w6,01>
	exp	<point 1,w5,29>,<point 1,w5,21>,<point 1,w5,13>,<point 1,w5,05>
	exp	<point 1,w6,27>,<point 1,w6,19>,<point 1,w6,11>,<point 1,w6,03>
	exp	<point 1,w5,31>,<point 1,w5,23>,<point 1,w5,15>,<point 1,w5,07>
	exp	<point 1,w6,20>,<point 1,w6,12>,<point 1,w6,04>,<point 1,w5,32>
	exp	<point 1,w5,24>,<point 1,w5,16>,<point 1,w5,08>,<point 1,w5,00>
	exp	<point 1,w6,22>,<point 1,w6,14>,<point 1,w6,06>,<point 1,w5,34>
	exp	<point 1,w5,26>,<point 1,w5,18>,<point 1,w5,10>,<point 1,w5,02>
	exp	<point 1,w6,24>,<point 1,w6,16>,<point 1,w6,08>,<point 1,w6,00>
	exp	<point 1,w5,28>,<point 1,w5,20>,<point 1,w5,12>,<point 1,w5,04>
	exp	<point 1,w6,26>,<point 1,w6,18>,<point 1,w6,10>,<point 1,w6,02>
	exp	<point 1,w5,30>,<point 1,w5,22>,<point 1,w5,14>,<point 1,w5,06>

fintr:	exp	<point 1,w6,03>,<point 1,w5,07>,<point 1,w6,11>,<point 1,w5,15>
	exp	<point 1,w6,19>,<point 1,w5,23>,<point 1,w6,27>,<point 1,w5,31>
	exp	<point 1,w6,02>,<point 1,w5,06>,<point 1,w6,10>,<point 1,w5,14>
	exp	<point 1,w6,18>,<point 1,w5,22>,<point 1,w6,26>,<point 1,w5,30>
	exp	<point 1,w6,01>,<point 1,w5,05>,<point 1,w6,09>,<point 1,w5,13>
	exp	<point 1,w6,17>,<point 1,w5,21>,<point 1,w6,25>,<point 1,w5,29>
	exp	<point 1,w6,00>,<point 1,w5,04>,<point 1,w6,08>,<point 1,w5,12>
	exp	<point 1,w6,16>,<point 1,w5,20>,<point 1,w6,24>,<point 1,w5,28>
	exp	<point 1,w5,35>,<point 1,w5,03>,<point 1,w6,07>,<point 1,w5,11>
	exp	<point 1,w6,15>,<point 1,w5,19>,<point 1,w6,23>,<point 1,w5,27>
	exp	<point 1,w5,34>,<point 1,w5,02>,<point 1,w6,06>,<point 1,w5,10>
	exp	<point 1,w6,14>,<point 1,w5,18>,<point 1,w6,22>,<point 1,w5,26>
	exp	<point 1,w5,33>,<point 1,w5,01>,<point 1,w6,05>,<point 1,w5,09>
	exp	<point 1,w6,13>,<point 1,w5,17>,<point 1,w6,21>,<point 1,w5,25>
	exp	<point 1,w5,32>,<point 1,w5,00>,<point 1,w6,04>,<point 1,w5,08>
	exp	<point 1,w6,12>,<point 1,w5,16>,<point 1,w6,20>,<point 1,w5,24>

keytr1:	exp	<point 1,w6,20>,<point 1,w6,12>,<point 1,w6,04>,<point 1,w5,32>
	exp	<point 1,w5,24>,<point 1,w5,16>,<point 1,w5,08>,<point 1,w5,00>
	exp	<point 1,w6,21>,<point 1,w6,13>,<point 1,w6,05>,<point 1,w5,33>
	exp	<point 1,w5,25>,<point 1,w5,17>,<point 1,w5,09>,<point 1,w5,01>
	exp	<point 1,w6,22>,<point 1,w6,14>,<point 1,w6,06>,<point 1,w5,34>
	exp	<point 1,w5,26>,<point 1,w5,18>,<point 1,w5,10>,<point 1,w5,02>
	exp	<point 1,w6,23>,<point 1,w6,15>,<point 1,w6,07>,<point 1,w5,35>
	exp	<point 1,w6,26>,<point 1,w6,18>,<point 1,w6,10>,<point 1,w6,02>
	exp	<point 1,w5,30>,<point 1,w5,22>,<point 1,w5,14>,<point 1,w5,06>
	exp	<point 1,w6,25>,<point 1,w6,17>,<point 1,w6,09>,<point 1,w6,01>
	exp	<point 1,w5,29>,<point 1,w5,21>,<point 1,w5,13>,<point 1,w5,05>
	exp	<point 1,w6,24>,<point 1,w6,16>,<point 1,w6,08>,<point 1,w6,00>
	exp	<point 1,w5,28>,<point 1,w5,20>,<point 1,w5,12>,<point 1,w5,04>
	exp	<point 1,w5,27>,<point 1,w5,19>,<point 1,w5,11>,<point 1,w5,03>

keytr2:	exp	<point 1,w5,13>,<point 1,w5,16>,<point 1,w5,10>,<point 1,w5,23>
	exp	<point 1,w5,00>,<point 1,w5,04>,<point 1,w5,02>,<point 1,w5,27>
	exp	<point 1,w5,14>,<point 1,w5,05>,<point 1,w5,20>,<point 1,w5,09>
	exp	<point 1,w5,22>,<point 1,w5,18>,<point 1,w5,11>,<point 1,w5,03>
	exp	<point 1,w5,25>,<point 1,w5,07>,<point 1,w5,15>,<point 1,w5,06>
	exp	<point 1,w5,26>,<point 1,w5,19>,<point 1,w5,12>,<point 1,w5,01>
	exp	<point 1,w6,04>,<point 1,w6,15>,<point 1,w5,30>,<point 1,w6,00>
	exp	<point 1,w6,10>,<point 1,w6,18>,<point 1,w5,29>,<point 1,w6,03>
	exp	<point 1,w6,14>,<point 1,w6,08>,<point 1,w5,32>,<point 1,w6,11>
	exp	<point 1,w6,07>,<point 1,w6,12>,<point 1,w6,02>,<point 1,w6,19>
	exp	<point 1,w5,33>,<point 1,w6,16>,<point 1,w6,09>,<point 1,w6,05>
	exp	<point 1,w6,13>,<point 1,w5,35>,<point 1,w5,28>,<point 1,w5,31>

etr:	exp	<point 1,w5,31>,<point 1,w5,00>,<point 1,w5,01>,<point 1,w5,02>
	exp	<point 1,w5,03>,<point 1,w5,04>,<point 1,w5,03>,<point 1,w5,04>
	exp	<point 1,w5,05>,<point 1,w5,06>,<point 1,w5,07>,<point 1,w5,08>
	exp	<point 1,w5,07>,<point 1,w5,08>,<point 1,w5,09>,<point 1,w5,10>
	exp	<point 1,w5,11>,<point 1,w5,12>,<point 1,w5,11>,<point 1,w5,12>
	exp	<point 1,w5,13>,<point 1,w5,14>,<point 1,w5,15>,<point 1,w5,16>
	exp	<point 1,w5,15>,<point 1,w5,16>,<point 1,w5,17>,<point 1,w5,18>
	exp	<point 1,w5,19>,<point 1,w5,20>,<point 1,w5,19>,<point 1,w5,20>
	exp	<point 1,w5,21>,<point 1,w5,22>,<point 1,w5,23>,<point 1,w5,24>
	exp	<point 1,w5,23>,<point 1,w5,24>,<point 1,w5,25>,<point 1,w5,26>
	exp	<point 1,w5,27>,<point 1,w5,28>,<point 1,w5,27>,<point 1,w5,28>
	exp	<point 1,w5,29>,<point 1,w5,30>,<point 1,w5,31>,<point 1,w5,00>

ptr:	exp	<point 1,w5,15>,<point 1,w5,06>,<point 1,w5,19>,<point 1,w5,20>
	exp	<point 1,w5,28>,<point 1,w5,11>,<point 1,w5,27>,<point 1,w5,16>
	exp	<point 1,w5,00>,<point 1,w5,14>,<point 1,w5,22>,<point 1,w5,25>
	exp	<point 1,w5,04>,<point 1,w5,17>,<point 1,w5,30>,<point 1,w5,09>
	exp	<point 1,w5,01>,<point 1,w5,07>,<point 1,w5,23>,<point 1,w5,13>
	exp	<point 1,w5,31>,<point 1,w5,26>,<point 1,w5,02>,<point 1,w5,08>
	exp	<point 1,w5,18>,<point 1,w5,12>,<point 1,w5,29>,<point 1,w5,05>
	exp	<point 1,w5,21>,<point 1,w5,10>,<point 1,w5,03>,<point 1,w5,24>


rots:	exp	1,1,2,2,2,2,2,2,1,2,2,2,2,2,2,1

;;; Align to page.
;reloc	<<<.-1>_-9>+1>_9

sbox:	exp	14,00,04,15,13,07,01,04,02,14,15,02,11,13,08,01
	exp	03,10,10,06,06,12,12,11,05,09,09,05,00,03,07,08
	exp	04,15,01,12,14,08,08,02,13,04,06,09,02,01,11,07
	exp	15,05,12,11,09,03,07,14,03,10,10,00,05,06,00,13

	exp	15,03,01,13,08,04,14,07,06,15,11,02,03,08,04,14
	exp	09,12,07,00,02,01,13,10,12,06,00,09,05,11,10,05
	exp	00,13,14,08,07,10,11,01,10,03,04,15,13,04,01,02
	exp	05,11,08,06,12,07,06,12,09,00,03,05,02,14,15,09

	exp	10,13,00,07,09,00,14,09,06,03,03,04,15,06,05,10
	exp	01,02,13,08,12,05,07,14,11,12,04,11,02,15,08,01
	exp	13,01,06,10,04,13,09,00,08,06,15,09,03,08,00,07
	exp	11,04,01,15,02,14,12,03,05,11,10,05,14,02,07,12

	exp	07,13,13,08,14,11,03,05,00,06,06,15,09,00,10,03
	exp	01,04,02,07,08,02,05,12,11,01,12,10,04,14,15,09
	exp	10,03,06,15,09,00,00,06,12,10,11,01,07,13,13,08
	exp	15,09,01,04,03,05,14,11,05,12,02,07,08,02,04,14

	exp	02,14,12,11,04,02,01,12,07,04,10,07,11,13,06,01
	exp	08,05,05,00,03,15,15,10,13,03,00,09,14,08,09,06
	exp	04,11,02,08,01,12,11,07,10,01,13,14,07,02,08,13
	exp	15,06,09,15,12,00,05,09,06,10,03,04,00,05,14,03

	exp	12,10,01,15,10,04,15,02,09,07,02,12,06,09,08,05
	exp	00,06,13,01,03,13,04,14,14,00,07,11,05,03,11,08
	exp	09,04,14,03,15,02,05,12,02,09,08,05,12,15,03,10
	exp	07,11,00,14,04,01,10,07,01,06,13,00,11,08,06,13

	exp	04,13,11,00,02,11,14,07,15,04,00,09,08,01,13,10
	exp	03,14,12,03,09,05,07,12,05,02,10,15,06,08,01,06
	exp	01,06,04,11,11,13,13,08,12,01,03,04,07,10,14,07
	exp	10,09,15,05,06,00,08,15,00,14,05,02,09,03,02,12

	exp	13,01,02,15,08,13,04,08,06,10,15,03,11,07,01,04
	exp	10,12,09,05,03,06,14,11,05,00,00,14,12,09,07,02
	exp	07,02,11,01,04,14,01,07,09,04,12,10,14,08,02,13
	exp	00,15,06,12,10,09,13,00,15,03,03,05,05,06,08,11


radix ^d8


	end
/PEM...