DIRECTORY
Basics USING [BITXOR],
DESFace USING [Block, Blocks, Direction, IV, Key, Mode, nullKey],
PrincOps USING [zADD, zLI3, zLI6, zRFS, zSHIFT],
PrincOpsUtils USING [GetClockPulses];

DESImpl: MONITOR 
IMPORTS Basics, PrincOpsUtils
EXPORTS DESFace
SHARES DESFace
= BEGIN OPEN DESFace;


IKey: TYPE = ARRAY [1..16] OF Bits48;

LeftShift28In: TYPE = MACHINE DEPENDENT RECORD
[f1: [0..1], f2: [0..77777B], f3: [0..1], f4: [0..3777B], f5: [0..15]];

LeftShift28Out: TYPE = MACHINE DEPENDENT RECORD
[f1: [0..77777B], f2: [0..1], f3: [0..3777B], f4: [0..1], f5: [0..15]];

Bits32: TYPE = MACHINE DEPENDENT RECORD [
b1, b2, b3, b4, b5, b6, b7, b8,
b9, b10, b11, b12, b13, b14, b15, b16,
b17, b18, b19, b20, b21, b22, b23, b24,
b25, b26, b27, b28, b29, b30, b31, b32: [0..1]];
PBits32: TYPE = POINTER TO Bits32;

Bits48: TYPE = MACHINE DEPENDENT RECORD [
b1, b2, b3, b4, b5, b6, b7, b8,
b9, b10, b11, b12, b13, b14, b15, b16,
b17, b18, b19, b20, b21, b22, b23, b24,
b25, b26, b27, b28, b29, b30, b31, b32,
b33, b34, b35, b36, b37, b38, b39, b40,
b41, b42, b43, b44, b45, b46, b47, b48: [0..1]];
PBits48: TYPE = POINTER TO Bits48;

Bits64: TYPE = MACHINE DEPENDENT RECORD [
b1, b2, b3, b4, b5, b6, b7, b8,
b9, b10, b11, b12, b13, b14, b15, b16,
b17, b18, b19, b20, b21, b22, b23, b24,
b25, b26, b27, b28, b29, b30, b31, b32,
b33, b34, b35, b36, b37, b38, b39, b40,
b41, b42, b43, b44, b45, b46, b47, b48,
b49, b50, b51, b52, b53, b54, b55, b56,
b57, b58, b59, b60, b61, b62, b63, b64: [0..1]];
PBits64: TYPE = POINTER TO Bits64;
LPBits64: TYPE = LONG POINTER TO Bits64;

Words2: TYPE = MACHINE DEPENDENT RECORD [w1, w2: WORD];

Words3: TYPE = MACHINE DEPENDENT RECORD [w1, w2, w3: WORD];

Words4: TYPE = MACHINE DEPENDENT RECORD [w1, w2, w3, w4: WORD];

Sixes: TYPE = MACHINE DEPENDENT RECORD [
s1, s2: [0..63], s31: [0..15], s32: [0..3], s4, s5: [0..63], s61: [0..3], s62: [0..15], s7, s8: [0..63]];

Fours: TYPE = MACHINE DEPENDENT RECORD [f1, f2, f3, f4, f5, f6, f7, f8: [0..15]];

Sbox: TYPE = MACHINE DEPENDENT RECORD [
f1, f2, f3, f4, f5, f6, f7, f8,
f9, f10, f11, f12, f13, f14, f15, f16,
f17, f18, f19, f20, f21, f22, f23, f24,
f25, f26, f27, f28, f29, f30, f31, f32,
f33, f34, f35, f36, f37, f38, f39, f40,
f41, f42, f43, f44, f45, f46, f47, f48,
f49, f50, f51, f52, f53, f54, f55, f56,
f57, f58, f59, f60, f61, f62, f63, f64: [0..15]];



shifts: ARRAY [1..16] OF CARDINAL =
[1,1,2,2,2,2,2,2,1,2,2,2,2,2,2,1];

