DataMuseum.dk

top - download

    Length: 21248 (0x5300)
    Types: TextFile
    Names: »DES.MAC«

└─⟦692ac107c⟧ Bits:30005923 PolyPascal-80 V3.10 arbejdsdiskette 1
    └─ ⟦this⟧ »DES.MAC« 

TextFile

;TLE	NBS/DES PROGRAM
;********************************************************
;
;	DES/NBS ENCRYPTON PROGRAM FOR 
;	EUROLOG EML/SPC1 SUBPROCESSOR BOARD
;
;********************************************************
;
VERSION	EQU	20
;
	.Z80
;
	ASEG
	ORG	100H
;
	.PHASE	0
;
MOVE	MACRO	DESTIN,SOURCE	;MOVE 8 BYTES FROM SOURCE TO DESTIN
	LD	HL,SOURCE	;LOAD SOURCE ADDR.
	LD	DE,DESTIN	;LOAD DESTIN ADDR.
	LD	BC,8		;LENGTH = 8 BYTES
	LDIR			;MOVE
	ENDM
;
ADXOR	MACRO	RESULT,SOURCE	;ADD ADDR TO RESULT MODULUS 2
	LD	HL,RESULT	;LOAD RESULT ADDR
	LD	DE,SOURCE	;LOAD ADDR
	LD	B,8		;LENGTH IS 8 BYTES
	CALL	ADDER		;CALL ROUTINE
	ENDM
;
RAM	EQU	2000H
;
SIO	EQU	0H
SIOAD	EQU	SIO
SIOAC	EQU	SIOAD+2
SIOBD	EQU	SIO+1
SIOBC	EQU	SIOBD+2
;
REQSTA	EQU	00H 		;REQUEST STATUS
ZAPKEY	EQU	14H 		;CLEAR KEY TO ALL ZERO
CALKEY	EQU	18H 		;CALCULATE KEY
STENCR	EQU	24H 		;START ENCRYPTION
CBCE	EQU	0A4H		;START ENCRYPTION WITH CBC
CPBCE	EQU	0E4H		;START ENCRYPTION WITH CPBC
STDECR	EQU	28H 		;START DECRYPTION
CBCD	EQU	0A8H		;START DECRYPTION WITH CBC
CPBCD	EQU	0E8H		;START DECRYPTION WITH CPBC
GETKEY	EQU	41H 		;GET KEYBYTE FROM PORT B
GETDAT	EQU	81H 		;GET DATABYTE FROM PORT B
PUTDAT	EQU	82H 		;SEND DATABYTE FROM PORT B
RESICV	EQU	0A2H		;RELOAD INIT CHAIN VALUE
GETICV	EQU	0A1H		;GET INIT.VAL BYTE FROM PORT B
;
;	STATUS VALUES
;
;	X X X X X X 0 0		INPUT DATABLOCK EMPTY
;	X X X X X X 0 1		INPUT DATABLOCK NOT EMPTY, NOT FULL
;	X X X X X X 1 1		INPUT DATABLOCK FULL
;	X X X X 0 0 X X		OUTPUT DATABLOCK EMPTY
;	X X X X 0 1 X X		OUTPUT DATABLOCK NOT EMPTY, NOT FULL
;	X X X X 1 1 X X		OUTPUT DATABLOCK FULL
;	X X 0 0 X X X X		KEYBLOCK UNDEFINED
;	X X 1 0 X X X X		KEYBLOCK = ZERO
;	X X 0 1 X X X X		KEYBLOCK NOT EMPTY, NOT FULL
;	X X 1 1 X X X X		KEYBLOCK FULL
;	0 0 X X X X X X		INIT.VAL UNDEFINED
;	1 0 X X X X X X 	INIT.VAL RESET
;	0 1 X X X X X X		INIT.VAL NOT EMPTY, NOT FULL
;	1 1 X X X X X X		INIT.VAL. ACTIVATED
;
;	INITIALIZE SIO'S
;
INIT:
	DI			;DISABLE INTERUPT
	LD	SP,STACK	;LOAD STACK POINTER
	LD	HL,DTR0
	LD	C,SIOAC
	LD	B,2
	OTIR
	LD	HL,DTR0
	LD	C,SIOBC
	LD	B,2
	OTIR
	XOR	A		;CLEAR <A>
	LD	(STATUS),A	;CLEAR STATUS
	LD	(IDATCNT),A	;CLEAR IN DATA COUNTER
	LD	(ODATCNT),A	;CLEAR OUT DATA COUNTER
	LD	(IBCCNT),A	;CLEAR IBC-COUNT
	LD	(KEYCNT),A	;CLEAR KEY COUNTER
;
	LD	HL,SIOBLK
INILOP:
	LD	A,(HL)
	OR	A
	JR	Z,IDLE0
	LD	B,A
	INC	HL
	LD	C,(HL)
	LD	A,18H
	OUT	(C),A
INILP1:
	INC	HL
	LD	A,(HL)
	OUT	(C),A
	DJNZ	INILP1
	INC	HL
	JR	INILOP
