DCL DD EPWD CHAR(16); /* ENCRYPTED PASSWORD             */
DCL DD PWD  CHAR(24); /* GIVEN PASSWORD TO 24 POSITIONS */
DCL DD WORK CHAR(1);
DCL DD SHIFT BIN(2) UNSGND;
DCL DD N     BIN(2);
DCL DD P     BIN(2);
DCL DD E     BIN(2);

DCL DD ASCII-TABLE CHAR(256);
    DCL DD *(16) CHAR(16) DEF(ASCII-TABLE) POS(1) INIT
    (X'00000000000000000000000000000000', /* 00-0F ---------------- */
     X'00000000000000000000000000000000', /* 10-1F ---------------- */
     X'00000000000000000000000000000000', /* 20-2F ---------------- */
     X'00000000000000000000000000000000', /* 30-3F ---------------- */
     X'00000000000000000000002E2C282B00', /* 40-4F  ----------.<(+- */
     X'2600000000000000000021242A293B00', /* 50-5F &---------!$*);- */
     X'2D2F0000000000000000002C255F3E3F', /* 60-6F -/---------,%_>? */
     X'000000000000000000003A2340273D22', /* 70-7F ----------:#@'=" */
     X'00414243444546474849000000000000', /* 80-8F -ABCDEFGHI------ */
     X'004A4B4C4D4E4F505152000000000000', /* 90-9F -JKLMNOPQR------ */
     X'0000535455565758595A000000000000', /* A0-AF --STUVWXYZ------ */
     X'00000000000000000000000000000000', /* B0-BF ---------------- */
     X'00414243444546474849000000000000', /* C0-CF -ABCDEFGHI------ */
     X'004A4B4C4D4E4F505152000000000000', /* D0-DF -JKLMNOPQR------ */
     X'0000535455565758595A000000000000', /* E0-EF --STUVWXYZ------ */
     X'30313233343536373839000000000000');/* F0-FF 0123456789------ */
     /* NOTE THAT 'BLANK' TRANSLATES TO '00' */

DCL DD CONTROL CHAR(32);
    DCL DD CTRL-FUNCTION CHAR(2) DEF(CONTROL) POS(1) INIT(X'0002');
    DCL DD CTRL-SIZE      BIN(2) DEF(CONTROL) POS(3) INIT(8);
    DCL DD CTRL-OPTION   CHAR(1) DEF(CONTROL) POS(5) INIT(X'00');
    DCL DD KEY           CHAR(8) DEF(CONTROL) POS(6);

DCL SPCPTR .USER  INIT(USER);
DCL DD      USER  CHAR(10);

DCL SPCPTR .CRYPT INIT(CRYPT);
DCL DD      CRYPT CHAR(8);

SET-USER-PWD:
    CPYBLAP     USER, "LSVALGAARD", " ";
    CPYBLAP     PWD , "LSVALGAARD", " ";

FIRST-ENCRYPTED-PASSWORD:
    CPYBREP     EPWD, " ";     /* CLEAR ENCRYPTED PASSWORD */
    CMPBLA(B)   USER(9:2), "  "/EQ(PREPARE-TO-ENCRYPT);
    CPYNV       N, 8;          /* START FROM THE END */
FOLD:
    SUBN        SHIFT, N ,1;
    ADDN(S)     SHIFT, SHIFT;
    CPYBTLLS    WORK, USER(9:2), SHIFT;
    AND(S)      WORK, X'C0'; /* TOP TWO BITS */
    XOR(S)      USER(N:1), WORK;
    SUBN(SB)    N, 1/POS(FOLD);

PREPARE-TO-ENCRYPT:
    CPYNV       P, 1;
ENCRYPT:
    CPYBLAP     KEY, PWD(P:8), X'40';        /* STEP 1 */
    CMPBLA(B)   KEY, X'40'/EQ(SHOW);

    XOR(S)      KEY, X'5555555555555555';    /* STEP 2 */
    ADDLC(S)    KEY, KEY;                    /* STEP 3 */
    CIPHER     .CRYPT, CONTROL, .USER;
    CPYBLA      EPWD(P:8), CRYPT;
    ADDN(SB)    P, 8/POS(ENCRYPT);

SHOW:
    CPYBREP     MSG-TEXT, " ";
    CVTHC       MSG-TEXT(1:32), EPWD; /* 1ST ENCRYPTED PASSWORD */

SECOND-ENCRYPTED-PASSWORD:
    XLATEWT     USER, "KGS!@#$%", ASCII-TABLE;
    XLATEWT     PWD ,  PWD      , ASCII-TABLE;

    CPYNV       P, 1; /* CHARACTER POSITION IN PASSWORD           */
    CPYNV       E, 1; /* CHARACTER POSITION IN ENCRYPTED PASSWORD */
NEXT:
    CPYNV       N, 8; /* CHARACTER POSITION IN DES KEY            */
BUILD:
    SUBN        SHIFT, N ,1;
    MULT(S)     SHIFT, 7;
    CPYBTLLS    KEY(N:1), PWD(P:8), SHIFT;
    SUBN(SB)    N, 1/POS(BUILD);
    CIPHER     .CRYPT, CONTROL, .USER;
    CPYBLA      EPWD(E:8), CRYPT;

    ADDN(S)     P, 7;
    ADDN(S)     E, 8;
    CMPNV(B)    P, 14/LO(NEXT);

    CVTHC       MSG-TEXT(34:32), EPWD; /* 2ND ENCRYPTED PASSWORD */
    CALLI       SHOW-MESSAGE, *, .SHOW-MESSAGE;
    RTX         *;

%INCLUDE SHOWMSG