sbox1: Sbox = [
14,0,4,15,13,7,1,4,2,14,15,2,11,13,8,1,
3,10,10,6,6,12,12,11,5,9,9,5,0,3,7,8,
4,15,1,12,14,8,8,2,13,4,6,9,2,1,11,7,
15,5,12,11,9,3,7,14,3,10,10,0,5,6,0,13];
sbox2: Sbox = [
15,3,1,13,8,4,14,7,6,15,11,2,3,8,4,14,
9,12,7,0,2,1,13,10,12,6,0,9,5,11,10,5,
0,13,14,8,7,10,11,1,10,3,4,15,13,4,1,2,
5,11,8,6,12,7,6,12,9,0,3,5,2,14,15,9];
sbox3: Sbox = [
10,13,0,7,9,0,14,9,6,3,3,4,15,6,5,10,
1,2,13,8,12,5,7,14,11,12,4,11,2,15,8,1,
13,1,6,10,4,13,9,0,8,6,15,9,3,8,0,7,
11,4,1,15,2,14,12,3,5,11,10,5,14,2,7,12];
sbox4: Sbox = [
7,13,13,8,14,11,3,5,0,6,6,15,9,0,10,3,
1,4,2,7,8,2,5,12,11,1,12,10,4,14,15,9,
10,3,6,15,9,0,0,6,12,10,11,1,7,13,13,8,
15,9,1,4,3,5,14,11,5,12,2,7,8,2,4,14];
sbox5: Sbox = [
2,14,12,11,4,2,1,12,7,4,10,7,11,13,6,1,
8,5,5,0,3,15,15,10,13,3,0,9,14,8,9,6,
4,11,2,8,1,12,11,7,10,1,13,14,7,2,8,13,
15,6,9,15,12,0,5,9,6,10,3,4,0,5,14,3];
sbox6: Sbox = [
12,10,1,15,10,4,15,2,9,7,2,12,6,9,8,5,
0,6,13,1,3,13,4,14,14,0,7,11,5,3,11,8,
9,4,14,3,15,2,5,12,2,9,8,5,12,15,3,10,
7,11,0,14,4,1,10,7,1,6,13,0,11,8,6,13];
sbox7: Sbox = [
4,13,11,0,2,11,14,7,15,4,0,9,8,1,13,10,
3,14,12,3,9,5,7,12,5,2,10,15,6,8,1,6,
1,6,4,11,11,13,13,8,12,1,3,4,7,10,14,7,
10,9,15,5,6,0,8,15,0,14,5,2,9,3,2,12];
sbox8: Sbox = [
13,1,2,15,8,13,4,8,6,10,15,3,11,7,1,4,
10,12,9,5,3,6,14,11,5,0,0,14,12,9,7,2,
7,2,11,1,4,14,1,7,9,4,12,10,14,8,2,13,
0,15,6,12,10,9,13,0,15,3,3,5,5,6,8,11];



cachedKey: Key;
cachedIKey: IKey;
noKeyCached: BOOL _ TRUE;

parityTable: PACKED ARRAY [0..127] OF [0..1] _ [
1,0,0,1,0,1,1,0,0,1,1,0,1,0,0,1,
0,1,1,0,1,0,0,1,1,0,0,1,0,1,1,0,
0,1,1,0,1,0,0,1,1,0,0,1,0,1,1,0,
1,0,0,1,0,1,1,0,0,1,1,0,1,0,0,1,
0,1,1,0,1,0,0,1,1,0,0,1,0,1,1,0,
1,0,0,1,0,1,1,0,0,1,1,0,1,0,0,1,
1,0,0,1,0,1,1,0,0,1,1,0,1,0,0,1,
0,1,1,0,1,0,0,1,1,0,0,1,0,1,1,0
];

randomSeed: Block _ [0,0,0,0];


BadParity: ERROR = CODE;
NotImplemented: ERROR = CODE;


CryptData: PUBLIC PROC [
keyP: POINTER TO Key, nBlks: CARDINAL,
from, to: Blocks, direction: Direction, mode: Mode, seedP: LONG POINTER TO IV _ NIL] = {
newSeed: IV;
iKey: IKey;
iKeyP: POINTER TO IKey = @iKey;
iKeyStart: INTEGER = IF direction = encrypt THEN 1 ELSE 16;
iKeyIncr: INTEGER = IF direction = encrypt THEN 1 ELSE -1;
temp32: Bits32;
temp32Ptr: PBits32 = @temp32;
otherTemp32: Bits32;
otherTemp32Ptr: PBits32 = @otherTemp32;
left32: Bits32;
left32Ptr: PBits32 = @left32;
right32: Bits32;
right32Ptr: PBits32 = @right32;
temp48: Bits48;
temp48Ptr: PBits48 = @temp48;

IF mode = checksum THEN ERROR NotImplemented;

IF mode = cbcCheck AND direction = encrypt AND nBlks > 0 THEN
FOR blk: CARDINAL IN [0..nBlks-1) DO
XOR64[@from[nBlks-1], @from[blk], @from[nBlks-1]];
ENDLOOP;
InternalizeKey[keyP, iKeyP];
FOR blk: CARDINAL IN [0 .. nBlks) DO
i: INTEGER _ iKeyStart;
IF mode ~= ecb THEN
IF direction=encrypt THEN XOR64[@from[blk], seedP, @from[blk]]
ELSE newSeed _ from[blk];
PermInitial[@from[blk], left32Ptr, right32Ptr];
THROUGH [1..16] DO  -- main encryption loop
temp32 _ right32;  -- save old right half
PermE[right32Ptr, temp48Ptr];  -- E permutation
XOR48[temp48Ptr, @iKeyP[i], temp48Ptr];  -- XOR with key array element
SMap[temp48Ptr, right32Ptr];  -- apply the SBoxes
PermP[right32Ptr, otherTemp32Ptr];  -- P permutation
XOR32[left32Ptr, otherTemp32Ptr, right32Ptr];
left32 _ temp32;
i _ i + iKeyIncr;
ENDLOOP;
PermInverseInitial[right32Ptr, left32Ptr, @to[blk]];
IF mode ~= ecb THEN
IF direction=encrypt THEN seedP _ @to[blk]
ELSE {XOR64[@to[blk], seedP, @to[blk]]; seedP^ _ newSeed};
ENDLOOP;

IF mode = cbcCheck AND direction = decrypt AND nBlks > 0 THEN
FOR blk: CARDINAL IN [0..nBlks-1) DO
XOR64[@to[nBlks-1], @to[blk], @to[nBlks-1]];
ENDLOOP;
};