;
;	IDLE LOOP TO WAIT FOR ACTIVITY ON SIO.
;
IDLE0:
	IN	A,(SIOAD)	;CLEAR INPUT BUFFER
	IN	A,(SIOAD)	;CLEAR INPUT BUFFER
	IN	A,(SIOAD)	;CLEAR INPUT BUFFER
	IN	A,(SIOBD)	;CLEAR INPUT BUFFER
	IN	A,(SIOBD)	;CLEAR INPUT BUFFER
	IN	A,(SIOBD)	;CLEAR INPUT BUFFER
;
IDLE:
	LD	HL,DTR1
	LD	C,SIOAC
	LD	B,2
	OTIR
IDL0:
	IN	A,(SIOAC)	;GET STATUS CB-A
	BIT	0,A		;RX BUFFER EMPTY?
	JR	Z,IDL0		;IF SO LOOP TO IDLE
;
;	GET COMMAND TYPE
;
	LD	HL,DTR0
	LD	C,SIOAC
	LD	B,2
	OTIR
	IN	A,(SIOAD)	;GET COMMAND
	LD	(CMDBYT),A	;SAVE COMMAND
	CP	REQSTA		;STATUS REQUEST?
	JP	Z,TXSTA		;YES - SEND STATUS
	CP	ZAPKEY		;CEAR KEY REQ ?
	JP	Z,CLRKEY	;YES - CLEAR KEY
	CP	CALKEY		;SET KEY REQ ?
	JP	Z,ZKEY		;YES - READ 8 KEY-BYTES.
	CP	STENCR		;START ENCRYPTION?
	JP	Z,ENCR		;YES - ENCRYPT
	CP	CBCE		;START ENCRYPTION?
	JP	Z,ENCR		;YES - ENCRYPT
	CP	CPBCE		;START ENCRYPTION?
	JP	Z,ENCR		;YES - ENCRYPT
	CP	STDECR		;START DECRYPTION?
	JP	Z,DECR		;YES - DECRYPT
	CP	CBCD		;START DECRYPTION?
	JP	Z,DECR		;YES - DECRYPT
	CP	CPBCD		;START DECRYPTION?
	JP	Z,DECR		;YES - DECRYPT
	CP	GETKEY		;GET KEYBYTE?
	JP	Z,INKEYB	;YES - INPUT KEYBYTE
	CP	GETDAT		;GET DATABYTE?
	JP	Z,INDATB	;YES - INPUT DATABYTE
	CP	PUTDAT		;SEND DATABYTE?
	JP	Z,OUTDATB	;YES - OUTPUT DATABYTE
	CP	GETICV		;GET INI.VAL?
	JP	Z,INICB		;YES - INPUT INI.VAL BYTE
	CP	RESICV		;RESET INI.VAL?
	JR	Z,RESINIV	;YES - RESET INI.VAL
	LD	C,0FFH		;INDICATE COMMAND ERROR
	JR	TXA		;SEND STATUS CH-A
;
;	TRANSMIT STATUS BYTE
;
TXSTA:
	LD	A,(STATUS)	;GET STATUS BYTE
	LD	C,A		;PUT IN <C>
TXA:
	IN	A,(SIOAC)	;TX-BUFFER STATUS
	BIT	2,A		;EMPTY?
	JR	Z,TXA		;NO - LOOP UNTIL READY
	LD	A,C		;GET BYTE TO SEND
	OUT	(SIOAD),A	;SEND IT
	JP	IDLE		;LOOK FOR NEW COMMAND
;
;	GET KEYBYTE FROM PORT B
;
INKEYB:
	LD	HL,DTR1
	LD	C,SIOBC
	LD	B,2
	OTIR
IKB0:
	IN	A,(SIOBC)	;GET STATUS
	BIT	0,A		;CHAR AVAILABLE?
	JR	Z,IKB0		;LOOP IF NOT
	LD	HL,DTR0
	LD	C,SIOBC
	LD	B,2
	OTIR
	IN	A,(SIOBD)	;GET DATABYTE
	PUSH	AF		;SAVE <A>
	LD	HL,KEY		;POINT TO KEY
	LD	A,(KEYCNT)	;GET KEY COUNT
	AND	07H		;MASK COUNT MOD 8
	LD	C,A		;MOVE <A> TO <C>
	LD	D,A		;SAVE IN <D>
	LD	B,0		;ZAP <B>
	ADD	HL,BC		;POINT TO BYTE
	POP	AF		;RESTORE INPUT BYTE
	LD	(HL),A		;MOVE INTO KEY
	LD	A,D		;GET KEY COUNT
	INC	A		;INCREMENT
	AND	07H		;MASK COUNT MOD 8
	LD	(KEYCNT),A	;RESTORE KEY COUNT
	LD	A,(STATUS)	;GET STATUS
	JR	NZ,IKB1		;JUMP IF KEY COUNT NOT FULL
	SET	5,A		;MARK FULL
	JR	IKB2		;BYPASS
IKB1:
	RES	5,A		;MARK NOT FULL
IKB2:
	SET	4,A		;MARK NOT EMPTY
	LD	(STATUS),A	;SAVE STATUS
	JP	TXSTA		;TRANSMIT STATUS
;
;	RESET INI.VAL FROM ORG VALUE
;
RESINIV:
	MOVE	IBCW,IBC
	LD	A,(STATUS)	;GET STATUS
	AND	0C0H		;MASK ACTUAL BYTES
	LD	A,(STATUS)
	JP	Z,TXSTA		;RETURN IF NOT LOADED
	SET	7,A		;SET BIT 7
	RES	6,A		;MARK INI.VAL RESET
	LD	(STATUS),A	;UPDATE STATUS
	JP	TXSTA		;SEND STATUS
