-- Software implementation of DES

-- DESSoft.mesa

-- Andrew Birrell  16-Mar-82  8:43:23
-- Michael D. Schroeder, November 3, 1981  10:14 AM;

DIRECTORY
    DESFace, Inline, Mopcodes,
    System	USING[ GetClockPulses ];



DESSoft: MONITOR 
    IMPORTS Inline, System
    EXPORTS DESFace
    SHARES DESFace

= BEGIN

OPEN DESFace;



-- Types --

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]];



-- Constants --

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];



-- Procedures --

PermInitial: PROCEDURE[inP: LONG POINTER,
        outLeft, outRight: PBits32] = INLINE
BEGIN

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;

END;



PermInverseInitial: PROCEDURE[inLeft, inRight: PBits32,
        outLP: LONG POINTER] = INLINE
BEGIN

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;

END;



PermP: PROCEDURE[in, out: PBits32] = INLINE
BEGIN

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;

END;



PermE: PROCEDURE[in: PBits32, out: PBits48] = INLINE
BEGIN

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;


END;



PermPC1: PROCEDURE[inP: POINTER, outC, outD: PBits32] = INLINE
BEGIN

OPEN in:LOOPHOLE[inP, PBits64];

-- converts 64 bit key into two 28 bit key parts.  (Only first 28 bits of outputs are set)

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;

END;



PermPC2: PROCEDURE[inC, inD: PBits32, out: PBits48] = INLINE
BEGIN

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;


END;



XOR32: PROCEDURE[a, b, out: PBits32]  = INLINE
BEGIN

OPEN
  aP: LOOPHOLE[a, POINTER TO Words2],
  bP: LOOPHOLE[b, POINTER TO Words2],
  outP: LOOPHOLE[out, POINTER TO Words2];

outP.w1 _ Inline.BITXOR[aP.w1, bP.w1];
outP.w2 _ Inline.BITXOR[aP.w2, bP.w2];

END;



XOR48: PROCEDURE[a, b, out: PBits48] = INLINE
BEGIN

OPEN
  aP: LOOPHOLE[a, POINTER TO Words3],
  bP: LOOPHOLE[b, POINTER TO Words3],
  outP: LOOPHOLE[out, POINTER TO Words3];

outP.w1 _ Inline.BITXOR[aP.w1, bP.w1];
outP.w2 _ Inline.BITXOR[aP.w2, bP.w2];
outP.w3 _ Inline.BITXOR[aP.w3, bP.w3];

END;



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.w1 _ Inline.BITXOR[aLP.w1, bLP.w1];
outP.w2 _ Inline.BITXOR[aLP.w2, bLP.w2];
outP.w3 _ Inline.BITXOR[aLP.w3, bLP.w3];
outP.w4 _ Inline.BITXOR[aLP.w4, bLP.w4];

END;



LeftShift28: PROCEDURE[aP: PBits32] = INLINE
BEGIN

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;

END;



SMap: PROCEDURE[in: PBits48, out: PBits32] = INLINE
BEGIN

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];

END;



Map: PROCEDURE[p: POINTER, b: [0..63]]
    RETURNS[[0..15]] = MACHINE CODE
BEGIN

Mopcodes.zLI6;
Mopcodes.zSHIFT;
Mopcodes.zLI3;
Mopcodes.zADD;
Mopcodes.zRFS;

END;


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

BadParity: ERROR = CODE;

InternalizeKey: ENTRY PROC [keyP: POINTER TO Key,
        iKeyP: POINTER TO IKey] =
BEGIN

IF noKeyCached OR cachedKey # keyP^ THEN
  BEGIN
  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;
  END;

iKeyP^ _ cachedIKey;

END; --InternalizeKey--


NotImplemented: ERROR = CODE;

CryptData: PUBLIC PROCEDURE [keyP: POINTER TO Key, nBlks: CARDINAL,
        from, to: Blocks, direction: Direction, mode: Mode,
        seedP: LONG POINTER TO IV _ NIL] =
BEGIN

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 BEGIN
       FOR blk: CARDINAL IN [0..nBlks-1)
       DO XOR64[@from[nBlks-1], @from[blk], @from[nBlks-1]] ENDLOOP;
       END;

  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 BEGIN
       FOR blk: CARDINAL IN [0..nBlks-1)
       DO XOR64[@to[nBlks-1], @to[blk], @to[nBlks-1]] ENDLOOP;
       END

  END; --CryptData--


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];

GetRandomIV: PUBLIC PROCEDURE RETURNS [iv: IV] =
  BEGIN
  -- Ideally, this should use a true random number generator --
  prevSeed: Block _ randomSeed;
  temp: Block;
  pulse: POINTER TO LONG CARDINAL = LOOPHOLE[@randomSeed];
  seedKey: POINTER TO Key = LOOPHOLE[@randomSeed];
  -- randomSeed _ slightly different one --
  -- This introduces a small number of bits of randomness --
  pulse^ _ pulse^ + System.GetClockPulses[];
  -- randomSeed _ [0] encrypted with adjusted randomSeed --
  -- This disperses the randomised bits --
  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];
  -- k _ prevSeed encrypted with randomSeed --
  -- So that knowing K doesn't make randomSeed vulnerable to plain-text attack --
  CorrectParity[seedKey];
  CryptData[keyP: seedKey, nBlks: 1,
            from: LOOPHOLE[LONG[@prevSeed], Blocks],
	    to:   LOOPHOLE[LONG[@iv], Blocks],
            direction: encrypt, mode: ecb, seedP: NIL];
  END; --GetRandomIV--

GetRandomKey: PUBLIC PROCEDURE RETURNS [k: Key] =
  BEGIN
  k _ LOOPHOLE[GetRandomIV[]];
  CorrectParity[@k];
  END; --GetRandomKey--


MakeKey: PUBLIC PROCEDURE [source: LONG STRING]
    RETURNS [key: Key] =
  BEGIN

  -- 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.

  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 _ Inline.BITXOR[LOOPHOLE[c, [0 .. 127]], key[j].b];
  ENDLOOP;

  CorrectParity[@key];

  END; -- MakeKey

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

[] _ GetRandomKey[];


END. --DES--