GetRandomIV: PUBLIC PROC RETURNS [iv: IV] = {
prevSeed: Block _ randomSeed;
temp: Block;
pulse: POINTER TO LONG CARDINAL = LOOPHOLE[@randomSeed];
seedKey: POINTER TO Key = LOOPHOLE[@randomSeed];
pulse^ _ pulse^ + PrincOpsUtils.GetClockPulses[];
temp _ [0,0,0,0];
CorrectParity[seedKey];
CryptData[keyP: seedKey, nBlks: 1,
from: LOOPHOLE[LONG[@temp], Blocks],
to:   LOOPHOLE[LONG[@randomSeed], Blocks],
direction: encrypt, mode: ecb, seedP: NIL];
CorrectParity[seedKey];
CryptData[keyP: seedKey, nBlks: 1,
from: LOOPHOLE[LONG[@prevSeed], Blocks],
to:   LOOPHOLE[LONG[@iv], Blocks],
direction: encrypt, mode: ecb, seedP: NIL];
};

GetRandomKey: PUBLIC PROC RETURNS [k: Key] = {
k _ LOOPHOLE[GetRandomIV[]];
CorrectParity[@k];
};

MakeKey: PUBLIC PROC [source: LONG STRING] RETURNS [key: Key] = {
key _ nullKey;
FOR i: CARDINAL IN [0..source.length) DO
j: CARDINAL = i MOD 8;
c: CHARACTER = IF source[i] IN ['A..'Z] THEN 'a + (source[i]-'A) ELSE source[i];
key[j].b _ Basics.BITXOR[LOOPHOLE[c, [0 .. 127]], key[j].b];
ENDLOOP;
CorrectParity[@key];
};

CorrectParity: PUBLIC PROC [keyP: LONG POINTER TO Key] = {
FOR i: CARDINAL IN [0 .. 7] DO keyP[i].p _ parityTable[keyP[i].b]; ENDLOOP;
};

PermInitial: PROC [inP: LONG POINTER, outLeft, outRight: PBits32] = INLINE {
OPEN in: LOOPHOLE[inP, LPBits64];
outLeft.b1 _ in.b58; outLeft.b2 _ in.b50; outLeft.b3 _ in.b42; outLeft.b4 _ in.b34;
outLeft.b5 _ in.b26; outLeft.b6 _ in.b18; outLeft.b7 _ in.b10; outLeft.b8 _ in.b2;
outLeft.b9 _ in.b60; outLeft.b10 _ in.b52; outLeft.b11 _ in.b44; outLeft.b12 _ in.b36;
outLeft.b13 _ in.b28; outLeft.b14 _ in.b20; outLeft.b15 _ in.b12; outLeft.b16 _ in.b4;
outLeft.b17 _ in.b62; outLeft.b18 _ in.b54; outLeft.b19 _ in.b46; outLeft.b20 _ in.b38;
outLeft.b21 _ in.b30; outLeft.b22 _ in.b22; outLeft.b23 _ in.b14; outLeft.b24 _ in.b6;
outLeft.b25 _ in.b64; outLeft.b26 _ in.b56; outLeft.b27 _ in.b48; outLeft.b28 _ in.b40;
outLeft.b29 _ in.b32; outLeft.b30 _ in.b24; outLeft.b31 _ in.b16; outLeft.b32 _ in.b8;
outRight.b1 _ in.b57; outRight.b2 _ in.b49; outRight.b3 _ in.b41; outRight.b4 _ in.b33;
outRight.b5 _ in.b25; outRight.b6 _ in.b17; outRight.b7 _ in.b9; outRight.b8 _ in.b1;
outRight.b9 _ in.b59; outRight.b10 _ in.b51; outRight.b11 _ in.b43; outRight.b12 _ in.b35;
outRight.b13 _ in.b27; outRight.b14 _ in.b19; outRight.b15 _ in.b11; outRight.b16 _ in.b3;
outRight.b17 _ in.b61; outRight.b18 _ in.b53; outRight.b19 _ in.b45; outRight.b20 _ in.b37;
outRight.b21 _ in.b29; outRight.b22 _ in.b21; outRight.b23 _ in.b13; outRight.b24 _ in.b5;
outRight.b25 _ in.b63; outRight.b26 _ in.b55; outRight.b27 _ in.b47; outRight.b28 _ in.b39;
outRight.b29 _ in.b31; outRight.b30 _ in.b23; outRight.b31 _ in.b15; outRight.b32 _ in.b7;
};

