-- Copyright (C) 1984 by Xerox Corporation. All rights reserved.
-- DESDLion.mesa, HGM, 12-Jan-84 22:48:38
DIRECTORY
Environment USING [Byte],
Inline USING [DBITXOR],
Mopcodes USING [zESC],
DESFace USING [Block, Blocks, Direction, IV, Key, Mode, parityTable];
DESDLion: MONITOR IMPORTS Inline EXPORTS DESFace SHARES DESFace =
BEGIN
BadParity: ERROR = CODE;
NotImplemented: ERROR = CODE;
Register: TYPE = MACHINE DEPENDENT {
data(0), command(2), mode(6)};
DESCtl: PROCEDURE [Register] = MACHINE CODE
BEGIN
Mopcodes.zESC, 0C0H;
END;
DESMP: PROCEDURE [Environment.Byte] = MACHINE CODE
BEGIN
Mopcodes.zESC, 0C1H;
END;
DESSP: PROCEDURE RETURNS [Environment.Byte] = MACHINE CODE
BEGIN
Mopcodes.zESC, 0C2H;
END;
DESWriteBlock: PROCEDURE [DESFace.Block] = MACHINE CODE
BEGIN
Mopcodes.zESC, 0C3H;
END;
DESReadBlock: PROCEDURE RETURNS [DESFace.Block] = MACHINE CODE
BEGIN
Mopcodes.zESC, 0C4H;
END;
DESWritePair: PROCEDURE [LONG CARDINAL] = MACHINE CODE
BEGIN
Mopcodes.zESC, 0C5H;
END;
DESReadPair: PROCEDURE RETURNS [LONG CARDINAL] = MACHINE CODE
BEGIN
Mopcodes.zESC, 0C6H;
END;
Delay6: PROCEDURE =
BEGIN -- Wait (at least) 6 clicks
END;
ResetTheChip: PROCEDURE =
BEGIN
DESCtl[command];
DESMP[00H];
Delay6[];
[] ← DESSP[]; -- Discard leftover byte, if any (if not causes error, but nobody looks)
END;
LoadIV: PROCEDURE [ivP: LONG POINTER TO DESFace.IV, direction: DESFace.Direction] =
BEGIN
iv: LONG POINTER TO DESFace.Block = LOOPHOLE[ivP];
DESCtl[command];
DESMP[IF direction = encrypt THEN 85H ELSE 84H];
Delay6[];
DESCtl[data];
DESWriteBlock[iv↑];
END;
LoadKey: PROCEDURE [keyP: LONG POINTER TO DESFace.Key, direction: DESFace.Direction] =
BEGIN
key: LONG POINTER TO DESFace.Block = LOOPHOLE[keyP];
FOR i: CARDINAL IN [0..7] DO
IF keyP[i].p # DESFace.parityTable[keyP[i].b] THEN ERROR BadParity;
ENDLOOP;
DESCtl[command];
DESMP[IF direction = encrypt THEN 11H ELSE 12H];
Delay6[];
DESCtl[data];
DESWriteBlock[key↑];
END;
SetMode: PROCEDURE [mode: DESFace.Mode, direction: DESFace.Direction] =
BEGIN
byte: Environment.Byte;
SELECT direction FROM
encrypt => byte ← 14H;
decrypt => byte ← 00H;
ENDCASE => ERROR;
SELECT mode FROM
ecb => NULL;
cbc => byte ← byte + 2;
cbcCheck => byte ← byte + 2;
ENDCASE => ERROR;
DESCtl[mode];
DESMP[byte];
Delay6[];
END;
CrunchBytes: PROCEDURE [from, to: DESFace.Blocks, nBlks: CARDINAL] =
BEGIN
Bytes: TYPE = LONG POINTER TO PACKED ARRAY [0..8) OF Environment.Byte;
DESCtl[command];
DESMP[0C0H]; -- Start
DESCtl[data];
FOR i: CARDINAL IN [0..nBlks) DO
f: Bytes = LOOPHOLE[@from[i]];
t: Bytes = LOOPHOLE[@to[i]];
FOR i: CARDINAL IN [0..8) DO DESMP[f[i]]; ENDLOOP;
Delay6[]; Delay6[]; Delay6[];
FOR i: CARDINAL IN [0..8) DO t[i] ← DESSP[]; ENDLOOP;
ENDLOOP;
END;
CrunchSingleBlocks: PROCEDURE [from, to: DESFace.Blocks, nBlks: CARDINAL] =
BEGIN
f: LONG POINTER TO DESFace.Block ← @from[0];
t: LONG POINTER TO DESFace.Block ← @to[0];
DESCtl[command];
DESMP[0C0H]; -- Start
Delay6[];
DESCtl[data];
FOR i: CARDINAL IN [0..nBlks) DO
DESWriteBlock[f↑];
Delay6[]; Delay6[]; Delay6[]; Delay6[];
t↑ ← DESReadBlock[];
f ← f + SIZE[DESFace.Block];
t ← t + SIZE[DESFace.Block];
ENDLOOP;
END;
CrunchBlocks: PROCEDURE [from, to: DESFace.Blocks, nBlks: CARDINAL] =
BEGIN
f: LONG POINTER TO DESFace.Block ← @from[0];
t: LONG POINTER TO DESFace.Block ← @to[0];
DESCtl[command];
DESMP[0C0H]; -- Start
Delay6[];
DESCtl[data];
IF nBlks = 0 THEN RETURN;
DESWriteBlock[f↑];
Delay6[];
IF nBlks = 1 THEN BEGIN Delay6[]; Delay6[]; END;
FOR i: CARDINAL IN [0..nBlks-1) DO
f ← f + SIZE[DESFace.Block];
DESWriteBlock[f↑];
t↑ ← DESReadBlock[];
t ← t + SIZE[DESFace.Block];
ENDLOOP;
t↑ ← DESReadBlock[];
END;
Crunch: PROCEDURE [from, to: DESFace.Blocks, nBlks: CARDINAL] =
BEGIN
TwoPairs: TYPE = RECORD [a, b: LONG CARDINAL];
f: LONG POINTER TO ARRAY [0..9) OF TwoPairs ← LOOPHOLE[@from[0]];
t: LONG POINTER TO ARRAY [0..8) OF TwoPairs ← LOOPHOLE[@to[0]];
DESCtl[command];
DESMP[0C0H]; -- Start
Delay6[];
DESCtl[data];
IF nBlks = 0 THEN RETURN;
DESWritePair[f[0].a];
DESWritePair[f[0].b];
f ← f + SIZE[DESFace.Block];
nBlks ← nBlks - 1;
IF nBlks = 0 THEN BEGIN Delay6[]; Delay6[]; END;
-- This is the GO FASTER feature
-- 4 blocks is as far as RLDILP+WLDILP can reach
UNTIL nBlks <= 4 DO
DESWritePair[f[0].a]; DESWritePair[f[0].b];
t[0].a ← DESReadPair[]; t[0].b ← DESReadPair[];
DESWritePair[f[1].a]; DESWritePair[f[1].b];
t[1].a ← DESReadPair[]; t[1].b ← DESReadPair[];
DESWritePair[f[2].a]; DESWritePair[f[2].b];
t[2].a ← DESReadPair[]; t[2].b ← DESReadPair[];
DESWritePair[f[3].a]; DESWritePair[f[3].b];
t[3].a ← DESReadPair[]; t[3].b ← DESReadPair[];
f ← f + SIZE[DESFace.Block, 4];
t ← t + SIZE[DESFace.Block, 4];
nBlks ← nBlks - 4;
ENDLOOP;
UNTIL nBlks = 0 DO
DESWritePair[f[0].a];
DESWritePair[f[0].b];
t[0].a ← DESReadPair[];
t[0].b ← DESReadPair[];
f ← f + SIZE[DESFace.Block];
t ← t + SIZE[DESFace.Block];
nBlks ← nBlks - 1;
ENDLOOP;
t[0].a ← DESReadPair[];
t[0].b ← DESReadPair[];
END;
CryptData: PUBLIC ENTRY PROCEDURE [
keyP: POINTER TO DESFace.Key, nBlks: CARDINAL, from, to: DESFace.Blocks,
direction: DESFace.Direction, mode: DESFace.Mode,
seedP: LONG POINTER TO DESFace.IV ← NIL] =
BEGIN ENABLE UNWIND => NULL;
IF mode = checksum THEN ERROR NotImplemented;
IF mode = cbcCheck AND direction = encrypt AND nBlks > 0 THEN
BEGIN
FOR blk: CARDINAL IN [0..nBlks - 1) DO
XOR64[@from[nBlks - 1], @from[blk], @from[nBlks - 1]]; ENDLOOP;
END;
ResetTheChip[];
SetMode[mode, direction];
LoadKey[keyP, direction];
IF mode = cbc OR mode = cbcCheck THEN LoadIV[seedP, direction];
Crunch[from, to, nBlks];
IF mode = cbcCheck AND direction = decrypt AND nBlks > 0 THEN
BEGIN
FOR blk: CARDINAL IN [0..nBlks - 1) DO
XOR64[@to[nBlks - 1], @to[blk], @to[nBlks - 1]]; ENDLOOP;
END
END;
Words4: TYPE = MACHINE DEPENDENT RECORD [a, b: LONG CARDINAL];
XOR64: PROCEDURE [a, b, out: LONG POINTER] = INLINE
BEGIN OPEN
aLP: LOOPHOLE[a, LONG POINTER TO Words4],
bLP: LOOPHOLE[b, LONG POINTER TO Words4],
outP: LOOPHOLE[out, LONG POINTER TO Words4];
outP.a ← Inline.DBITXOR[aLP.a, bLP.a];
outP.b ← Inline.DBITXOR[aLP.b, bLP.b];
END;
END.