-- Copyright (C) 1983, 1984  by Xerox Corporation. All rights reserved. 
-- DESSoft.mesa
-- JMaloney, 19-Jul-83 19:16:35.

-- Last modified: JMaloney, 23-Feb-84 21:31:51.

-- Software implementation of DES Face operations.
--
-- Performance notes:
--    MakeInternalKeys takes ~10.0 milliseconds.
--    CryptABlock takes ~11.1 milliseconds.
-- The following times all assume that the internal keys are in the cache.
--    ECB takes ~11.2 milliseconds/block (1 block test case).
--    CryptData (ECB Mode) takes ~11.6 milliseconds/block (1 block test case).
--    CBC takes ~12.1 milliseconds/block (10 block test case).
--    CBCCheck takes ~12.2 milliseconds/block (10 block test case).
-- (Measured on a DLion with 384K words, using System.GetClockPulses.)

DIRECTORY
  DESFace USING [Blocks, CheckKeyParity, Direction, IV, Key, Mode, nullKey],
  Environment USING [Byte, Word],
  Inline USING [BITXOR, DBITXOR];

DESSoft: MONITOR
  IMPORTS DESFace, Inline
  EXPORTS DESFace =
  BEGIN


-- Public data --


hardwareExists: PUBLIC BOOLEAN ¬ FALSE;
  -- If the hardware existed, we wouldn't be using this head!!


-- Types --


  DESBlock: TYPE = Rec64;
  DESBlocksPtr: TYPE = LONG POINTER TO ARRAY OF DESBlock;
  DESKey: TYPE = Rec64;
  IntKeys: TYPE = ARRAY [1..16] OF Rec48;
  IVector: TYPE = Rec64;


-- Bit hacking type definitions --


  Bit: TYPE = [0..1];
  Nibble: TYPE = [0..15];

  Rec32: TYPE = MACHINE DEPENDENT RECORD [
    SELECT OVERLAID * FROM
    by1 => [bit: PACKED ARRAY [1..32] OF Bit],
    by4 => [nibble: PACKED ARRAY [1..8] OF Nibble],
    by8 => [byte: PACKED ARRAY [1..4] OF Environment.Byte],
    by16 => [word1, word2: Environment.Word],
    leftShift28in => [
      f1in: [0..1],
      f2in: [0..77777B],
      f3in: [0..1],
      f4in: [0..3777B],
      extraBits: [0..15]], -- not interesting
    leftShift28out => [
      f1out: [0..77777B],
      f2out: [0..1],
      f3out: [0..3777B],
      f4out: [0..1],
      extraBits: [0..15]],  -- not interesting
    double => [long: LONG UNSPECIFIED]
    ENDCASE];

  Rec48: TYPE = MACHINE DEPENDENT RECORD [
    SELECT OVERLAID * FROM
    by1 => [bit: PACKED ARRAY [1..48] OF Bit],
    by4 => [nibble: PACKED ARRAY [1..12] OF Nibble],
    by8 => [byte: PACKED ARRAY [1..6] OF Environment.Byte],
    sixes => [
      s1, s2: [0..63],
      s31: [0..15],
      s32: [0..3],
      s4, s5: [0..63],
      s61: [0..3],
      s62: [0..15],
      s7, s8: [0..63]],
    by16 => [word: PACKED ARRAY [1..3] OF Environment.Word],
    a32a16 => [big: LONG CARDINAL, small: CARDINAL],
    ENDCASE];

  Rec64: TYPE = MACHINE DEPENDENT RECORD [
    SELECT OVERLAID * FROM
    by1 => [bit: PACKED ARRAY [1..64] OF Bit],
    by4 => [nibble: PACKED ARRAY [1..16] OF Nibble],
    by8 => [byte: PACKED ARRAY [1..8] OF Environment.Byte],
    by16 => [word: PACKED ARRAY [1..4] OF Environment.Word],
    by32 => [long: PACKED ARRAY [1..2] OF LONG CARDINAL],
    ENDCASE];

  Sbox: TYPE = PACKED ARRAY [0..63] OF Nibble;


-- Constants --


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


-- Private procedures --