;
;	GET INI.VAL BYTE FROM PORT B
;
INICB:
	LD	HL,DTR1
	LD	C,SIOBC
	LD	B,2
	OTIR
IIB0:
	IN	A,(SIOBC)	;GET STATUS
	BIT	0,A		;CHAR. AVAILABLE?
	JR	Z,IIB0		;LOOP IF NOT
	LD	HL,DTR0		;RESET DTR
	LD	C,SIOBC
	LD	B,2
	OTIR
	IN	A,(SIOBD)	;GET DATABYTE
	PUSH	AF		;SAVE <A>
	LD	HL,IBC		;POINT TO INI-BYTE START VALUE
	LD	A,(IBCCNT)	;GET INI COUNT
	AND	07H		;MASK COUNT MOD 8
	LD	C,A		;MOVE <A> TO <C>
	LD	D,A		;SAVE IN <D>
	LD	B,0		;ZAP <B>
	ADD	HL,BC		;POINT TO BYTE
	POP	AF		;RESTORE INPUT BYTE
	LD	(HL),A		;MOVE INTO I-DATA
	LD	A,D		;GET INI COUNT
	INC	A		;INCREMENT
	AND	07H		;MASK COUNT MOD 8
	LD	(IBCCNT),A	;RESTORE INI COUNT
	LD	A,(STATUS)	;GET STATUS
	JR	NZ,IIB1		;JUMP IF INI COUNT NOT FULL
	SET	7,A		;MARK FULL
	JR	IIB2		;BYPASS
IIB1:
	RES	7,A		;MARK NOT FULL
IIB2:
	SET	6,A		;MARK NOT EMPTY
	LD	(STATUS),A	;SAVE STATUS
	JP	TXSTA		;TRANSMIT STATUS
;
;	GET DATABYTE FROM PORT B
;
INDATB:
	LD	HL,DTR1
	LD	C,SIOBC
	LD	B,2
	OTIR
IDB0:
	IN	A,(SIOBC)	;GET STATUS
	BIT	0,A		;CHAR. AVAILABLE?
	JR	Z,IDB0		;LOOP IF NOT
	LD	HL,DTR0		;RESET DTR
	LD	C,SIOBC
	LD	B,2
	OTIR
	IN	A,(SIOBD)	;GET DATABYTE
	PUSH	AF		;SAVE <A>
	LD	HL,IDATA	;POINT TO I-DATA
	LD	A,(IDATCNT)	;GET I-DATA COUNT
	AND	07H		;MASK COUNT MOD 8
	LD	C,A		;MOVE <A> TO <C>
	LD	D,A		;SAVE IN <D>
	LD	B,0		;ZAP <B>
	ADD	HL,BC		;POINT TO BYTE
	POP	AF		;RESTORE INPUT BYTE
	LD	(HL),A		;MOVE INTO I-DATA
	LD	A,D		;GET INI COUNT
	INC	A		;INCREMENT
	AND	07H		;MASK COUNT MOD 8
	LD	(IDATCNT),A	;RESTORE I-DATA COUNT
	LD	A,(STATUS)	;GET STATUS
	JR	NZ,IDB1		;JUMP IF I-DATA COUNT NOT FULL
	SET	1,A		;MARK FULL
	JR	IDB2		;BYPASS
IDB1:
	RES	1,A		;MARK NOT FULL
IDB2:
	SET	0,A		;MARK NOT EMPTY
	LD	(STATUS),A	;SAVE STATUS
	JP	TXSTA		;TRANSMIT STATUS
;
;	PUT DATABYTE TO PORT B
;
OUTDATB:
ODB0:
	IN	A,(SIOBC)	;GET STATUS
	BIT	2,A		;TX BUFFER EMPTY?
	JR	Z,ODB0		;LOOP IF NOT
	LD	HL,ODATA	;POINT TO O-DATA 
	LD	A,(ODATCNT)	;GET O-DATA COUNT
	AND	07H		;MASK COUNT MOD 8
	LD	C,A		;MOVE <A> TO <C>
	LD	D,A		;SAVE IN <D>
	LD	B,0		;ZAP <B>
	ADD	HL,BC		;POINT TO BYTE
	LD	A,(HL)		;GET DATA
	OUT	(SIOBD),A	;GET DATABYTE
	LD	A,D		;GET O-DATA COUNT
	INC	A		;INCREMENT
	AND	07H		;MASK COUNT MOD 8
	LD	(ODATCNT),A	;RESTORE O-DATA COUNT
	LD	A,(STATUS)	;GET STATUS
	JR	NZ,ODB1		;JUMP IF O-DATA COUNT NOT EMPTY
	RES	2,A		;MARK EMPTY
ODB1:
	RES	3,A		;MARK NOT FULL
	LD	(STATUS),A	;SAVE STATUS
	JP	TXSTA		;TRANSMIT STATUS
;
;	CLEAR KEY TO ALL ZERO
;
CLRKEY:
	CALL	CCK0		;CLEAR KEY
	JP	TXSTA		;SEND STATUS
CCK0:
	LD	HL,KEY		;POINT TO KEY
	LD	B,8		;COUNT 8 BYTES
	XOR	A		;ZAP <A>
