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