PermInitial: PROC [
  in: LONG POINTER TO Rec64, outLeft, outRight: POINTER TO Rec32] =
  BEGIN
    outLeft.bit ¬ [
      in.bit[58],  --1
      in.bit[50],  --2
      in.bit[42],  --3
      in.bit[34],  --4
      in.bit[26],  --5
      in.bit[18],  --6
      in.bit[10],  --7
      in.bit[2],   --8
      in.bit[60],  --9
      in.bit[52],  --10
      in.bit[44],  --11
      in.bit[36],  --12
      in.bit[28],  --13
      in.bit[20],  --14
      in.bit[12],  --15
      in.bit[4],   --16
      in.bit[62],  --17
      in.bit[54],  --18
      in.bit[46],  --19
      in.bit[38],  --20
      in.bit[30],  --21
      in.bit[22],  --22
      in.bit[14],  --23
      in.bit[6],   --24
      in.bit[64],  --25
      in.bit[56],  --26
      in.bit[48],  --27
      in.bit[40],  --28
      in.bit[32],  --29
      in.bit[24],  --30
      in.bit[16],  --31
      in.bit[8]];  --32

    outRight.bit ¬ [
      in.bit[57],  --1
      in.bit[49],  --2
      in.bit[41],  --3
      in.bit[33],  --4
      in.bit[25],  --5
      in.bit[17],  --6
      in.bit[9],   --7
      in.bit[1],   --8
      in.bit[59],  --9
      in.bit[51],  --10
      in.bit[43],  --11
      in.bit[35],  --12
      in.bit[27],  --13
      in.bit[19],  --14
      in.bit[11],  --15
      in.bit[3],   --16
      in.bit[61],  --17
      in.bit[53],  --18
      in.bit[45],  --19
      in.bit[37],  --20
      in.bit[29],  --21
      in.bit[21],  --22
      in.bit[13],  --23
      in.bit[5],   --24
      in.bit[63],  --25
      in.bit[55],  --26
      in.bit[47],  --27
      in.bit[39],  --28
      in.bit[31],  --29
      in.bit[23],  --30
      in.bit[15],  --31
      in.bit[7]];  --32
  END;

PermInverseInitial: PROC [
  inLeft, inRight: POINTER TO Rec32, out: LONG POINTER TO Rec64] =
  BEGIN
    out.bit ¬ [
      inRight.bit[8],  --1
      inLeft.bit[8],   --2
      inRight.bit[16], --3
      inLeft.bit[16],  --4
      inRight.bit[24], --5
      inLeft.bit[24],  --6
      inRight.bit[32], --7
      inLeft.bit[32],  --8
      inRight.bit[7],  --9
      inLeft.bit[7],   --10
      inRight.bit[15], --11
      inLeft.bit[15],  --12
      inRight.bit[23], --13
      inLeft.bit[23],  --14
      inRight.bit[31], --15
      inLeft.bit[31],  --16
      inRight.bit[6],  --17
      inLeft.bit[6],   --18
      inRight.bit[14], --19
      inLeft.bit[14],  --20
      inRight.bit[22], --21
      inLeft.bit[22],  --22
      inRight.bit[30], --23
      inLeft.bit[30],  --24
      inRight.bit[5],  --25
      inLeft.bit[5],   --26
      inRight.bit[13], --27
      inLeft.bit[13],  --28
      inRight.bit[21], --29
      inLeft.bit[21],  --30
      inRight.bit[29], --31
      inLeft.bit[29],  --32
      inRight.bit[4],  --33
      inLeft.bit[4],   --34
      inRight.bit[12], --35
      inLeft.bit[12],  --36
      inRight.bit[20], --37
      inLeft.bit[20],  --38
      inRight.bit[28], --39
      inLeft.bit[28],  --40
      inRight.bit[3],  --41
      inLeft.bit[3],   --42
      inRight.bit[11], --43
      inLeft.bit[11],  --44
      inRight.bit[19], --45
      inLeft.bit[19],  --46
      inRight.bit[27], --47
      inLeft.bit[27],  --48
      inRight.bit[2],  --49
      inLeft.bit[2],  --50
      inRight.bit[10],  --51
      inLeft.bit[10],  --52
      inRight.bit[18],  --53
      inLeft.bit[18],  --54
      inRight.bit[26],  --55
      inLeft.bit[26],  --56
      inRight.bit[1],  --57
      inLeft.bit[1],  --58
      inRight.bit[9],  --59
      inLeft.bit[9],  --60
      inRight.bit[17],  --61
      inLeft.bit[17],  --62
      inRight.bit[25],  --63
      inLeft.bit[25]];  --64
  END;