PermInverseInitial: PROC [inLeft, inRight: PBits32, outLP: LONG POINTER] = INLINE {
OPEN out: LOOPHOLE[outLP, LPBits64];
out.b1 _ inRight.b8; out.b2 _ inLeft.b8; out.b3 _ inRight.b16; out.b4 _ inLeft.b16;
out.b5 _ inRight.b24; out.b6 _ inLeft.b24; out.b7 _ inRight.b32; out.b8 _ inLeft.b32;
out.b9 _ inRight.b7; out.b10 _ inLeft.b7; out.b11 _ inRight.b15; out.b12 _ inLeft.b15;
out.b13 _ inRight.b23; out.b14 _ inLeft.b23; out.b15 _ inRight.b31; out.b16 _ inLeft.b31;
out.b17 _ inRight.b6; out.b18 _ inLeft.b6; out.b19 _ inRight.b14; out.b20 _ inLeft.b14;
out.b21 _ inRight.b22; out.b22 _ inLeft.b22; out.b23 _ inRight.b30; out.b24 _ inLeft.b30;
out.b25 _ inRight.b5; out.b26 _ inLeft.b5; out.b27 _ inRight.b13; out.b28 _ inLeft.b13;
out.b29 _ inRight.b21; out.b30 _ inLeft.b21; out.b31 _ inRight.b29; out.b32 _ inLeft.b29;
out.b33 _ inRight.b4; out.b34 _ inLeft.b4; out.b35 _ inRight.b12; out.b36 _ inLeft.b12;
out.b37 _ inRight.b20; out.b38 _ inLeft.b20; out.b39 _ inRight.b28; out.b40 _ inLeft.b28;
out.b41 _ inRight.b3; out.b42 _ inLeft.b3; out.b43 _ inRight.b11; out.b44 _ inLeft.b11;
out.b45 _ inRight.b19; out.b46 _ inLeft.b19; out.b47 _ inRight.b27; out.b48 _ inLeft.b27;
out.b49 _ inRight.b2; out.b50 _ inLeft.b2; out.b51 _ inRight.b10; out.b52 _ inLeft.b10;
out.b53 _ inRight.b18; out.b54 _ inLeft.b18; out.b55 _ inRight.b26; out.b56 _ inLeft.b26;
out.b57 _ inRight.b1; out.b58 _ inLeft.b1; out.b59 _ inRight.b9; out.b60 _ inLeft.b9;
out.b61 _ inRight.b17; out.b62 _ inLeft.b17; out.b63 _ inRight.b25; out.b64 _ inLeft.b25;
};

PermP: PROC [in, out: PBits32] = INLINE {
out.b1 _ in.b16; out.b2 _ in.b7; out.b3 _ in.b20; out.b4 _ in.b21;
out.b5 _ in.b29; out.b6 _ in.b12; out.b7 _ in.b28; out.b8 _ in.b17;
out.b9 _ in.b1; out.b10 _ in.b15; out.b11 _ in.b23; out.b12 _ in.b26;
out.b13 _ in.b5; out.b14 _ in.b18; out.b15 _ in.b31; out.b16 _ in.b10;
out.b17 _ in.b2; out.b18 _ in.b8; out.b19 _ in.b24; out.b20 _ in.b14;
out.b21 _ in.b32; out.b22 _ in.b27; out.b23 _ in.b3; out.b24 _ in.b9;
out.b25 _ in.b19; out.b26 _ in.b13; out.b27 _ in.b30; out.b28 _ in.b6;
out.b29 _ in.b22; out.b30 _ in.b11; out.b31 _ in.b4; out.b32 _ in.b25;
};