CCK1:
	LD	(HL),A		;ZAP BYTE
	INC	HL		;POINT TO NEXT
	DJNZ	CCK1		;LOOP 8 TIMES
	CALL	CKEY		;CALCULATE SUBKEYS
	LD	A,(STATUS)	;GET STATUS
	AND	0CFH		;RESET KEYFLAGS
	OR	020H		;MARK ZERO AND FULL
	LD	(STATUS),A	;RESTORE STATUS
	RET			;RETURN
;
;	CALCULATE SUBKEYS
;
ZKEY:
	CALL	CKEY		;CALCULATE SUBKEYS
	JP	TXSTA		;SEND STATUS
;
;	CLEAR WORK-AREA;
;
CLRW:
	LD	HL,WORK
	XOR	A
	LD	B,WORKL
CW1:
	LD	(HL),A
	INC	HL
	DJNZ	CW1
	RET
;
;	ENCRYPTION ROUTINE
;
ENCR:
	LD	HL,SKEYS	;ADDR OG SUB-KEYS 1 - 16
	JR	EDCR		;COMMON ROUTNIE
;
;	DECRYPTION ROUTINE
;
DECR:
	LD	HL,DKEYS	;ADDR OF SUB-KEYS 16 - 1
EDCR:
	LD	(SKEYP),HL	;STORE S-KEY POINTER
	LD	A,(CMDBYT)	;GET COMMAND BYTE
	CP	CBCE		;ENCR WITH CBC?
	JR	Z,CRB1		;YES
	CP	CPBCE		;ENCR WITH CPBC?
	JR	NZ,CRB2		;NO BYPASS
CRB1:
	MOVE	IDATAH,IDATA
	ADXOR	IDATA,IBCW
CRB2:
	CALL	CRYPT		;PERFORM ALGORITHM
	LD	A,(CMDBYT)	;GET COMMAND
	CP	CBCD		;DECRYPTION WITH CBC?
	JR	Z,CRK0		;YES
	CP	CPBCD		;CPBCD?
	JR	Z,CRK1		;YES
	CP	CPBCE		;ENCRYPTION WITH CPBC?
	JR	Z,CRK2		;YES
	CP	CBCE		;ENCRYPTION WITH CBC?
	JR	Z,CRK4		;YES
	JR	CRK5		;NORMAL EECRYPTION
;
CRK0:				;DECR WITH CBC
	ADXOR	ODATA,IBCW
	MOVE	IBCW,IDATA
	JR	CRK5
;
CRK1:				;DECR WITH CPBC
	ADXOR	ODATA,IBCW
	MOVE	IBCW,ODATA
	ADXOR	IBCW,IDATA
	JR	CRK5
;
CRK2:				;ENCR WITH CPBC
	MOVE	IBCW,ODATA
	ADXOR	IBCW,IDATAH
	JR	CRK5
;
CRK3:				;DECR WITH CBC
	MOVE	IBCW,IDATA
	JR	CRK5
;
CRK4:				;ENCR WITH CBC
	MOVE	IBCW,ODATA
CRK5:
	LD	A,(STATUS)	;GET STATUS
	AND	0F0H		;RESET I/O DATABLOCK FLAGS
	OR	00CH		;SET OUTPUT DATABLOCK FULL
	LD	(STATUS),A	;RESTORE STATUS
	JP	TXSTA		;TRANSMIT STATUS
;
;	COMMON ROUTINE FOR ENCRYPTION AND DECRYPTION
;
CRYPT:
	CALL	CLRW
	LD	HL,IDATA	;GET INPUT DATA ADDR.
	LD	(IWORD),HL	;SAVE THEM
	LD	HL,LR		;ADDR OF LEFT-RIGHT
	LD	(OWORD),HL	;SAVE IT
	LD	HL,IPERM	;ADDR OF INPUT PERMUT. TABLE
	LD	(PTAB),HL	;SAVE IT
	LD	A,64		;PERMUTATE 64 BITS
	CALL	PERM		;PERMFORM PERMUTATION
	LD	B,16		;PREPARE FOR 16 ITERATIONS
CRYPT1:
	PUSH	BC		;SAVE <BC>
	CALL	CIFCAL		;PERFORM BOX-CALC. AND PERMUT.
	CALL	EXCHLR		;EXCHANGE LEFT & RIGHT
▶8a◀	POP	BC		;RESTORE <BC>
	DJNZ	CRYPT1		;LOOP TIL DONE
	CALL	EXCHLR		;EXCHANGE LEFT & RIGHT BACK AGAIN
	LD	HL,LR		;ADDR OF LEFT & RIGHT
	LD	(IWORD),HL	;SAVE IT
	LD	HL,ODATA	;ADDR OF OUTPUT BLOCK
	LD	(OWORD),HL	;SAVE IT
	LD	HL,OPERM	;ADDR OF OUTPUT PERMUTATION TABLE
	LD	(PTAB),HL	;SAVE IT
	LD	A,64		;PERMUTATE 64 BITS
	CALL	PERM		;PERFORM PERMUTATION
	RET