PermE: PROC [in: POINTER TO Rec32, out: POINTER TO Rec48] = INLINE
  BEGIN
    InputBits: TYPE = MACHINE DEPENDENT RECORD [
      SELECT OVERLAID * FROM
	a => [bit1: [0..1], trailing15Bits: [0..32767]],
	b => [bits1to5: [0..31], trailing11Bits: [0..2047]],
	c => [leading03Bits: [0..7], bits4to9: [0..63], trailing07Bits: [0..127]],
	d => [
	  leading03Bits: [0..7],
	  bits4to5: [0..3],
	  bits6to9: [0..15],
	  trailing07Bits: [0..127]],
	e => [leading07Bits: [0..127], bits8to13: [0..63], trailing03Bits: [0..7]],
	f => [
	  leading07Bits: [0..127],
	  bits8to11: [0..15],
	  bits12to13: [0..3],
	  trailing03Bits: [0..7]],
	g => [leading11Bits: [0..2047], bits12to16: [0..31]],
	h => [leading15Bits: [0..32767], bit16: [0..1]],
      ENDCASE];

    BEGIN
      OPEN inWord1: LOOPHOLE[in, POINTER TO InputBits]; -- saves one load
      inWord2: POINTER TO InputBits = LOOPHOLE[@in.word2];
      out­ ¬ [
	sixes[
	  s1:  inWord2.bit16*32 + inWord1.bits1to5,
	  s2:  inWord1.bits4to9,
	  s31: inWord1.bits8to11,
	  s32: inWord1.bits12to13,
	  s4:  inWord1.bits12to16*2 + inWord2.bit1,
	  s5:  inWord1.bit16*32 + inWord2.bits1to5,
	  s61: inWord2.bits4to5,
	  s62: inWord2.bits6to9,
	  s7:  inWord2.bits8to13,
	  s8:  inWord2.bits12to16*2 + inWord1.bit1]];
      END;
    END;

SMap: PROC [in: POINTER TO Rec48, out: POINTER TO Rec32] = INLINE
  BEGIN
    out.nibble ¬ [
      sbox1[in.s1],
      sbox2[in.s2],
      sbox3[in.s31*4 + in.s32],
      sbox4[in.s4],
      sbox5[in.s5],
      sbox6[in.s61*16 + in.s62],
      sbox7[in.s7],
      sbox8[in.s8]];
  END;

PermP: PROC [in, out: POINTER TO Rec32] = INLINE
  BEGIN
    out.bit ¬ [
      in.bit[16],  --1
      in.bit[7],   --2
      in.bit[20],  --3
      in.bit[21],  --4
      in.bit[29],  --5
      in.bit[12],  --6
      in.bit[28],  --7
      in.bit[17],  --8
      in.bit[1],   --9
      in.bit[15],  --10
      in.bit[23],  --11
      in.bit[26],  --12
      in.bit[5],   --13
      in.bit[18],  --14
      in.bit[31],  --15
      in.bit[10],  --16
      in.bit[2],   --17
      in.bit[8],   --18
      in.bit[24],  --19
      in.bit[14],  --20
      in.bit[32],  --21
      in.bit[27],  --22
      in.bit[3],   --23
      in.bit[9],   --24
      in.bit[19],  --25
      in.bit[13],  --26
      in.bit[30],  --27
      in.bit[6],   --28
      in.bit[22],  --29
      in.bit[11],  --30
      in.bit[4],   --31
      in.bit[25]]; --32
  END;