PermE: PROC [in: PBits32, out: PBits48] = INLINE {
out.b1 _ out.b47 _ in.b32;
out.b2 _ out.b48 _ in.b1;
out.b3 _ in.b2;
out.b4 _ in.b3;
out.b5 _ out.b7 _ in.b4;
out.b6 _ out.b8 _ in.b5;
out.b9 _ in.b6;
out.b10 _ in.b7;
out.b11 _ out.b13 _ in.b8;
out.b12 _ out.b14 _ in.b9;
out.b15 _ in.b10;
out.b16 _ in.b11;
out.b17 _ out.b19 _ in.b12;
out.b18 _ out.b20 _ in.b13;
out.b21 _ in.b14;
out.b22 _ in.b15;
out.b23 _ out.b25 _ in.b16;
out.b24 _ out.b26 _ in.b17;
out.b27 _ in.b18;
out.b28 _ in.b19;
out.b29 _ out.b31 _ in.b20;
out.b30 _ out.b32 _ in.b21;
out.b33 _ in.b22;
out.b34 _ in.b23;
out.b35 _ out.b37 _ in.b24;
out.b36 _ out.b38 _ in.b25;
out.b39 _ in.b26;
out.b40 _ in.b27;
out.b41 _ out.b43 _ in.b28;
out.b42 _ out.b44 _ in.b29;
out.b45 _ in.b30;
out.b46 _ in.b31;
};

PermPC1: PROC [inP: POINTER, outC, outD: PBits32] = INLINE {
OPEN in: LOOPHOLE[inP, PBits64];
outC.b1 _ in.b57; outC.b2 _ in.b49; outC.b3 _ in.b41; outC.b4 _ in.b33;
outC.b5 _ in.b25; outC.b6 _ in.b17; outC.b7 _ in.b9; outC.b8 _ in.b1;
outC.b9 _ in.b58; outC.b10 _ in.b50; outC.b11 _ in.b42; outC.b12 _ in.b34;
outC.b13 _ in.b26; outC.b14 _ in.b18; outC.b15 _ in.b10; outC.b16 _ in.b2;
outC.b17 _ in.b59; outC.b18 _ in.b51; outC.b19 _ in.b43; outC.b20 _ in.b35;
outC.b21 _ in.b27; outC.b22 _ in.b19; outC.b23 _ in.b11; outC.b24 _ in.b3;
outC.b25 _ in.b60; outC.b26 _ in.b52; outC.b27 _ in.b44; outC.b28 _ in.b36;
outD.b1 _ in.b63; outD.b2 _ in.b55; outD.b3 _ in.b47; outD.b4 _ in.b39;
outD.b5 _ in.b31; outD.b6 _ in.b23; outD.b7 _ in.b15; outD.b8 _ in.b7;
outD.b9 _ in.b62; outD.b10 _ in.b54; outD.b11 _ in.b46; outD.b12 _ in.b38;
outD.b13 _ in.b30; outD.b14 _ in.b22; outD.b15 _ in.b14; outD.b16 _ in.b6;
outD.b17 _ in.b61; outD.b18 _ in.b53; outD.b19 _ in.b45; outD.b20 _ in.b37;
outD.b21 _ in.b29; outD.b22 _ in.b21; outD.b23 _ in.b13; outD.b24 _ in.b5;
outD.b25 _ in.b28; outD.b26 _ in.b20; outD.b27 _ in.b12; outD.b28 _ in.b4;
};

PermPC2: PROC [inC, inD: PBits32, out: PBits48] = INLINE {
out.b1 _ inC.b14; out.b2 _ inC.b17; out.b3 _ inC.b11; out.b4 _ inC.b24;
out.b5 _ inC.b1; out.b6 _ inC.b5; out.b7 _ inC.b3; out.b8 _ inC.b28;
out.b9 _ inC.b15; out.b10 _ inC.b6; out.b11 _ inC.b21; out.b12 _ inC.b10;
out.b13 _ inC.b23; out.b14 _ inC.b19; out.b15 _ inC.b12; out.b16 _ inC.b4;
out.b17 _ inC.b26; out.b18 _ inC.b8; out.b19 _ inC.b16; out.b20 _ inC.b7;
out.b21 _ inC.b27; out.b22 _ inC.b20; out.b23 _ inC.b13; out.b24 _ inC.b2;
out.b25 _ inD.b13; out.b26 _ inD.b24; out.b27 _ inD.b3; out.b28 _ inD.b9;
out.b29 _ inD.b19; out.b30 _ inD.b27; out.b31 _ inD.b2; out.b32 _ inD.b12;
out.b33 _ inD.b23; out.b34 _ inD.b17; out.b35 _ inD.b5; out.b36 _ inD.b20;
out.b37 _ inD.b16; out.b38 _ inD.b21; out.b39 _ inD.b11; out.b40 _ inD.b28;
out.b41 _ inD.b6; out.b42 _ inD.b25; out.b43 _ inD.b18; out.b44 _ inD.b14;
out.b45 _ inD.b22; out.b46 _ inD.b8; out.b47 _ inD.b1; out.b48 _ inD.b4;
};