;
;	CIFFER CALCULATOR
;	(SKEYP) POINTS TO SUBKEY
;	INPUT:	LEFT & RIGHT
;	OUTPUT: SAME
;
CIFCAL:
	LD	HL,RIGHT	;ADDR OF RIGHT HALF WORD
	LD	(IWORD),HL	;SAVE IT
	LD	HL,BUF48	;ADDR OF 48-BIT BUFFER
	LD	(OWORD),HL	;SAVE IT
	LD	HL,ELIST	;ADDR OF E-PERM.-LIST
	LD	(PTAB),HL	;SAVE IT
	LD	A,48		;PERM. 48 BITS
	CALL	PERM		;PERMUTATE
	LD	HL,BUF48	;ADDR OG 48-BIT BUFFER
	LD	DE,(SKEYP)	;SUB-KEY POINTER
	LD	B,6		;XOR 6 BYTES
	CALL	ADDER		;ADD MODULUS 2
	LD	(SKEYP),DE	;UPDATED VALUE TO (SKEYP)
;
;	S-BOX CALCULATION
;
SBOX:
	LD	HL,STABS	;ADDR OF S-TABLES
	LD	(SBUF),HL	;SAVE IT
	LD	HL,BUFP		;ADDR OF 48-BIR RESULT WORD
	LD	(PBUF),HL	;SAVE IT
	LD	B,8		;8 S-BOXES
GET6:
	PUSH	BC		;SAVE COUNTER
	XOR	A		;RESET FLAGS AND CLEAR <A>
	LD	B,6		;GET 6 BITS PER BOX
SHBF48:
	LD	C,A		;SAVE <A> IN <C>
	PUSH	BC		;SAVE COUNTER AND <C>
	LD	HL,BUF48+5	;POINT TO LAST BYTE OF START BUFFER
	XOR	A		;RESET FLAGS
	LD	B,6		;SHIFT 6 BYTES TO SHIFT ALL 48 BITS
SHB1:
	LD	A,(HL)		;GET BYTE
	RL	A		;ROTATE LEFT
	LD	(HL),A		;RESTORE BYTE
▶8a◀	DEC	HL		;POINT TO BYTE BEFORE
	DJNZ	SHB1		;LOOP FOR ALL 6 BYTES
	POP	BC		;RESTORE COUNTER AND <C>
	LD	A,C		;PUT <C> BACK TO <A>
	ADC	A,A		;MULTIPLY BY 2 AND ADD <CY>
	DJNZ	SHBF48		;LOOP FOR ALL 6 BITS
;
	LD	HL,(SBUF)	;POINT TO S-TABLE
	PUSH	HL		;SAVE ADDR
	LD	BC,64		;ADD LENGTH
	ADD	HL,BC		;POINT TO NEXT S-TABLE
	LD	(SBUF),HL	;SAVE ADDR
	POP	HL		;RESTORE S-TABLE ADDR
	LD	C,A		;GET INDEX IN <C> (<B> IS ZERO)
	ADD	HL,BC		;POINT TO S-TABLE VALUE
	LD	A,(HL)		;GET IT IN <A>
	LD	HL,(PBUF)	;GET ADDR OF RESULT BUFFER
	LD	(HL),A		;STORE VALUE
	INC	HL		;POINT TO NEXT BYTE
	LD	(PBUF),HL	;SAVE ADDR
	POP	BC		;RESTORE S-BOX COUNTER
	DJNZ	GET6		;LOOP UNTIL ALL 8 S-BOXES
;
;	BUFP NOW HAVE 8 4-BIT VALUES (ONE IN EACH BYTE)
;
	LD	HL,BUFP		;GET RESULT BUFFER
	LD	(IWORD),HL	;SAVE IT
	LD	HL,BUFPL	;ADDR OG P-L
	LD	(OWORD),HL	;SAVE IT
	LD	HL,PLIST	;ADDR OF P-PERM.-LIST
	LD	(PTAB),HL	;SAVE IT
	LD	A,32
	CALL	PERM		;MAKE 32 BIT
;
;	RESULT IS NOW IN BUFPL
;
	LD	HL,LEFT		;ADDR OF LEFT HALF WORD
	LD	DE,BUFPL	;ADDR OF BOX CALCULATION
	LD	B,4		;ADD 4 BYTES MOD 2
;
;	ADD BUFFER POINTED TO BY <HL>
;	AND BUFFER POINTED TO BY <DE> MODULUS 2 (XOR)
;	<B> GIVES # OF BYTES TO ADD.
;	RESULT IS WORD FROM <HL>
;
ADDER:
	LD	A,(DE)		;GET BYTE
	XOR	(HL)		;XOR WITH (<HL>)
	LD	(HL),A		;STORE RESULT
	INC	HL		;NEXT BYTE
	INC	DE		;NEXT BYTE
	DJNZ	ADDER		;LOOP TILL DONE
	RET
;
;
▶8a◀;	EXCHANGE LEFT AND RIGHT
;
EXCHLR:
	LD	HL,(LEFT)	;TAKE FIRST 2 BYTES OF LEFT
	PUSH	HL		;SAVE THEM
	LD	HL,(RIGHT)	;TAKE FIRST 2 BYTES OF RIGHT
	LD	(LEFT),HL	;PUT THEM IN LEFT
	POP	HL		;RESTORE LEFT (1 & 2)
	LD	(RIGHT),HL	;PUT THEM IN RIGHT
	LD	HL,(LEFT+2)
	PUSH	HL
	LD	HL,(RIGHT+2)
	LD	(LEFT+2),HL
	POP	HL
	LD	(RIGHT+2),HL
	RET