PermPC1: PROC [in: POINTER TO Rec64, outC, outD: POINTER TO Rec32] = INLINE
  BEGIN
  -- converts 64 bit key into two 28 bit key parts.
  -- (Only first 28 bits of outC and outD are set.)
    outC.bit ¬ [
      in.bit[57],  --1
      in.bit[49],  --2
      in.bit[41],  --3
      in.bit[33],  --4
      in.bit[25],  --5
      in.bit[17],  --6
      in.bit[9],   --7
      in.bit[1],   --8
      in.bit[58],  --9
      in.bit[50],  --10
      in.bit[42],  --11
      in.bit[34],  --12
      in.bit[26],  --13
      in.bit[18],  --14
      in.bit[10],  --15
      in.bit[2],   --16
      in.bit[59],  --17
      in.bit[51],  --18
      in.bit[43],  --19
      in.bit[35],  --20
      in.bit[27],  --21
      in.bit[19],  --22
      in.bit[11],  --23
      in.bit[3],   --24
      in.bit[60],  --25
      in.bit[52],  --26
      in.bit[44],  --27
      in.bit[36], , , , ];  --28

    outD.bit ¬ [
      in.bit[63],  --1
      in.bit[55],  --2
      in.bit[47],  --3
      in.bit[39],  --4
      in.bit[31],  --5
      in.bit[23],  --6
      in.bit[15],  --7
      in.bit[7],   --8
      in.bit[62],  --9
      in.bit[54],  --10
      in.bit[46],  --11
      in.bit[38],  --12
      in.bit[30],  --13
      in.bit[22],  --14
      in.bit[14],  --15
      in.bit[6],   --16
      in.bit[61],  --17
      in.bit[53],  --18
      in.bit[45],  --19
      in.bit[37],  --20
      in.bit[29],  --21
      in.bit[21],  --22
      in.bit[13],  --23
      in.bit[5],   --24
      in.bit[28],  --25
      in.bit[20],  --26
      in.bit[12],  --27
      in.bit[4], , , , ];  --28
  END;

PermPC2: PROC [inC, inD: POINTER TO Rec32,
  out: LONG POINTER TO Rec48] = INLINE
  -- Converts inC, inD into an element of the internal key array.
  BEGIN
  out.bit ¬ [
    inC.bit[14],  --1
    inC.bit[17],  --2
    inC.bit[11],  --3
    inC.bit[24],  --4
    inC.bit[1],   --5
    inC.bit[5],   --6
    inC.bit[3],   --7
    inC.bit[28],  --8
    inC.bit[15],  --9
    inC.bit[6],   --10
    inC.bit[21],  --11
    inC.bit[10],  --12
    inC.bit[23],  --13
    inC.bit[19],  --14
    inC.bit[12],  --15
    inC.bit[4],   --16
    inC.bit[26],  --17
    inC.bit[8],   --18
    inC.bit[16],  --19
    inC.bit[7],   --20
    inC.bit[27],  --21
    inC.bit[20],  --22
    inC.bit[13],  --23
    inC.bit[2],   --24

    inD.bit[13],  --25
    inD.bit[24],  --26
    inD.bit[3],   --27
    inD.bit[9],   --28
    inD.bit[19],  --29
    inD.bit[27],  --30
    inD.bit[2],   --31
    inD.bit[12],  --32
    inD.bit[23],  --33
    inD.bit[17],  --34
    inD.bit[5],   --35
    inD.bit[20],  --36
    inD.bit[16],  --37
    inD.bit[21],  --38
    inD.bit[11],  --39
    inD.bit[28],  --40
    inD.bit[6],   --41
    inD.bit[25],  --42
    inD.bit[18],  --43
    inD.bit[14],  --44
    inD.bit[22],  --45
    inD.bit[8],   --46
    inD.bit[1],   --47
    inD.bit[4]];  --48
  END;

LoopBody: PROC [oldLeft32, oldRight32: Rec32,
  ithKeyPtr: LONG POINTER TO Rec48]
    RETURNS [newLeft32, newRight32: Rec32] = INLINE
  BEGIN
    temp48: Rec48;
    temp32, anotherTemp32: Rec32;

  -- new Left is old Right
    newLeft32 ¬ oldRight32;

  -- new Right is computed as follows:
  --   E-permute the old Right; XOR that with ith key array element;
  --   apply the SBoxes; P-permute that and XOR result with old Left

    PermE[@oldRight32, @temp48];
    temp48 ¬ [
      a32a16[
      big: Inline.DBITXOR[temp48.big, ithKeyPtr.big],
      small: Inline.BITXOR[temp48.small, ithKeyPtr.small] ]];
    SMap[@temp48, @temp32];
    PermP[@temp32, @anotherTemp32];
    newRight32.long ¬ Inline.DBITXOR[oldLeft32.long, anotherTemp32.long];
  END;