XOR32: PROC [a, b, out: PBits32]  = INLINE {
OPEN
aP: LOOPHOLE[a, POINTER TO Words2],
bP: LOOPHOLE[b, POINTER TO Words2],
outP: LOOPHOLE[out, POINTER TO Words2];
outP.w1 _ Basics.BITXOR[aP.w1, bP.w1];
outP.w2 _ Basics.BITXOR[aP.w2, bP.w2];
};


XOR48: PROC [a, b, out: PBits48] = INLINE {
OPEN
aP: LOOPHOLE[a, POINTER TO Words3],
bP: LOOPHOLE[b, POINTER TO Words3],
outP: LOOPHOLE[out, POINTER TO Words3];
outP.w1 _ Basics.BITXOR[aP.w1, bP.w1];
outP.w2 _ Basics.BITXOR[aP.w2, bP.w2];
outP.w3 _ Basics.BITXOR[aP.w3, bP.w3];
};

XOR64: PROC [a, b, out: LONG POINTER] = INLINE {
OPEN
aLP: LOOPHOLE[a, LONG POINTER TO Words4],
bLP: LOOPHOLE[b, LONG POINTER TO Words4],
outP: LOOPHOLE[out, LONG POINTER TO Words4];
outP.w1 _ Basics.BITXOR[aLP.w1, bLP.w1];
outP.w2 _ Basics.BITXOR[aLP.w2, bLP.w2];
outP.w3 _ Basics.BITXOR[aLP.w3, bLP.w3];
outP.w4 _ Basics.BITXOR[aLP.w4, bLP.w4];
};

LeftShift28: PROC [aP: PBits32] = INLINE {
OPEN
inP: LOOPHOLE[aP, POINTER TO LeftShift28In];
temp32: Bits32;
outP: POINTER TO LeftShift28Out = LOOPHOLE[@temp32];
outP.f1 _ inP.f2;
outP.f2 _ inP.f3;
outP.f3 _ inP.f4;
outP.f4 _ inP.f1;
aP^ _ temp32;
};

SMap: PROC[in: PBits48, out: PBits32] = INLINE {
OPEN
inP: LOOPHOLE[in, POINTER TO Sixes],
outP: LOOPHOLE[out, POINTER TO Fours];
sbox: Sbox;
sboxP: POINTER = @sbox;
sbox _ sbox1;
outP.f1 _ Map[sboxP, inP.s1];
sbox _ sbox2;
outP.f2 _ Map[sboxP, inP.s2];
sbox _ sbox3;
outP.f3 _ Map[sboxP, inP.s31*4+inP.s32];
sbox _ sbox4;
outP.f4 _ Map[sboxP, inP.s4];
sbox _ sbox5;
outP.f5 _ Map[sboxP, inP.s5];
sbox _ sbox6;
outP.f6 _ Map[sboxP, inP.s61*16+inP.s62];
sbox _ sbox7;
outP.f7 _ Map[sboxP, inP.s7];
sbox _ sbox8;
outP.f8 _ Map[sboxP, inP.s8];
};

Map: PROC[p: POINTER, b: [0..63]] RETURNS[[0..15]] = MACHINE CODE {
PrincOps.zLI6;
PrincOps.zSHIFT;
PrincOps.zLI3;
PrincOps.zADD;
PrincOps.zRFS;
};


InternalizeKey: ENTRY PROC [keyP: POINTER TO Key, iKeyP: POINTER TO IKey] = {
IF noKeyCached OR cachedKey ~= keyP^ THEN {
c, d: Bits32; cP: PBits32 = @c; dP: PBits32 = @d;
FOR i: CARDINAL IN [0..7] DO
IF keyP[i].p ~= parityTable[keyP[i].b] THEN RETURN WITH ERROR BadParity;
ENDLOOP;
cachedKey _ keyP^;
PermPC1[keyP,  cP, dP];
FOR i: CARDINAL IN [1..16] DO
THROUGH [1..shifts[i]] DO LeftShift28[cP]; LeftShift28[dP]; ENDLOOP;
PermPC2[cP,dP,@cachedIKey[i]];
ENDLOOP;
noKeyCached _ FALSE;
};
iKeyP^ _ cachedIKey;
};