;
;
;	GENERATE 16 SUBKEYS FROM 64 BIT IN 'KEY'
;	(BIT 0 OF EACH BYTE IS PARITY AND IGNORED)
;
CKEY:
	CALL	CLRW
	LD	HL,KEY
	LD	(IWORD),HL	;ADDR OF START VALUE
	LD	HL,CD
	LD	(OWORD),HL	;ADDR OF RESULT VALUE
	LD	HL,PC1
	LD	(PTAB),HL	;ADDR OF PERMUTATION TAB.
	LD	A,56		;# OF BITS TO PERMUTATE
	CALL	PERM
	LD	HL,CD
	LD	(IWORD),HL
	LD	HL,SKEYS	;POINT TO ADDR OF SUB-KEYS
	LD	BC,0		;INITIALIZE COUNTER
CKEY1:
	PUSH	BC		;SAVE COUNTER
	PUSH	HL		;SAVE SUB-KEY ADDR
	CALL	CSUBK		;CALCULATE SUBKEY (<C>)
	POP	HL		;RESTORE SUBKEY ADDR
	LD	BC,6
	ADD	HL,BC		;POINT TO NEXT SUB-KEY ADDR
	POP	BC		;RESTORE COUNTER
	INC	C		;INCREMENT COUNTER
	LD	A,16		;SET MAX COUNTER
	CP	C		;LAST SUB-KEY
	JR	NZ,CKEY1	;LOOP UNTIL LAST SUB-KEY
;
	LD	DE,DKEYS	;SUBKEY LIST FOR DECRYPTION
	LD	HL,DKEYS-6	;ADDR OF SUB-KEY-16
	LD	B,16		;MOVE 16 SUBKEYS
DK1:
	PUSH	BC		;SAVE <BC>
	LD	BC,6		;MOVE 6 BYTES (48-BITS)
	LDIR			;MOVE
	LD	BC,12		;LENGTH OF 2 SUB-KEYS
▶8a◀	XOR	A		;RESET <CY>
	SBC	HL,BC		;POINT TO SUBKEY BEFORE
	POP	BC		;RESTORE <BC>
	DJNZ	DK1		;LOOP TIL ALL 16 SUBKEYS ARE MOVED
;
	RET			;EXIT KEY-GENERATION
;
;	CALCULATE SUBKEY (<C>)
;
CSUBK:
	LD	(OWORD),HL	;DESTINATION = SUB-KEY (<C>)
	LD	HL,SHTAB	;POINT TO SHIFT TABLE
	ADD	HL,BC		;POINT TO RIGHT SHIFT FACTOR
	LD	A,(HL)		;GET IT
	LD	B,A		; AND PUT IT IN <A>
CS1:
	PUSH	BC		;SAVE SHIFT FACTOR
	CALL	SHFTCD		;SHIFT 1 BIT
	POP	BC		;RESTORE SHIFT FACTOR
	DJNZ	CS1		;LOOP IF NOT ZERO
	LD	A,48		;# OF BITS TO PERMUTATE
	LD	HL,PC2		;GET PERMUTATION TABLE ADDR
	LD	(PTAB),HL	;PUT IT IN ARGUMENT
	CALL	PERM		;PERMUTATE SUB-KEY
	RET
;
;	PERMUTATIONS ROUTINE.
;	<A> = # OF BITS TO PERMUTATE
;
PERM:
	PUSH	AF		;SAVE # OF BITS
	SRL	A		;DIVIDE BY 2
	SRL	A		;DIVIDE BY 2
	SRL	A		;DIVIDE BY 2
	LD	B,A		;# OF BITS TO <B>
	LD	HL,(OWORD)	;POINT TO DESTINATION
PERM0:
	LD	(HL),0		;CLEAR DESTINATION BYTE
	INC	HL		;POINT TO NEXT BYTE
	DJNZ	PERM0		;LOOP UNTIL ALL BYTES ARE CLEARED
	POP	AF		;RESTORE <A>
	LD	C,0		;INIT COUNTER
PERM1:
	PUSH	AF		;RESTORE # OF BITS
	PUSH	BC		;SAVE COUNTER
	CALL	PERMBIT		;PERMUTATE BIT
	POP	BC		;RESTORE COUNTER
	INC	C		;INCREMENT COUNTER
	POP	AF		;GET MAX COUNTER
	CP	C		;ALL BITS PERMUTATED?
	JR	NZ,PERM1	;LOOP IF NOT
	RET
;
;	BIT-PERMUTATION ROUTINE
;	<C> = BIT # TO BE PERMUTATED (0-63)
▶8a◀;
PERMBIT:
	LD	HL,(PTAB)	;ADDR OF PERMTAB
	LD	B,0
	PUSH	BC
	ADD	HL,BC
	LD	A,(HL)
	DEC	A		;PERMTAB HAS VALUE FROM 1 ->
	PUSH	AF		;SAVE BIT #
	SRL	A		;DIVIDE BY 2
	SRL	A		;DIVIDE BY 2
	SRL	A		;DIVIDE BY 2
	LD	HL,(IWORD)	;GET ADDR OF INPUT WORD(64-BIT)
	LD	C,A		;BYTE # IN <C> (<B> IS 0 )
	ADD	HL,BC		;<HL> POINTS TO BYTE IN IWORD
	POP	AF		;GET BIT #
	AND	7		;MASK BIT # IN BYTE
	INC	A		;FIRST BIT IS #1
	LD	B,A		;LOAD BIT # IN <B>
	LD	A,(HL)		;GET ORG.-BYTE FROM IWORD