CryptABlock: PROC [
  internalKeys: LONG POINTER TO IntKeys, from, to: LONG POINTER TO DESBlock,
  direction: DESFace.Direction] =
  BEGIN
    left32, right32: Rec32;
    i: CARDINAL;

    PermInitial[from, @left32, @right32];
    IF direction = encrypt THEN
      FOR i IN [1..16] DO
	[left32, right32] ¬ LoopBody[left32, right32, @(internalKeys[i])];
      ENDLOOP
    ELSE -- direction = decrypt --
      FOR i DECREASING IN [1..16] DO
	[left32, right32] ¬ LoopBody[left32, right32, @(internalKeys[i])];
      ENDLOOP;
     PermInverseInitial[@right32, @left32, to];
  END;

-- A one key cache, to avoid recomputing internal keys unnecessarily
--   (This is monitored data!):
lastKeyUsed: DESKey ¬ LOOPHOLE[DESFace.nullKey];
lastIntKeys: IntKeys;
hits: LONG CARDINAL ¬ 0;
misses: LONG CARDINAL ¬ 0;

GetInternalKey: ENTRY PROC [
  key: POINTER TO DESKey, internalKeys: LONG POINTER TO IntKeys] =
  BEGIN
    ENABLE UNWIND => NULL; -- Just to be safe!
    IF (key­ # lastKeyUsed) THEN
      BEGIN
	misses ¬ misses +1;
	lastKeyUsed ¬ key­;
	MakeInternalKeys[key, @lastIntKeys];
      END
    ELSE hits ¬ hits + 1;
    internalKeys­ ¬ lastIntKeys;
  END;

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

MakeInternalKeys: PROC [
  key: POINTER TO DESKey, internalKeys: LONG POINTER TO IntKeys] =
  BEGIN
    c: Rec32; cPtr: POINTER TO Rec32 ¬ @c;
    d: Rec32; dPtr: POINTER TO Rec32 ¬ @d;

    LeftShift28: PROC [in: POINTER TO Rec32] RETURNS [out: Rec32] = INLINE
      BEGIN
	out ¬ [
	  leftShift28out[
	    f1out: in.f2in, f2out: in.f3in, f3out: in.f4in, f4out: in.f1in,
	    extraBits: NULL]];
      END;

    PermPC1[key, cPtr, dPtr];
    FOR i: CARDINAL IN [1..16] DO
      THROUGH [1..shifts[i]] DO
	c ¬ LeftShift28[cPtr]; d ¬ LeftShift28[dPtr];
      ENDLOOP;
      PermPC2[cPtr, dPtr, @(internalKeys[i])];
    ENDLOOP;
  END;

XOR64: PROC [a, b, out: LONG POINTER TO Rec64] = INLINE
  BEGIN
    out.long[1] ¬ Inline.DBITXOR[a.long[1], b.long[1]];
    out.long[2] ¬ Inline.DBITXOR[a.long[2], b.long[2]];
  END;


-- Public procedures and errors --


BadKey: PUBLIC ERROR = CODE; -- Key parity bad.

CryptData: PUBLIC PROC [
  keyP: POINTER TO DESFace.Key, nBlks: CARDINAL,
  from, to: DESFace.Blocks, direction: DESFace.Direction,
  mode: DESFace.Mode, seedP: LONG POINTER TO DESFace.IV] =
  BEGIN
    IF ~(mode = checksum) THEN -- don't check key parity if we just want checksum
      IF ~DESFace.CheckKeyParity[keyP] THEN ERROR BadKey;
    SELECT mode FROM
      ecb =>
	ECB[
	  LOOPHOLE[keyP, POINTER TO DESKey], nBlks,
	  LOOPHOLE[from, DESBlocksPtr],
	  LOOPHOLE[to, DESBlocksPtr], direction];
      cbc =>
	CBC[
	  LOOPHOLE[keyP, POINTER TO DESKey], nBlks,
	  LOOPHOLE[from, DESBlocksPtr],
	  LOOPHOLE[to, DESBlocksPtr], direction,
	  LOOPHOLE[seedP, LONG POINTER TO IVector]];
      cbcCheck =>
	CBCCheck[
	  LOOPHOLE[keyP, POINTER TO DESKey], nBlks,
	  LOOPHOLE[from, DESBlocksPtr],
	  LOOPHOLE[to, DESBlocksPtr], direction,
	  LOOPHOLE[seedP, LONG POINTER TO IVector]];
      checksum =>
	XORChecksum[nBlks,
	  LOOPHOLE[from, DESBlocksPtr],
	  LOOPHOLE[seedP, LONG POINTER TO IVector]];
    ENDCASE => ERROR;
  END;


-- Support for different encryption modes --


ECB: PROC [
  key: POINTER TO DESKey, nBlks: CARDINAL, from, to: DESBlocksPtr,
  direction: DESFace.Direction] =
  BEGIN
    internalKeys: IntKeys;

    GetInternalKey[key, @internalKeys];
    FOR n: CARDINAL IN [0..nBlks) DO
      CryptABlock[@internalKeys, @from[n], @to[n], direction];
    ENDLOOP;
  END;

CBC: PROC [
  key: POINTER TO DESKey, nBlks: CARDINAL, from, to: DESBlocksPtr,
  direction: DESFace.Direction, seedP: LONG POINTER TO IVector] =
  BEGIN
    internalKeys: IntKeys;
    temp: Rec64;

    GetInternalKey[key, @internalKeys];

    IF direction = encrypt THEN
      BEGIN
     -- Do the first block:
	XOR64[a: @from[0], b: seedP, out: @temp];
	CryptABlock[@internalKeys, @temp, @to[0], encrypt];
     -- Do the rest:
	FOR n: CARDINAL IN [1..nBlks) DO
	  XOR64[a: @from[n], b: @to[n-1], out: @temp];
	  CryptABlock[@internalKeys, @temp, @to[n], encrypt];
	ENDLOOP;
      END
    ELSE -- direction = decrypt
      BEGIN
     -- Do all but the first block:
	FOR n: CARDINAL DECREASING IN [1..nBlks) DO
	  CryptABlock[@internalKeys, @from[n], @temp, decrypt];
	  XOR64[a: @temp, b: @from[n-1], out: @to[n]];
	ENDLOOP;
     -- Do the first block:
	CryptABlock[@internalKeys, @from[0], @temp, decrypt];
	XOR64[a: @temp, b: seedP, out: @to[0]];
      END;
  END;

CBCCheck: PROC [
  key: POINTER TO DESKey, nBlks: CARDINAL, from, to: DESBlocksPtr,
  direction: DESFace.Direction, seedP: LONG POINTER TO IVector] =
  BEGIN
    internalKeys: IntKeys;
    temp: Rec64;
    secondToLastCipherBlock: Rec64;
    chk: Rec64;

    IF nBlks = 0 THEN RETURN; -- Noop.
    IF nBlks = 1 THEN -- One block case is same as CBC.
      {CBC[key, nBlks, from, to, direction, seedP]; RETURN};

  -- Assume: nBlks >= 2 from here on.

  -- In case to­ = from­,
  --    Compute checksum BEFORE doing encryption, or
  --    Remember penultimate cipher block BEFORE doing decryption:
    IF direction = encrypt
      THEN XORChecksum[nBlks-1, from, @chk]
      ELSE secondToLastCipherBlock ¬ from[nBlks-2];

  -- Perform CBC en/decryption on first n-1 blocks:
    CBC[key, nBlks-1, from, to, direction, seedP];

  -- On encryption, to[n] ¬ Encrypt[from[n] XOR to[n-1] XOR chk]
  -- On decryption, to[n] ¬ Decrypt[from[n]] XOR from[n-1] XOR chk
  --    where in both cases chk is the XOR sum of the n-1 plaintext blocks:
    GetInternalKey[key, @internalKeys];
    IF direction = encrypt
      THEN
	BEGIN
	-- Assume: chk has been set
	  XOR64[a: @from[nBlks-1], b: @chk, out: @temp];
	  XOR64[a: @temp, b: @to[nBlks-2], out: @temp];
	  CryptABlock[@internalKeys, @temp, @to[nBlks-1], encrypt]
	END
      ELSE -- (direction = decrypt)
	BEGIN
	  XORChecksum[nBlks-1, to, @chk];
	  CryptABlock[@internalKeys, @from[nBlks-1], @temp, decrypt];
	  XOR64[a: @temp, b: @chk, out: @temp];
	  XOR64[a: @temp, b: @secondToLastCipherBlock, out: @to[nBlks-1]];
	END;
  END;

XORChecksum: PROC [
  nBlks: CARDINAL, from: DESBlocksPtr, out: LONG POINTER TO DESBlock] =
  BEGIN
    out­.long ¬ [0,0];
    FOR n: CARDINAL IN [0..nBlks) DO
      XOR64[a: out, b: @from[n], out: out];
    ENDLOOP;
  END;


-- Initialization --


MakeInternalKeys[@lastKeyUsed, @lastIntKeys];


END.

LOG

May 28, 1982 -- JMaloney -- Incorporated Jerry Farrell's improvements.
June  8, 1982 -- JMaloney -- Fixed PermP and incorporated Jerry's fix for PermE.
June 15, 1982 -- JMaloney -- Made changes to match Crypt interface.
June 15, 1982 -- JMaloney -- Added MakeRandomKey, MakeRandomIVector.
June 16, 1982 -- JMaloney -- Added BulkEncrypt/Decrypt, CorrectParity.
June 24, 1982 -- JMaloney -- Fixed BulkEncrypt/Decrypt. They were running over by one block.
May 10, 1983 -- JMaloney -- Performance improvement in PermP. My "clever" code wasn't as fast as the straight-forward code.
May 12, 1983 -- JMaloney -- Renamed to DESSoft and made it implement DESFace.
May 19, 1983 -- JMaloney -- Fixed CBCCheck as per Andrew's message.
May 31, 1983 -- JMaloney -- Fixed bug in CheckKeyParity found by Bruce Malasky.
July 19, 1983 -- JMaloney -- Use parityTable in DESFace.
August 9, 1983 -- JMaloney -- Fixed CBCCheck.
October 31, 1983 -- JMaloney -- Removed references to DESFaceExtras.
January 20, 1983 -- JMaloney -- Added hardwareExists.
February 23, 1983 -- JMaloney -- Moved CheckKeyParity to DESAux.


-- Performance testing:

tStart, tFinish: LONG CARDINAL;
tLoop: LONG CARDINAL;
iterations: CARDINAL ¬ 1000;

t1, t2, t3: LONG CARDINAL ¬ 0;
t1InMicroseconds,
t2InMicroseconds,
t3InMicroseconds: LONG CARDINAL ¬ 0;

tempKeys: IntKeys;
tempBlock: DESBlock;
tempKey: DESKey;

tStart ¬ System.GetClockPulses[];
THROUGH [1..iterations] DO
ENDLOOP;
tFinish ¬ System.GetClockPulses[];
tLoop ¬ tFinish - tStart;

tStart ¬ System.GetClockPulses[];
THROUGH [1..iterations] DO
  CryptABlock[@tempKeys, @tempBlock, @tempBlock, encrypt];
ENDLOOP;
tFinish ¬ System.GetClockPulses[];
t1 ¬ tFinish - tStart - tLoop;
t1InMicroseconds ¬ System.PulsesToMicroseconds[[t1]];

tStart ¬ System.GetClockPulses[];
THROUGH [1..iterations] DO
  MakeInternalKeys[@tempKey, @tempKeys];
ENDLOOP;
tFinish ¬ System.GetClockPulses[];
t2 ¬ tFinish - tStart - tLoop;
t2InMicroseconds ¬ System.PulsesToMicroseconds[[t2]];

tStart ¬ System.GetClockPulses[];
THROUGH [1..iterations] DO
  ECB[@tempKey, 1, LOOPHOLE[LONG[@tempBlock]],
    LOOPHOLE[LONG[@tempBlock]], encrypt];
ENDLOOP;
tFinish ¬ System.GetClockPulses[];
t3 ¬ tFinish - tStart - tLoop;
t3InMicroseconds ¬ System.PulsesToMicroseconds[[t3]];