[] _ GetRandomKey[];


END.

ζDESImpl.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Andrew Birrell  16-Mar-82  8:43:23
Michael D. Schroeder, November 3, 1981  10:14 AM;
Levin, August 8, 1983 2:43 pm
Russ Atkinson (RRA) January 29, 1985 1:17:09 am PST
Types
Constants
Global Variables
Errors
Exported Procedures
Ideally, this should use a true random number generator --
randomSeed _ slightly different one --
This introduces a small number of bits of randomness --
randomSeed _ [0] encrypted with adjusted randomSeed --
This disperses the randomised bits --
k _ prevSeed encrypted with randomSeed --
So that knowing K doesn't make randomSeed vulnerable to plain-text attack --
User interface routine to construct a 64 bit key from an ASCII string.
"key" is an array that holds the 64 bit key.
Note: every eighth bit of "key" is an odd parity bit for the preceeding seven bits.

Internal Procedures
converts 64 bit key into two 28 bit key parts.  (Only first 28 bits of outputs are set)
Initialization
Κ
Š˜
codeš
œ™Kšœ
Οm
œ1™<Kš
œ"™"Kš
œ1™1Kš
œ™J™3—K˜š
Οk	˜	Kšœžœžœ˜Kšœžœžœ˜AKšœ	žœ"˜0Kšœžœ˜%K˜—šœ	žœ
˜Kšžœ˜Kšžœ˜Kšžœ˜Kšœžœ
žœ	˜—K˜Kš
œ™K˜Kšœžœžœ	žœ˜%K˜šœžœžœ
ž	œ
ž˜.K˜GK˜—šœžœžœ
ž	œ
ž˜/K˜GK˜—š	œžœžœ
ž	œ
žœ˜)K˜K˜&K˜'K˜0—Kšœ	žœžœ
žœ˜"K˜š	œžœžœ
ž	œ
žœ˜)K˜K˜&K˜'K˜'K˜'K˜0—Kšœ	žœžœ
žœ˜"K˜š	œžœžœ
ž	œ
žœ˜)K˜K˜&K˜'K˜'K˜'K˜'K˜'K˜0—Kšœ	žœžœ
žœ˜"Kš	œ
žœžœ
žœ
žœ˜(K˜šœžœžœ
ž	œ
žœ
žœ˜7K˜—šœžœžœ
ž	œ
žœžœ˜;K˜—šœžœžœ
ž	œ
žœžœ˜?K˜—š	œžœžœ
ž	œ
žœ˜(˜iK˜——š	œžœžœ
ž	œ
žœ+˜QK˜—š	œžœžœ
ž	œ
žœ˜'K˜K˜&K˜'K˜'K˜'K˜'K˜'˜1K˜K˜——Kš
œ	™	K˜šœžœ	žœ
žœ˜#K˜"K˜—˜K˜'K˜%K˜%K˜(—˜K˜&K˜&K˜'K˜&—˜K˜%K˜'K˜$K˜)—˜K˜&K˜&K˜'K˜&—˜K˜'K˜%K˜'K˜&—˜K˜&K˜&K˜&K˜'—˜K˜'K˜%K˜'K˜&—˜K˜&K˜&K˜&K˜'K˜K˜—K™K˜K˜K˜Kšœ
žœžœ
˜K˜šœ
žœ
žœ
žœ˜0K˜ K˜ K˜ K˜ K˜ K˜ K˜ K˜K˜K˜—K˜K˜K™K˜Kšœžœžœ
˜Kšœžœžœ
˜K˜Kš
œ™K˜šΟn	œžœ
žœ˜Kšœžœ
žœ
žœ
˜&Kšœ;žœ
žœ
žœ
žœžœ˜XKšœ	žœ
˜K˜Kšœžœ
žœ˜Kš	œžœžœžœžœ˜;Kš	œ
žœžœžœžœ˜:K˜K˜K˜K˜'K˜K˜K˜K˜K˜K˜K˜Kšžœžœ
žœ˜-K˜šžœžœžœž˜=šžœžœ
žœž˜$Kš
œ2˜2Kšžœ
˜——K˜šžœžœ
žœž˜$Kšœžœ
˜šžœ
ž˜Kšžœžœ%˜>Kšžœ˜—K˜/šžœ	žœΟc˜+Kšœ ˜)Kšœ ˜/Kšœ) ˜FKšœ ˜1Kšœ$ ˜4K˜-K˜K˜Kšžœ
˜—K˜4šžœ
ž˜Kšžœžœ˜*Kšžœ6˜:—šžœ
˜K˜—šžœžœžœž˜=šžœžœ
žœž˜$Kš
œ,˜,Kšžœ
˜———Kš
œ˜K˜—š
Ÿœžœ
žœ
žœžœ˜-Kš
œ:™:K˜K˜Kšœžœ
žœ
žœ
žœžœ˜8Kšœ	žœ
žœžœ˜0Kš
œ&™&Kš
œ7™7K˜1Kš
œ6™6Kš
œ%™%K˜K˜˜"Kšœžœ
žœ˜$Kšœžœ
žœ˜*Kšœ&žœ˜+—Kš
œ)™)Kš
œL™LK˜˜"Kšœžœ
žœ˜(Kšœžœ
žœ˜"Kšœ&žœ˜+—Kš
œ˜K˜—šŸœžœ
žœ
žœ
˜.Kšœžœ˜K˜Kš
œ˜K˜—šŸœžœ
žœ
žœ
žœžœ˜AKš
œF™FKš
œ,™,Kš
œS™SK˜šžœžœ
žœž˜(Kšœžœžœ˜Kšœž	œžœžœ
žœžœ˜PKšœžœ
žœ˜<—Kšžœ
˜K˜Kš
œ˜K˜—šŸ
œžœ
žœžœ
žœ
žœ	˜:Kš
žœžœ
žœ
žœ%žœ
˜KKš
œ˜—K™Kš
œ™K˜š
Ÿœžœžœ
žœ žœ˜LKšžœž	œ˜!K˜SK˜RK˜VK˜VK˜WK˜VK˜WK˜VK˜WK˜UK˜ZK˜ZK˜[K˜ZK˜[K˜ZKš
œ˜—K˜š
Ÿœžœ#žœ
žœžœ˜SKšžœž	œ˜$K˜SK˜UK˜VK˜YK˜WK˜YK˜WK˜YK˜WK˜YK˜WK˜YK˜WK˜YK˜UK˜YKš
œ˜—K˜šŸœžœžœ˜)K˜BK˜CK˜EK˜FK˜EK˜EK˜FK˜FK˜—K˜šŸœžœžœ˜2K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜—K˜šŸœžœžœžœ˜<Kšžœž	œ˜ Kš
œW™WK˜GK˜EK˜JK˜JK˜KK˜JK˜KK˜GK˜FK˜JK˜JK˜KK˜JK˜JKš
œ˜—K˜šŸœžœ%žœ˜:K˜GK˜DK˜IK˜JK˜IK˜JK˜IK˜JK˜JK˜KK˜JK˜HK˜—K˜šŸœžœžœ˜,š
ž˜Kšœžœžœ
žœ	˜#Kšœžœžœ
žœ	˜#Kšœžœžœ
žœ	˜'—Kšœžœ˜&Kšœžœ˜&K˜—K˜K˜šŸœžœžœ˜+š
ž˜Kšœžœžœ
žœ	˜#Kšœžœžœ
žœ	˜#Kšœžœžœ
žœ	˜'—Kšœžœ˜&Kšœžœ˜&Kšœžœ˜&K˜—K˜š
Ÿœžœ
žœ
žœžœ˜0š
ž˜Kš	œžœžœ
žœ
žœ	˜)Kš	œžœžœ
žœ
žœ	˜)Kš	œžœžœ
žœ
žœ	˜,—Kšœžœ˜(Kšœžœ˜(Kšœžœ˜(Kšœžœ˜(K˜—K˜šŸœžœžœ˜*š
ž˜Kšœžœžœ
žœ˜,—K˜Kšœžœ
žœžœ
˜4K˜K˜K˜K˜K˜
K˜—K˜šŸœžœžœ˜0š
ž˜Kšœžœžœ
žœ˜$Kšœžœžœ
žœ˜&—K˜Kšœžœ	˜K˜
K˜K˜
K˜K˜
K˜(K˜
K˜K˜
K˜K˜
K˜)K˜
K˜K˜
K˜K˜—K˜šŸœžœžœžœžœ
žœ˜CKš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜K˜—K˜K˜šŸœžœ
žœžœ
žœ
žœ
žœ
˜Mšžœ
žœžœ˜+K˜1šžœžœ
žœž˜Kš
žœ%žœ
žœ
žœ
žœ˜HKšžœ
˜—K˜K˜šžœžœ
žœ	ž˜Kšžœžœ#žœ
˜DK˜Kšžœ
˜—Kšœžœ
˜Kš
œ˜—K˜K˜—K˜K˜š
œ™K˜—K˜K˜K˜Kšžœ
˜K˜—…—?Pr