PB1:
	RL	A		;ROTATE BIT INTO <CY>
	DJNZ	PB1		;LOOP UNTIL RIGHT BIT
;
;	OBS!	<CY> NOW HAS THE VALUE OF THE PERMUTATED BIT.
;
	POP	BC		;GET BIT #
	PUSH	AF		;SAVE <CY>
	LD	A,C		;GET BIT # IN <A>
	PUSH	AF		;SAVE BIT #
	SRL	A		;DIVIDE BY 2
	SRL	A		;DIVIDE BY 2
	SRL	A		;DIVIDE BY 2
	LD	HL,(OWORD)	;GET ADDR OF ONPUT WORD(64-BIT)
	LD	C,A		;BYTE # IN <C> (<B> IS 0 )
	ADD	HL,BC		;<HL> POINTS TO BYTE IN OWORD
	POP	AF		;GET BIT #
	AND	7		;MASK BIT # IN BYTE
	INC	A		;FIRST BIT IS #1
	LD	B,A		;LOAD BIT # IN <B>
	POP	AF		;RESTOR <CY>
	LD	A,0		;CLEAR <A> WITHOUT CHANGING <CY>
PB2:
	RRA			;ROTATE <CY> TO RIGHT POSISTION
	DJNZ	PB2		;LOOP
	OR	(HL)		;OR WITH BYTE IN OUTPUT WORD
	LD	(HL),A		;PUT NEW VALUE OG BYTE.
	RET
;
;	SHIFT 2 * 28 BIT (CD) POINTED TO BY IWORD
;
SHFTCD:
	LD	HL,(IWORD)	;POINT TO START VALUE
	LD	BC,6
	ADD	HL,BC		;POINT TO LAST BYTE
▶8a◀	XOR	A		;RESET <CY>
	LD	B,7		;SHIFT 7 BYTES
SH1:
	LD	A,(HL)		;GET BYTE
	RL	A		;ROTATE LEFT
	LD	(HL),A		;RESTORE BYTE
	DEC	HL		;POINT TO BYTE BEFORE
	DJNZ	SH1		;LOOP
	PUSH	AF		;SAVE <CY>
	LD	BC,4
	ADD	HL,BC		;POINT TO MID-BYTE
	LD	A,(HL)		;GET MID-BYTE
	AND	00010000B	;MASK LAST BIT OF 'C' (IN BIT 4)
	SRL	A
	SRL	A
	SRL	A
	SRL	A		;NOW MOVED TO BIT 0
	LD	BC,3		;POINT TO LAST BYTE
	ADD	HL,BC
	ADD	A,(HL)		;LAST BIT WAS ZERO
	LD	(HL),A		;REPLACE BYTE WITH MODIFIED
	POP	AF		;RESTORE <CY>
	LD	A,0		;ZAP <A> WITHOUT CHANGING <CY>
	JR	NC,SH2		;MAINTAIN ZERO IF NOT <CY>
	LD	A,00010000B	;SET BIT 4 IF <CY>
SH2:
	PUSH	AF		;SAVE <A>
	LD	HL,(IWORD)	;POINT TO VALUE
	LD	BC,3
	ADD	HL,BC		;POINT TO MID-BYTE
	RES	4,(HL)		;CLEAR BIT 4
	POP	AF		;RESTORE <A>
	ADD	A,(HL)
	LD	(HL),A
	RET
;
FIN	EQU	$
	IF FIN GT 800H
	.PRINTX	'MORE THAN 800H BYTES FOR PROGRAM'
	ENDIF
;
FILLER:	DS	800H-$
;
SIOBLK:				;SIO INIT BLOCKS
	DB	8,SIOAC,4,0CCH,5,06AH,3,0C1H,1,0
	DB	8,SIOBC,4,0CCH,5,06AH,3,0C1H,1,0
	DB	0
;
DTR0:	DB	5,6AH
DTR1:	DB	5,0EAH
;
STABS:
S1:	DB	14,0,4,15,13,7,1,4,2,14,15,2,11,13,8,1
	DB	3,10,10,6,6,12,12,11,5,9,9,5,0,3,7,8
	DB	4,15,1,12,14,8,8,2,13,4,6,9,2,1,11,7
	DB	15,5,12,11,9,3,7,14,3,10,10,0,5,6,0,13
S2:	DB	15,3,1,13,8,4,14,7,6,15,11,2,3,8,4,14
	DB	9,12,7,0,2,1,13,10,12,6,0,9,5,11,10,5
	DB	0,13,14,8,7,10,11,1,10,3,4,15,13,4,1,2
	DB	5,11,8,6,12,7,6,12,9,0,3,5,2,14,15,9
S3:	DB	10,13,0,7,9,0,14,9,6,3,03,4,15,6,5,10
	DB	1,2,13,8,12,5,7,14,11,12,4,11,2,15,8,1
	DB	13,1,6,10,4,13,9,0,8,6,15,9,3,8,0,7
	DB	11,4,1,15,2,14,12,3,5,11,10,5,14,2,7,12
