
    <<DESImpl.mesa>>
        <<Copyright © 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>>

    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;

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


    <<Global Variables>>

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

    <<Errors>>

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

    <<Exported Procedures>>

    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] = {
        <<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^ + PrincOpsUtils.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];
        };

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

    MakeKey: PUBLIC PROC [source: LONG STRING] RETURNS [key: Key] = {
        <<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 _ 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;
        };
    <<>>
    <<Internal Procedures>>

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

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


    <<Initialization>>

    [] _ GetRandomKey[];


    END.