S4:	DB	7,13,13,8,14,11,3,5,0,6,6,15,9,0,10,3
	DB	1,4,2,7,8,2,5,12,11,1,12,10,4,14,15,9
	DB	10,3,6,15,9,0,0,6,12,10,11,1,7,13,13,8
	DB	15,9,1,4,3,5,14,11,5,12,2,7,8,2,4,14
S5:	DB	2,14,12,11,4,2,1,12,7,4,10,7,11,13,6,1
	DB	8,5,5,0,3,15,15,10,13,3,0,9,14,8,9,6
▶8a◀	DB	4,11,2,8,1,12,11,7,10,1,13,14,7,2,8,13
	DB	15,6,9,15,12,0,5,9,6,10,3,4,0,5,14,3
S6:	DB	12,10,1,15,10,4,15,2,9,7,2,12,6,9,8,5
	DB	0,6,13,1,3,13,4,14,14,0,7,11,5,3,11,8
	DB	9,4,14,3,15,2,5,12,2,9,8,5,12,15,3,10
	DB	7,11,0,14,4,1,10,7,1,6,13,0,11,8,6,13
S7:	DB	4,13,11,0,2,11,14,7,15,4,0,9,8,1,13,10
	DB	3,14,12,3,9,5,7,12,5,2,10,15,6,8,1,6
	DB	1,6,4,11,11,13,13,8,12,1,3,4,7,10,14,7
	DB	10,9,15,5,6,0,8,15,0,14,5,2,9,3,2,12
S8:	DB	13,1,2,15,8,13,4,8,6,10,15,3,11,7,1,4
	DB	10,12,9,5,3,6,14,11,5,0,0,14,12,9,7,2
	DB	7,2,11,1,4,14,1,7,9,4,12,10,14,8,2,13
	DB	0,15,6,12,10,9,13,0,15,3,3,5,5,6,8,11
;
ELIST:	DB	32,1,2,3,4,5,4,5,6,7,8,9,8,9,10,11,12,13,12,13,14,15,16,17
	DB	16,17,18,19,20,21,20,21,22,23,24,25,24,25,26,27,28,29
	DB	28,29,30,31,32,1
;
PLIST:	DB	16+16,7+8,20+20,21+24,29+32,12+12,28+28,17+20,1+4
	DB	15+16,23+24,26+28,5+8,18+20,31+32,10+12
	DB	2+4,8+8,24+24,14+16,32+32,27+28,3+4,9+12,19+20
	DB	13+16,30+32,6+8,22+24,11+12,4+4,25+28
;
IPERM:	DB	58,50,42,34,26,18,10,2
	DB	60,52,44,36,28,20,12,4
	DB	62,54,46,38,30,22,14,6
	DB	64,56,48,40,32,24,16,8
	DB	57,49,41,33,25,17,9,1
	DB	59,51,43,35,27,19,11,3
	DB	61,53,45,37,29,21,13,5
	DB	63,55,47,39,31,23,15,7
;
OPERM:	DB	40,8,48,16,56,24,64,32
	DB	39,7,47,15,55,23,63,31
	DB	38,6,46,14,54,22,62,30
	DB	37,5,45,13,53,21,61,29
	DB	36,4,44,12,52,20,60,28
	DB	35,3,43,11,51,19,59,27
	DB	34,2,42,10,50,18,58,26
	DB	33,1,41,9,49,17,57,25
;
PC1:	DB	57,49,41,33,25,17,9
	DB	1,58,50,42,34,26,18
	DB	10,2,59,51,43,35,27
	DB	19,11,3,60,52,44,36
	DB	63,55,47,39,31,23,15
	DB	7,62,54,46,38,30,22
	DB	14,6,61,53,45,37,29
	DB	21,13,5,28,20,12,4
;
PC2:	DB	14,17,11,24,1,5
	DB	3,28,15,6,21,10
	DB	23,19,12,4,26,8
	DB	16,7,27,20,13,2
	DB	41,52,31,37,47,55
	DB	30,40,51,45,33,48
	DB	44,49,39,56,34,53
	DB	46,42,50,36,29,32

SHTAB:	DB	1,1,2,2,2,2,2,2,1,2,2,2,2,2,2,1
;
;
	.DEPHASE
;
;	RAM ARAE
;
	.PHASE	RAM
;
STATUS:	DS	1
CMDBYT:	DS	1
KEY:	DS	8
IDATA:	DS	8
IDATAH:	DS	8
ODATA:	DS	8
IBC:	DS	8
IBCW:	DS	8
IDATCNT:DS	1
ODATCNT:DS	1
KEYCNT:	DS	1
IBCCNT:	DS	1
SKEYP:	DS	2
;
WORK	EQU	$
IWORD:	DS	2
OWORD:	DS	2
PTAB:	DS	2
SBUF:	DS	2
PBUF:	DS	2
BUFP:	DS	8
BUF48:	DS	6
CD:	DS	8
BUFPL:	DS	4
LR	EQU	$
▶8a◀LEFT:	DS	4
RIGHT:	DS	4
WORKL	EQU	$-WORK
;
SKEYS:	DS	16*6

DKEYS:	DS	16*6
;
	DS	100
STACK:
	END;

«eof»