./ ADD SSI=01013558,NAME=IKJEFA22,SOURCE=1 TITLE ' IKJEFA22 CHANGE SUBCOMMAND - PASSWORD/ACCTNMBR ROUTINX00010000 E ' 00020000 * /*******************************************************************/ 00030000 * /* */ 00040000 * /* P R O L O G U E FOR I K J E F A 2 2 */ 00050000 * /* CHANGE PASSWORD/ACCTNMBR ROUTINE */ 00060000 * /* */ 00070000 * /* STATUS: */ 00080000 * /* CHANGE LEVEL 000 */ 00090000 * /* PTMS INCLUDED: 1467,2581 */ 00100000 * /* CHANGE LEVEL 001 */ 00110000 * /* PTMS INCLUDED: 1860 */ 00120000 * /* A 43110,43120 M1859 */ 00130000 * /* D 69500 M1859 */ 00140000 * /* A 309300-309420,309900,382200 M1860 */ 00150000 * /* C 309500,309800 M1860 */ 00160000 * /* A 36520-36760 21974 */ 00170000 * /* C 484100,496100,499000,511100,515200,515300 21974 */ 00180000 * /* */ 00190000 * /* FUNCTION: */ 00200000 * /* THIS ROUTINE PERFORMS THE ADMINISTRATIVE FUNCTION OF */ 00210000 * /* CHANGING CONTROL INFORMATION FIELDS AT THE PASSWORD AND */ 00220000 * /* ACCTNMBR LEVEL OF THE USER ATTRIBUTE DATA SET (UADS) AS */ 00230000 * /* SPECIFIED IN THE CHANGE COMMAND. */ 00240000 * /* */ 00250000 * /* ENTRY POINTS: */ 00260000 * /* IKJEFA22 - ONLY ENTRY POINT */ 00270000 * /* */ 00280000 * /* INPUT: */ 00290000 * /* REGISTER 1 POINTS TO THE CHANGE CONTROL TABLE: */ 00300000 * /* */ 00310000 * /* ³------------------------------------------------------³ */ 00320000 * /* +0 ³ PTR TO THE ACCOUNT PARAMETER LIST ³ */ 00330000 * /* ³------------------------------------------------------³ */ 00340000 * /* +4 ³ PTR TO THE PARAMETER DESCRIPTOR LIST (PDL) ³ */ 00350000 * /* ³------------------------------------------------------³ */ 00360000 * /* +8 ³ PTR TO THE NODELIST TABLE ³ */ 00370000 * /* ³------------³-----------------------------------------³ */ 00380000 * /* +12³ BLKCNT ³ PTR TO THE USERID TREE BUFFER ³ */ 00390000 * /* ³------------³-----------------------------------------³ */ 00400000 * /* +16³ ADDR OF THE NODELIST PASSWORD OFFSET BLOCK ³ */ 00410000 * /* ³------------------------------------------------------³ */ 00420000 * /* +20³ ADDR OF THE NODELIST ACCTNMBR OFFSET BLOCK ³ */ 00430000 * /* ³------------------------------------------------------³ */ 00440000 * /* +24³ ADDR OF THE NODELIST PROCNAME OFFSET BLOCK ³ */ 00450000 * /* ³--------------------------³---------------------------³ */ 00460000 * /* +28³ CHANGE LEVEL ³ SEARCH INDICATOR ³ */ 00470000 * /* ³--------------------------³---------------------------³ */ 00480000 * /* +32³ MESSAGE NUMBER ³ CHANGE INDICATOR ³ */ 00490000 * /* ³--------------------------³---------------------------³ */ 00500000 * /* */ 00510000 * /* OUTPUT: */ 00520000 * /* THREE INDICATORS IN THE CHANGE CONTROL TABLE ARE SET: */ 00530000 * /* . SEARCH INDICATOR - INDICATES WHICH SEARCH LOOP TO RE- */ 00540000 * /* ENTER, IF ANY. */ 00550000 * /* . MESSAGE NUMBER - INDICATES SUCCESSFUL COMPLETION OR AN */ 00560000 * /* ERROR CONDITION ENCOUNTERED DURING PROCESSING OF THE */ 00570000 * /* USERID TREE. CHANGE CP WILL ISSUE THE ERROR MESSAGE. */ 00580000 * /* . CHANGE INDICATOR - INDICATES WHETHER ANY CHANGES HAVE */ 00590000 * /* BEEN MADE TO A TREE. */ 00600000 * /* */ 00610000 * /* EXTERNAL REFERENCES: */ 00620000 * /* . IKJEFA53 - ACCOUNT GETSPACE ROUTINE */ 00630000 * /* . IKJEFA54 - ACCOUNT FREESPACE ROUTINE */ 00640000 * /* */ 00650000 * /* EXITS: */ 00660000 * /* . NORMAL: RETURN TO CHANGE CP (IKJEFA20) */ 00670000 * /* . ERROR: RETURN TO CHANGE CP (IKJEFA20) */ 00680000 * /* */ 00690000 * /* TABLES/WORKAREAS: */ 00700000 * /* . BUFFER FOR ONE USERID TREE */ 00710000 * /* . PARAMETER DESCRIPTOR LIST (PDL) */ 00720000 * /* . NODELIST TABLE (NLSTTAB) */ 00730000 * /* . CHANGE CONTROL TABLE (CTRLTAB) */ 00740000 * /* */ 00750000 * /* ATTRIBUTES: */ 00760000 * /* REENTRANT, REFRESHABLE */ 00770000 * /* */ 00780000 * /* NOTES: */ 00790000 * /* . CHARACTER DEPENDENCY - CLASS C */ 00800000 * /* THE OPERATION OF THIS MODULE DEPENDS UPON AN INTERNAL RE- */ 00810000 * /* PRESENTATION OF THE EXTERNAL CHARACTER SET WHICH IS EQUI- */ 00820000 * /* VALENT TO THE ONE USED AT ASSEMBLY TIME. THE CODING HAS */ 00830000 * /* BEEN ARRANGED SO THAT REDEFINITION OF 'CHARACTER' CON- */ 00840000 * /* STANTS, BY REASSEMBLY, WILL RESULT IN A CORRECT MODULE FOR */ 00850000 * /* THE NEW DEFINITIONS. */ 00860000 * /* . RELEASE 20 SUPPORT CODE - 20035 */ 00870000 * /* */ 00880000 * /*******************************************************************/ 00890000 * 00900000 * GENERATE; /* ASSIGN SUBPOOL NUMBER - 1 */ 00910000 LCLA &T,&SPN 00920000 &SPN SETA 1 00930000 AGO .@001 00940000 * 00950000 **/*IKJEFA22: CHART */ 00960000 **/*HEADER 00970000 **/*CHANGE PASSWORD/ACCTNMBR ROUTINE - IKJEFA22 00980000 **/* PAGE # 11/11/71 */ 00990000 **/* E IKJEFA22 */ 01000000 * 01010000 * 01020000 * IKJEFA22: 01030000 * PROCEDURE (DUMR1) 01040000 * OPTIONS (REENTRANT, 01050000 * DONTSAVE(15), 01060000 * CODEREG(9,11)); 01070000 LCLA &T,&SPN 0002 01080000 .@001 ANOP 0002 01090000 IKJEFA22 CSECT , 0002 01100000 ST @E,12(0,@D) 0002 01110000 STM @0,@C,20(@D) 0002 01120000 BALR @9,0 0002 01130000 @PSTART DS 0H 0002 01140000 USING @PSTART+00000,@9 0002 01150000 LA @B,4095(0,@9) 0002 01160000 USING @PSTART+04095,@B 0002 01170000 L @0,@SIZ001 0002 01180000 GETMAIN R,LV=(0) 0002 01190000 LR @C,@1 0002 01200000 USING @DATD+00000,@C 0002 01210000 LM @0,@1,20(@D) 0002 01220000 XC @TEMPS(@L),@TEMPS 0002 01230000 ST @D,@SAV001+4 0002 01240000 LA @F,@SAV001 0002 01250000 ST @F,8(0,@D) 0002 01260000 LR @D,@F 0002 01270000 * 01280000 * GOTO STCODE; /* BYPASS MODULE IDENTIFICATION*/ 01290000 BC 15,STCODE 0003 01300000 * GENERATE; 01310000 DC CL8'IKJEFA22' MODULE NAME 01320000 DC XL4'11111971' DATE OF LAST CHANGE 01330000 DS 0H 01340000 * 01350000 * 01360000 * DECLARE 01370000 * /* EXTERNAL AND INTERNAL ROUTINES USED BY IKJEFA22. */ 01380000 * IKJEFA53 EXTERNAL ENTRY, /* GETSPACE ROUTINE */ 01390000 * IKJEFA54 EXTERNAL ENTRY, /* FREESPACE ROUTINE */ 01400000 * IKJFRSP INTERNAL ENTRY, /* FREESPACE INTERFACE SUBR*/ 01410000 * DLACLS INTERNAL ENTRY, /* LOCAL CHAIN SEARCH SUBR */ 01420000 * DLACTS INTERNAL ENTRY; /* TOTAL CHAIN SEARCH SUBR */ 01430000 * 01440000 * DECLARE 01450000 * /* INTERNAL LABELS USED BY IKJEFA22. */ 01460000 * ACTWSR5 INTERNAL LABEL STATIC, /* RETURN AFTER PRUNE*/ 01470000 * TCTWSR4 INTERNAL LABEL STATIC; /* RETURN AFTER PRUNE*/ 01480000 * 01490000 * DECLARE 01500000 * /* CONTROL TABLE BUILT BY CHANGE (IKJEFA20). */ 01510000 * CTABPTR PTR, /* PTR TO THE CONTROL TABLE */ 01520000 * 1 CTRLTAB BASED(CTABPTR), 01530000 * 2 ACTPLADR PTR, /* PTR TO ACCOUNT PARMLIST */ 01540000 * 2 CHPDLPTR PTR, /* PTR TO THE PDL */ 01550000 * 2 NODELPTR PTR, /* PTR TO NODELIST ITEMS */ 01560000 * 2 * PTR, 01570000 * 3 BLKCNT PTR(8), /* NO. OF BLOCKS READ IN */ 01580000 * 3 HEADADDR PTR(24),/* PTR TO THE USER HEADER */ 01590000 * 2 PASSADDR PTR, /* UADS ADDR OF NODELIST PWRD */ 01600000 * 2 ACCTADDR PTR, /* UADS ADDR OF NODELST ACTNO */ 01610000 * 2 PROCADDR PTR, /* UADS ADDR OF NODELST PRNAME*/ 01620000 * 2 CHLEVL PTR(15), /* CHANGE LEVEL */ 01630000 * 2 SRCHIND PTR(15), /* INDICATES TO CHANGE WHICH 01640000 * SEARCH LOOP TO REENTER - 01650000 * ..0 NO FURTHER SEARCH 01660000 * ..1 ACCTNMBR 01670000 * ..2 PROCNAME */ 01680000 * 2 MSGNMBR PTR(15), /* MSG NUMBER SET BY THIS RTNE*/ 01690000 * 2 TRCHGE PTR(15), /* ..0 TREE IS UNCHANGED 01700000 * ..1 TREE HAS BEEN CHANGED */ 01710000 * 2 RETCODE FIXED, /* VARIABLE FOR RETURN CODES */ 01720000 * 2 VCHKCODE FIXED; /* VARIABLE FOR RETURN CODES */ 01730000 * 01740000 * DECLARE 01750000 * /* THE NODELIST, CONSTRUCTED FROM THE PDL BY THE */ 01760000 * /* NODELIST VALIDITY CHECK EXIT ROUTINE IN IKJEFA20 */ 01770000 * NODELADR PTR, /* BASE PTR FOR NODELIST TABLE*/ 01780000 * 1 NLSTTAB BASED(NODELADR), 01790000 * 2 * CHAR(8), /* NOT PERTINENT */ 01800000 * 2 PASSWD CHAR(8), /* PASSWORD */ 01810000 * 2 ACCTNO CHAR(40), /* ACCOUNT-NUMBER */ 01820000 * 2 PROCNM CHAR(8), /* PROCEDURE NAME */ 01830000 * 2 * PTR(15), /* NOT PERTINENT */ 01840000 * 2 PWLEN PTR(15), /* LENGTH OF THE PASSWORD */ 01850000 * 2 ACTLEN PTR(15), /* LENGTH OF THE ACCTNMBR */ 01860000 * 2 PRLEN PTR(15); /* LENGTH OF THE PROCNAME */ 01870000 * 01880000 * DECLARE 01890000 * /* THE PARAMETER DESCRIPTOR LIST (PDL). */ 01900000 * CHNPDLAD PTR, /* ADDR OF THE PDL */ 01910000 * 1 CHNGPDL BASED(CHNPDLAD), 01920000 * 2 * CHAR(24), /* NOT PERTINENT TO THIS RTNE */ 01930000 * 2 SIZENBR BIT(16), /* PROCSIZE KEY */ 01940000 * 2 UNITNBR BIT(16), /* UNIT NAME KEY */ 01950000 * 2 DATANBR BIT(16), /* DATALIST KEY */ 01960000 * 2 * BIT(16), /* FILLER */ 01970000 * 2 MAXSUBF, /* PDE FOR MAX REGION SIZE */ 01980000 * 3 MAXSADR PTR, /* PTR TO MAXSIZE INTEGERS */ 01990000 * 3 MAXSLNG FIXED(15),/* LENGTH OF MAXSIZE NUMBER */ 02000000 * 3 MAXSFLGS BIT(16),/* MAXSIZE FLAGS */ 02010000 * 4 MAXSFLG BIT(1),/* BIT1 = 1: PARM PRESENT */ 02020000 * 2 SIZSUBF, /* PDE FOR PROCSIZE */ 02030000 * 3 RSIZADR PTR, /* PTR TO SIZE INTEGERS */ 02040000 * 3 RSIZLNG FIXED(15),/* LENGTH OF SIZE INTEGERS */ 02050000 * 3 RSIZFLGS BIT(16),/* PROCSIZE FLAGS */ 02060000 * 4 RSIZFLG BIT(1),/* BIT1 = 1: PARM PRESENT */ 02070000 * 2 UNITSUBF, /* PDE FOR THE UNIT NAME */ 02080000 * 3 UNITADR PTR, /* PTR TO THE UNIT NAME */ 02090000 * 3 UNITLNG FIXED(15),/* LENGTH OF THE UNIT NAME */ 02100000 * 3 UNITFLGS BIT(16),/* UNIT NAME FLAGS */ 02110000 * 4 UNITFLG BIT(1),/* BIT1 = 1: PARM PRESENT */ 02120000 * 2 PROCSUBF, /* PDE FOR THE DATALIST ITEM 02130000 * (NEW PROCNAME) */ 02140000 * 3 DLPTR4 PTR, /* PTR TO THE DATALIST ITEM */ 02150000 * 3 DATALNG4 FIXED(15),/* LENGTH OF DATALIST ITEM */ 02160000 * 3 * BIT(16), /* DATALIST PDE FLAGS */ 02170000 * 4 DLFLG4 BIT(1),/* BIT1 = 1: PARM PRESENT */ 02180000 * 2 ACCTSUBF, /* PDE FOR THE DATALIST ITEM 02190000 * (NEW ACCTNMBR) */ 02200000 * 3 DLPTR3 PTR, /* PTR TO THE DATALIST ITEM */ 02210000 * 3 DATALNG3 FIXED(15),/* LENGTH OF DATALIST ITEM */ 02220000 * 3 * BIT(16), /* DATALIST PDE FLAGS */ 02230000 * 4 DLFLG3 BIT(1),/* BIT1 = 1: PARM PRESENT */ 02240000 * 2 PASSSUBF, /* PDE FOR THE DATALIST ITEM 02250000 * (NEW PASSWORD) */ 02260000 * 3 DLPTR2 PTR, /* PTR TO THE DATALIST ITEM */ 02270000 * 3 DATALNG2 FIXED(15),/* LENGTH OF DATALIST ITEM */ 02280000 * 3 * BIT(16), /* DATALIST PDE FLAGS */ 02290000 * 4 DLFLG2 BIT(1),/* BIT1 = 1: PARM PRESENT */ 02300000 * 2 USIDSUBF, /* PDE FOR THE DATALIST ITEM 02310000 * (NEW USERID) */ 02320000 * 3 DLPTR1 PTR, /* PTR TO THE DATALIST ITEM */ 02330000 * 3 DATALNG1 FIXED(15),/* LENGTH OF DATALIST ITEM */ 02340000 * 3 * BIT(16), /* DATALIST PDE FLAGS */ 02350000 * 4 DLFLG1 BIT(1);/* BIT1 = 1: PARM PRESENT */ 02360000 * 02370000 * DECLARE 02380000 * /* ITEMS ADDRESSED BY PDL POINTERS. */ 02390000 * DLITEM CHAR(40) /* ITEM IN THE DATA SUBFIELD -*/ 02400000 * BASED(DLPTR3), /* NEW ACCTNMBR */ 02410000 * /* SPECIFIC WORK AREA FOR THE DATALIST ITEM, IF IT */ 02420000 * /* IS A PASSWORD. */ 02430000 * DLPWD CHAR(8); /* NEW PASSWORD */ 02440000 * 02450000 * DECLARE 02460000 * /* GETSPACE/FREESPACE (IKJEFA53/54) PARAMETER LIST */ 02470000 * 1 GETFREE, 02480000 * 2 READBUFF PTR, /* ADDR OF USERID TREE BUFFER */ 02490000 * 2 NUMBLOKS PTR(15), /* NO. OF BLOCKS IN BUFFER */ 02500000 * 2 AREALNTH PTR(15), /* SIZE OF AREA TO BE FREED, 02510000 * OR ADDED TO THE TREE */ 02520000 * 2 AREAOFST PTR; /* OFFSET TO THIS AREA, FILLED 02530000 * IN BY GETSPACE OR CALLER OF 02540000 * FREESPACE */ 02550000 * 02560000 * DECLARE 02570000 * /* GENERAL VARIABLES */ 02580000 * R1 REG(1) PTR, /* PTR TO PARAMETER LISTS */ 02590000 * R15 REG(15) PTR, /* RETURN CODES */ 02600000 * SAVE14 PTR, /* SAVE AREA FOR REGISTER 14 */ 02610000 * NLEVL PTR(8), /* NUMBER OF ITEMS IN THE NODE- 02620000 * LIST (= CHANGE LEVEL) */ 02630000 * NLPWOBAD PTR, /* PTR TO THE NODELIST 02640000 * PASSWORD OFFSET BLOCK */ 02650000 * DLPWOBAD PTR, /* PTR TO THE DATALIST 02660000 * PASSWORD OFFSET BLOCK */ 02670000 * OACSAVE PTR, /* PTR TO THE NODELIST 02680000 * ACCTNMBR OFFSET BLOCK */ 02690000 * RNEXSAVE PTR, /* WORK VARIABLE FOR OBLK OFFS*/ 02700000 * ANEXSAVE PTR, /* SAME AS ABOVE */ 02710000 * PNEXSAVE PTR, /* SAME AS ABOVE */ 02720000 * ADATSAVE PTR, /* WORK VARIABLE FOR DATA FIELD 02730000 * OFFSETS */ 02740000 * RDATSAVE PTR, /* SAME AS ABOVE */ 02750000 * ODFPTR PTR, /* PTR TO THE DATA FIELD OF A 02760000 * NODELIST ITEM */ 02770000 * NDFPTR PTR, /* PTR TO THE DATA FIELD OF THE 02780000 * DATALIST ITEM */ 02790000 * LASTOB PTR, /* PTR TO THE LAST OFFSET BLOCK 02800000 * IN A LOCAL CHAIN */ 02810000 * NEWDFPTR PTR, /* PTR TO A NEWLY CREATED 02820000 * DATA FIELD */ 02830000 * PRCOMP CHAR(8), /* PROCNAME WORK VARIABLE */ 02840000 * ACTWIN1 PTR, /* PTR TO 1ST OF ACTNBR TWINS */ 02850000 * ACTWIN2 PTR, /* PTR TO 2ND OF ACTNBR TWINS */ 02860000 * PRTWIN1 PTR, /* PTR TO 1ST OF PROC TWINS */ 02870000 * PRTWIN2 PTR, /* PTR TO 2ND OF PROC TWINS */ 02880000 * CSNSAVE PTR, /* OFFSET TO COUSIN OBLK */ 02890000 * ACSNOFS PTR, /* SAME AS ABOVE */ 02900000 * CSNPTR PTR, /* PTR TO COUSIN OFFSET BLOCK */ 02910000 * PRUNOFS PTR, /* OFFSET TO PRUNED OFFSET BLK*/ 02920000 * SUBOFS PTR, /* OFFSET TO A SUB OBLK */ 02930000 * RETPTR PTR, /* USED TO HOLD ADDR OF POINT 02940000 * OF TRANSFER */ 02950000 * RETLABL LABEL /* NAME OF TRANSFER POINT */ 02960000 * BASED(RETPTR); 02970000 * 02980000 * DECLARE 02990000 * /* INDICATORS FOR LOOP CONTROL */ 03000000 * 1 CFLAGS CHAR(1), 03010000 * 2 FLGSAVE BIT(1), /* CHAIN FLAG SAVE AREA */ 03020000 * 2 FLDFLG BIT(1), /* LOGIC CONTROL FLAG */ 03030000 * 2 ALLACFLG BIT(1), /* SAME AS ABOVE */ 03040000 * 2 NACDFLG BIT(1), /* SAME AS ABOVE */ 03050000 * 2 ACPRFLG BIT(1); /* SAME AS ABOVE */ 03060000 * 03070000 * DECLARE 03080000 * /* BASE POINTERS FOR THE UADS STRUCTURE. */ 03090000 * HEDBPTR REG(4) PTR, /* PTR TO THE UADS USERID DATA*/ 03100000 * DPOBPTR PTR, /* PTR TO PASSWORD OFFSET BLCK*/ 03110000 * DNOBPTR REG(2) PTR, /* PTR TO ACCTNMBR OFFSET BLCK*/ 03120000 * DROBPTR REG(3) PTR, /* PTR TO PROCNAME OFFSET BLCK*/ 03130000 * UADSPPTR PTR, /* PTR TO THE PASSWORD DATA */ 03140000 * UADSAPTR PTR, /* PTR TO THE ACCTNMBR DATA */ 03150000 * UADSRPTR PTR; /* PTR TO THE PROCNAME DATA */ 03160000 * 03170000 * 03180000 * 03190000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03200000 **/* * * 03210000 **/* * H E A D E R B L O C K * 03220000 **/* * * 03230000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03240000 **/* * * 03250000 **/* * * 03260000 **/* * I---------------------I---------------------I * 03270000 **/* * 0 I UADSBLNG I UADSFSQP I * 03280000 **/* * I---------------------I---------------------I * 03290000 **/* * 4 I UADSUSER I * 03300000 **/* * I I * 03310000 **/* * I I * 03320000 **/* * I----------I----------I---------------------I * 03330000 **/* * 12 I UADSBN01 I UADSBN02 I UADSMAXC I * 03340000 **/* * I----------I----------I---------------------I * 03350000 **/* * 16 I UADSATTR I * 03360000 **/* * I-------------------------------------------I * 03370000 **/* * 20 I UADSUPTP I * 03380000 **/* * I-------------------------------------------I * 03390000 **/* * 24 I UADSPWD1 I * 03400000 **/* * I-------------------------------------------I * 03410000 **/* * * 03420000 ** 03430000 ** 03440000 **DECLARE 03450000 ** 1 DHED BASED(HEDBPTR), 03460000 ** 03470000 ** 03480000 ** 2 UADSMHDR CHAR(14) BDY(WORD), 03490000 ** /* COMMON HEADER AREA * 03500000 ** 3 UADSBLNG PTR(15) BDY(BYTE), 03510000 ** /* BLOCK LENGTH * 03520000 ** 3 UADSFSQP PTR(15) BDY(BYTE), 03530000 ** /* OFFSET TO INITIAL FSQE (FREE * 03540000 **/* ..SPACE QUEUE ELEMENT) * 03550000 ** 3 UADSUSER CHAR(8), /* USERID * 03560000 ** 4 UADSUSID CHAR(7), /* USERID * 03570000 ** 4 UADSIND1 PTR(8), /* RESERVED * 03580000 ** 3 UADSBN01 PTR(8), /* RESERVED * 03590000 ** 3 UADSBN02 CHAR(1), /* FLAGS * 03600000 ** 4 UADSNUSP BIT(1), /*..NO NON-USABLE SPACE * 03610000 **/* ..1 -- ONLY NON-USABLE SPACE * 03620000 **/* .......EXISTS IN THIS BLOCK * 03630000 ** 4 * BIT(1), /* RESERVED * 03640000 ** 4 * BIT(1), /* RESERVED * 03650000 ** 4 * BIT(1), /* RESERVED * 03660000 ** 4 * BIT(1), /* RESERVED * 03670000 ** 4 * BIT(1), /* RESERVED * 03680000 ** 4 * BIT(1), /* RESERVED * 03690000 ** 4 * BIT(1), /* RESERVED * 03700000 ** 2 UADSMAXC PTR(16) BDY(BYTE), 03710000 ** /* MAXIMUM CORE SIZE ALLOTTABLE * 03720000 **/* ..TO THIS USER * 03730000 ** 2 UADSATTR CHAR(4), /* SYSTEM ATTRIBUTES OF USERID * 03740000 ** 3 UADSIBMT CHAR(2), /* IBM FLAG AREA * 03750000 ** 4 * CHAR(1), /* FIRST BYTE OF FLAGS * 03760000 ** 5 USATR00 BIT(1), /* ..0 -- NO OPERATOR 03770000 ** CAPABILITY * 03780000 **/* ..1 -- OPERATOR CAPABILITY * 03790000 ** 5 USATR01 BIT(1), /* ..0 -- NO ACCOUNT CAPABILITY * 03800000 **/* ..1 -- ACCOUNT CAPABILITY * 03810000 ** 5 USATR02 BIT(1), /* ..0 -- NO JCL CAPABILITY * 03820000 **/* ..1 -- JCL CAPABILITY * 03830000 **/* FLAGS 3 THROUGH 15 ARE * 03840000 **/* ..RESERVED FOR IBM USE * 03850000 ** 5 * BIT(1), /* RESERVED * 03860000 ** 5 * BIT(1), /* RESERVED * 03870000 ** 5 * BIT(1), /* RESERVED * 03880000 ** 5 * BIT(1), /* RESERVED * 03890000 ** 5 * BIT(1), /* RESERVED * 03900000 ** 4 * CHAR(1), /* SECOND BYTE OF FLAGS, 8 -- 03910000 ** 15 * 03920000 ** 03930000 ** 3 UADSINST CHAR(2), /* RESERVED * 03940000 **/* FLAGS 16 THROUGH 31 ARE * 03950000 **/* ..RESERVED FOR INSTALLATION * 03960000 **/* ..USE * 03970000 ** 4 * CHAR(1), /* THIRD BYTE OF FLAGS, 16 -- 03980000 ** 23 * 03990000 ** 4 * CHAR(1), /* FOURTH BYTE OF FLAGS * 04000000 ** 2 UADSUPTP PTR(31), /* OFFSET TO CURRENT UPT * 04010000 ** 2 UADSPWD1 PTR(31); /* OFFSET TO 1ST PASSWD OFFSET * 04020000 ** 04030000 ** 04040000 ** 04050000 ** 04060000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04070000 **/* * * 04080000 **/* * P A S S W O R D O F F S E T B L O C K * 04090000 **/* * * 04100000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04110000 **/* * * 04120000 **/* * * 04130000 **/* * I----------I--------------------------------I * 04140000 **/* * 0 I UADSPFLG I UADSPNEX I * 04150000 **/* * I----------I--------------------------------I * 04160000 **/* * 4 I UADSPSUB I * 04170000 **/* * I-------------------------------------------I * 04180000 **/* * 8 I UADSPDAT I * 04190000 **/* * I-------------------------------------------I * 04200000 **/* * * 04210000 ** 04220000 ** 04230000 **DECLARE 04240000 ** 1 DPOB BASED(DPOBPTR), 04250000 ** 04260000 ** 2 UADSPFLG CHAR(1), /* PASSWORD BLOCK INDICATORS * 04270000 ** 3 PFLG01 BIT(1), /* ..0 -- CONTINUE CHAINING * 04280000 **/* ..1 -- LAST PASSWORD FOR THIS * 04290000 **/* .......USERID * 04300000 **/* ..FLAGS 1 THRU 7 ARE RESERVED * 04310000 ** 3 * BIT(1), /* RESERVED * 04320000 ** 3 * BIT(1), /* RESERVED * 04330000 ** 3 * BIT(1), /* RESERVED * 04340000 ** 3 * BIT(1), /* RESERVED * 04350000 ** 3 * BIT(1), /* RESERVED * 04360000 ** 3 * BIT(1), /* RESERVED * 04370000 ** 3 * BIT(1), /* RESERVED * 04380000 ** 2 UADSPNEX PTR(24) BDY(BYTE), 04390000 ** /* OFFSET TO NEXT PASSWD OFFSET * 04400000 **/* ..BLOCK * 04410000 ** 2 UADSPSUB PTR(31), /* OFFSET TO ASSOCIATED ACCOUNT * 04420000 **/* ..NUMBER OFFSET BLOCK * 04430000 ** 2 UADSPDAT PTR(31); /* OFFSET TO PASSWORD DATA 04440000 ** BLOCK * 04450000 ** 04460000 ** 04470000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04480000 **/* * * 04490000 **/* * A C C O U N T N U M B E R * 04500000 **/* * O F F S E T B L O C K * 04510000 **/* * * 04520000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04530000 **/* * * 04540000 **/* * * 04550000 **/* * I----------I--------------------------------I * 04560000 **/* * 0 I UADSAFLG I UADSANEX I * 04570000 **/* * I----------I--------------------------------I * 04580000 **/* * 4 I UADSASUB I * 04590000 **/* * I-------------------------------------------I * 04600000 **/* * 8 I UADSADAT I * 04610000 **/* * I-------------------------------------------I * 04620000 **/* * * 04630000 ** 04640000 ** 04650000 **DECLARE 04660000 ** 1 DNOB BASED(DNOBPTR), 04670000 ** 04680000 ** 2 UADSAFLG CHAR(1), /* ACCOUNT NUMBER OFFSET BLOCK * 04690000 **/* ..INDICATORS * 04700000 ** 3 AFLG01 BIT(1), /* ..0 -- CONTINUE CHAINING * 04710000 **/* ..1 -- LAST ACCOUNT NUMBER FO * 04720000 **/* .......THIS PASSWORD CHAIN * 04730000 **/* .. FLAGS 1 THRU 7 ARE RESERVE * 04740000 ** 3 * BIT(1), /* RESERVED * 04750000 ** 3 * BIT(1), /* RESERVED * 04760000 ** 3 * BIT(1), /* RESERVED * 04770000 ** 3 * BIT(1), /* RESERVED * 04780000 ** 3 * BIT(1), /* RESERVED * 04790000 ** 3 * BIT(1), /* RESERVED * 04800000 ** 3 * BIT(1), /* RESERVED * 04810000 ** 2 UADSANEX PTR(24) BDY(BYTE), 04820000 ** /* OFFSET TO NEXT ACCOUNT 04830000 ** NUMBER * 04840000 **/* ..OFFSET BLOCK * 04850000 ** 2 UADSASUB PTR(31), /* OFFSET TO ASSOCIATED 04860000 ** PROCNAME * 04870000 **/* ..OFFSET BLOCK * 04880000 ** 2 UADSADAT PTR(31); /* OFFSET TO ACCOUNT NUMBER 04890000 ** DATA * 04900000 **/* ..BLOCK * 04910000 ** 04920000 ** 04930000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04940000 **/* * * 04950000 **/* * P R O C E D U R E N A M E * 04960000 **/* * O F F S E T B L O C K * 04970000 **/* * * 04980000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04990000 **/* * * 05000000 **/* * * 05010000 **/* * I----------I--------------------------------I * 05020000 **/* * 0 I UADSRFLG I UADSRNEX I * 05030000 **/* * I----------I--------------------------------I * 05040000 **/* * 4 I UADSRSUB I * 05050000 **/* * I-------------------------------------------I * 05060000 **/* * 8 I UADSRDAT I * 05070000 **/* * I-------------------------------------------I * 05080000 **/* * * 05090000 ** 05100000 ** 05110000 **DECLARE 05120000 ** 1 DROB BASED(DROBPTR), 05130000 ** 05140000 ** 2 UADSRFLG CHAR(1), /* PROCNAME OFFSET BLOCK * 05150000 **/* ..INDICATORS * 05160000 ** 3 FLGR01 BIT(1), /* ..0 -- CONTINUE CHAINING * 05170000 **/* ..1 -- LAST PROCNAME FOR THIS * 05180000 **/* .......ACCOUNT NUMBER * 05190000 **/* ..FLAGS 1 THRU 7 ARE RESERVED * 05200000 ** 3 * BIT(1), /* RESERVED * 05210000 ** 3 * BIT(1), /* RESERVED * 05220000 ** 3 * BIT(1), /* RESERVED * 05230000 ** 3 * BIT(1), /* RESERVED * 05240000 ** 3 * BIT(1), /* RESERVED * 05250000 ** 3 * BIT(1), /* RESERVED * 05260000 ** 3 * BIT(1), /* RESERVED * 05270000 ** 2 UADSRNEX PTR(24) BDY(BYTE), 05280000 ** /* OFFSET TO NEXT PROCNAME * 05290000 **/* ..OFFSET BLOCK * 05300000 ** 2 UADSRSUB PTR(31), /* RESERVED BY ACCOUNT * 05310000 ** 2 UADSRDAT PTR(31); /* OFFSET TO PROCNAME DATA 05320000 ** BLOCK * 05330000 ** 05340000 ** 05350000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05360000 **/* * * 05370000 **/* * P A S S W O R D D A T A B L O C K * 05380000 **/* * * 05390000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05400000 **/* * * 05410000 **/* * * 05420000 **/* * I----------I--------------------------------I * 05430000 **/* * 0 I UADSPCTR I UADSPRES I * 05440000 **/* * I----------I--------------------------------I * 05450000 **/* * 4 I UADSPPWD I * 05460000 **/* * I I * 05470000 **/* * 8 I I * 05480000 **/* * I-------------------------------------------I * 05490000 **/* * * 05500000 ** 05510000 ** 05520000 **DECLARE 05530000 ** 1 DPOBD BASED(UADSPPTR), 05540000 ** 05550000 ** 2 UADSPCTR PTR(8), /* COUNT OF REFERENCES TO THIS * 05560000 **/* ..DATA BLOCK * 05570000 ** 2 UADSPRES CHAR(3), /* RESERVED FOR ACCOUNT * 05580000 ** 2 UADSPPWD CHAR(8); /* PASSWORD * 05590000 ** 05600000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05610000 **/* * * 05620000 **/* * A C C O U N T N U M B E R * 05630000 **/* * D A T A B L O C K * 05640000 **/* * * 05650000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05660000 **/* * * 05670000 **/* * * 05680000 **/* * I----------I--------------------------------I * 05690000 **/* * 0 I UADSACTR I UADSARES I * 05700000 **/* * I----------I--------------------------------I * 05710000 **/* * 4 I UADSADRF (40 BYTES) I * 05720000 **/* * I I * 05730000 **/* * I I * 05740000 **/* * I I * 05750000 **/* * I----------I--------------------------------I * 05760000 **/* * 44 I UADSALEN I UADSANUM (MAX OF 40 BYTES) I * 05770000 **/* * I----------I I * 05780000 **/* * I I * 05790000 **/* * I I * 05800000 **/* * I I * 05810000 **/* * = = * 05820000 **/* * I I * 05830000 **/* * I-------------------------------------------I * 05840000 **/* * * 05850000 ** 05860000 ** 05870000 **DECLARE 05880000 ** 1 DNOBD BASED(UADSAPTR), 05890000 ** 05900000 ** 2 UADSACTR PTR(8), /* COUNT OF REFERENCES TO THIS * 05910000 **/* ..DATA BLOCK * 05920000 ** 2 UADSARES CHAR(3), /* RESERVED FOR ACCOUNT * 05930000 ** 2 UADSADRF CHAR(40), /* DRIVER DATA FIELD * 05940000 ** 2 UADSALEN PTR(8), /* LENGTH OF FOLLOWING ACCOUNT * 05950000 **/* ..NUMBER DATA FIELD * 05960000 ** 2 UADSANUM CHAR(40); /* ACCT NMBR DATA FIELD * 05970000 ** 05980000 ** 05990000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06000000 **/* * * 06010000 **/* * P R O C E D U R E N A M E * 06020000 **/* * D A T A B L O C K * 06030000 **/* * * 06040000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06050000 **/* * * 06060000 **/* * * 06070000 **/* * I----------I--------------------------------I * 06080000 **/* * 0 I UADSRCTR I UADSRRES I * 06090000 **/* * I----------I--------------------------------I * 06100000 **/* * 4 I UADSRNAM I * 06110000 **/* * I I * 06120000 **/* * I I * 06130000 **/* * I----------I----------I---------------------I * 06140000 **/* * 12 I UADSRNDS I UADSRRS2 I UADSRSIZ I * 06150000 **/* * I----------I----------I---------------------I * 06160000 **/* * 16 I UADSUNAM I * 06170000 **/* * I I * 06180000 **/* * I I * 06190000 **/* * I-------------------------------------------I * 06200000 **/* * * 06210000 ** 06220000 ** 06230000 **DECLARE 06240000 ** 1 DROBD BASED(UADSRPTR), 06250000 ** 06260000 ** 2 UADSRCTR PTR(8), /* COUNT OF REFERENCES TO THIS * 06270000 **/* DATA BLOCK * 06280000 ** 2 UADSRRES CHAR(3), /* RESERVED FOR ACCOUNT * 06290000 ** 2 UADSRNAM CHAR(8), /* LOGON PROCEDURE NAME * 06300000 ** 2 UADSRNDS CHAR(1), /* RESERVED * 06310000 ** 2 UADSRRS2 CHAR(1), /* RESERVED * 06320000 ** 2 UADSRSIZ PTR(16) BDY(BYTE), 06330000 ** /* REGION SIZE SPECIFIED IN THE * 06340000 **/* ..NAMED PROCEDURE * 06350000 ** 2 UADSUNAM CHAR(8); /* ESOTERIC GROUP UNIT NAME * 06360000 ** 06370000 ** 06380000 * 06390000 * STCODE: /**********************************************************/ 06400000 * /* */ 06410000 * /* BEGINNING OF EXECUTABLE CODE */ 06420000 * /* */ 06430000 * /**********************************************************/ 06440000 * 06450000 **/*STCODE: P SET BASE PTR FOR CHANGE CONTROL TABLE */ 06460000 **/* P SET ALL LOGIC CONTROL FLAGS TO 0 */ 06470000 * CTABPTR = R1; /* ADDR OF THE CHANGE 06480000 * CONTROL TABLE */ 06490000 STCODE ST @1,CTABPTR 0022 06500000 * NLEVL = CHLEVL; /* THE CHANGE LEVEL */ 06510000 L @8,CTABPTR 0023 06520000 MVC NLEVL(1),29(@8) 0023 06530000 * CHNPDLAD = CHPDLPTR; /* TRANSFER BASE PTR FOR PDL */ 06540000 MVC CHNPDLAD(4),4(@8) 0024 06550000 * NODELADR = NODELPTR; /* BASE PTR FOR NODELIST TABLE*/ 06560000 MVC NODELADR(4),8(@8) 0025 06570000 * /* ALLOCATE WORK REGISTERS. */ 06580000 * RESTRICT(HEDBPTR,DNOBPTR,DROBPTR); 06590000 * HEDBPTR = HEADADDR; /* ASSIGN PTR TO USER HEADER */ 06600000 MVC @TEMP3+1(3),13(@8) 0027 06610000 L @4,@TEMP3 0027 06620000 * SRCHIND = 0; /* INIT THE SEARCH INDICATOR */ 06630000 SR @F,@F 0028 06640000 STH @F,30(0,@8) 0028 06650000 * CFLAGS = '00'X; /* INITIALIZE ALL FLAGS */ 06660000 MVI CFLAGS,X'00' 0029 06670000 * 06680000 * /* TRANSFER THE DATALIST ITEM TO A WORK AREA IF THE ITEM */ 06690000 * /* IS A PASSWORD. */ 06700000 * 06710000 * /* IS THE DATALIST ITEM A PASSWORD? */ 06720000 * IF NLEVL = 2 06730000 * THEN /* YES, */ 06740000 CLI NLEVL,2 0030 06750000 BC 07,@9FF 0030 06760000 * DLPWD = DLPTR2 -> /* TRANSFER THE DATALIST PASS-*/ 06770000 * DLITEM(1:DATALNG2); /* WORD TO ITS WORK AREA */ 06780000 L @5,CHNPDLAD 0031 06790000 LH @6,76(0,@5) 0031 06800000 BCTR @6,0 0031 06810000 L @7,CHNPDLAD 0031 06820000 L @7,72(0,@7) CHNGPDL 0031 06830000 LR @E,@7 0031 06840000 LA @A,DLPWD 0031 06850000 MVI 0(@A),C' ' 0031 06860000 MVC 1(007,@A),0(@A) 0031 06870000 EX @6,@MVC 0031 06880000 * 06890000 * /* PARTIAL BUILDING OF GETSPACE/FREESPACE PARAMETER LIST. */ 06900000 * /* IT WILL BE COMPLETED AT EACH POINT OF CALL. */ 06910000 * READBUFF = HEADADDR; /* PTR TO USERID TREE BUFFER */ 06920000 @9FF L @5,CTABPTR 0032 06930000 MVC GETFREE+1(3),13(@5) 0032 06940000 MVI GETFREE,X'00' 0032 06950000 * NUMBLOKS = BLKCNT; /* NO. OF BLOCKS IN BUFFER */ 06960000 MVC GETFREE+5(1),12(@5) 0033 06970000 MVI GETFREE+4,X'00' 0033 06980000 * 06990000 * STRTPW: /**********************************************************/ 07000000 * /* */ 07010000 * /* CHANGE LEVEL = PASSWORD LEVEL */ 07020000 * /* */ 07030000 * /**********************************************************/ 07040000 * 07050000 **/*STRTPW: D (YES,%CAC,NO,) NODELST PASSWD SPECIFIED? */ 07060000 **/* P (,%CAC2) REFERENCE 1ST PASSWRD OBLK FOR THIS USERID * 07070000 **/*%CAC: P GET ADDR OF PASSWRD OBLK FROM CTRLTAB */ 07080000 * 07090000 * /* IF A PASSWORD WAS SPECIFIED IN THE NODELIST, THEN GET */ 07100000 * /* THE ADDR OF ITS OFFSET BLOCK FROM THE CHANGE CONTROL */ 07110000 * /* TABLE. IF NOT, REFERENCE THE 1ST PASSWORD IN THE TREE. */ 07120000 * IF PASSWD(1) = '*' /* PASSWORD = '*'? */ 07130000 * THEN /* YES, */ 07140000 STRTPW L @5,NODELADR 0034 07150000 CLI 8(@5),C'*' 0034 07160000 BC 07,@9FE 0034 07170000 * DPOBPTR = HEDBPTR+UADSPWD1;/* REF 1ST PASSWD OBLK */ 07180000 L @F,24(0,@4) 0035 07190000 AR @F,@4 0035 07200000 ST @F,DPOBPTR 0035 07210000 BC 15,@9FD 0036 07220000 * ELSE /* NO, PASSWORD WAS SPECIFIED,*/ 07230000 * DPOBPTR = PASSADDR; /* GET ADDR FROM CTRLTAB */ 07240000 @9FE L @8,CTABPTR 0036 07250000 MVC DPOBPTR(4),16(@8) 0036 07260000 * NLPWOBAD = DPOBPTR; /* SAVE ADDR OF THIS OBLK */ 07270000 @9FD MVC NLPWOBAD(4),DPOBPTR 0037 07280000 * 07290000 **/*%CAC2: D (NO,STRTAC,YES,) CHGE LEVL = PASSWD LEVL? */ 07300000 * /* DETERMINE WHETHER CHANGE LEVEL = PASSWORD LEVEL. IF IT */ 07310000 * /* IS, THEN SEARCH FOR THE DATALIST PASSWORD. IF NOT, THEN*/ 07320000 * /* CONTINUE AT THE ACCTNMBR LEVEL. */ 07330000 * IF NLEVL ª= 2 07340000 * THEN /* CHANGE LEVEL ª= PASSED LEVL*/ 07350000 CLI NLEVL,2 0038 07360000 * GOTO STRTAC; /* CONTINUE AT THE ACTNBR LEVL*/ 07370000 BC 07,STRTAC 0039 07380000 **/* D (YES,CHALLPW,NO,) PASSWD = '*'? */ 07390000 * /* AN '*' IN THE PASSWORD POSITION MEANS: CHANGE ALL PASS-*/ 07400000 * /* WORDS TO THE NEW PASSWORD. */ 07410000 * IF PASSWD(1) = '*' /* NLPASSWORD = '*'? */ 07420000 * THEN /* YES, */ 07430000 CLI 8(@5),C'*' 0040 07440000 * GOTO CHALLPW; /* GO CHANGE ALL PASSWORDS */ 07450000 BC 08,CHALLPW 0041 07460000 * ELSE; /* NO, A PASSWORD IS SPECIFIED*/ 07470000 * DPOBPTR = HEDBPTR+UADSPWD1; /* REF 1ST PASSWRD OBLK M1467 */ 07480000 L @F,24(0,@4) 0043 07490000 AR @F,@4 0043 07500000 ST @F,DPOBPTR 0043 07510000 * DLPWSCH: /* SEARCH FOR THE PASSWORD SPECIFIED IN THE DATALIST. */ 07520000 * /* BEGINNING OF THE SEARCH LOOP. */ 07530000 * UADSPPTR = HEDBPTR+UADSPDAT;/* REF THE PASSWORD DATA FIELD*/ 07540000 DLPWSCH L @5,DPOBPTR 0044 07550000 L @F,8(0,@5) 0044 07560000 AR @F,@4 0044 07570000 ST @F,UADSPPTR 0044 07580000 **/* D (YES,ACTWSR1,NO,) NEW PASSWD ALREADY EXISTS */ 07590000 * /* COMPARE THE UADS PASSWORD TO THE DATALIST PASSWORD. */ 07600000 * IF UADSPPWD = DLPWD 07610000 * THEN /* THE DLPASSWORD EXISTS IN THIS 07620000 * CHAIN. PRUNING IS NECESSARY*/ 07630000 LR @8,@F 0045 07640000 CLC 4(8,@8),DLPWD 0045 07650000 BC 07,@9FC 0045 07660000 * DO; 07670000 * DLPWOBAD = DPOBPTR; /* SAVE THE ADDR OF THIS OBLK */ 07680000 MVC DLPWOBAD(4),DPOBPTR 0047 07690000 * GOTO ACTWSR1; /* GO SEARCH FOR ACTNBR TWINS */ 07700000 BC 15,ACTWSR1 0048 07710000 * END; 07720000 * /* THE DATALIST PASSWORD HAS NOT BEEN FOUND YET. IF THERE */ 07730000 * /* ARE MORE PASSWORDS IN THIS CHAIN, THEN CONTINUE THE */ 07740000 * /* SEARCH. */ 07750000 * IF PFLG01 = '0'B /* MORE BROTHERS? */ 07760000 * THEN /* YES, */ 07770000 @9FC L @5,DPOBPTR 0050 07780000 TM 0(@5),B'10000000' 0050 07790000 BC 05,@9FB 0050 07800000 * DO; 07810000 * DPOBPTR = HEDBPTR /* REF THE NEXT PASSWORD OBLK */ 07820000 * +UADSPNEX; 07830000 MVC @TEMP3+1(3),1(@5) 0052 07840000 L @F,@TEMP3 0052 07850000 AR @F,@4 0052 07860000 ST @F,DPOBPTR 0052 07870000 * GOTO DLPWSCH; /* CONTINUE THE SEARCH */ 07880000 BC 15,DLPWSCH 0053 07890000 * END; 07900000 **/* P (,CHGEOK) CHANGE NODELIST PASSWD TO NEW PASSWD */ 07910000 * /* THE DATALIST PASSWORD DOES NOT EXIST IN THIS CHAIN. */ 07920000 * /* THEREFORE, PRUNING IS NOT NECESSARY. CHANGE THE NODE- */ 07930000 * /* LIST PASSWORD DATA FIELD. */ 07940000 * DPOBPTR = NLPWOBAD; /* REF THE NLPASSWORD OBLK */ 07950000 @9FB MVC DPOBPTR(4),NLPWOBAD 0055 07960000 * UADSPPTR = HEDBPTR+UADSPDAT;/* REF THE DATA FIELD */ 07970000 L @5,DPOBPTR 0056 07980000 L @F,8(0,@5) 0056 07990000 AR @F,@4 0056 08000000 ST @F,UADSPPTR 0056 08010000 * UADSPPWD = DLPWD; /* INSERT THE NEW PASSWORD */ 08020000 LR @8,@F 0057 08030000 MVC 4(8,@8),DLPWD 0057 08040000 * GOTO CHGEOK; /* WRITE THIS TREE BACK INTO 08050000 * THE UADS */ 08060000 BC 15,CHGEOK 0058 08070000 * 08080000 * 08090000 **/*ACTWSR1: P REF ACTNBR CHAINS OF NODELST & NEW PASSWD */ 08100000 * ACTWSR1: /* A MERGING OF TWO ACCTNMBR CHAINS IS NECESSARY BECAUSE */ 08110000 * /* OF THE PRUNING OF A PASSWORD FROM THE TREE. THE TWO */ 08120000 * /* CHAINS MUST BE COMPARED TO ASSURE THAT THE MERGE WILL */ 08130000 * /* NOT RESULT IN TWINS. IF IT DOES, THEN ONE OF THE TWINS */ 08140000 * /* MUST BE PRUNED FROM THE TREE. */ 08150000 * DNOBPTR = HEDBPTR+UADSPSUB; /* REF THE DATA FIELD */ 08160000 ACTWSR1 L @5,DPOBPTR 0059 08170000 L @2,4(0,@5) 0059 08180000 AR @2,@4 0059 08190000 **/*%ATW2: P SEARCH THE TWO CHAINS FOR IDENTICAL ACTNBRS */ 08200000 **/* D (YES,PRTWSR1,NO,) TWINS FOUND? */ 08210000 * ACTWSR2: /* BEGINNING OF THE SEARCH LOOP */ 08220000 * ACTWIN2 = DNOBPTR; /* SAVE ADDR OF THIS OBLK IN 08230000 * THE DLPASSWORD ACTNBR CHAIN*/ 08240000 ACTWSR2 ST @2,ACTWIN2 0060 08250000 * ADATSAVE = UADSADAT; /* SAVE OFFSET TO THIS DATAFLD*/ 08260000 MVC ADATSAVE(4),8(@2) 0061 08270000 * DPOBPTR = NLPWOBAD; /* REF THE NLPASSWORD OBLK */ 08280000 MVC DPOBPTR(4),NLPWOBAD 0062 08290000 * DNOBPTR = HEDBPTR+UADSPSUB; /* REF ITS DATA FIELD */ 08300000 L @5,DPOBPTR 0063 08310000 L @2,4(0,@5) 0063 08320000 AR @2,@4 0063 08330000 * ACTWSR3: /* COMPARE THE OFFSETS TO THE DATA FIELDS. IF THE ACCTNBRS*/ 08340000 * /* ARE THE SAME, THEN THEIR OFFSET BLOCKS MUST POINT TO */ 08350000 * /* THE SAME DATA FIELDS. */ 08360000 * IF UADSADAT = ADATSAVE /* OFFSETS TO DATAFLDS EQUAL? */ 08370000 * THEN /* YES, TWINS EXIST */ 08380000 ACTWSR3 L @F,ADATSAVE 0064 08390000 C @F,8(0,@2) 0064 08400000 BC 07,@9FA 0064 08410000 * DO; 08420000 * ACTWIN1 = DNOBPTR; /* SAVE ADDR OF THIS TWIN OBLK*/ 08430000 ST @2,ACTWIN1 0066 08440000 * RETPTR = /* ADDR OF RETURN POINT AFTER */ 08450000 * ADDR(ACTWSR5); /* ONE TWIN HAS BEEN PRUNED */ 08460000 LA @F,ACTWSR5 0067 08470000 ST @F,RETPTR 0067 08480000 * GOTO PRTWSR1; /* GO SEARCH FOR PROC TWINS IN 08490000 * THESE TWO ACCTNMBR CHAINS */ 08500000 BC 15,PRTWSR1 0068 08510000 * END; 08520000 * ELSE; /* THE OFFSETS ARE NOT EQUAL */ 08530000 @9FA EQU * 0070 08540000 * /* CHECK THE CHAIN FLAG: ARE THERE MORE ACCTNMBRS UNDER */ 08550000 * /* THE NODELIST PASSWORD? */ 08560000 * IF AFLG01 = '0'B 08570000 * THEN /* YES, CONTINUE THE SEARCH */ 08580000 @9F9 TM 0(@2),B'10000000' 0071 08590000 BC 05,@9F8 0071 08600000 * DO; 08610000 * DNOBPTR = HEDBPTR /* REF THE NEXT ACCTNMBR OBLK */ 08620000 * +UADSANEX; /* UNDER THE NODELIST PASSWORD*/ 08630000 MVC @TEMP3+1(3),1(@2) 0073 08640000 L @F,@TEMP3 0073 08650000 AR @F,@4 0073 08660000 LR @2,@F 0073 08670000 * GOTO ACTWSR3; /* CONTINUE THE SEARCH */ 08680000 BC 15,ACTWSR3 0074 08690000 * END; 08700000 * ELSE; /* NO, THIS IS THE END OF THE 08710000 * CHAIN UNDER THE NLPASSWORD */ 08720000 @9F8 EQU * 0076 08730000 **/*%ATW4: D (YES,%ATW2,NO,) MORE ACTNBRS TO COMPARE? */ 08740000 * ACTWSR4: /* CONTINUATION AFTER A TWIN HAS BEEN PRUNED. */ 08750000 * DNOBPTR = ACTWIN2; /* REF THE LAST-USED ACCTNMBR 08760000 * OBLK UNDER THE DLPASSWORD */ 08770000 @9F7 EQU * 0077 08780000 ACTWSR4 L @2,ACTWIN2 0077 08790000 * /* ARE THERE MORE ACCTNMBRS UNDER THE DATALIST PASSWORD? */ 08800000 * IF AFLG01 = '0'B 08810000 * THEN /* YES, */ 08820000 TM 0(@2),B'10000000' 0078 08830000 BC 05,@9F6 0078 08840000 * DO; 08850000 * DNOBPTR = HEDBPTR /* REF THE NEXT ACCTNMBR OBLK */ 08860000 * +UADSANEX; /* UNDER THE DATALIST PASSWORD*/ 08870000 MVC @TEMP3+1(3),1(@2) 0080 08880000 L @F,@TEMP3 0080 08890000 AR @F,@4 0080 08900000 LR @2,@F 0080 08910000 * GOTO ACTWSR2; /* CONTINUE THE SEARCH */ 08920000 BC 15,ACTWSR2 0081 08930000 * END; 08940000 * ELSE /* NO, */ 08950000 * GOTO ACMERGE; /* GO MERGE THE TWO CHAINS */ 08960000 * ACTWSR5: /* LABEL FOR RETURN POINT AFTER PRUNING. */ 08970000 * DPOBPTR = NLPWOBAD; /* REF THE NODELIST PASSWORD */ 08980000 @9F5 EQU * 0084 08990000 ACTWSR5 MVC DPOBPTR(4),NLPWOBAD 0084 09000000 * /* IT IS POSSIBLE THAT THERE ARE NO ACCTNMBRS LEFT UNDER */ 09010000 * /* THIS PASSWORD. IF SO, NO MERGING IS NECESSARY. */ 09020000 * IF UADSPSUB = 0 /* ANY ACTNBRS LEFT? */ 09030000 * THEN /* NO, */ 09040000 SR @F,@F 0085 09050000 L @5,DPOBPTR 0085 09060000 C @F,4(0,@5) 0085 09070000 * GOTO PWPRUNE; /* GO PRUNE THE NODELST PWD */ 09080000 BC 08,PWPRUNE 0086 09090000 * ELSE /* YES, */ 09100000 * GOTO ACTWSR4; /* CONTINUE SEARCH FOR TWINS */ 09110000 BC 15,ACTWSR4 0087 09120000 **/*ACMERGE: P REF ACTNBR CHAINS OF NODELST & NEW PASSWD */ 09130000 * ACMERGE: /* THIS SECTION OF CODE WILL MERGE TWO ACCTNMBR CHAINS. */ 09140000 * /* THE MERGE IS MADE NECESSARY BY THE PRUNING OF ONE PASS-*/ 09150000 * /* WORD TWIN FROM THE TREE. */ 09160000 * DPOBPTR = DLPWOBAD; /* REF THE DLPASSWORD OBLK */ 09170000 ACMERGE MVC DPOBPTR(4),DLPWOBAD 0088 09180000 * DNOBPTR = HEDBPTR+UADSPSUB; /* REF THE FIRST ACCTNMBR IN 09190000 * THIS LOCAL CHAIN */ 09200000 L @5,DPOBPTR 0089 09210000 L @2,4(0,@5) 0089 09220000 AR @2,@4 0089 09230000 **/* P FIND THEIR RELATIVE POSITION IN THE TOTAL CHAIN */ 09240000 * ACMERG1: /* FIND THE LAST ACCTNMBR IN THIS LOCAL CHAIN. */ 09250000 * IF AFLG01 = '0'B /* MORE BROTHERS? */ 09260000 * THEN /* YES, */ 09270000 ACMERG1 TM 0(@2),B'10000000' 0090 09280000 BC 05,@9F4 0090 09290000 * DO; 09300000 * DNOBPTR = HEDBPTR /* REF THE NEXT ACCTNMBR OBLK */ 09310000 * +UADSANEX; 09320000 MVC @TEMP3+1(3),1(@2) 0092 09330000 L @F,@TEMP3 0092 09340000 AR @F,@4 0092 09350000 LR @2,@F 0092 09360000 * GOTO ACMERG1; /* CONTINUE THE SEARCH */ 09370000 BC 15,ACMERG1 0093 09380000 * END; 09390000 * ELSE; /* END OF LOCAL CHAIN */ 09400000 @9F4 EQU * 0095 09410000 * /* CHECK WHETHER THIS IS ALSO THE END OF THE TOTAL CHAIN. */ 09420000 * /* IF IT IS, THEN THIS PROCESS MUST START WITH THE CHAIN */ 09430000 * /* UNDER THE OTHER PASSWORD TWIN. */ 09440000 * IF UADSANEX = 0 /* END OF TOTAL CHAIN? */ 09450000 * THEN /* YES, */ 09460000 @9F3 SR @F,@F 0096 09470000 MVC @TEMP3+1(3),1(@2) 0096 09480000 C @F,@TEMP3 0096 09490000 * GOTO ACMERG5; /* START WITH OTHER TWIN CHAIN*/ 09500000 BC 08,ACMERG5 0097 09510000 * ELSE; /* NO, CONTINUE */ 09520000 * LASTOB = DNOBPTR; /* SAVE ADDR OF THIS LAST OBLK*/ 09530000 ST @2,LASTOB 0099 09540000 * ACSNOFS = UADSANEX; /* SAVE OFFSET TO COUSIN */ 09550000 MVC ACSNOFS+1(3),1(@2) 0100 09560000 MVI ACSNOFS,X'00' 0100 09570000 * CSNSAVE = ACSNOFS; /* SAME AS ABOVE,FOR LATER USE*/ 09580000 MVC CSNSAVE(4),ACSNOFS 0101 09590000 * DPOBPTR = NLPWOBAD; /* REF THE OTHER TWIN OBLK */ 09600000 MVC DPOBPTR(4),NLPWOBAD 0102 09610000 * SUBOFS = UADSPSUB; /* SAVE OFFSET TO FIRST ACCT- 09620000 * NMBR OBLK */ 09630000 L @5,DPOBPTR 0103 09640000 MVC SUBOFS(4),4(@5) 0103 09650000 * /* COMPARE COUSIN-OFFSET FROM THE FIRST CHAIN TO THE ABOVE*/ 09660000 * /* OFFSET. IF THEY ARE EQUAL, THEN THE TWO CHAINS ARE */ 09670000 * /* ADJACENT AND OFFSETS DO NOT HAVE TO BE CHANGED. */ 09680000 * IF ACSNOFS = SUBOFS 09690000 * THEN /* YES, THEY ARE ADJACENT */ 09700000 L @F,SUBOFS 0104 09710000 C @F,ACSNOFS 0104 09720000 BC 07,@9F2 0104 09730000 * DO; 09740000 * DNOBPTR = LASTOB; /* REF LAST OBLK UNDER FIRST 09750000 * PASSWORD TWIN */ 09760000 L @2,LASTOB 0106 09770000 * AFLG01 = '0'B; /* SET CHAIN FLAG TO 0, CHANGING 09780000 * COUSINS TO BROTHERS */ 09790000 NI 0(@2),B'01111111' 0107 09800000 * GOTO PWPRUNE; /* GO FREE THE OBLK AND DATAFD*/ 09810000 BC 15,PWPRUNE 0108 09820000 * END; 09830000 * ACMERG2: /* THE TWO CHAINS ARE NOT ADJACENT. FIND THE END OF THE */ 09840000 * /* NEXT INTERVENING CHAIN AND CHECK WHETHER IT POINTS TO */ 09850000 * /* THE SECOND TWIN CHAIN. */ 09860000 * DNOBPTR = HEDBPTR+ACSNOFS; /* REF FIRST OBLK OF THE INTER- 09870000 * VENING CHAIN */ 09880000 @9F2 EQU * 0110 09890000 ACMERG2 L @2,ACSNOFS 0110 09900000 AR @2,@4 0110 09910000 * ACMERG3: /* FIND THE END OF THIS CHAIN. */ 09920000 * IF AFLG01 = '0'B /* MORE BROTHERS? */ 09930000 * THEN /* YES, */ 09940000 ACMERG3 TM 0(@2),B'10000000' 0111 09950000 BC 05,@9F1 0111 09960000 * DO; 09970000 * DNOBPTR = HEDBPTR /* REF THE NEXT OBLK */ 09980000 * +UADSANEX; 09990000 MVC @TEMP3+1(3),1(@2) 0113 10000000 L @F,@TEMP3 0113 10010000 AR @F,@4 0113 10020000 LR @2,@F 0113 10030000 * GOTO ACMERG3; /* CONTINUE THE SEARCH */ 10040000 BC 15,ACMERG3 0114 10050000 * END; 10060000 * /* END OF THIS CHAIN. IF IT IS ALSO THE END OF THE TOTAL */ 10070000 * /* CHAIN, THEN THE SEARCH MUST BEGIN WITH THE OTHER TWIN */ 10080000 * /* CHAIN. */ 10090000 * IF UADSANEX = 0 /* END OF TOTAL CHAIN? */ 10100000 * THEN /* YES, */ 10110000 @9F1 SR @F,@F 0116 10120000 MVC @TEMP3+1(3),1(@2) 0116 10130000 C @F,@TEMP3 0116 10140000 * GOTO ACMERG5; /* GO START WITH OTHER TWIN */ 10150000 BC 08,ACMERG5 0117 10160000 * CSNPTR = DNOBPTR; /* SAVE ADDR OF THIS OBLK */ 10170000 ST @2,CSNPTR 0118 10180000 * ACSNOFS = UADSANEX; /* SAVE OFFSET TO COUSIN */ 10190000 MVC ACSNOFS+1(3),1(@2) 0119 10200000 MVI ACSNOFS,X'00' 0119 10210000 * /* COMPARE THE ABOVE OFFSET TO THE OFFSET TO THE TWIN */ 10220000 * /* CHAIN. REPEAT THE PROCESS UNTIL THE TWIN CHAIN IS FOUND*/ 10230000 * IF ACSNOFS ª= SUBOFS 10240000 * THEN /* THIS IS NOT THE OFFSET TO 10250000 * THE TWIN CHAIN */ 10260000 L @F,SUBOFS 0120 10270000 C @F,ACSNOFS 0120 10280000 * GOTO ACMERG2; /* CONTINUE THE SEARCH */ 10290000 BC 07,ACMERG2 0121 10300000 * ELSE; /* THE TWIN CHAIN HAS BEEN 10310000 * FOUND. START THE MERGE */ 10320000 * DNOBPTR = HEDBPTR+UADSPSUB; /* REF FIRST OBLK OF SECOND 10330000 * TWIN CHAIN */ 10340000 L @5,DPOBPTR 0123 10350000 L @2,4(0,@5) 0123 10360000 AR @2,@4 0123 10370000 **/* P TRANSFER OFFSETS & CHAIN FLAGS TO MERGE THE TWO CHAINS */ 10380000 * ACMERG4: /* FIND THE END OF THE SECOND TWIN CHAIN. */ 10390000 * IF AFLG01 = '0'B /* MORE BROTHERS? */ 10400000 * THEN /* YES, */ 10410000 ACMERG4 TM 0(@2),B'10000000' 0124 10420000 BC 05,@9F0 0124 10430000 * DO; 10440000 * DNOBPTR = HEDBPTR /* REF NEXT OBLK */ 10450000 * +UADSANEX; 10460000 MVC @TEMP3+1(3),1(@2) 0126 10470000 L @F,@TEMP3 0126 10480000 AR @F,@4 0126 10490000 LR @2,@F 0126 10500000 * GOTO ACMERG4; /* CONTINUE THE SEARCH */ 10510000 BC 15,ACMERG4 0127 10520000 * END; 10530000 * ANEXSAVE = UADSANEX; /* SAVE OFFSET TO NEXT CHAIN */ 10540000 @9F0 MVC ANEXSAVE+1(3),1(@2) 0129 10550000 MVI ANEXSAVE,X'00' 0129 10560000 * UADSANEX = CSNSAVE; /* CONNECT THE INTERVENING 10570000 * CHAIN(S) TO THE END OF THE 10580000 * SECOND TWIN CHAIN */ 10590000 MVC 1(3,@2),CSNSAVE+1 0130 10600000 * DNOBPTR = CSNPTR; /* REF THE LAST OBLK OF THE 10610000 * INTERVENING CHAIN(S) */ 10620000 L @2,CSNPTR 0131 10630000 * UADSANEX = ANEXSAVE; /* CONNECT THE ABOVE OBLK TO THE 10640000 * REST OF THE TOTAL CHAIN */ 10650000 MVC 1(3,@2),ANEXSAVE+1 0132 10660000 * DNOBPTR = LASTOB; /* REF LAST OBLK IN FIRST TWIN*/ 10670000 L @2,LASTOB 0133 10680000 * UADSANEX = ACSNOFS; /* CONNECT THE TWO TWIN CHAINS*/ 10690000 MVC 1(3,@2),ACSNOFS+1 0134 10700000 * AFLG01 = '0'B; /* SET CHAIN FLAG TO 0, CHANGING 10710000 * COUSINS TO BROTHERS */ 10720000 NI 0(@2),B'01111111' 0135 10730000 * GOTO PWPRUNE; /* MERGING IS COMPLETED. GO FREE 10740000 * THE PWD OBLK AND DATA FIELD*/ 10750000 BC 15,PWPRUNE 0136 10760000 * ACMERG5: /* THE END OF THE TOTAL CHAIN WAS REACHED BEFORE THE */ 10770000 * /* TWIN CHAIN WAS FOUND. RESET APPROPRIATE PTRS AND START */ 10780000 * /* THE MERGE PROCESS WITH THE OTHER TWIN CHAIN. */ 10790000 * DPOBPTR = DLPWOBAD; /* REF ONE TWIN PWD OBLK */ 10800000 ACMERG5 MVC DPOBPTR(4),DLPWOBAD 0137 10810000 * SUBOFS = UADSPSUB; /* SAVE OFFSET TO 1ST ACTNBR */ 10820000 L @5,DPOBPTR 0138 10830000 MVC SUBOFS(4),4(@5) 0138 10840000 * DPOBPTR = NLPWOBAD; /* REF THE OTHER TWIN OBLK */ 10850000 MVC DPOBPTR(4),NLPWOBAD 0139 10860000 * ACSNOFS = UADSPSUB; /* SAVE OFFSET TO 1ST ACTNBR */ 10870000 L @5,DPOBPTR 0140 10880000 MVC ACSNOFS(4),4(@5) 0140 10890000 * UADSPSUB = SUBOFS; /* CONNECT CHAIN OF OTHER TWIN*/ 10900000 MVC 4(4,@5),SUBOFS 0141 10910000 * DPOBPTR = DLPWOBAD; /* REF 1ST TWIN AGAIN */ 10920000 MVC DPOBPTR(4),DLPWOBAD 0142 10930000 * UADSPSUB = ACSNOFS; /* CONNECT CHAIN OF OTHER TWIN*/ 10940000 L @5,DPOBPTR 0143 10950000 MVC 4(4,@5),ACSNOFS 0143 10960000 * DNOBPTR = HEDBPTR+ACSNOFS; /* REF FIRST ACCTNMBR OBLK */ 10970000 L @2,ACSNOFS 0144 10980000 AR @2,@4 0144 10990000 * GOTO ACMERG1; /* GO START THE PROCESS AGAIN */ 11000000 BC 15,ACMERG1 0145 11010000 * 11020000 **/*PWPRUNE: P SAVE OFFSET & CHAIN FLAG OF NODELIST PASSWD */ 11030000 * PWPRUNE: /* THIS SECTION OF CODE WILL PRUNE ONE PASSWORD OFFSET */ 11040000 * /* BLOCK AND DATA FIELD FROM THE TREE. */ 11050000 * DPOBPTR = NLPWOBAD; /* REF THE OBLK TO BE PRUNED */ 11060000 PWPRUNE MVC DPOBPTR(4),NLPWOBAD 0146 11070000 * PRUNOFS = NLPWOBAD-HEDBPTR; /* RECALCULATE OFFSET TO OBLK 11080000 * THAT IS TO BE PRUNED */ 11090000 L @F,NLPWOBAD 0147 11100000 SR @F,@4 0147 11110000 ST @F,PRUNOFS 0147 11120000 * CSNSAVE = UADSPNEX; /* SAVE OFFSET TO BROTHER */ 11130000 L @5,DPOBPTR 0148 11140000 MVC CSNSAVE+1(3),1(@5) 0148 11150000 MVI CSNSAVE,X'00' 0148 11160000 * DPOBPTR = HEDBPTR+UADSPWD1; /* REF FIRST OBLK IN PWD CHAIN*/ 11170000 L @F,24(0,@4) 0149 11180000 AR @F,@4 0149 11190000 ST @F,DPOBPTR 0149 11200000 * /* CHECK WHETHER THE OBLK TO BE PRUNED IS THE FIRST ONE */ 11210000 * /* IN THE CHAIN. */ 11220000 * IF DPOBPTR = NLPWOBAD 11230000 * THEN /* YES, */ 11240000 L @F,NLPWOBAD 0150 11250000 C @F,DPOBPTR 0150 11260000 BC 07,@9EF 0150 11270000 * DO; 11280000 * UADSPWD1 = CSNSAVE; /* PUT THE OFFSET TO THE BROTHER 11290000 * OBLK INTO THE USER HEADER */ 11300000 MVC 24(4,@4),CSNSAVE 0152 11310000 * GOTO PWPRUN3; /* GO FREE THE OBLK AND DATAFD*/ 11320000 BC 15,PWPRUN3 0153 11330000 * END; 11340000 * PWPRUN2: /* FIND THE BROTHER OBLK WHICH POINTS TO THE OBLK TO BE */ 11350000 * /* PRUNED FROM THE TREE. */ 11360000 * IF PRUNOFS ª= UADSPNEX 11370000 * THEN /* THIS IS NOT THE ABOVE OBLK */ 11380000 @9EF EQU * 0155 11390000 PWPRUN2 L @5,DPOBPTR 0155 11400000 MVC @TEMP3+1(3),1(@5) 0155 11410000 L @F,@TEMP3 0155 11420000 C @F,PRUNOFS 0155 11430000 BC 08,@9EE 0155 11440000 * DO; 11450000 * DPOBPTR = HEDBPTR /* REF THE NEXT PASSWORD OBLK */ 11460000 * +UADSPNEX; 11470000 MVC @TEMP3+1(3),1(@5) 0157 11480000 L @F,@TEMP3 0157 11490000 AR @F,@4 0157 11500000 ST @F,DPOBPTR 0157 11510000 * GOTO PWPRUN2; /* CONTINUE THE SEARCH */ 11520000 BC 15,PWPRUN2 0158 11530000 * END; 11540000 * /* THE DESIRED BROTHER OBLK HAS BEEN FOUND. */ 11550000 * UADSPNEX = CSNSAVE; /* PUT THE BROTHER-OFFSET FROM 11560000 * THE PRUNED OBLK INTO THIS 11570000 * OBLK */ 11580000 @9EE L @5,DPOBPTR 0160 11590000 MVC 1(3,@5),CSNSAVE+1 0160 11600000 * /* IF THE OBLK TO BE PRUNED IS THE LAST ONE IN THE TOTAL */ 11610000 * /* CHAIN, THEN THE CHAIN FLAG IN THE 'NEW' LAST OBLK MUST */ 11620000 * /* BE SET TO 1, INDICATING END OF CHAIN. */ 11630000 * IF CSNSAVE = 0 11640000 * THEN /* YES, IT IS THE LAST OBLK */ 11650000 SR @F,@F 0161 11660000 C @F,CSNSAVE 0161 11670000 BC 07,@9ED 0161 11680000 * PFLG01 = '1'B; /* SET CHAIN FLAG IN NEW LAST 11690000 * OBLK TO 1 */ 11700000 OI 0(@5),B'10000000' 0162 11710000 **/* S IKJFRSP: PRUNE DATAFLD OF NODELIST PASSWD */ 11720000 **/* S IKJFRSP: PRUNE OFSBLK OF NODELIST PASSWD */ 11730000 **/* P (,CHGEOK) TRANSFER OFFSET & FLAG TO RECONNECT PASSWD CHAIN */ 11740000 * PWPRUN3: /* PREPARE TO CALL THE FREESPACE ROUTINE - IKJEFA54 */ 11750000 * DPOBPTR = NLPWOBAD; /* REF THE OBLK TO BE PRUNED */ 11760000 @9ED EQU * 0163 11770000 PWPRUN3 MVC DPOBPTR(4),NLPWOBAD 0163 11780000 * AREAOFST = UADSPDAT; /* OFFSET TO DATA FIELD */ 11790000 L @5,DPOBPTR 0164 11800000 MVC GETFREE+8(4),8(@5) 0164 11810000 * AREALNTH = 12; /* NUMBER OF BYTES TO BE FREED*/ 11820000 LA @F,12 0165 11830000 STH @F,GETFREE+6 0165 11840000 * CALL IKJFRSP; /* GO FREE THE DATA FIELD */ 11850000 BAL @E,IKJFRSP 0166 11860000 * /* PREPARE TO FREE THE OFFSET BLOCK */ 11870000 * AREAOFST = PRUNOFS; /* OFFSET TO THIS OBLOK */ 11880000 MVC GETFREE+8(4),PRUNOFS 0167 11890000 * CALL IKJFRSP; /* GO FREE THE OFFSET BLOCK */ 11900000 BAL @E,IKJFRSP 0168 11910000 * GOTO CHGEOK; /* GO WRITE THIS TREE BACK INTO 11920000 * THE UADS */ 11930000 BC 15,CHGEOK 0169 11940000 * 11950000 **/*CHALLPW: P REF 1ST PASSWD OFSBLK IN THIS TREE */ 11960000 **/* P INSERT NEW PASSWORD INTO DATA FIELD */ 11970000 **/* P SET OFFSET TO NEXT OFSBLK TO 0 */ 11980000 * CHALLPW: /* ALL PASSWORDS IN THIS TREE ARE TO BE CHANGED TO THE */ 11990000 * /* DATALIST PASSWORD. ALL ACCTNMBRS WILL BECOME BROTHERS. */ 12000000 * /* TWINS CREATED BY THIS MERGE MUST BE PRUNED FROM THE */ 12010000 * /* USERID TREE. */ 12020000 * UADSPPTR = HEDBPTR+UADSPDAT;/* REF ITS DATA FIELD */ 12030000 CHALLPW L @5,DPOBPTR 0170 12040000 L @F,8(0,@5) 0170 12050000 AR @F,@4 0170 12060000 ST @F,UADSPPTR 0170 12070000 * UADSPPWD = DLPWD; /* INSERT THE DATALIST PASSWRD*/ 12080000 LR @8,@F 0171 12090000 MVC 4(8,@8),DLPWD 0171 12100000 * PNEXSAVE = UADSPNEX; /* SAVE OFFSET TO NEXT OBLK */ 12110000 MVC PNEXSAVE+1(3),1(@5) 0172 12120000 MVI PNEXSAVE,X'00' 0172 12130000 * UADSPNEX = 0; /* SET OFFSET TO NEXT OBLK TO 0, 12140000 * INDICATING END OF CHAIN */ 12150000 MVC 1(3,@5),@D1+1 0173 12160000 **/* D (YES,CHGEOK,NO,) ONLY 1 PASSWD IN TREE? */ 12170000 * /* IF THIS TREE HAS ONLY ONE PASSWORD, THEN NO OTHER CHAN-*/ 12180000 * /* GES ARE NECESSARY. */ 12190000 * IF PFLG01 = '1'B /* ANY BROTHERS? */ 12200000 * THEN /* NO, */ 12210000 TM 0(@5),B'10000000' 0174 12220000 * GOTO CHGEOK; /* GO WRITE THIS TREE BACK 12230000 * INTO THE UADS */ 12240000 BC 01,CHGEOK 0175 12250000 * PFLG01 = '1'B; /* SET CHAIN FLAG TO '1' */ 12260000 OI 0(@5),B'10000000' 0176 12270000 * DNOBPTR = HEDBPTR+UADSPSUB; /* REF THE FIRST ACCTNMBR OBLK*/ 12280000 L @2,4(0,@5) 0177 12290000 AR @2,@4 0177 12300000 **/* P SET ALL ACTNBR CHAIN FLAGS, EXCEPT LAST ONE, TO 0 */ 12310000 * CHNGFLG: /* MERGE ALL ACCTNMBR CHAINS BY CHANGING ALL COUSINS TO */ 12320000 * /* BROTHERS. */ 12330000 * 12340000 * /* CHANGE ALL CHAIN FLAGS THAT ARE '1' TO '0', EXCEPT THE */ 12350000 * /* LAST ONE IN THE TOTAL CHAIN. */ 12360000 * IF UADSANEX = 0 /* END OF TOTAL CHAIN? */ 12370000 * THEN /* YES, */ 12380000 CHNGFLG SR @F,@F 0178 12390000 MVC @TEMP3+1(3),1(@2) 0178 12400000 C @F,@TEMP3 0178 12410000 * GOTO TCTWSR1; /* GO SEARCH FOR TWINS */ 12420000 BC 08,TCTWSR1 0179 12430000 * AFLG01 = '0'B; /* CHANGE FLAG TO '0' */ 12440000 NI 0(@2),B'01111111' 0180 12450000 * DNOBPTR = HEDBPTR+UADSANEX; /* REF THE NEXT ACCTNMBR OBLK */ 12460000 MVC @TEMP3+1(3),1(@2) 0181 12470000 L @F,@TEMP3 0181 12480000 AR @F,@4 0181 12490000 LR @2,@F 0181 12500000 * GOTO CHNGFLG; /* CONTINUE THE PROCESS UNTIL 12510000 * ALL COUSINS HAVE BEEN CHANGED 12520000 * TO BROTHERS */ 12530000 BC 15,CHNGFLG 0182 12540000 **/*TCTWSR1: P SEARCH TOTAL ACTNBR CHAIN FOR TWINS */ 12550000 * TCTWSR1: /* SEARCH THE TOTAL ACCTNMBR CHAIN FOR TWINS. */ 12560000 * DNOBPTR = HEDBPTR+UADSPSUB; /* REF THE FIRST ACCTNMBR OBLK*/ 12570000 TCTWSR1 L @5,DPOBPTR 0183 12580000 L @2,4(0,@5) 0183 12590000 AR @2,@4 0183 12600000 * 12610000 **/*%TCTW2: D (YES,PRTWSR1,NO,) TWINS FOUND? */ 12620000 * TCTWSR2: /* COMPARE THIS ACCTNMBR TO ALL OTHERS IN THE TOTAL CHAIN */ 12630000 * 12640000 * /* IF THIS IS THE LAST ACCTNMBR IN THE TOTAL CHAIN, */ 12650000 * /* THEN THE SEARCH FOR ACCTNMBR TWINS IS FINISHED. */ 12660000 * IF AFLG01 = '1'B /* END OF CHAIN? */ 12670000 * THEN /* YES, */ 12680000 TCTWSR2 TM 0(@2),B'10000000' 0184 12690000 * GOTO PWPRUN4; /* GO PRUNE THE PASSWORDS */ 12700000 BC 01,PWPRUN4 0185 12710000 * ACTWIN2 = DNOBPTR; /* SAVE THE ADDR OF THIS OBLK */ 12720000 ST @2,ACTWIN2 0186 12730000 * ADATSAVE = UADSADAT; /* SAVE THE OFFSET TO ITS DFLD*/ 12740000 MVC ADATSAVE(4),8(@2) 0187 12750000 * TCTWSR3: /* REFERENCE THE FIRST BROTHER AND COMPARE THE DATA FIELD */ 12760000 * /* OFFSETS. IF THEY ARE EQUAL, THEN THE ACCTNMBRS MUST BE */ 12770000 * /* EQUAL. */ 12780000 * DNOBPTR = HEDBPTR+UADSANEX; /* REF THE BROTHER OBLK */ 12790000 TCTWSR3 MVC @TEMP3+1(3),1(@2) 0188 12800000 L @F,@TEMP3 0188 12810000 AR @F,@4 0188 12820000 LR @2,@F 0188 12830000 * /* ARE THE DATA FIELD OFFSETS EQUAL? */ 12840000 * IF UADSADAT = ADATSAVE 12850000 * THEN /* YES, TWINS HAVE BEEN FOUND */ 12860000 L @F,ADATSAVE 0189 12870000 C @F,8(0,@2) 0189 12880000 BC 07,@9EC 0189 12890000 * DO; 12900000 * ACTWIN1 = DNOBPTR; /* SAVE ADDR OF SECOND TWIN */ 12910000 ST @2,ACTWIN1 0191 12920000 * RETPTR = /* ADDR OF RETURN POINT AFTER */ 12930000 * ADDR(TCTWSR4); /* ONE TWIN HAS BEEN PRUNED */ 12940000 LA @F,TCTWSR4 0192 12950000 ST @F,RETPTR 0192 12960000 * GOTO PRTWSR1; /* GO SEARCH FOR PROC TWINS */ 12970000 BC 15,PRTWSR1 0193 12980000 * END; 12990000 * /* HAS THE END OF THE CHAIN BEEN REACHED? */ 13000000 * IF AFLG01 = '0'B 13010000 * THEN /* NO, */ 13020000 @9EC TM 0(@2),B'10000000' 0195 13030000 * GOTO TCTWSR3; /* CONTINUE COMPARING */ 13040000 BC 08,TCTWSR3 0196 13050000 * DNOBPTR = ACTWIN2; /* REF THE ACCTNMBR JUST USED 13060000 * FOR COMPARISON */ 13070000 L @2,ACTWIN2 0197 13080000 * DNOBPTR = HEDBPTR+UADSANEX; /* REF ITS BROTHER AND MAKE IT 13090000 * THE BASIS FOR COMPARISON */ 13100000 MVC @TEMP3+1(3),1(@2) 0198 13110000 L @F,@TEMP3 0198 13120000 AR @F,@4 0198 13130000 LR @2,@F 0198 13140000 * GOTO TCTWSR2; /* CONTINUE THE TWIN SEARCH */ 13150000 BC 15,TCTWSR2 0199 13160000 **/*%TCTW4: D (YES,%TCTW2,NO,) MORE ACTNBRS TO COMPARE? */ 13170000 * TCTWSR4: /* LABEL FOR RETURN POINT AFTER ONE TWIN HAS BEEN PRUNED. */ 13180000 * DNOBPTR = ACTWIN2; /* REF THE ACCTNMBR JUST USED 13190000 * FOR COMPARISON */ 13200000 TCTWSR4 L @2,ACTWIN2 0200 13210000 * GOTO TCTWSR2; /* CONTINUE THE TWIN SEARCH */ 13220000 BC 15,TCTWSR2 0201 13230000 * 13240000 **/* P REF 2ND PASSWD IN CHAIN */ 13250000 * PWPRUN4: /* PRUNE ALL PASSWORDS AFTER THE FIRST ONE IN THE CHAIN */ 13260000 * /* FROM THIS USERID TREE. */ 13270000 * DPOBPTR = HEDBPTR+PNEXSAVE; /* REF THE NEXT OBLK */ 13280000 PWPRUN4 L @F,PNEXSAVE 0202 13290000 AR @F,@4 0202 13300000 ST @F,DPOBPTR 0202 13310000 **/*%PPDF: S IKJFRSP: PRUNE PASSWD DATA FIELD */ 13320000 **/* P SAVE OFFSET TO NEXT PASSWD OFSBLK */ 13330000 * /* PREPARE TO FREE THE PASSWORD DATA FIELD. */ 13340000 * AREAOFST = UADSPDAT; /* OFFSET TO THIS DATAFLD */ 13350000 LR @5,@F 0203 13360000 MVC GETFREE+8(4),8(@5) 0203 13370000 * AREALNTH = 12; /* NUMBER OF BYTES TO BE FREED*/ 13380000 LA @F,12 0204 13390000 STH @F,GETFREE+6 0204 13400000 * CALL IKJFRSP; /* GO FREE THIS DATA FIELD */ 13410000 BAL @E,IKJFRSP 0205 13420000 * PNEXSAVE = UADSPNEX; /* SAVE OFFSET TO NEXT OBLK */ 13430000 L @5,DPOBPTR 0206 13440000 MVC PNEXSAVE+1(3),1(@5) 0206 13450000 MVI PNEXSAVE,X'00' 0206 13460000 **/* S IKJFRSP: PRUNE PASSWD OFFSET BLOCK */ 13470000 * /* PREPARE TO FREE THE PASSWORD OFFSET BLOCK. */ 13480000 * AREAOFST = DPOBPTR-HEDBPTR; /* OFFSET TO THIS OBLK */ 13490000 L @F,DPOBPTR 0207 13500000 SR @F,@4 0207 13510000 ST @F,GETFREE+8 0207 13520000 * CALL IKJFRSP; /* GO FREE THIS OFFSET BLOCK */ 13530000 BAL @E,IKJFRSP 0208 13540000 **/* D (NO,CHGEOK,YES,) MORE PASSWDS TO BE PRUNED? */ 13550000 **/* P (,%PPDF) REF NEXT PASSWD OFSBLK */ 13560000 * /* MORE PASSWORDS TO BE PRUNED? */ 13570000 * IF PNEXSAVE = 0 13580000 * THEN /* NO, */ 13590000 SR @F,@F 0209 13600000 C @F,PNEXSAVE 0209 13610000 * GOTO CHGEOK; /* GO WRITE THIS TREE BACK INTO 13620000 * THE UADS */ 13630000 BC 08,CHGEOK 0210 13640000 * GOTO PWPRUN4; /* GO PRUNE THE NEXT BROTHER */ 13650000 BC 15,PWPRUN4 0211 13660000 * 13670000 **/*PRTWSR1: P REF PROCNAME CHAINS OF ACTNBR TWINS */ 13680000 * PRTWSR1: /* MERGING OF TWO PROCNAME CHAINS IS NECESSARY BECAUSE */ 13690000 * /* AN ACCTNMBR (ONE OF A PAIR OF TWINS) HAS TO BE PRUNED */ 13700000 * /* FROM THE TREE. THE TWO CHAINS MUST BE COMPARED TO */ 13710000 * /* ASSURE THAT THE MERGE WILL NOT RESULT IN PROC TWINS. */ 13720000 * /* IF IT DOES, THEN ONE OF THE TWINS MUST BE PRUNED FROM */ 13730000 * /* THE TREE. */ 13740000 * DNOBPTR = ACTWIN2; /* REF FIRST ACCTNMBR TWIN */ 13750000 PRTWSR1 L @2,ACTWIN2 0212 13760000 * DROBPTR = HEDBPTR+UADSASUB; /* REF ITS FIRST PROCNAME OBLK*/ 13770000 L @3,4(0,@2) 0213 13780000 AR @3,@4 0213 13790000 **/* P SEARCH THE TWO CHAINS FOR PROC TWINS */ 13800000 * PRTWSR2: /* BEGINNING OF THE SEARCH LOOP. */ 13810000 * RDATSAVE = UADSRDAT; /* SAVE OFFSET TO DATA FIELD */ 13820000 PRTWSR2 MVC RDATSAVE(4),8(@3) 0214 13830000 * UADSRPTR = HEDBPTR+RDATSAVE;/* REF THE DATA FIELD */ 13840000 L @F,RDATSAVE 0215 13850000 AR @F,@4 0215 13860000 ST @F,UADSRPTR 0215 13870000 * PRCOMP = UADSRNAM; /* SAVE THIS PROCNAME */ 13880000 LR @5,@F 0216 13890000 MVC PRCOMP(8),4(@5) 0216 13900000 * PRTWIN1 = DROBPTR; /* SAVE ADDR OF THIS OBLK */ 13910000 ST @3,PRTWIN1 0217 13920000 * DNOBPTR = ACTWIN1; /* REF THE SECOND ACTNBR TWIN */ 13930000 L @2,ACTWIN1 0218 13940000 * /* IT IS POSSIBLE THAT ALL PROCS UNDER THE TWIN HAVE */ 13950000 * /* BEEN PRUNED. IF SO, THEN THE SUB OFFSET WAS SET TO 0. */ 13960000 * IF UADSASUB = 0 /* ANY PROCS LEFT? */ 13970000 * THEN /* NO, */ 13980000 SR @F,@F 0219 13990000 C @F,4(0,@2) 0219 14000000 * GOTO PRTWSR5; /* GO CHECK WHERE TO CONTINUE */ 14010000 BC 08,PRTWSR5 0220 14020000 * DROBPTR = HEDBPTR+UADSASUB; /* REF ITS FIRST PROCNAME OBLK*/ 14030000 L @3,4(0,@2) 0221 14040000 AR @3,@4 0221 14050000 **/*%PRTW1: D (NO,%PRTW4,YES,) PROC TWINS FOUND? */ 14060000 * PRTWSR3: /* COMPARE THE PROCEDURE NAMES. IF TWO EQUAL NAMES ARE */ 14070000 * /* FOUND, THEN COMPARE THE DATA FIELDS. IF THESE ARE NOT */ 14080000 * /* EQUAL, THEN THE MERGE IS NOT POSSIBLE SINCE IT IS NOT */ 14090000 * /* KNOWN WHICH ATTRIBUTES ARE TO BE KEPT. */ 14100000 * UADSRPTR = HEDBPTR+UADSRDAT;/* REF THIS PROC DATA FIELD */ 14110000 PRTWSR3 L @F,8(0,@3) 0222 14120000 AR @F,@4 0222 14130000 ST @F,UADSRPTR 0222 14140000 * /* ARE THE PROCNAMES EQUAL? */ 14150000 * IF PRCOMP = UADSRNAM 14160000 * THEN /* YES, */ 14170000 LR @5,@F 0223 14180000 CLC PRCOMP(8),4(@5) 0223 14190000 BC 07,@9EB 0223 14200000 **/* D (YES,PRPRUNE,NO,) DATA FIELDS EQUAL? */ 14210000 **/* P (,%RTRN) SET ERROR MSGNMBR */ 14220000 * /* DO THEY USE THE SAME DATA FIELDS? IF NOT, THEN THE */ 14230000 * /* DATA IS DIFFERENT AND THE MERGE IS IMPOSSIBLE. */ 14240000 * IF RDATSAVE ª= UADSRDAT 14250000 * THEN /* THE DATA IS NOT EQUAL */ 14260000 L @F,8(0,@3) 0224 14270000 C @F,RDATSAVE 0224 14280000 BC 08,@9EA 0224 14290000 * DO; 14300000 * MSGNMBR = 15; /* 13- IMPOSSIBLE MERGE */ 14310000 LA @F,15 0226 14320000 L @8,CTABPTR 0226 14330000 STH @F,32(0,@8) 0226 14340000 * RETURN; /* CHANGE CP WILL ISSUE THE 14350000 * ERROR MSG & CONTINUE WITH 14360000 * THE NEXT USERID, IF ANY */ 14370000 BC 15,@EL01 0227 14380000 * END; 14390000 * ELSE /* THE DATA IS EQUAL */ 14400000 * DO; 14410000 * PRTWIN2 = DROBPTR;/* SAVE ADDR OF THIS TWIN */ 14420000 @9EA ST @3,PRTWIN2 0230 14430000 * GOTO PRPRUNE; /* GO PRUNE ONE TWIN */ 14440000 BC 15,PRPRUNE 0231 14450000 * END; 14460000 * ELSE; /* PROCNAMES ARE NOT EQUAL. 14470000 * CONTINUE THE SEARCH */ 14480000 @9EB EQU * 0233 14490000 * /* CHECK THE CHAIN FLAG - MORE BROTHERS? */ 14500000 * IF FLGR01 = '0'B 14510000 * THEN /* YES, */ 14520000 @9E8 TM 0(@3),B'10000000' 0234 14530000 BC 05,@9E7 0234 14540000 * DO; 14550000 * DROBPTR = HEDBPTR /* REF THE BROTHER OBLK */ 14560000 * +UADSRNEX; 14570000 MVC @TEMP3+1(3),1(@3) 0236 14580000 L @F,@TEMP3 0236 14590000 AR @F,@4 0236 14600000 LR @3,@F 0236 14610000 * GOTO PRTWSR3; /* CONTINUE THE TWIN SEARCH */ 14620000 BC 15,PRTWSR3 0237 14630000 * END; 14640000 **/*%PRTW4: D (YES,%PRTW1,NO,) MORE PROCS TO COMPARE? */ 14650000 * PRTWSR4: /* LABEL FOR RETURN POINT AFTER ONE TWIN HAS BEEN PRUNED. */ 14660000 * DROBPTR = PRTWIN1; /* REF THE LAST-USED OBLK IN 14670000 * THE ACTWIN2 CHAIN */ 14680000 @9E7 EQU * 0239 14690000 PRTWSR4 L @3,PRTWIN1 0239 14700000 * /* ARE THERE MORE PROCNAMES IN THE ACTWIN2 CHAIN? */ 14710000 * IF FLGR01 = '0'B 14720000 * THEN /* YES, */ 14730000 TM 0(@3),B'10000000' 0240 14740000 BC 05,@9E6 0240 14750000 * DO; 14760000 * DROBPTR = HEDBPTR /* REF THE BROTHER OBLK */ 14770000 * +UADSRNEX; 14780000 MVC @TEMP3+1(3),1(@3) 0242 14790000 L @F,@TEMP3 0242 14800000 AR @F,@4 0242 14810000 LR @3,@F 0242 14820000 * GOTO PRTWSR2; /* CONTINUE THE TWIN SEARCH */ 14830000 BC 15,PRTWSR2 0243 14840000 * END; 14850000 * ELSE /* NO, SEARCH IS COMPLETED, */ 14860000 **/* D (YES,%CHTW2,NO,PRMERGE) ACTNBR = '*'? */ 14870000 * PRTWSR5: /* CHECK CONTROL FLAG TO DETERMINE WHERE TO CONTINUE. */ 14880000 * IF ALLACFLG = '1'B 14890000 * THEN 14900000 @9E6 EQU * 0245 14910000 PRTWSR5 TM CFLAGS,B'00100000' 0245 14920000 * GOTO CHTWSR2; /* CONTINUE SEARCH UNDER NEXT 2 14930000 * ACCTNMBRS IN A LOCAL CHAIN */ 14940000 BC 01,CHTWSR2 0246 14950000 * ELSE 14960000 * GOTO PRMERGE; /* GO MERGE THE TWO PROCNAME 14970000 * CHAINS OF ACTWIN1 & ACTWIN2*/ 14980000 BC 15,PRMERGE 0247 14990000 * 15000000 **/*PRPRUNE: P REF PROC TWIN TO BE PRUNED */ 15010000 **/* P SAVE ITS CHAIN FLAG & OFFSET TO NEXT OFSBLK */ 15020000 * PRPRUNE: /* THIS SECTION OF CODE WILL PRUNE A PROCEDURE NAME OFF- */ 15030000 * /* SET BLOCK, ONE OF A PAIR OF TWINS, FROM THE TREE. THE */ 15040000 * /* TWINS ARE THE RESULT OF THE MERGE OF TWO PROCNAME */ 15050000 * /* CHAINS UNDER ACCTNMBR TWINS. */ 15060000 * UADSRPTR = HEDBPTR+UADSRDAT;/* REF ITS DATA FIELD */ 15070000 @9E5 EQU * 0248 15080000 PRPRUNE L @F,8(0,@3) 0248 15090000 AR @F,@4 0248 15100000 ST @F,UADSRPTR 0248 15110000 * UADSRCTR = UADSRCTR-1; /* DECREMENT THE USE COUNTER */ 15120000 LH @F,@D2 0249 15130000 L @5,UADSRPTR 0249 15140000 SR @0,@0 0249 15150000 IC @0,0(0,@5) 0249 15160000 AR @F,@0 0249 15170000 STC @F,0(0,@5) 0249 15180000 * RNEXSAVE = UADSRNEX; /* SAVE OFFSET TO NEXT OBLK */ 15190000 MVC RNEXSAVE+1(3),1(@3) 0250 15200000 MVI RNEXSAVE,X'00' 0250 15210000 * /* SAVE THE CHAIN FLAG BEFORE PRUNING THE OFFSET BLOCK */ 15220000 * IF FLGR01 = '0'B /* CHAIN FLAG = '0'? */ 15230000 * THEN /* YES, */ 15240000 TM 0(@3),B'10000000' 0251 15250000 BC 05,@9E4 0251 15260000 * FLGSAVE = '0'B; /* SET FLAGSAVE TO '0' */ 15270000 NI CFLAGS,B'01111111' 0252 15280000 BC 15,@9E3 0253 15290000 * ELSE /* NO, */ 15300000 * FLGSAVE = '1'B; /* SET FLAGSAVE TO '1' */ 15310000 @9E4 OI CFLAGS,B'10000000' 0253 15320000 * DPOBPTR = HEDBPTR+UADSPWD1; /* REF FIRST PASSWORD OBLK */ 15330000 @9E3 L @F,24(0,@4) 0254 15340000 AR @F,@4 0254 15350000 ST @F,DPOBPTR 0254 15360000 * DNOBPTR = HEDBPTR+UADSPSUB; /* REF FIRST ACCTNMBR OBLK */ 15370000 LR @8,@F 0255 15380000 L @2,4(0,@8) 0255 15390000 AR @2,@4 0255 15400000 * 15410000 * ASUBCHK: /* IT IS POSSIBLE THAT NO PROCNAMES ARE LEFT UNDER THE */ 15420000 * /* FIRST ACCTNMBR. FIND THE 1ST ACCTNMBR OFFSET BLOCK IN */ 15430000 * /* WHICH THE SUB OFFSET IS NOT 0. */ 15440000 * IF UADSASUB = 0 /* ALL PROCNAMES PRUNED? */ 15450000 * THEN /* YES, */ 15460000 ASUBCHK SR @F,@F 0256 15470000 C @F,4(0,@2) 0256 15480000 BC 07,@9E2 0256 15490000 * DO; 15500000 * DNOBPTR = HEDBPTR+UADSANEX;/* REF NEXT ACCTNMBR OBLK*/ 15510000 MVC @TEMP3+1(3),1(@2) 0258 15520000 L @F,@TEMP3 0258 15530000 AR @F,@4 0258 15540000 LR @2,@F 0258 15550000 * GOTO ASUBCHK; /* CHECK NEXT SUB OFFSET */ 15560000 BC 15,ASUBCHK 0259 15570000 * END; 15580000 * DROBPTR = HEDBPTR+UADSASUB; /* REF FIRST PROCNAME OBLK */ 15590000 @9E2 L @3,4(0,@2) 0261 15600000 AR @3,@4 0261 15610000 * PRUNOFS = PRTWIN2-HEDBPTR; /* RECALCULATE OFFSET TO OBLK 15620000 * TO BE PRUNED */ 15630000 L @F,PRTWIN2 0262 15640000 SR @F,@4 0262 15650000 ST @F,PRUNOFS 0262 15660000 * /* IF THE OFFSET BLOCK TO BE PRUNED IS THE FIRST ONE IN */ 15670000 * /* THE TOTAL CHAIN, NO CHANGES TO OTHER OBLKS ARE NECES- */ 15680000 * /* SARY. IF NOT, THEN THE BROTHER OR COUSIN POINTING TO */ 15690000 * /* THE TWIN TO BE PRUNED MUST BE FOUND. */ 15700000 * IF DROBPTR = PRTWIN2 /* FIRST OBLK IN TOTAL CHAIN? */ 15710000 * THEN /* YES, */ 15720000 C @3,PRTWIN2 0263 15730000 * GOTO PRPRUN3; /* GO FREE THIS OBLK */ 15740000 BC 08,PRPRUN3 0264 15750000 * PRPRUN2: /* FIND THE OFFSET BLOCK POINTING TO THE TWIN OBLK BY */ 15760000 * /* COMPARING UADSRNEX TO THE KNOWN OFFSET. */ 15770000 * IF UADSRNEX ª= PRUNOFS /* DOES THIS OBLK POINT TO THE 15780000 * OBLK TO BE PRUNED? */ 15790000 * THEN /* NO, */ 15800000 PRPRUN2 L @F,PRUNOFS 0265 15810000 MVC @TEMP3+1(3),1(@3) 0265 15820000 C @F,@TEMP3 0265 15830000 BC 08,@9E1 0265 15840000 * DO; 15850000 * DROBPTR = HEDBPTR /* REF NEXT OBLK IN THE CHAIN */ 15860000 * +UADSRNEX; 15870000 MVC @TEMP3+1(3),1(@3) 0267 15880000 L @F,@TEMP3 0267 15890000 AR @F,@4 0267 15900000 LR @3,@F 0267 15910000 * GOTO PRPRUN2; /* CONTINUE THE SEARCH */ 15920000 BC 15,PRPRUN2 0268 15930000 * END; 15940000 * /* THE ABOVE DESCRIBED OFFSET BLOCK HAS BEEN FOUND. INSERT*/ 15950000 * /* CHAIN FLAG OF TWIN IF THAT FLAG IS '1', I.E., IF THE */ 15960000 * /* TWIN IS THE LAST OFFSET BLOCK IN ITS LOCAL CHAIN. */ 15970000 * IF FLGSAVE = '1'B 15980000 * THEN /* YES, LAST IN CHAIN, */ 15990000 @9E1 TM CFLAGS,B'10000000' 0270 16000000 BC 12,@9E0 0270 16010000 * FLGR01 = '1'B; /* INSERT FLAG OF TWIN */ 16020000 OI 0(@3),B'10000000' 0271 16030000 * UADSRNEX = RNEXSAVE; /* INSERT THE OFFSET TO THE 16040000 * NEXT OBLK. THIS UNHOOKS THE 16050000 * TWIN FROM THE CHAIN */ 16060000 @9E0 MVC 1(3,@3),RNEXSAVE+1 0272 16070000 **/* S IKJFRSP: PRUNE PROC TWIN OFSBLK */ 16080000 **/* P (,%PRTW4) TRANSFER OFFSET & CHAINFLG TO RECONNECT THE CHAIN */ 16090000 * PRPRUN3: /* PRUNE THE TWIN OFFSET BLOCK FROM THE TREE. */ 16100000 * 16110000 * /* IF THE PROC OFFSET BLOCK TO BE PRUNED IS THE ONLY ONE */ 16120000 * /* UNDER ITS ACCTNMBR, THEN SET THE SUB OFFSET IN THE */ 16130000 * /* ACCTNMBR OBLK TO 0 FOR LATER USE. */ 16140000 * DNOBPTR = ACTWIN1; /* REF THE ACCTNMBR TWIN */ 16150000 PRPRUN3 L @2,ACTWIN1 0273 16160000 * DROBPTR = PRTWIN2; /* REF THE PROC TO BE PRUNED */ 16170000 L @3,PRTWIN2 0274 16180000 * /* IS THE PROC TWIN THE 1ST ONE IN ITS CHAIN? */ 16190000 * IF UADSASUB = PRUNOFS 16200000 * THEN /* YES, */ 16210000 L @F,PRUNOFS 0275 16220000 C @F,4(0,@2) 0275 16230000 BC 07,@9DF 0275 16240000 * /* IF IT IS ALSO THE LAST ONE, THEN IT IS THE ONLY ONE*/ 16250000 * IF FLGR01 = '1'B 16260000 * THEN /* IT IS THE ONLY PROC */ 16270000 TM 0(@3),B'10000000' 0276 16280000 BC 12,@9DE 0276 16290000 * UADSASUB = 0; /* SET SUB OFFSET TO 0 */ 16300000 SR @F,@F 0277 16310000 ST @F,4(0,@2) 0277 16320000 BC 15,@9DD 0278 16330000 * ELSE /* NOT THE ONLY ONE, */ 16340000 * UADSASUB = RNEXSAVE;/* INSERT OFFSET TO BROTHER */ 16350000 @9DE MVC 4(4,@2),RNEXSAVE 0278 16360000 * AREAOFST = PRUNOFS; /* OFFSET TO OBLK TO BE FREED */ 16370000 @9DD EQU * 0279 16380000 @9DF MVC GETFREE+8(4),PRUNOFS 0279 16390000 * AREALNTH = 12; /* NUMBER OF BYTES TO BE FREED*/ 16400000 LA @F,12 0280 16410000 STH @F,GETFREE+6 0280 16420000 * CALL IKJFRSP; /* GO FREE THIS OBLK */ 16430000 BAL @E,IKJFRSP 0281 16440000 * GOTO PRTWSR4; /* CONTINUE THE SEARCH FOR 16450000 * PROCNAME TWINS */ 16460000 BC 15,PRTWSR4 0282 16470000 * 16480000 **/*PRMERGE: P REF PROCNAME CHAINS OF ACTNBR TWINS */ 16490000 * PRMERGE: /* THIS SECTION OF CODE WILL MERGE TWO PROCNAME CHAINS. */ 16500000 * /* PROCNAME TWINS, IF ANY WERE FOUND, HAVE BEEN PRUNED. */ 16510000 * /* THE MERGE IS MADE NECESSARY BY THE PRUNING OF ONE */ 16520000 * /* ACCTNMBR TWIN FROM THE TREE. */ 16530000 * DNOBPTR = ACTWIN1; /* REF THE TWIN TO BE PRUNED */ 16540000 PRMERGE L @2,ACTWIN1 0283 16550000 * /* IF THERE ARE NO PROCS LEFT UNDER THIS ACCTNMBR TWIN, */ 16560000 * /* THEN MERGING IS UNNECESSARY. */ 16570000 * IF UADSASUB = 0 16580000 * THEN /* NO PROCS LEFT */ 16590000 SR @F,@F 0284 16600000 C @F,4(0,@2) 0284 16610000 * GOTO MRGNEXT; /* BYPASS THE MERGING SECTION */ 16620000 BC 08,MRGNEXT 0285 16630000 * DNOBPTR = ACTWIN2; /* REF THE OTHER ACTNBR TWIN */ 16640000 L @2,ACTWIN2 0286 16650000 * DROBPTR = HEDBPTR+UADSASUB; /* REF ITS FIRST PROC OBLK */ 16660000 L @3,4(0,@2) 0287 16670000 AR @3,@4 0287 16680000 **/* P FIND THEIR RELATIVE POSITION IN TOTAL CHAIN */ 16690000 * PRMERG1: /* FIND THE LAST OFFSET BLOCK IN THIS LOCAL CHAIN. */ 16700000 * IF FLGR01 = '0'B /* ANY BROTHERS? */ 16710000 * THEN /* YES, */ 16720000 PRMERG1 TM 0(@3),B'10000000' 0288 16730000 BC 05,@9DC 0288 16740000 * DO; 16750000 * DROBPTR = HEDBPTR /* REF THE NEXT BROTHER OBLK */ 16760000 * +UADSRNEX; 16770000 MVC @TEMP3+1(3),1(@3) 0290 16780000 L @F,@TEMP3 0290 16790000 AR @F,@4 0290 16800000 LR @3,@F 0290 16810000 * GOTO PRMERG1; /* CONTINUE THE SEARCH */ 16820000 BC 15,PRMERG1 0291 16830000 * END; 16840000 * ELSE; /* END OF THIS LOCAL CHAIN */ 16850000 @9DC EQU * 0293 16860000 * /* CHECK WHETHER THIS IS ALSO THE END OF THE TOTAL CHAIN. */ 16870000 * /* IF IT IS, THEN THIS PROCESS MUST START WITH THE CHAIN */ 16880000 * /* UNDER THE OTHER ACCTNMBR TWIN. */ 16890000 * IF UADSRNEX = 0 /* END OF TOTAL CHAIN? */ 16900000 * THEN /* YES, */ 16910000 @9DB SR @F,@F 0294 16920000 MVC @TEMP3+1(3),1(@3) 0294 16930000 C @F,@TEMP3 0294 16940000 * GOTO PRMERG5; /* START WITH OTHER TWIN CHAIN*/ 16950000 BC 08,PRMERG5 0295 16960000 * LASTOB = DROBPTR; /* SAVE ADDR OF THIS LAST OBLK*/ 16970000 ST @3,LASTOB 0296 16980000 * ACSNOFS = UADSRNEX; /* SAVE OFFSET TO COUSIN */ 16990000 MVC ACSNOFS+1(3),1(@3) 0297 17000000 MVI ACSNOFS,X'00' 0297 17010000 * CSNSAVE = ACSNOFS; /* SAME AS ABOVE,FOR LATER USE*/ 17020000 MVC CSNSAVE(4),ACSNOFS 0298 17030000 * DNOBPTR = ACTWIN1; /* REF THE OTHER TWIN OBLK */ 17040000 L @2,ACTWIN1 0299 17050000 * SUBOFS = UADSASUB; /* SAVE OFFSET TO ITS FIRST 17060000 * PROCNAME OBLK */ 17070000 MVC SUBOFS(4),4(@2) 0300 17080000 * /* COMPARE COUSIN-OFFSET FROM THE FIRST CHAIN TO THE ABOVE*/ 17090000 * /* OFFSET. IF THEY ARE EQUAL, THEN THE TWO CHAINS ARE */ 17100000 * /* ADJACENT AND OFFSETS DO NOT HAVE TO BE CHANGED. */ 17110000 * IF ACSNOFS = SUBOFS 17120000 * THEN /* YES, THEY ARE ADJACENT */ 17130000 L @F,SUBOFS 0301 17140000 C @F,ACSNOFS 0301 17150000 BC 07,@9DA 0301 17160000 * DO; 17170000 * DROBPTR = LASTOB; /* REF LAST OBLK UNDER FIRST 17180000 * ACCTNMBR TWIN */ 17190000 L @3,LASTOB 0303 17200000 * FLGR01 = '0'B; /* CHANGE COUSIN TO BROTHER */ 17210000 NI 0(@3),B'01111111' 0304 17220000 * GOTO MRGNEXT; /* GO CHK WHERE TO CONTINUE */ 17230000 BC 15,MRGNEXT 0305 17240000 * END; 17250000 * PRMERG2: /* THE TWO CHAINS ARE NOT ADJACENT. FIND THE END OF THE */ 17260000 * /* NEXT INTERVENING CHAIN AND CHECK WHETHER IT POINTS TO */ 17270000 * /* THE SECOND TWIN CHAIN. */ 17280000 * DROBPTR = HEDBPTR+ACSNOFS; /* REF FIRST OBLK OF THE INTER- 17290000 * VENING CHAIN */ 17300000 @9DA EQU * 0307 17310000 PRMERG2 L @3,ACSNOFS 0307 17320000 AR @3,@4 0307 17330000 * PRMERG3: /* FIND THE END OF THIS CHAIN. */ 17340000 * IF FLGR01 = '0'B /* ANY BROTHERS? */ 17350000 * THEN /* YES, */ 17360000 PRMERG3 TM 0(@3),B'10000000' 0308 17370000 BC 05,@9D9 0308 17380000 * DO; 17390000 * DROBPTR = HEDBPTR /* REF THE NEXT OBLK */ 17400000 * +UADSRNEX; 17410000 MVC @TEMP3+1(3),1(@3) 0310 17420000 L @F,@TEMP3 0310 17430000 AR @F,@4 0310 17440000 LR @3,@F 0310 17450000 * GOTO PRMERG3; /* CONTINUE THE SEARCH */ 17460000 BC 15,PRMERG3 0311 17470000 * END; 17480000 * /* END OF THIS CHAIN. IF IT IS ALSO THE END OF THE TOTAL */ 17490000 * /* CHAIN, THEN THE SEARCH MUST BEGIN WITH THE OTHER TWIN. */ 17500000 * IF UADSRNEX = 0 /* END OF TOTAL CHAIN? */ 17510000 * THEN /* YES, */ 17520000 @9D9 SR @F,@F 0313 17530000 MVC @TEMP3+1(3),1(@3) 0313 17540000 C @F,@TEMP3 0313 17550000 * GOTO PRMERG5; /* GO START WITH OTHER TWIN */ 17560000 BC 08,PRMERG5 0314 17570000 * CSNPTR = DROBPTR; /* SAVE ADDR OF THIS OBLK */ 17580000 ST @3,CSNPTR 0315 17590000 * ACSNOFS = UADSRNEX; /* SAVE OFFSET TO COUSIN */ 17600000 MVC ACSNOFS+1(3),1(@3) 0316 17610000 MVI ACSNOFS,X'00' 0316 17620000 * /* COMPARE THE ABOVE OFFSET TO THE OFFSET TO THE TWIN */ 17630000 * /* CHAIN. REPEAT THE PROCESS UNTIL THE TWIN CHAIN IS FOUND*/ 17640000 * IF ACSNOFS ª= SUBOFS 17650000 * THEN /* THIS IS NOT THE OFFSET TO 17660000 * THE TWIN CHAIN */ 17670000 L @F,SUBOFS 0317 17680000 C @F,ACSNOFS 0317 17690000 * GOTO PRMERG2; /* CONTINUE THE SEARCH */ 17700000 BC 07,PRMERG2 0318 17710000 * ELSE; /* THE TWIN CHAIN HAS BEEN 17720000 * FOUND. START THE MERGE */ 17730000 * DROBPTR = HEDBPTR+UADSASUB; /* REF FIRST OBLK OF SECOND 17740000 * TWIN CHAIN */ 17750000 L @3,4(0,@2) 0320 17760000 AR @3,@4 0320 17770000 **/* P TRANSFER OFFSETS & CHAIN FLAGS TO MERGE THE TWO CHAINS */ 17780000 * PRMERG4: /* FIND THE END OF THE SECOND TWIN CHAIN. */ 17790000 * IF FLGR01 = '0'B /* ANY BROTHERS? */ 17800000 * THEN /* YES, */ 17810000 PRMERG4 TM 0(@3),B'10000000' 0321 17820000 BC 05,@9D8 0321 17830000 * DO; 17840000 * DROBPTR = HEDBPTR /* REF NEXT BROTHER OBLK */ 17850000 * +UADSRNEX; 17860000 MVC @TEMP3+1(3),1(@3) 0323 17870000 L @F,@TEMP3 0323 17880000 AR @F,@4 0323 17890000 LR @3,@F 0323 17900000 * GOTO PRMERG4; /* CONTINUE THE SEARCH */ 17910000 BC 15,PRMERG4 0324 17920000 * END; 17930000 * RNEXSAVE = UADSRNEX; /* SAVE OFFSET TO NEXT CHAIN */ 17940000 @9D8 MVC RNEXSAVE+1(3),1(@3) 0326 17950000 MVI RNEXSAVE,X'00' 0326 17960000 * UADSRNEX = CSNSAVE; /* CONNECT THE INTERVENING 17970000 * CHAIN(S) TO THE END OF THE 17980000 * SECOND TWIN CHAIN */ 17990000 MVC 1(3,@3),CSNSAVE+1 0327 18000000 * DROBPTR = CSNPTR; /* REF THE LAST OBLK OF THE 18010000 * INTERVENING CHAIN(S) */ 18020000 L @3,CSNPTR 0328 18030000 * UADSRNEX = RNEXSAVE; /* CONNECT THE ABOVE OBLK TO THE 18040000 * REST OF THE TOTAL CHAIN */ 18050000 MVC 1(3,@3),RNEXSAVE+1 0329 18060000 * DROBPTR = LASTOB; /* REF FIRST OBLK IN THE FIRST 18070000 * TWIN CHAIN */ 18080000 L @3,LASTOB 0330 18090000 * UADSRNEX = ACSNOFS; /* CONNECT THE TWO TWIN CHAINS*/ 18100000 MVC 1(3,@3),ACSNOFS+1 0331 18110000 * FLGR01 = '0'B; /* CHANGE COUSINS TO BROTHERS */ 18120000 NI 0(@3),B'01111111' 0332 18130000 **/* D (YES,ACCHGE2,NO,) CHGE LEVL = ACTNBR LEVL? */ 18140000 * MRGNEXT: /* CHECK CONTROL FLAG TO DETERMINE WHERE TO GO NEXT. */ 18150000 * IF ACPRFLG = '1'B 18160000 * THEN 18170000 MRGNEXT TM CFLAGS,B'00001000' 0333 18180000 * GOTO ACCHGE2; /* GO MAKE REQUIRED ADJUSTMENTS 18190000 * BEFORE PRUNING THE OBLK */ 18200000 BC 01,ACCHGE2 0334 18210000 * GOTO ACPRUNE; /* MERGING IS COMPLETED. GO FREE 18220000 * ONE ACCTNMBR TWIN */ 18230000 BC 15,ACPRUNE 0335 18240000 * PRMERG5: /* THE END OF THE TOTAL CHAIN WAS REACHED BEFORE THE */ 18250000 * /* SECOND TWIN CHAIN WAS FOUND. RESET APPROPRIATE PTRS */ 18260000 * /* AND START THE MERGE PROCESS WITH THE OTHER TWIN CHAIN. */ 18270000 * DNOBPTR = ACTWIN2; /* REF ONE TWIN OBLK */ 18280000 PRMERG5 L @2,ACTWIN2 0336 18290000 * SUBOFS = UADSASUB; /* SAVE OFFSET TO ITS 1ST PROC*/ 18300000 MVC SUBOFS(4),4(@2) 0337 18310000 * DNOBPTR = ACTWIN1; /* REF THE OTHER ACTNBR TWIN */ 18320000 L @2,ACTWIN1 0338 18330000 * ACSNOFS = UADSASUB; /* SAVE OFFSET TO ITS 1ST PROC*/ 18340000 MVC ACSNOFS(4),4(@2) 0339 18350000 * UADSASUB = SUBOFS; /* INSERT OFFSET TO OTHER TWIN'S 18360000 * FIRST PROC */ 18370000 MVC 4(4,@2),SUBOFS 0340 18380000 * DNOBPTR = ACTWIN2; /* REF 1ST TWIN AGAIN */ 18390000 L @2,ACTWIN2 0341 18400000 * UADSASUB = ACSNOFS; /* INSERT OFFSET TO OTHER TWIN'S 18410000 * FIRST PROC */ 18420000 MVC 4(4,@2),ACSNOFS 0342 18430000 * DROBPTR = HEDBPTR+ACSNOFS; /* REF FIRST PROCNAME OBLK */ 18440000 L @3,ACSNOFS 0343 18450000 AR @3,@4 0343 18460000 * GOTO PRMERG1; /* GO START THE PROCESS AGAIN */ 18470000 BC 15,PRMERG1 0344 18480000 * 18490000 **/*ACPRUNE: P REF ACTNBR TWIN OFSBLK */ 18500000 **/* P SAVE ITS CHAINFLG & OFFSET TO NEXT OFSBLK */ 18510000 * ACPRUNE: /* THIS SECTION OF CODE WILL PRUNE AN ACCTNMBR OFFSET */ 18520000 * /* BLOCK, ONE OF A PAIR OF TWINS, FROM THE TREE. */ 18530000 * DNOBPTR = ACTWIN1; /* REF THE TWIN TO BE PRUNED */ 18540000 ACPRUNE L @2,ACTWIN1 0345 18550000 * IF UADSADAT = 0 /* ARE ACCT NMBRS SUPPORTED 18560000 * M1860 */ 18570000 * THEN /* M1860 */ 18580000 SR @F,@F 0346 18590000 C @F,8(0,@2) 0346 18600000 BC 07,@9D7 0346 18610000 * DO; /* M1860 */ 18620000 * UADSAPTR = HEDBPTR+UADSADAT;/* REF ITS DATA FIELD 18630000 * M1860 */ 18640000 L @F,8(0,@2) 0348 18650000 AR @F,@4 0348 18660000 ST @F,UADSAPTR 0348 18670000 * UADSACTR = UADSACTR-1; /* DECREMENT THE USE CNT 18680000 * M1860 */ 18690000 LH @F,@D2 0349 18700000 L @5,UADSAPTR 0349 18710000 SR @0,@0 0349 18720000 IC @0,0(0,@5) 0349 18730000 AR @F,@0 0349 18740000 STC @F,0(0,@5) 0349 18750000 * END; /* M1860 */ 18760000 * ANEXSAVE = UADSANEX; /* SAVE OFFSET TO NEXT OBLK */ 18770000 @9D7 MVC ANEXSAVE+1(3),1(@2) 0351 18780000 MVI ANEXSAVE,X'00' 0351 18790000 * /* SAVE THE CHAIN FLAG BEFORE PRUNING THE OFFSET BLOCK */ 18800000 * IF AFLG01 = '0'B /* CHAIN FLAG = '0'? */ 18810000 * THEN /* YES, */ 18820000 TM 0(@2),B'10000000' 0352 18830000 BC 05,@9D6 0352 18840000 * FLGSAVE = '0'B; /* SET FLAGSAVE TO '0' */ 18850000 NI CFLAGS,B'01111111' 0353 18860000 BC 15,@9D5 0354 18870000 * ELSE /* NO, */ 18880000 * FLGSAVE = '1'B; /* SET FLAGSAVE TO '1' */ 18890000 @9D6 OI CFLAGS,B'10000000' 0354 18900000 * DPOBPTR = HEDBPTR+UADSPWD1; /* REF FIRST PASSWORD OBLK */ 18910000 @9D5 L @F,24(0,@4) 0355 18920000 AR @F,@4 0355 18930000 ST @F,DPOBPTR 0355 18940000 * 18950000 * PSUBCHK: /* IT IS POSSIBLE THAT NO ACCTNMBRS ARE LEFT UNDER THE */ 18960000 * /* FIRST PASSWORD. FIND THE 1ST PASSWORD OFFSET BLOCK IN */ 18970000 * /* WHICH THE SUB OFFSET IS NOT 0. */ 18980000 * IF UADSPSUB = 0 /* ALL ACCTNMBRS PRUNED? */ 18990000 * THEN /* YES, */ 19000000 PSUBCHK SR @F,@F 0356 19010000 L @5,DPOBPTR 0356 19020000 C @F,4(0,@5) 0356 19030000 BC 07,@9D4 0356 19040000 * DO; 19050000 * DPOBPTR = HEDBPTR+UADSPNEX;/* REF NEXT PASSWORD OBLK*/ 19060000 MVC @TEMP3+1(3),1(@5) 0358 19070000 L @F,@TEMP3 0358 19080000 AR @F,@4 0358 19090000 ST @F,DPOBPTR 0358 19100000 * GOTO PSUBCHK; /* CHECK NEXT SUB OFFSET */ 19110000 BC 15,PSUBCHK 0359 19120000 * END; 19130000 * DNOBPTR = HEDBPTR+UADSPSUB; /* REF FIRST ACCTNMBR OBLK IN 19140000 * THE TOTAL CHAIN */ 19150000 @9D4 L @5,DPOBPTR 0361 19160000 L @2,4(0,@5) 0361 19170000 AR @2,@4 0361 19180000 * PRUNOFS = ACTWIN1-HEDBPTR; /* RECALCULATE OFFSET TO OBLK 19190000 * TO BE PRUNED */ 19200000 L @F,ACTWIN1 0362 19210000 SR @F,@4 0362 19220000 ST @F,PRUNOFS 0362 19230000 * /* IF THE OFFSET BLOCK TO BE PRUNED IS THE FIRST ONE IN */ 19240000 * /* THE TOTAL CHAIN, NO CHANGES TO OTHER OBLKS ARE NECES- */ 19250000 * /* SARY. IF NOT, THEN THE BROTHER OR COUSIN POINTING TO */ 19260000 * /* THE TWIN TO BE PRUNED MUST BE FOUND. */ 19270000 * IF DNOBPTR = ACTWIN1 /* FIRST IN TOTAL CHAIN? */ 19280000 * THEN /* YES, */ 19290000 C @2,ACTWIN1 0363 19300000 * GOTO ACPRUN3; /* GO FREE THIS OBLK */ 19310000 BC 08,ACPRUN3 0364 19320000 * ACPRUN2: /* FIND THE OFFSET BLOCK POINTING TO THE TWIN OFFSET BLOCK*/ 19330000 * /* BY COMPARING UADSANEX TO THE KNOWN OFFSET. */ 19340000 * IF UADSANEX ª= PRUNOFS /* DOES THIS OBLK POINT TO THE 19350000 * OBLK TO BE PRUNED? */ 19360000 * THEN /* NO, */ 19370000 ACPRUN2 L @F,PRUNOFS 0365 19380000 MVC @TEMP3+1(3),1(@2) 0365 19390000 C @F,@TEMP3 0365 19400000 BC 08,@9D3 0365 19410000 * DO; 19420000 * DNOBPTR = HEDBPTR /* REF NEXT OBLK IN THE CHAIN */ 19430000 * +UADSANEX; 19440000 MVC @TEMP3+1(3),1(@2) 0367 19450000 L @F,@TEMP3 0367 19460000 AR @F,@4 0367 19470000 LR @2,@F 0367 19480000 * GOTO ACPRUN2; /* CONTINUE THE SEARCH */ 19490000 BC 15,ACPRUN2 0368 19500000 * END; 19510000 * /* THE ABOVE DESCRIBED OFFSET BLOCK HAS BEEN FOUND. */ 19520000 * /* INSERT THE CHAIN FLAG OF THE OFFSET BLOCK TO BE PRUNED */ 19530000 * /* IF THAT FLAG WAS '1'. */ 19540000 * IF FLGSAVE = '1'B 19550000 * THEN 19560000 @9D3 TM CFLAGS,B'10000000' 0370 19570000 BC 12,@9D2 0370 19580000 * AFLG01 = '1'B; /* CHANGE FLAG OF BROTHER TO 1*/ 19590000 OI 0(@2),B'10000000' 0371 19600000 * UADSANEX = ANEXSAVE; /* INSERT THE OFFSET TO THE 19610000 * NEXT OBLK. THIS UNHOOKS THE 19620000 * TWIN FROM THE CHAIN */ 19630000 @9D2 MVC 1(3,@2),ANEXSAVE+1 0372 19640000 **/* S IKJFRSP: PRUNE ACTNBR OFFSET BLOCK */ 19650000 * ACPRUN3: /* PRUNE THE TWIN OFFSET BLOCK FROM THE TREE. */ 19660000 * 19670000 * /* IF THE ACTNO OFFSET BLOCK TO BE PRUNED IS THE ONLY ONE */ 19680000 * /* UNDER ITS PASSWORD, THEN SET THE SUB OFFSET IN THE */ 19690000 * /* PASSWORD OBLK TO 0 FOR LATER USE. */ 19700000 * DPOBPTR = NLPWOBAD; /* REF THE NODELST PASSWRD */ 19710000 ACPRUN3 MVC DPOBPTR(4),NLPWOBAD 0373 19720000 * DNOBPTR = ACTWIN1; /* REF THE ACCTNMBR TWIN */ 19730000 L @2,ACTWIN1 0374 19740000 * /* IS THE ACTNO TWIN THE 1ST ONE IN ITS CHAIN? */ 19750000 * IF UADSPSUB = PRUNOFS 19760000 * THEN /* YES, */ 19770000 L @F,PRUNOFS 0375 19780000 L @5,DPOBPTR 0375 19790000 C @F,4(0,@5) 0375 19800000 BC 07,@9D1 0375 19810000 * /* IF IT IS ALSO THE LAST ONE, THEN IT IS THE ONLY ONE*/ 19820000 * IF AFLG01 = '1'B 19830000 * THEN /* IT IS THE ONLY ACTNO */ 19840000 TM 0(@2),B'10000000' 0376 19850000 BC 12,@9D0 0376 19860000 * UADSPSUB = 0; /* SET SUB OFFSET TO 0 */ 19870000 SR @F,@F 0377 19880000 ST @F,4(0,@5) 0377 19890000 BC 15,@9CF 0378 19900000 * ELSE /* NOT THE ONLY ONE, */ 19910000 * UADSPSUB = ANEXSAVE;/* INSERT OFFSET TO BROTHER */ 19920000 @9D0 MVC 4(4,@5),ANEXSAVE 0378 19930000 * AREAOFST = PRUNOFS; /* OFFSET TO OBLK TO BE FREED */ 19940000 @9CF EQU * 0379 19950000 @9D1 MVC GETFREE+8(4),PRUNOFS 0379 19960000 * AREALNTH = 12; /* NUMBER OF BYTES TO BE FREED*/ 19970000 LA @F,12 0380 19980000 STH @F,GETFREE+6 0380 19990000 * CALL IKJFRSP; /* GO FREE THIS OBLK */ 20000000 BAL @E,IKJFRSP 0381 20010000 **/* D (YES,CHKACDF,NO,) CHGE LEVL = ACTNBR LEVL? */ 20020000 **/* D (YES,%TCTW4,NO,%ATW4) PASSWD = '*'? */ 20030000 * /* FREESPACE WAS SUCCESSFUL. CHECK CONTROL FLAG TO DETER- */ 20040000 * /* MINE WHERE TO CONTINUE. */ 20050000 * IF ACPRFLG = '1'B 20060000 * THEN 20070000 TM CFLAGS,B'00001000' 0382 20080000 * GOTO CHKACDF; /* GO PROCESS THE ACCTNMBR DATA- 20090000 * FIELD ASSOCIATED WITH THE 20100000 * PRUNED OFFSET BLOCK */ 20110000 BC 01,CHKACDF 0383 20120000 * ELSE 20130000 * GOTO RETLABL; /* CONTINUE THE SEARCH FOR 20140000 * ACCTNMBR TWINS IN THE SECTION 20150000 * ADDRESSED BY RETLABL */ 20160000 L @5,RETPTR 0384 20170000 BCR 15,@5 0384 20180000 * 20190000 * STRTAC: /**********************************************************/ 20200000 * /* */ 20210000 * /* CHANGE LEVEL = ACCTNMBR LEVEL */ 20220000 * /* */ 20230000 * /**********************************************************/ 20240000 * 20250000 **/*STRTAC: D (YES,CHALLAC,NO,) ACTNBR = '*'? */ 20260000 **/* P GET ADDR OF PASSWRD & ACTNBR OBLK FROM CTRLTAB */ 20270000 * 20280000 * /* AN '*' IN THE ACCTNMBR POSITION OF THE NODELIST MEANS: */ 20290000 * /* CHANGE ALL ACCTNMBRS TO THE NEW ACCTNMBR. THIS CASE */ 20300000 * /* WILL BE HANDLED BY A SEPARATE SECTION OF CODE. */ 20310000 * IF ACCTNO(1:2) = '* ' /* NLACCTNMBR = '*'? */ 20320000 * THEN /* YES, */ 20330000 STRTAC L @5,NODELADR 0385 20340000 CLC 16(2,@5),@C5 0385 20350000 * GOTO CHALLAC; /* GO TO SPECIAL SECTION TO 20360000 * HANDLE THIS CASE */ 20370000 BC 08,CHALLAC 0386 20380000 * DPOBPTR = PASSADDR; /* GET PTR TO PASSWRD OBLK FROM 20390000 * THE CHANGE CONTROL TABLE */ 20400000 L @8,CTABPTR 0387 20410000 MVC DPOBPTR(4),16(@8) 0387 20420000 * NLPWOBAD = DPOBPTR; /* SAVE ADDR OF THIS OBLK */ 20430000 MVC NLPWOBAD(4),DPOBPTR 0388 20440000 * OACSAVE = ACCTADDR; /* GET PTR TO ACCTNBR OBLK FROM 20450000 * THE CHANGE CONTROL TABLE */ 20460000 MVC OACSAVE(4),20(@8) 0389 20470000 * /* SEARCH FOR THE ACCTNMBR SPECIFIED IN THE DATALIST. */ 20480000 * DNOBPTR = HEDBPTR+UADSPSUB; /* REF 1ST ACCTNMBR OBLK IN 20490000 * THE LOCAL CHAIN */ 20500000 L @6,DPOBPTR 0390 20510000 L @2,4(0,@6) 0390 20520000 AR @2,@4 0390 20530000 **/* S DLACLS: SEARCH LOC CHAIN FOR NEW ACTNBR */ 20540000 * CALL DLACLS; /* GO TO SEARCH RTNE */ 20550000 BAL @E,DLACLS 0391 20560000 **/* D (YES,PRTWSR1,NO,) NEW ACTNBR IN LOC CHAIN? */ 20570000 * /* DOES THE NEW ACCTNMBR EXIST IN THE LOCAL CHAIN? */ 20580000 * IF ACTWIN2 ª= 0 20590000 * THEN /* YES, PRUNING IS NECESSARY */ 20600000 SR @F,@F 0392 20610000 C @F,ACTWIN2 0392 20620000 BC 08,@9CE 0392 20630000 * DO; 20640000 * ACTWIN1 = OACSAVE; /* SET PTR TO TWIN OBLK */ 20650000 MVC ACTWIN1(4),OACSAVE 0394 20660000 * ACPRFLG = '1'B; /* FLAG WILL DETERMINE ACTION 20670000 * AFTER PROC TWIN PRUNING */ 20680000 OI CFLAGS,B'00001000' 0395 20690000 * GOTO PRTWSR1; /* GO SEARCH FOR PROCTWINS */ 20700000 BC 15,PRTWSR1 0396 20710000 * END; 20720000 **/* S DLACTS: SEARCH TOTAL CHAIN FOR NEW ACTNBR */ 20730000 **/* D (YES,ACCHGE1,NO,) NEW ACTNBR IN TOT CHAIN? */ 20740000 * CALL DLACTS; /* GO SEARCH THE TOTAL CHAIN */ 20750000 @9CE BAL @E,DLACTS 0398 20760000 * /* DOES THE NEW ACCTNMBR EXIST IN THE TOTAL CHAIN? */ 20770000 * IF CSNPTR ª= 0 20780000 * THEN /* YES, */ 20790000 SR @F,@F 0399 20800000 C @F,CSNPTR 0399 20810000 * GOTO ACCHGE1; /* GO MAKE APPROPRIATE CHANGES*/ 20820000 BC 07,ACCHGE1 0400 20830000 **/* D (YES,%NACD,NO,) NDLIST ACTNBR DATFLD SHARED? */ 20840000 * /* DETERMINE WHETHER THE EXISTING NODELIST DATA FIELD CAN */ 20850000 * /* BE USED (USE CTR = 1). IF NOT, THEN A NEW DATA FIELD */ 20860000 * /* MUST BE CREATED. */ 20870000 * DNOBPTR = OACSAVE; /* REF THE NLACCTNMBR OBLK */ 20880000 L @2,OACSAVE 0401 20890000 * UADSAPTR = HEDBPTR+UADSADAT;/* REF ITS DATAFLD */ 20900000 L @F,8(0,@2) 0402 20910000 AR @F,@4 0402 20920000 ST @F,UADSAPTR 0402 20930000 * /* CHECK THE USE CTR. IF THE FIELD IS SHARED BY COUSINS, */ 20940000 * /* THEN IT CANNOT BE USED. */ 20950000 * IF UADSACTR > 1 20960000 * THEN /* THE DATAFLD IS SHARED */ 20970000 LR @5,@F 0403 20980000 CLI 0(@5),1 0403 20990000 BC 12,@9CD 0403 21000000 * DO; 21010000 * UADSACTR = UADSACTR-1;/* DECREMENT THE USE CTR */ 21020000 LH @F,@D2 0405 21030000 SR @0,@0 0405 21040000 IC @0,0(0,@5) 0405 21050000 AR @F,@0 0405 21060000 STC @F,0(0,@5) 0405 21070000 * GOTO NEWACDF; /* GO BUILD A NEW DATAFLD */ 21080000 BC 15,NEWACDF 0406 21090000 * END; 21100000 **/* D (YES,%IA,NO,) OLD LNGTH = NEW LNGTH? */ 21110000 **/* S (,%NACD) IKJFRSP: PRUNE NODELIST ACTNBR DATAFLD */ 21120000 * /* THE FIELD IS NOT SHARED. IT WILL BE USED IF THE NEW */ 21130000 * /* ACCTNMBR HAS THE SAME LENGTH AS THE OLD ONE. IF IT DOES*/ 21140000 * /* NOT, THEN THE EXISTING FIELD WILL BE FREED AND A NEW */ 21150000 * /* FIELD WILL BE BUILT. */ 21160000 * IF UADSALEN ª= DATALNG3 21170000 * THEN /* THE LENGTHS ARE DIFFERENT */ 21180000 @9CD L @5,CHNPDLAD 0408 21190000 LH @F,68(0,@5) 0408 21200000 L @8,UADSAPTR 0408 21210000 SR @0,@0 0408 21220000 IC @0,44(0,@8) 0408 21230000 CR @F,@0 0408 21240000 BC 08,@9CC 0408 21250000 * DO; 21260000 * ADATSAVE = UADSADAT; /* SAVE OFFSET TO OLD DATAFLD */ 21270000 MVC ADATSAVE(4),8(@2) 0410 21280000 * FLDFLG = '1'B; /* SET FLAG: OLD DATAFLD HAS 21290000 * TO BE FREED */ 21300000 OI CFLAGS,B'01000000' 0411 21310000 * GOTO NEWACDF; /* GO BUILD A NEW DATAFLD AND 21320000 * FREE THE EXISTING ONE */ 21330000 BC 15,NEWACDF 0412 21340000 * END; 21350000 **/*%IA: P INSERT THE NEW ACTNBR */ 21360000 * /* THE EXISTING FIELD CAN BE USED. */ 21370000 * UADSANUM(1:DATALNG3) = /* INSERT THE NEW ACCTNMBR */ 21380000 * DLITEM(1:DATALNG3); 21390000 @9CC L @5,CHNPDLAD 0414 21400000 L @5,64(0,@5) CHNGPDL 0414 21410000 LR @E,@5 0414 21420000 L @8,CHNPDLAD 0414 21430000 LH @6,68(0,@8) 0414 21440000 BCTR @6,0 0414 21450000 L @7,UADSAPTR 0414 21460000 LA @A,45(0,@7) 0414 21470000 EX @6,@MVC 0414 21480000 **/*ACNEXT: D (NO,CHGEOK,YES,) MORE PASSWDS? */ 21490000 **/* P INDICATE PART OF TREE HAS BEEN CHANGED */ 21500000 **/* P PUT ADDR OF NEXT PASSWRD OBLK INTO CTRLTAB */ 21510000 **/* P (,%RTRN) SIGNAL IKJEFA20 TO REPEAT ACTNBR SEARCH */ 21520000 * ACNEXT: /* AT LEAST ONE ACCTNMBR HAS NOW BEEN PROCESSED AND THIS */ 21530000 * /* USERID TREE HAS BEEN CHANGED (THE WORK COPY). DETERMINE*/ 21540000 * /* WHERE PROCESSING IS TO CONTINUE. */ 21550000 * 21560000 * DPOBPTR = NLPWOBAD; /* REF PASSWD JUST PROCESSED */ 21570000 ACNEXT MVC DPOBPTR(4),NLPWOBAD 0415 21580000 * /* IF A PASSWORD WAS SPECIFIED, OR THERE ARE NO MORE PASS-*/ 21590000 * /* WORDS IN THE CHAIN, THEN ALL NECESSARY CHANGES HAVE */ 21600000 * /* BEEN MADE TO THIS TREE. OTHERWISE, IKJEFA20 WILL SEARCH*/ 21610000 * /* FOR THE SPECIFIED ACCTNMBR IN THE REMAINING BRANCHES */ 21620000 * /* OF THIS TREE. */ 21630000 * IF PASSWD(1) ª= '*' /* PASSWORD SPECIFIED? */ 21640000 * ³ PFLG01 = '1'B /* OR END OF CHAIN? */ 21650000 * THEN /* YES, ONE OF THE ABOVE, */ 21660000 L @5,NODELADR 0416 21670000 CLI 8(@5),C'*' 0416 21680000 BC 07,@9CB 0416 21690000 L @8,DPOBPTR 0416 21700000 TM 0(@8),B'10000000' 0416 21710000 BC 12,@9CA 0416 21720000 * GOTO CHGEOK; /* CHANGE CP WILL WRITE THIS 21730000 * TREE BACK INTO THE UADS */ 21740000 BC 03,CHGEOK 0417 21750000 * PASSADDR = HEDBPTR /* REF THE NEXT PASSWORD OBLK */ 21760000 * +UADSPNEX; 21770000 @9CA L @5,DPOBPTR 0418 21780000 MVC @TEMP3+1(3),1(@5) 0418 21790000 L @F,@TEMP3 0418 21800000 AR @F,@4 0418 21810000 L @8,CTABPTR 0418 21820000 ST @F,16(0,@8) 0418 21830000 * SRCHIND = 1; /* SEARCH FOR THE NODELIST ACCT- 21840000 * NMBR UNDER THE NEXT PASSWRD*/ 21850000 LA @F,1 0419 21860000 STH @F,30(0,@8) 0419 21870000 * TRCHGE = 1; /* THIS TREE HAS BEEN CHANGED */ 21880000 STH @F,34(0,@8) 0420 21890000 * RETURN; /* RETURN TO THE CHANGE CP */ 21900000 BC 15,@EL01 0421 21910000 * 21920000 * NEWACDF: /* THIS SECTION OF CODE WILL CREATE A NEW ACCTNMBR DATAFLD*/ 21930000 * AREALNTH = 45+DATALNG3; /* NUMBER OF BYTES NECESSARY: 21940000 * CONSTANT AREA + LENGTH OF 21950000 * THE NEW ACCTNMBR */ 21960000 NEWACDF L @5,CHNPDLAD 0422 21970000 LH @F,68(0,@5) 0422 21980000 AH @F,@D3 0422 21990000 STH @F,GETFREE+6 0422 22000000 * R1 = ADDR(GETFREE); /* PTR TO GETSPACE PARMLIST */ 22010000 LA @1,GETFREE 0423 22020000 **/*%NACD: S IKJEFA53: GET SPACE FOR ACTNBR DATAFLD */ 22030000 * CALL IKJEFA53; /* CALL THE GETSPACE ROUTINE */ 22040000 L @F,@V1 ADDRESS OF IKJEFA53 0424 22050000 BALR @E,@F 0424 22060000 * RETCODE = R15; /* ASSIGN THE RETURN CODE */ 22070000 L @5,CTABPTR 0425 22080000 ST @F,36(0,@5) 0425 22090000 **/* D (YES,%NDOK,NO,) GETSPACE SUCCESSFUL? */ 22100000 **/* P (,%RTRN) SET ERROR MSGNMBR */ 22110000 * /* CHECK THE RETURN CODE FROM GETSPACE. */ 22120000 * IF RETCODE ª= 0 22130000 * THEN /* GETSPACE UNSUCCESSFUL */ 22140000 SR @F,@F 0426 22150000 C @F,36(0,@5) 0426 22160000 BC 08,@9C9 0426 22170000 * DO; 22180000 * MSGNMBR = 24; /* SET ERROR MSG NUMBER */ 22190000 LA @F,24 0428 22200000 STH @F,32(0,@5) 0428 22210000 * RETURN; /* CHANGE CP WILL ISSUE THE 22220000 * ERROR MSG & CONTINUE WITH 22230000 * THE NEXT USERID, IF ANY */ 22240000 BC 15,@EL01 0429 22250000 * END; 22260000 * ELSE; /* GETSPACE WAS SUCCESSFUL */ 22270000 @9C9 EQU * 0431 22280000 * NEWDFPTR = HEDBPTR+AREAOFST;/* ADDR OF THE NEW DATAFLD */ 22290000 @9C8 L @F,GETFREE+8 0432 22300000 AR @F,@4 0432 22310000 ST @F,NEWDFPTR 0432 22320000 * NEWDFPTR -> DNOBD(1:45) = /* COPY THE EXISTING DATA, EX-*/ 22330000 * UADSAPTR -> DNOBD(1:45); /* CLUDING THE ACCTNMBR, INTO 22340000 * THE NEW DATAFLD */ 22350000 L @5,UADSAPTR 0433 22360000 LR @8,@F 0433 22370000 MVC 0(45,@8),0(@5) 0433 22380000 **/*%NDOK: P INSERT NEW DATAFLD OFFSET INTO OFSBLK */ 22390000 **/* P INSERT NEW LNGTH & NEW ACTNBR */ 22400000 * UADSADAT = AREAOFST; /* PUT OFFSET TO NEW DATAFLD 22410000 * INTO THE OFFSET BLOCK */ 22420000 MVC 8(4,@2),GETFREE+8 0434 22430000 * UADSAPTR = NEWDFPTR; /* REF THE NEW DATAFLD */ 22440000 MVC UADSAPTR(4),NEWDFPTR 0435 22450000 * UADSACTR = 1; /* SET USE CTR TO 1 */ 22460000 L @5,UADSAPTR 0436 22470000 MVI 0(@5),1 0436 22480000 * UADSALEN = DATALNG3; /* INSERT NEW LENGTH */ 22490000 L @6,CHNPDLAD 0437 22500000 MVC 44(1,@5),69(@6) 0437 22510000 * UADSANUM(1:DATALNG3) = /* INSERT NEW ACCTNMBR */ 22520000 * DLITEM(1:DATALNG3); 22530000 L @7,CHNPDLAD 0438 22540000 L @7,64(0,@7) CHNGPDL 0438 22550000 LR @E,@7 0438 22560000 LH @8,68(0,@6) 0438 22570000 BCTR @8,0 0438 22580000 LA @A,45(0,@5) 0438 22590000 EX @8,@MVC 0438 22600000 **/* D (YES,%NAC2,NO,ACNEXT) ACTNBR = '*'? */ 22610000 * /* CHECK CONTROL FLAG TO DETERMINE WHERE TO CONTINUE. */ 22620000 * IF NACDFLG = '1'B 22630000 * THEN 22640000 TM CFLAGS,B'00010000' 0439 22650000 * GOTO NACNF2; /* GO TO INDICATED SECTION */ 22660000 BC 01,NACNF2 0440 22670000 * /* CHECK WHETHER THE OLD DATA FIELD HAS TO BE FREED. */ 22680000 * IF FLDFLG = '0'B 22690000 * THEN /* NO, */ 22700000 TM CFLAGS,B'01000000' 0441 22710000 * GOTO ACNEXT; /* GO CHECK WHERE PROCESSING 22720000 * IS TO CONTINUE */ 22730000 BC 08,ACNEXT 0442 22740000 * UADSAPTR = HEDBPTR+ADATSAVE;/* REF THE OLD DATAFLD */ 22750000 L @F,ADATSAVE 0443 22760000 AR @F,@4 0443 22770000 ST @F,UADSAPTR 0443 22780000 * FREACDF: /* THIS SECTION WILL PRUNE AN ACCTNMBR DATA FIELD FROM */ 22790000 * /* THE USERID TREE. */ 22800000 * AREALNTH = 45+UADSALEN; /* NUMBER OF BYTES TO BE FREED*/ 22810000 FREACDF L @5,UADSAPTR 0444 22820000 SR @F,@F 0444 22830000 IC @F,44(0,@5) 0444 22840000 AH @F,@D3 0444 22850000 STH @F,GETFREE+6 0444 22860000 * AREAOFST = ADATSAVE; /* OFFSET TO FIELD TO BE FREED*/ 22870000 MVC GETFREE+8(4),ADATSAVE 0445 22880000 * CALL IKJFRSP; /* GO FREE THIS DATA FIELD */ 22890000 BAL @E,IKJFRSP 0446 22900000 * FLDFLG = '0'B; /* SET CONTROL FLAG BACK TO 0 */ 22910000 NI CFLAGS,B'10111111' 0447 22920000 * GOTO ACNEXT; /* GO CHECK WHERE PROCESSING 22930000 * IS TO CONTINUE */ 22940000 BC 15,ACNEXT 0448 22950000 * 22960000 * ACCHGE1: /* THE NEW ACCTNMBR ALREADY EXISTS IN A COUSIN CHAIN OF */ 22970000 * /* THIS TREE. THE COUSIN DATA FIELD WILL BE USED AND THE */ 22980000 * /* NODELIST ACCTNMBR DATA FIELD WILL BE FREED IF IT IS */ 22990000 * /* NOT SHARED (USE CTR = 1). */ 23000000 * UADSAPTR = NDFPTR; /* REF THE COUSIN DATAFLD 23010000 * M1860 */ 23020000 ACCHGE1 MVC UADSAPTR(4),NDFPTR 0449 23030000 * 23040000 **/*ACCHGE1: D (NO,%C256,YES,) USE COUNTER = 255? */ 23050000 **/* P (,%RTRN) SET ERROR MSGNMBR */ 23060000 **/*%C256: P INCREMENT USE COUNTER */ 23070000 **/* P INSERT OFFSET TO COUSIN DATAFLD */ 23080000 * 23090000 * /* CHECK THE USE COUNTER BEFORE INCREMENTING IT. IT CANNOT*/ 23100000 * /* EXCEED 255. */ 23110000 * IF UADSACTR = 255 /* M2581 */ 23120000 * THEN /* CTR LIMIT HAS BEEN REACHED */ 23130000 L @5,UADSAPTR 0450 23140000 CLI 0(@5),255 0450 23150000 BC 07,@9C7 0450 23160000 * DO; 23170000 * /* M2581 */ 23180000 * MSG30: MSGNMBR = 30; /* SET MSG NO FOR IKJEFA20 */ 23190000 MSG30 LA @F,30 0452 23200000 L @5,CTABPTR 0452 23210000 STH @F,32(0,@5) 0452 23220000 * GOTO WORKEND; /* GO RETURN M2581 */ 23230000 BC 15,WORKEND 0453 23240000 * END; 23250000 * UADSACTR = UADSACTR+1; /* INCREMENT THE USE CTR */ 23260000 @9C7 LA @F,1 0455 23270000 L @5,UADSAPTR 0455 23280000 SR @0,@0 0455 23290000 IC @0,0(0,@5) 0455 23300000 AR @F,@0 0455 23310000 STC @F,0(0,@5) 0455 23320000 * DNOBPTR = OACSAVE; /* REF THE NODELIST ACTNO OBLK*/ 23330000 L @2,OACSAVE 0456 23340000 * ADATSAVE = UADSADAT; /* SAVE OFFSET TO ITS DATAFLD */ 23350000 MVC ADATSAVE(4),8(@2) 0457 23360000 * UADSADAT = RDATSAVE; /* PUT OFFSET TO COUSIN DATAFLD 23370000 * INTO THIS OFFSET BLOCK */ 23380000 MVC 8(4,@2),RDATSAVE 0458 23390000 * UADSAPTR = HEDBPTR+ADATSAVE;/* REF NODELIST ACTNO DATAFLD */ 23400000 L @F,ADATSAVE 0459 23410000 AR @F,@4 0459 23420000 ST @F,UADSAPTR 0459 23430000 **/*%FRAD: D (YES,ACNEXT,NO,) NODELST ACTNBR DATFLD SHARED? */ 23440000 **/* S (,ACNEXT) IKJFRSP: PRUNE NODELIST ACTNBR DATAFLD */ 23450000 * /* IF THE NODELIST ACCTNMBR DATA FIELD IS NOT SHARED, IT */ 23460000 * /* WILL BE PRUNED FROM THIS USERID TREE. */ 23470000 * IF UADSACTR = 1 23480000 * THEN /* THIS DATAFLD IS NOT SHARED */ 23490000 LR @5,@F 0460 23500000 CLI 0(@5),1 0460 23510000 * GOTO FREACDF; /* GO PRUNE IT FROM THE TREE */ 23520000 BC 08,FREACDF 0461 23530000 * ELSE; /* IT IS SHARED, */ 23540000 * UADSACTR = UADSACTR-1; /* DECREMENT ITS USE CTR */ 23550000 LH @F,@D2 0463 23560000 IC @0,0(0,@5) 0463 23570000 AR @F,@0 0463 23580000 STC @F,0(0,@5) 0463 23590000 * GOTO ACNEXT; /* GO CHECK WHERE PROCESSING 23600000 * IS TO CONTINUE */ 23610000 BC 15,ACNEXT 0464 23620000 * 23630000 * ACCHGE2: /* THE NEW ACCTNMBR ALREADY EXISTS IN THE SAME LOCAL CHAIN*/ 23640000 * /* AS THE NODELIST ACCTNMBR. THE LATTER'S OFFSET BLOCK */ 23650000 * /* WILL BE PRUNED FROM THE TREE. ITS DATA FIELD WILL ALSO */ 23660000 * /* BE FREED IF IT IS NOT SHARED. THE TWO PROCNAME CHAINS */ 23670000 * /* HAVE BEEN MERGED AND PROCNAME TWINS, IF ANY WERE FOUND,*/ 23680000 * /* HAVE BEEN PRUNED. */ 23690000 * 23700000 **/*ACCHGE2: P (,ACPRUNE) REF NODELIST ACTNBR & SAVE DATAFLD OFFSET */ 23710000 * DNOBPTR = OACSAVE; /* REF THE NODELIST ACTNO OBLK*/ 23720000 ACCHGE2 L @2,OACSAVE 0465 23730000 * ADATSAVE = UADSADAT; /* SAVE OFFSET TO ITS DATAFLD */ 23740000 MVC ADATSAVE(4),8(@2) 0466 23750000 * GOTO ACPRUNE; /* GO TO PRUNING SECTION */ 23760000 BC 15,ACPRUNE 0467 23770000 * 23780000 **/*CHKACDF: P (,%FRAD) REF NODELIST ACTNBR DATAFLD */ 23790000 * CHKACDF: /* AFTER PRUNING THE NODELIST ACCTNMBR OFFSET BLOCK, */ 23800000 * /* CHECK ITS DATA FIELD. IF IT IS NOT SHARED (USE CTR = 1)*/ 23810000 * /* IT WILL ALSO BE FREED. */ 23820000 * UADSAPTR = HEDBPTR+ADATSAVE;/* REF NODELIST ACTNO DATAFLD */ 23830000 CHKACDF L @F,ADATSAVE 0468 23840000 AR @F,@4 0468 23850000 ST @F,UADSAPTR 0468 23860000 * UADSACTR = UADSACTR+1; /* RESET USE CTR. IT WAS DECRE- 23870000 * MENTED IN THE COMMON ACCTNMBR 23880000 * OBLK PRUNING SECTION */ 23890000 LA @F,1 0469 23900000 L @5,UADSAPTR 0469 23910000 SR @0,@0 0469 23920000 IC @0,0(0,@5) 0469 23930000 AR @F,@0 0469 23940000 STC @F,0(0,@5) 0469 23950000 * ACPRFLG = '0'B; /* RESET THIS CONTROL FLAG */ 23960000 NI CFLAGS,B'11110111' 0470 23970000 * /* IS THIS DATA FIELD SHARED WITH COUSINS? */ 23980000 * IF UADSACTR > 1 23990000 * THEN /* IT IS SHARED, */ 24000000 CLI 0(@5),1 0471 24010000 BC 12,@9C6 0471 24020000 * UADSACTR = UADSACTR-1; /* DECREMENT ITS USE CTR */ 24030000 LH @F,@D2 0472 24040000 IC @0,0(0,@5) 0472 24050000 AR @F,@0 0472 24060000 STC @F,0(0,@5) 0472 24070000 * ELSE /* IT IS NOT SHARED, */ 24080000 * GOTO FREACDF; /* GO PRUNE IT FROM THE TREE */ 24090000 * GOTO ACNEXT; /* GO CHECK WHERE PROCESSING 24100000 * IS TO CONTINUE */ 24110000 BC 15,ACNEXT 0474 24120000 * 24130000 * 24140000 * CHALLAC: /* THIS SECTION OF CODE WILL CHANGE ALL ACCTNMBRS IN A */ 24150000 * /* LOCAL ACCTNMBR CHAIN TO THE NEW ACCTNMBR SPECIFIED IN */ 24160000 * /* THE DATA SUBFIELD OF THE COMMAND. ALL UNNECESSARY DATA */ 24170000 * /* FIELDS & OFFSET BLOCKS WILL BE PRUNED FROM THE TREE. */ 24180000 * DNOBPTR = HEDBPTR+UADSPSUB; /* REF 1ST OBLK IN LOC CHAIN */ 24190000 CHALLAC L @5,DPOBPTR 0475 24200000 L @2,4(0,@5) 0475 24210000 AR @2,@4 0475 24220000 * OACSAVE = DNOBPTR; /* SAVE ADDR OF THIS OBLK */ 24230000 ST @2,OACSAVE 0476 24240000 * ODFPTR = HEDBPTR+UADSADAT; /* SAVE ADDR OF ITS DATAFLD */ 24250000 L @F,8(0,@2) 0477 24260000 AR @F,@4 0477 24270000 ST @F,ODFPTR 0477 24280000 **/*CHALLAC: P REF 1ST ACTNBR UNDER CURRENT PASSWORD */ 24290000 **/* D (NO,%CHTW1,YES,) ONLY 1 ACTNBR IN CHAIN? */ 24300000 * /* IS THIS THE ONLY ACCTNMBR IN THIS CHAIN? IF IT IS, THEN*/ 24310000 * /* MERGING OF PROCNAME CHAINS IS NOT NECESSARY. */ 24320000 * IF AFLG01 = '0'B 24330000 * THEN /* NO, THERE ARE BROTHERS */ 24340000 TM 0(@2),B'10000000' 0478 24350000 * GOTO CHTWSR1; /* GO SEARCH FOR PROC TWINS */ 24360000 BC 08,CHTWSR1 0479 24370000 **/*NACLS: S DLACLS: SEARCH LOC CHAIN FOR NEW ACTNBR */ 24380000 **/* D (NO,%NACTS,YES,) NEW ACTNBR IN LOC CHAIN? */ 24390000 * NACLS: /* IF THE NEW ACCTNMBR EXISTS IN THIS CHAIN, THEN ITS */ 24400000 * /* DATA FIELD MUST BE USED. */ 24410000 * RDATSAVE = UADSADAT; /* SAVE ADDR OF 1ST DATAFLD */ 24420000 NACLS MVC RDATSAVE(4),8(@2) 0480 24430000 * CALL DLACLS; /* GO TO SEARCH SUBRTNE */ 24440000 BAL @E,DLACLS 0481 24450000 * /* DOES THE NEW ACCTNMBR EXIST IN THIS CHAIN? IF NOT, THEN*/ 24460000 * /* SEARCH THE TOTAL CHAIN. A COUSIN DATA FIELD MUST BE */ 24470000 * /* USED IF IT EXISTS. */ 24480000 * IF ACTWIN2 = 0 24490000 * THEN /* NO, IT WAS NOT FOUND, */ 24500000 SR @F,@F 0482 24510000 C @F,ACTWIN2 0482 24520000 * GOTO NACTS; /* GO SEARCH THE TOTAL CHAIN */ 24530000 BC 08,NACTS 0483 24540000 **/* P TRANSFER DATAFLD OFFSET TO 1ST OFSBLK IN CHAIN */ 24550000 **/* P REF 2ND OFSBLK IN LOCAL CHAIN */ 24560000 * /* THE NEW ACCTNMBR EXISTS IN THIS LOCAL CHAIN. SWITCH */ 24570000 * /* THE DATA FIELD OFFSET TO THE 1ST OFFSET BLOCK IN THE */ 24580000 * /* CHAIN TO FACILITATE THE PRUNING OF THE UNNECESSARY */ 24590000 * /* OFFSET BLOCKS. */ 24600000 * ADATSAVE = UADSADAT; /* SAVE OFFSET TO THE NEW ACCT- 24610000 * NMBR DATA FIELD */ 24620000 MVC ADATSAVE(4),8(@2) 0484 24630000 * UADSADAT = RDATSAVE; /* PUT IN OFFSET TO 1ST DATAFD*/ 24640000 MVC 8(4,@2),RDATSAVE 0485 24650000 * DNOBPTR = OACSAVE; /* REF 1ST OBLK AGAIN */ 24660000 L @2,OACSAVE 0486 24670000 * UADSADAT = ADATSAVE; /* PUT IN OFFSET TO NEW ACCT- 24680000 * NMBR DATA FIELD */ 24690000 MVC 8(4,@2),ADATSAVE 0487 24700000 * ACHNPR1: /* IF THERE ARE NO BROTHERS, THEN PRUNING IS UNNECESSARY. */ 24710000 * IF AFLG01 = '1'B 24720000 * THEN /* NO BROTHERS, */ 24730000 ACHNPR1 TM 0(@2),B'10000000' 0488 24740000 * GOTO ACNEXT2; /* GO CHECK WHERE PROCESSING 24750000 * IS TO CONTINUE */ 24760000 BC 01,ACNEXT2 0489 24770000 * /* MUST MAKE SURE THAT THE 1ST OFFSET BLOCK POINTS TO THE */ 24780000 * /* BEGINNING OF THE PROC CHAIN. IT IS POSSIBLE THAT THERE */ 24790000 * /* ARE NO PROCS LEFT UNDER THE 1ST ACCTNMBR, SO THAT THE */ 24800000 * /* 1ST PROC IS UNDER ONE OF THE BROTHERS THAT WILL BE */ 24810000 * /* PRUNED FROM THE TREE. */ 24820000 * IF UADSASUB ª= 0 /* ANY PROCS UNDER 1ST ACTNBR?*/ 24830000 * THEN /* YES, */ 24840000 SR @F,@F 0490 24850000 C @F,4(0,@2) 0490 24860000 * GOTO ACHNPRB; /* GO START PRUNING */ 24870000 BC 07,ACHNPRB 0491 24880000 * ACHNPRA: /* FIND THE 1ST REMAINING PROC UNDER THE CURRENT PASSWORD */ 24890000 * DNOBPTR = HEDBPTR+UADSANEX; /* REF THE 1ST ACTNBR BROTHER */ 24900000 ACHNPRA MVC @TEMP3+1(3),1(@2) 0492 24910000 L @F,@TEMP3 0492 24920000 AR @F,@4 0492 24930000 LR @2,@F 0492 24940000 * /* PROC CHAIN START UNDER THIS ACCTNMBR? */ 24950000 * IF UADSASUB = 0 24960000 * THEN /* NO, */ 24970000 SR @F,@F 0493 24980000 C @F,4(0,@2) 0493 24990000 * GOTO ACHNPRA; /* CONTINUE THE SEARCH */ 25000000 BC 08,ACHNPRA 0494 25010000 * SUBOFS = UADSASUB; /* SAVE OFFSET TO 1ST PROC */ 25020000 MVC SUBOFS(4),4(@2) 0495 25030000 * DNOBPTR = OACSAVE; /* REF 1ST ACCTNMBR AGAIN */ 25040000 L @2,OACSAVE 0496 25050000 * UADSASUB = SUBOFS; /* CONNECT 1ST PROC TO IT */ 25060000 MVC 4(4,@2),SUBOFS 0497 25070000 * ACHNPRB: /* START THE PRUNING PROCESS WITH THE 1ST BROTHER. */ 25080000 * DNOBPTR = HEDBPTR+UADSANEX; 25090000 ACHNPRB MVC @TEMP3+1(3),1(@2) 0498 25100000 L @F,@TEMP3 0498 25110000 AR @F,@4 0498 25120000 LR @2,@F 0498 25130000 **/*%CHN2: P SAVE CHAINFLG & OFFSET TO NEXT OFSBLK */ 25140000 * ACHNPR2: /* BEGINNING OF THE PRUNING SECTION. */ 25150000 * ANEXSAVE = UADSANEX; /* SAVE OFFSET TO NEXT OBLK */ 25160000 ACHNPR2 MVC ANEXSAVE+1(3),1(@2) 0499 25170000 MVI ANEXSAVE,X'00' 0499 25180000 * /* SAVE THE CHAIN FLAG. */ 25190000 * IF AFLG01 = '1'B 25200000 * THEN 25210000 TM 0(@2),B'10000000' 0500 25220000 BC 12,@9C4 0500 25230000 * FLGSAVE = '1'B; 25240000 OI CFLAGS,B'10000000' 0501 25250000 BC 15,@9C3 0502 25260000 * ELSE 25270000 * FLGSAVE = '0'B; 25280000 @9C4 NI CFLAGS,B'01111111' 0502 25290000 * UADSAPTR = HEDBPTR+UADSADAT;/* REF ITS DATA FIELD */ 25300000 @9C3 L @F,8(0,@2) 0503 25310000 AR @F,@4 0503 25320000 ST @F,UADSAPTR 0503 25330000 **/* D (YES,%CHN3,NO,) DATAFLD SHARED? */ 25340000 **/* S IKJFRSP: PRUNE ACTNBR DATAFLD */ 25350000 * /* CHECK WHETHER THE DATAFLD CAN BE FREED (IF USE CTR = 1)*/ 25360000 * IF UADSACTR = 1 25370000 * THEN /* YES, */ 25380000 LR @5,@F 0504 25390000 CLI 0(@5),1 0504 25400000 BC 07,@9C2 0504 25410000 * DO; 25420000 * AREAOFST = UADSADAT; /* OFFSET TO AREA TO BE FREED */ 25430000 MVC GETFREE+8(4),8(@2) 0506 25440000 * AREALNTH = 45+UADSALEN;/* LENGTH TO BE FREED */ 25450000 SR @F,@F 0507 25460000 IC @F,44(0,@5) 0507 25470000 AH @F,@D3 0507 25480000 STH @F,GETFREE+6 0507 25490000 * CALL IKJFRSP; /* GO FREE THE DATAFLD */ 25500000 BAL @E,IKJFRSP 0508 25510000 BC 15,@9C1 0510 25520000 * END; 25530000 * ELSE /* NO, */ 25540000 * UADSACTR = UADSACTR-1; /* DECREMENT THE USE COUNTER */ 25550000 @9C2 LH @F,@D2 0510 25560000 L @5,UADSAPTR 0510 25570000 SR @0,@0 0510 25580000 IC @0,0(0,@5) 0510 25590000 AR @F,@0 0510 25600000 STC @F,0(0,@5) 0510 25610000 **/*%CHN3: S IKJFRSP: PRUNE ACTNBR OFFSET BLOCK */ 25620000 * ACHNPR3: /* PRUNE ONE ACCTNMBR OFFSET BLOCK FROM THE TREE. */ 25630000 * AREAOFST = DNOBPTR-HEDBPTR; /* OFFSET TO AREA TO BE FREED */ 25640000 @9C1 EQU * 0511 25650000 ACHNPR3 LR @F,@2 0511 25660000 SR @F,@4 0511 25670000 ST @F,GETFREE+8 0511 25680000 * AREALNTH = 12; /* LENGTH TO BE FREED */ 25690000 LA @F,12 0512 25700000 STH @F,GETFREE+6 0512 25710000 * CALL IKJFRSP; /* GO FREE THE OBLK */ 25720000 BAL @E,IKJFRSP 0513 25730000 **/* D (NO,%EOPR,YES,) MORE ACTNBRS IN LOC CHAIN? */ 25740000 **/* P (,%CHN2) REF NEXT ACTNBR OFSBLK IN LOCAL CHAIN */ 25750000 * /* CHECK FOR MORE BROTHERS IN THIS CHAIN. */ 25760000 * IF FLGSAVE = '0'B 25770000 * THEN /* MORE OBLKS TO BE FREED */ 25780000 TM CFLAGS,B'10000000' 0514 25790000 BC 05,@9C0 0514 25800000 * DO; 25810000 * DNOBPTR = /* REF THE NEXT OBLK */ 25820000 * HEDBPTR+ANEXSAVE; 25830000 L @2,ANEXSAVE 0516 25840000 AR @2,@4 0516 25850000 * GOTO ACHNPR2; /* CONTINUE PRUNING */ 25860000 BC 15,ACHNPR2 0517 25870000 * END; 25880000 **/*%EOPR: P (,ACNEXT2) CHAINFLG & OFFSET FROM LAST OFSBLK TO 1ST */ 25890000 * /* PRUNING IN THIS LOCAL CHAIN HAS BEEN COMPLETED. */ 25900000 * DNOBPTR = OACSAVE; /* REF THE 1ST OBLK AGAIN */ 25910000 @9C0 L @2,OACSAVE 0519 25920000 * UADSANEX = ANEXSAVE; /* INSERT THE OFFSET TO THE 1ST 25930000 * OBLK IN THE NEXT CHAIN */ 25940000 MVC 1(3,@2),ANEXSAVE+1 0520 25950000 * AFLG01 = '1'B; /* SET THE CHAIN FLAG TO 1 - 25960000 * END OF THIS LOCAL CHAIN */ 25970000 OI 0(@2),B'10000000' 0521 25980000 * GOTO ACNEXT2; /* GO CHECK WHERE PROCESSING 25990000 * IS TO CONTINUE */ 26000000 BC 15,ACNEXT2 0522 26010000 **/*%NACTS: S DLACTS: SEARCH FOR NEW ACTNBR IN TOTAL CHAIN */ 26020000 **/* D (NO,%NAC1,YES,) NEW ACTNBR IN TOT CHAIN? */ 26030000 * NACTS: /* SEARCH THE TOTAL CHAIN FOR THE NEW ACCTNMBR. */ 26040000 * CALL DLACTS; /* GO TO TOTAL SEARCH SUBRTNE */ 26050000 NACTS BAL @E,DLACTS 0523 26060000 * /* DOES THE NEW ACCTNMBR EXIST IN THE TOTAL CHAIN? */ 26070000 * IF CSNPTR = 0 26080000 * THEN /* NO, */ 26090000 SR @F,@F 0524 26100000 C @F,CSNPTR 0524 26110000 * GOTO NACNF1; /* GO MAKE APPROPRIATE CHANGES*/ 26120000 BC 08,NACNF1 0525 26130000 * /* THE NEW ACCTNMBR EXISTS IN A COUSIN CHAIN. THE COUSIN */ 26140000 * /* DATA FIELD MUST BE USED. */ 26150000 * 26160000 **/* D (NO,%C255,YES,) USE COUNTER = 255? */ 26170000 **/* P (,%RTRN) SET ERROR MSGNMBR */ 26180000 **/*%C255: P INCREMENT USE COUNTER */ 26190000 **/* P INSERT OFFSET TO COUSIN DATAFLD INTO 1ST OFSBLK */ 26200000 * /* CHECK THE USE COUNTER BEFORE INCREMENTING IT. IT CANNOT*/ 26210000 * /* EXCEED 255. */ 26220000 * IF UADSACTR = 255 /* M2581 */ 26230000 * THEN /* CTR LIMIT HAS BEEN REACHED */ 26240000 L @5,UADSAPTR 0526 26250000 CLI 0(@5),255 0526 26260000 * GOTO MSG30; /* GO SET MSGNO & RETURN */ 26270000 BC 08,MSG30 0527 26280000 * UADSACTR = UADSACTR+1; /* INCREMENT THE USE CTR */ 26290000 LA @F,1 0528 26300000 SR @0,@0 0528 26310000 IC @0,0(0,@5) 0528 26320000 AR @F,@0 0528 26330000 STC @F,0(0,@5) 0528 26340000 * DNOBPTR = OACSAVE; /* REF 1ST OBLK AGAIN */ 26350000 L @2,OACSAVE 0529 26360000 * ADATSAVE = UADSADAT; /* SAVE OFFSET TO ITS DATAFLD */ 26370000 MVC ADATSAVE(4),8(@2) 0530 26380000 * UADSADAT = RDATSAVE; /* INSERT OFFSET TO COUSIN DFD*/ 26390000 MVC 8(4,@2),RDATSAVE 0531 26400000 **/*%PRADF: D (YES,%CHN2,NO,) DATFLD OF 1ST OFSBLK SHARED? */ 26410000 **/* S (,%CHN2) IKJFRSP: PRUNE ITS DATAFLD */ 26420000 * PRADF: /* LABEL FOR BRANCH POINT. */ 26430000 * UADSAPTR = ODFPTR; /* REF DATAFLD OF 1ST OBLK */ 26440000 PRADF MVC UADSAPTR(4),ODFPTR 0532 26450000 * /* CHECK WHETHER THIS DATA FIELD CAN BE FREED. */ 26460000 * IF UADSACTR = 1 26470000 * THEN /* YES, */ 26480000 L @5,UADSAPTR 0533 26490000 CLI 0(@5),1 0533 26500000 BC 07,@9BF 0533 26510000 * DO; 26520000 * AREAOFST = ADATSAVE; /* OFFSET TO AREA TO BE FREED */ 26530000 MVC GETFREE+8(4),ADATSAVE 0535 26540000 * AREALNTH = 45+UADSALEN;/* LENGTH TO BE FREED */ 26550000 SR @F,@F 0536 26560000 IC @F,44(0,@5) 0536 26570000 AH @F,@D3 0536 26580000 STH @F,GETFREE+6 0536 26590000 * CALL IKJFRSP; /* GO FREE THE DATAFLD */ 26600000 BAL @E,IKJFRSP 0537 26610000 BC 15,@9BE 0539 26620000 * END; 26630000 * ELSE /* NO, */ 26640000 * UADSACTR = UADSACTR-1; /* DECREMENT THE USE CTR */ 26650000 @9BF LH @F,@D2 0539 26660000 L @5,UADSAPTR 0539 26670000 SR @0,@0 0539 26680000 IC @0,0(0,@5) 0539 26690000 AR @F,@0 0539 26700000 STC @F,0(0,@5) 0539 26710000 * GOTO ACHNPR1; /* GO TO THE PRUNING SECTION */ 26720000 BC 15,ACHNPR1 0540 26730000 **/*%NAC1: P (,%NACD) REF 1ST ACTNBR OFSBLK UNDER CURRENT PASSWD * 26740000 * NACNF1: /* THE NEW ACCTNMBR DOES NOT EXIST IN THIS TREE. CREATE A */ 26750000 * /* NEW DATA FIELD FOR IT. */ 26760000 * DNOBPTR = OACSAVE; /* REF THE 1ST OBLK AGAIN */ 26770000 NACNF1 L @2,OACSAVE 0541 26780000 * UADSAPTR = ODFPTR; /* REF ITS DATA FIELD */ 26790000 MVC UADSAPTR(4),ODFPTR 0542 26800000 * ADATSAVE = UADSADAT; /* SAVE OFFSET TO ITS DATAFLD */ 26810000 MVC ADATSAVE(4),8(@2) 0543 26820000 * NACDFLG = '1'B; /* SET FLAG FOR LOGIC FLOW */ 26830000 OI CFLAGS,B'00010000' 0544 26840000 * GOTO NEWACDF; /* GO CREATE A NEW DATAFLD */ 26850000 BC 15,NEWACDF 0545 26860000 **/*%NAC2: P (,%PRADF) SET DRIVER FIELD OF NEW DATAFLD TO 0 */ 26870000 * NACNF2: /* RETURN POINT AFTER A NEW DATA FIELD HAS BEEN CREATED. */ 26880000 * UADSADRF(1) = '00'X; /* SET THE DRIVER FIELD IN THE*/ 26890000 NACNF2 L @5,UADSAPTR 0546 26900000 MVI 4(@5),X'00' 0546 26910000 * UADSADRF(2:40) = UADSADRF(1:39);/* DATA FIELD TO ZERO */ 26920000 MVC 5(39,@5),4(@5) 0547 26930000 * NACDFLG = '0'B; /* RESET THE CONTROL FLAG */ 26940000 NI CFLAGS,B'11101111' 0548 26950000 * GOTO PRADF; /* GO FREE THE OLD DATAFLD */ 26960000 BC 15,PRADF 0549 26970000 * 26980000 * CHTWSR1: /* THE PROCNAME CHAINS UNDER THE ACCTNMBRS OF THIS LOCAL */ 26990000 * /* ACCTNMBR CHAIN MUST BE COMPARED TO MAKE SURE THAT NO */ 27000000 * /* TWINS EXIST. THESE CHAINS WILL BE MERGED INTO ONE AND */ 27010000 * /* ONE OF EACH PAIR OF TWINS MUST BE PRUNED. IF THE TWINS */ 27020000 * /* DO NOT HAVE IDENTICAL DATA FIELDS, HOWEVER, THEN THE */ 27030000 * /* MERGE IS NOT POSSIBLE & AN ERROR MSG WILL BE ISSUED. */ 27040000 **/*%CHTW1: P (,PRTWSR1) SET PTRS TO 1ST TWO BROTHERS IN LOC CHAIN */ 27050000 * ACTWIN1 = DNOBPTR; /* REF THE 1ST ACCTNMBR OBLK */ 27060000 CHTWSR1 ST @2,ACTWIN1 0550 27070000 * ACTWIN2 = HEDBPTR+UADSANEX; /* REF ITS BROTHER. THEIR PROC- 27080000 * NAME CHAINS WILL BE COMPARD*/ 27090000 MVC @TEMP3+1(3),1(@2) 0551 27100000 L @F,@TEMP3 0551 27110000 AR @F,@4 0551 27120000 ST @F,ACTWIN2 0551 27130000 * ALLACFLG = '1'B; /* SET FLAG FOR LOGIC FLOW */ 27140000 OI CFLAGS,B'00100000' 0552 27150000 * /* GO TO THE TWIN SEARCH SECTION & PRUNE ONE OF EACH PAIR */ 27160000 * /* OF TWINS THAT ARE FOUND. */ 27170000 * GOTO PRTWSR1; 27180000 BC 15,PRTWSR1 0553 27190000 **/*%CHTW2: D (NO,CHMRG1,YES,) MORE BROTHERS? */ 27200000 **/* P (,PRTWSR1) SET PTRS TO NEXT TWO BROTHERS */ 27210000 * CHTWSR2: /* RETURN POINT AFTER TWIN SEARCH AND PRUNING. */ 27220000 * DNOBPTR = ACTWIN2; /* REF THE 2ND OF THE TWO ACCT- 27230000 * NMBRS WHOSE PROCNAME CHAINS 27240000 * WHERE JUST COMPARED */ 27250000 CHTWSR2 L @2,ACTWIN2 0554 27260000 * /* DOES THIS 2ND ACCTNMBR HAVE MORE BROTHERS? */ 27270000 * IF AFLG01 = '0'B 27280000 * THEN /* YES, */ 27290000 TM 0(@2),B'10000000' 0555 27300000 BC 05,@9BD 0555 27310000 * DO; 27320000 * ACTWIN2 = /* REF ITS BROTHER FOR THE */ 27330000 * HEDBPTR+UADSANEX; /* NEXT COMPARISON OF PROCS */ 27340000 MVC @TEMP3+1(3),1(@2) 0557 27350000 L @F,@TEMP3 0557 27360000 AR @F,@4 0557 27370000 ST @F,ACTWIN2 0557 27380000 * /* GO TO THE TWIN SEARCH SECTION AGAIN. */ 27390000 * GOTO PRTWSR1; 27400000 BC 15,PRTWSR1 0558 27410000 * END; 27420000 * /* END OF CHAIN HAS BEEN REACHED. REF THE 1ST OF THE TWO */ 27430000 * /* ACCTNMBRS AGAIN. THIS PROCESS WILL CONTINUE UNTIL EVERY*/ 27440000 * /* PROCNAME CHAIN UNDER THIS PASSWORD HAS BEEN COMPARED */ 27450000 * /* TO ALL OTHERS. */ 27460000 * DNOBPTR = ACTWIN1; 27470000 @9BD L @2,ACTWIN1 0560 27480000 * DNOBPTR = HEDBPTR+UADSANEX; /* REF ITS BROTHER */ 27490000 MVC @TEMP3+1(3),1(@2) 0561 27500000 L @F,@TEMP3 0561 27510000 AR @F,@4 0561 27520000 LR @2,@F 0561 27530000 * /* ARE THERE MORE BROTHERS? */ 27540000 * IF AFLG01 = '0'B 27550000 * THEN /* YES, */ 27560000 TM 0(@2),B'10000000' 0562 27570000 * GOTO CHTWSR1; /* CONTINUE THE PROCESS */ 27580000 BC 08,CHTWSR1 0563 27590000 **/*CHMRG1: P (,NACLS) MERGE ALL PROC CHAINS UNDER CURRENT PASSWD */ 27600000 * CHMRG1: /* THE SEARCH FOR & PRUNING OF POSSIBLE PROCNAME TWINS */ 27610000 * /* HAS BEEN COMPLETED. ALL PROCNAME CHAINS UNDER THIS */ 27620000 * /* PASSWORD WILL NOW BE MERGED INTO ONE CHAIN. */ 27630000 * DNOBPTR = OACSAVE; /* REF 1ST ACCTNMBR OBLK */ 27640000 CHMRG1 L @2,OACSAVE 0564 27650000 * CHMRG2: /* ANY MORE ACCTNMBRS IN THIS CHAIN? */ 27660000 * IF AFLG01 = '1'B 27670000 * THEN /* NO, THE MERGE IS COMPLETE */ 27680000 CHMRG2 TM 0(@2),B'10000000' 0565 27690000 BC 12,@9BC 0565 27700000 * DO; 27710000 * DNOBPTR = OACSAVE; /* REF 1ST ACCTNMBR IN CHAIN */ 27720000 L @2,OACSAVE 0567 27730000 * GOTO NACLS; /* START THE PRUNING PROCESS */ 27740000 BC 15,NACLS 0568 27750000 * END; 27760000 * /* IT IS POSSIBLE THAT AN ACCTNMBR HAS NO PROCS LEFT. IF */ 27770000 * /* SO, CONTINUE WITH THE NEXT ACCTNMBR. */ 27780000 * IF UADSASUB = 0 27790000 * THEN /* NO PROCS LEFT, */ 27800000 @9BC SR @F,@F 0570 27810000 C @F,4(0,@2) 0570 27820000 * GOTO CHMRG4; /* CONTINUE WITH NEXT ACCTNMBR*/ 27830000 BC 08,CHMRG4 0571 27840000 * /* REF THE 1ST PROCNAME OBLK UNDER THIS ACCTNMBR. */ 27850000 * DROBPTR = HEDBPTR+UADSASUB; 27860000 L @3,4(0,@2) 0572 27870000 AR @3,@4 0572 27880000 * CHMRG3: /* FIND THE END OF THIS PROCNAME CHAIN & SET THE CHAIN */ 27890000 * /* FLAG TO '0'B. THIS MERGES IT WITH THE NEXT CHAIN. */ 27900000 * IF FLGR01 = '0'B /* END OF CHAIN? */ 27910000 * THEN /* NO, */ 27920000 CHMRG3 TM 0(@3),B'10000000' 0573 27930000 BC 05,@9BB 0573 27940000 * DO; 27950000 * DROBPTR = /* REF THE NEXT PROC BROTHER */ 27960000 * HEDBPTR+UADSRNEX; 27970000 MVC @TEMP3+1(3),1(@3) 0575 27980000 L @F,@TEMP3 0575 27990000 AR @F,@4 0575 28000000 LR @3,@F 0575 28010000 * GOTO CHMRG3; /* CONTINUE UNTIL END OF CHAIN 28020000 * IS FOUND */ 28030000 BC 15,CHMRG3 0576 28040000 * END; 28050000 * FLGR01 = '0'B; /* SET CHAIN FLAG TO ZERO */ 28060000 @9BB NI 0(@3),B'01111111' 0578 28070000 * SUBOFS = DROBPTR; /* SAVE ADDR OF THIS OBLK */ 28080000 ST @3,SUBOFS 0579 28090000 * CHMRG4: DNOBPTR = HEDBPTR+UADSANEX; /* REF NEXT ACCTNMBR IN CHAIN */ 28100000 CHMRG4 MVC @TEMP3+1(3),1(@2) 0580 28110000 L @F,@TEMP3 0580 28120000 AR @F,@4 0580 28130000 LR @2,@F 0580 28140000 * /* IF THIS IS THE LAST ACCTNMBR IN THIS LOCAL CHAIN AND */ 28150000 * /* THERE ARE NO PROCS LEFT UNDER IT, THEN THE CHAIN FLAG */ 28160000 * /* IN THE LAST PROC OBLK OF THE PREVIOUS CHAIN MUST BE */ 28170000 * /* SET TO '1'. */ 28180000 * IF AFLG01 = '1'B /* LAST ACCTNMBR IN LOC CHAIN?*/ 28190000 * THEN /* YES, */ 28200000 TM 0(@2),B'10000000' 0581 28210000 BC 12,@9BA 0581 28220000 * /* ANY PROCS LEFT UNDER THIS ACCTNMBR? */ 28230000 * IF UADSASUB = 0 28240000 * THEN /* NO, */ 28250000 SR @F,@F 0582 28260000 C @F,4(0,@2) 0582 28270000 BC 07,@9B9 0582 28280000 * DO; 28290000 * DROBPTR = SUBOFS; /* REF LAST EXISTING PROC */ 28300000 L @3,SUBOFS 0584 28310000 * FLGR01 = '1'B; /* SET ITS CHAIN FLAG TO '1' TO 28320000 * INDICATE END OF CHAIN */ 28330000 OI 0(@3),B'10000000' 0585 28340000 * END; 28350000 * GOTO CHMRG2; /* GO CHECK WHERE TO CONTINUE */ 28360000 BC 15,CHMRG2 0587 28370000 * 28380000 * ACNEXT2: /* DETERMINE WHERE PROCESSING IS TO CONTINUE. IF THERE ARE*/ 28390000 * /* MORE PASSWORDS TO BE PROCESSED IN THIS TREE, THEN */ 28400000 * /* REFERENCE THE NEXT PASSWORD AND CONTINUE. IF NOT, THEN */ 28410000 * /* RETURN TO IKJEFA20 TO WRITE THIS TREE INTO THE UADS. */ 28420000 * 28430000 **/*ACNEXT2: D (NO,CHGEOK,YES,) MORE PASSWDS? */ 28440000 **/* P (,CHALLAC) REF NEXT PASSWORD OFFSET BLOCK */ 28450000 * DPOBPTR = NLPWOBAD; /* REF PASSWORD JUST PROCESSED*/ 28460000 ACNEXT2 MVC DPOBPTR(4),NLPWOBAD 0588 28470000 * /* IF A PASSWORD WAS SPECIFIED, OR THERE ARE NO MORE PASS-*/ 28480000 * /* WORDS IN THE CHAIN, THEN ALL NECESSARY CHANGES HAVE */ 28490000 * /* BEEN MADE TO THIS TREE. */ 28500000 * IF PASSWD(1) ª= '*' /* PASSWORD SPECIFIED? */ 28510000 * ³ PFLG01 = '1'B /* OR END OF CHAIN? */ 28520000 * THEN /* YES, ONE OF THE ABOVE */ 28530000 L @5,NODELADR 0589 28540000 CLI 8(@5),C'*' 0589 28550000 BC 07,@9B8 0589 28560000 L @8,DPOBPTR 0589 28570000 TM 0(@8),B'10000000' 0589 28580000 BC 12,@9B7 0589 28590000 * GOTO CHGEOK; /* GO SET INDICATORS & RETURN */ 28600000 BC 03,CHGEOK 0590 28610000 * DPOBPTR = HEDBPTR+UADSPNEX; /* REF THE NEXT PASSWD OBLK */ 28620000 @9B7 L @5,DPOBPTR 0591 28630000 MVC @TEMP3+1(3),1(@5) 0591 28640000 L @F,@TEMP3 0591 28650000 AR @F,@4 0591 28660000 ST @F,DPOBPTR 0591 28670000 * NLPWOBAD = DPOBPTR; /* SAVE ADDR OF THIS OBLK */ 28680000 MVC NLPWOBAD(4),DPOBPTR 0592 28690000 * GOTO CHALLAC; /* CONTINUE UNDER NEXT PASSWRD*/ 28700000 BC 15,CHALLAC 0593 28710000 * 28720000 **/*CHGEOK: P INDICATE SUCCESSFUL COMPLETION */ 28730000 * CHGEOK: /* THIS TREE HAS BEEN CHANGED SUCCESSFULLY. SET APPROPRI- */ 28740000 * /* ATE INDICATORS AND RETURN TO CHANGE (IKJEFA20). */ 28750000 * MSGNMBR = 0; /* ALL REQUIRED CHANGES TO THIS 28760000 * TREE HAVE BEEN MADE */ 28770000 CHGEOK SR @F,@F 0594 28780000 L @5,CTABPTR 0594 28790000 STH @F,32(0,@5) 0594 28800000 **/*%RTRN: R RETURN TO CHANGE CP */ 28810000 * WORKEND: /* THIS ROUTINE HAS COMPLETED PROCESSING. RETURN TO */ 28820000 * /* CHANGE (IKJEFA20) WITH EITHER A REQUEST TO WRITE THIS */ 28830000 * /* TREE BACK INTO THE UADS, OR A REQUEST TO PERFORM */ 28840000 * /* ANOTHER SEARCH, OR A REQUEST TO ISSUE AN ERROR MESSAGE.*/ 28850000 * RETURN; 28860000 BC 15,@EL01 0595 28870000 * 28880000 * /**********************************************************/ 28890000 * /* */ 28900000 * /* SUBROUTINES */ 28910000 * /* */ 28920000 * /**********************************************************/ 28930000 * 28940000 **/* E DLACLS */ 28950000 * DLACLS: /**********************************************************/ 28960000 * /* THIS SUBROUTINE WILL SEARCH FOR AN ACCTNMBR IN A */ 28970000 * /* LOCAL ACCTNMBR CHAIN. */ 28980000 * /**********************************************************/ 28990000 * 29000000 * PROCEDURE OPTIONS(NOSAVEAREA,DONTSAVE); 29010000 @EL01 L @D,4(0,@D) 0596 29020000 LR @1,@C 0596 29030000 L @0,@SIZ001 0596 29040000 FREEMAIN R,LV=(0),A=(1) 0596 29050000 L @E,12(0,@D) 0596 29060000 LM @0,@C,20(@D) 0596 29070000 BCR 15,@E 0596 29080000 DLACLS EQU * 0596 29090000 * GEN(ST @E,SAVE14); /* SAVE REGISTER 14 */ 29100000 ST @E,SAVE14 29110000 DS 0H 29120000 * RESTRICT(HEDBPTR,DNOBPTR); 29130000 **/* P CODE TO SEARCH A LOCAL CHAIN FOR THE NEW ACTNBR */ 29140000 **/*%ACLS1: D (NO,%ACLS2,YES,) NEW ACTNBR FOUND? */ 29150000 * DLACLS1: /* BEGINNING OF THE SEARCH LOOP (LOCAL CHAIN). */ 29160000 * UADSAPTR = HEDBPTR+UADSADAT;/* REF ACCTNMBR DATAFLD */ 29170000 DLACLS1 L @F,8(0,@2) 0599 29180000 AR @F,@4 0599 29190000 ST @F,UADSAPTR 0599 29200000 * /* COMPARE LENGTH OF THE NEW ACCTNMBR TO LENGTH OF UADS */ 29210000 * /* ACCTNMBR. AFTER FINDING TWO EQUAL LENGTHS, COMPARE THE */ 29220000 * /* ACCOUNT NUMBERS. */ 29230000 * IF DATALNG3 = UADSALEN 29240000 * THEN /* LENGTHS ARE EQUAL */ 29250000 LR @1,@F 0600 29260000 SR @F,@F 0600 29270000 IC @F,44(0,@1) 0600 29280000 L @3,CHNPDLAD 0600 29290000 CH @F,68(0,@3) 0600 29300000 BC 07,@9B6 0600 29310000 * /* COMPARE THE NEW ACCTNMBR TO THE UADS ACCTNMBR */ 29320000 * IF UADSANUM(1:UADSALEN) 29330000 * = DLITEM(1:UADSALEN) 29340000 * THEN /* THE NEW ACCTNMBR EXISTS IN 29350000 * THE LOCAL CHAIN. */ 29360000 L @5,CHNPDLAD 0601 29370000 L @5,64(0,@5) CHNGPDL 0601 29380000 LR @E,@5 0601 29390000 SR @8,@8 0601 29400000 IC @8,44(0,@1) 0601 29410000 BCTR @8,0 0601 29420000 LA @A,45(0,@1) 0601 29430000 EX @8,@CLC 0601 29440000 BC 07,@9B5 0601 29450000 * DO; 29460000 * ACTWIN2 = DNOBPTR;/* SAVE ADDR OF THIS OBLK */ 29470000 ST @2,ACTWIN2 0603 29480000 * GOTO LSRTN; /* GO BACK TO POINT OF CALL */ 29490000 BC 15,LSRTN 0604 29500000 * END; 29510000 **/* P (,%ACRTN) SET PTR TO ITS OFSBLK */ 29520000 **/*%ACLS2: D (YES,%ACLS1,NO,) MORE ACTNBRS IN CHAIN? */ 29530000 **/* P INDICATE NEW ACTNBR NOT FOUND */ 29540000 * /* THE NEW ACCTNMBR HAS NOT BEEN FOUND YET. IF THERE */ 29550000 * /* ARE MORE ACCTNMBRS IN THIS CHAIN, THEN CONTINUE THE */ 29560000 * /* SEARCH. */ 29570000 * IF AFLG01 = '0'B /* ANY BROTHERS? */ 29580000 * THEN /* YES, */ 29590000 @9B5 EQU * 0606 29600000 @9B6 TM 0(@2),B'10000000' 0606 29610000 BC 05,@9B4 0606 29620000 * DO; 29630000 * DNOBPTR = HEDBPTR /* REF NEXT ACCTNMBR OBLK */ 29640000 * +UADSANEX; 29650000 MVC @TEMP3+1(3),1(@2) 0608 29660000 L @F,@TEMP3 0608 29670000 AR @F,@4 0608 29680000 LR @2,@F 0608 29690000 * GOTO DLACLS1; /* CONTINUE THE SEARCH */ 29700000 BC 15,DLACLS1 0609 29710000 * END; 29720000 * /* THE NEW ACCTNMBR DOES NOT EXIST IN THIS LOCAL CHAIN. */ 29730000 * ACTWIN2 = 0; /* 0- ACCTNMBR NOT FOUND */ 29740000 @9B4 SR @F,@F 0611 29750000 ST @F,ACTWIN2 0611 29760000 * LSRTN: /*RESTORE REGISTER 14 AND RETURN. */ 29770000 * GEN(L @E,SAVE14); /* RESTORE REGISTER 14 */ 29780000 LSRTN L @E,SAVE14 29790000 DS 0H 29800000 **/*%ACRTN: R RETURN TO POINT OF CALL */ 29810000 **/*DLACLS: END */ 29820000 * END DLACLS; /* GO BACK TO POINT OF CALL */ 29830000 @EL02 BCR 15,@E 0613 29840000 * 29850000 * 29860000 **/* E DLACTS */ 29870000 * DLACTS: /**********************************************************/ 29880000 * /* THIS SUBROUTINE WILL SEARCH FOR AN ACCTNMBR IN THE */ 29890000 * /* TOTAL LATERAL CHAIN. */ 29900000 * /**********************************************************/ 29910000 * 29920000 * PROCEDURE OPTIONS(NOSAVEAREA,DONTSAVE); 29930000 DLACTS EQU * 0614 29940000 * GEN(ST @E,SAVE14); /* SAVE REGISTER 14 */ 29950000 ST @E,SAVE14 29960000 DS 0H 29970000 * RESTRICT(HEDBPTR,DNOBPTR); 29980000 * DPOBPTR = HEDBPTR+UADSPWD1; /* REF THE 1ST PASSWORD OBLK */ 29990000 L @F,24(0,@4) 0617 30000000 AR @F,@4 0617 30010000 ST @F,DPOBPTR 0617 30020000 * DNOBPTR = HEDBPTR+UADSPSUB; /* REF THE 1ST PROCNAME OBLK */ 30030000 LR @1,@F 0618 30040000 L @2,4(0,@1) 0618 30050000 AR @2,@4 0618 30060000 **/* P CODE TO SEARCH THE TOTAL CHAIN FOR THE NEW ACTNBR */ 30070000 **/*%ACTS2: D (NO,%ACTS3,YES,) NEW ACTNBR FOUND? */ 30080000 * DLACTS2: /* BEGINNING OF THE SEARCH LOOP. */ 30090000 * UADSAPTR = HEDBPTR+UADSADAT;/* REF THE ACCTNMBR DATAFLD */ 30100000 DLACTS2 L @F,8(0,@2) 0619 30110000 AR @F,@4 0619 30120000 ST @F,UADSAPTR 0619 30130000 * /* IS THIS LENGTH EQUAL TO THE DATALIST ACCTNMBR LENGTH? */ 30140000 * IF DATALNG3 = UADSALEN 30150000 * THEN /* YES, LENGTHS ARE EQUAL */ 30160000 LR @1,@F 0620 30170000 SR @F,@F 0620 30180000 IC @F,44(0,@1) 0620 30190000 L @3,CHNPDLAD 0620 30200000 CH @F,68(0,@3) 0620 30210000 BC 07,@9B3 0620 30220000 * /* COMPARE THE DATALIST ACCTNMBR TO THE UADS ACCTNMBR */ 30230000 * IF UADSANUM(1:UADSALEN) 30240000 * = DLITEM(1:UADSALEN) 30250000 * THEN /* THE DATALIST ACCTNMBR EXISTS 30260000 * IN THIS COUSIN CHAIN */ 30270000 L @5,CHNPDLAD 0621 30280000 L @5,64(0,@5) CHNGPDL 0621 30290000 LR @E,@5 0621 30300000 SR @8,@8 0621 30310000 IC @8,44(0,@1) 0621 30320000 BCTR @8,0 0621 30330000 LA @A,45(0,@1) 0621 30340000 EX @8,@CLC 0621 30350000 BC 07,@9B2 0621 30360000 * DO; 30370000 * CSNPTR = DNOBPTR; /* SAVE ADDR OF THIS OBLK */ 30380000 ST @2,CSNPTR 0623 30390000 * RDATSAVE = UADSADAT;/* SAVE OFFSET TO THIS DFLD */ 30400000 MVC RDATSAVE(4),8(@2) 0624 30410000 * NDFPTR = UADSAPTR;/* SAVE ADDR OF THIS DATAFLD */ 30420000 MVC NDFPTR(4),UADSAPTR 0625 30430000 * GOTO TSRTN; /* GO BACK TO POINT OF CALL */ 30440000 BC 15,TSRTN 0626 30450000 * END; 30460000 **/* P (,%TSRTN) SET PTR TO ITS OFFSET BLOCK */ 30470000 **/*%ACTS3: D (YES,%ACTS2,NO,) MORE ACTNBRS IN TOT CHAIN? */ 30480000 **/* P INDICATE NEW ACTNBR NOT IN THIS TREE */ 30490000 * /* THE DESIRED ACCTNMBR HAS NOT BEEN FOUND YET. IF THERE */ 30500000 * /* ARE MORE ACCTNMBRS IN THE TOTAL CHAIN, THEN CONTINUE */ 30510000 * /* THE SEARCH. */ 30520000 * IF UADSANEX ª= 0 /* MORE ACCTNMBRS? */ 30530000 * THEN /* YES, */ 30540000 @9B2 EQU * 0628 30550000 @9B3 SR @F,@F 0628 30560000 MVC @TEMP3+1(3),1(@2) 0628 30570000 C @F,@TEMP3 0628 30580000 BC 08,@9B1 0628 30590000 * DO; 30600000 * DNOBPTR = HEDBPTR /* REF NEXT ACCTNMBR OBLK */ 30610000 * +UADSANEX; 30620000 MVC @TEMP3+1(3),1(@2) 0630 30630000 L @F,@TEMP3 0630 30640000 AR @F,@4 0630 30650000 LR @2,@F 0630 30660000 * GOTO DLACTS2; /* COUNTINUE THE SEARCH */ 30670000 BC 15,DLACTS2 0631 30680000 * END; 30690000 * CSNPTR = 0; /* 0- ACCTNMBR NOT FOUND */ 30700000 @9B1 SR @F,@F 0633 30710000 ST @F,CSNPTR 0633 30720000 * TSRTN: /*RESTORE REGISTER 14 AND RETURN. */ 30730000 * GEN(L @E,SAVE14); /* RESTORE REGISTER 14 */ 30740000 TSRTN L @E,SAVE14 30750000 DS 0H 30760000 **/*%TSRTN: R RETURN TO POINT OF CALL */ 30770000 **/*DLACTS: END */ 30780000 * END DLACTS; /* RETURN TO POINT OF CALL */ 30790000 @EL03 BCR 15,@E 0635 30800000 * 30810000 * 30820000 **/* E IKJFRSP */ 30830000 * IKJFRSP: /**********************************************************/ 30840000 * /* THIS SUBROUTINE WILL INTERFACE WITH THE FREESPACE */ 30850000 * /* ROUTINE (IKJEFA54) AND CHECK ITS RETURN CODE. IF */ 30860000 * /* FREESPACE WAS SUCCESSFUL, CONTROL WILL BE PASSED BACK */ 30870000 * /* TO THE POINT OF CALL. IF NOT, CONTROL WILL BE RETURNED */ 30880000 * /* TO THE CHANGE CP (IKJEFA20) WHICH WILL ISSUE THE */ 30890000 * /* APPROPRIATE ERROR MESSAGE. */ 30900000 * /**********************************************************/ 30910000 * 30920000 * PROCEDURE OPTIONS(NOSAVEAREA,DONTSAVE); 30930000 IKJFRSP EQU * 0636 30940000 * GEN(ST @E,SAVE14); /* SAVE REGISTER 14 */ 30950000 ST @E,SAVE14 30960000 DS 0H 30970000 * RESTRICT (R1); 30980000 * R1 = ADDR(GETFREE); /* PTR TO FREESPACE PARMLIST */ 30990000 LA @1,GETFREE 0639 31000000 **/* S IKJEFA54: FREE OFFSET BLK OR DATAFLD */ 31010000 * CALL IKJEFA54; /* GO TO THE FREESPACE ROUTINE*/ 31020000 L @F,@V2 ADDRESS OF IKJEFA54 0640 31030000 BALR @E,@F 0640 31040000 * RETCODE = R15; /* SAVE THE RETURN CODE */ 31050000 L @8,CTABPTR 0641 31060000 ST @F,36(0,@8) 0641 31070000 **/* D (YES,%FRRTN,NO,) FREESPACE SUCCESSFUL? */ 31080000 **/* P (,%RTRN) SET ERROR MSGNMBR */ 31090000 * /* CHECK THE FREESPACE RETURN CODE. */ 31100000 * IF RETCODE ª= 0 31110000 * THEN /* FREESPACE UNSUCCESSFUL */ 31120000 SR @F,@F 0642 31130000 C @F,36(0,@8) 0642 31140000 BC 08,@9B0 0642 31150000 * DO; 31160000 * MSGNMBR = 25; /* SET ERROR MSG NUMBER */ 31170000 LA @F,25 0644 31180000 STH @F,32(0,@8) 0644 31190000 * GOTO WORKEND; /* CHANGE CP WILL ISSUE THE 31200000 * ERROR MSG & CONTINUE WITH 31210000 * THE NEXT USERID, IF ANY */ 31220000 BC 15,WORKEND 0645 31230000 * END; 31240000 * ELSE; /* FREESPACE WAS SUCCESSFUL */ 31250000 @9B0 EQU * 0647 31260000 * GEN(L @E,SAVE14); /* RESTORE REGISTER 14 */ 31270000 @9AF EQU * 0648 31280000 L @E,SAVE14 31290000 DS 0H 31300000 **/*%FRRTN: R RETURN TO POINT OF CALL */ 31310000 * RETURN; /* GO BACK TO POINT OF CALL */ 31320000 **/*IKJFRSP: END */ 31330000 * END IKJFRSP; 31340000 @EL04 BCR 15,@E 0650 31350000 * 31360000 **/*IKJEFA22: END */ 31370000 * END IKJEFA22 31380000 * /* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. 31390000 * /*%INCLUDE SYSLIB (IKJEFUAD) 31400000 * ; 31410000 @DATA1 EQU * 31420000 @0 EQU 00 EQUATES FOR REGISTERS 0-15 31430000 @1 EQU 01 31440000 @2 EQU 02 31450000 @3 EQU 03 31460000 @4 EQU 04 31470000 @5 EQU 05 31480000 @6 EQU 06 31490000 @7 EQU 07 31500000 @8 EQU 08 31510000 @9 EQU 09 31520000 @A EQU 10 31530000 @B EQU 11 31540000 @C EQU 12 31550000 @D EQU 13 31560000 @E EQU 14 31570000 @F EQU 15 31580000 @D1 DC F'0' 31590000 @D2 DC H'-1' 31600000 @D3 DC H'45' 31610000 @CLC CLC 0(1,@A),0(@E) 31620000 @MVC MVC 0(1,@A),0(@E) 31630000 @V1 DC V(IKJEFA53) 31640000 @V2 DC V(IKJEFA54) 31650000 DS 0F 31660000 @SIZ001 DC AL1(&SPN) 31670000 DC AL3(@DATEND-@DATD) 31680000 DS 0F 31690000 @C5 DC C'* ' 31700000 DS 0D 31710000 @DATA EQU * 31720000 DUMR1 EQU 00000000 FULLWORD INTEGER 31730000 CTRLTAB EQU 00000000 44 BYTE(S) ON WORD 31740000 ACTPLADR EQU CTRLTAB+00000000 FULLWORD POINTER 31750000 CHPDLPTR EQU CTRLTAB+00000004 FULLWORD POINTER 31760000 NODELPTR EQU CTRLTAB+00000008 FULLWORD POINTER 31770000 A00000 EQU CTRLTAB+00000012 FULLWORD POINTER 31780000 BLKCNT EQU CTRLTAB+00000012 1 BYTE POINTER 31790000 HEADADDR EQU CTRLTAB+00000013 3 BYTE POINTER ON WORD+1 31800000 PASSADDR EQU CTRLTAB+00000016 FULLWORD POINTER 31810000 ACCTADDR EQU CTRLTAB+00000020 FULLWORD POINTER 31820000 PROCADDR EQU CTRLTAB+00000024 FULLWORD POINTER 31830000 CHLEVL EQU CTRLTAB+00000028 HALFWORD POINTER 31840000 SRCHIND EQU CTRLTAB+00000030 HALFWORD POINTER 31850000 MSGNMBR EQU CTRLTAB+00000032 HALFWORD POINTER 31860000 TRCHGE EQU CTRLTAB+00000034 HALFWORD POINTER 31870000 RETCODE EQU CTRLTAB+00000036 FULLWORD INTEGER 31880000 VCHKCODE EQU CTRLTAB+00000040 FULLWORD INTEGER 31890000 NLSTTAB EQU 00000000 72 BYTE(S) ON WORD 31900000 A00001 EQU NLSTTAB+00000000 8 BYTE(S) 31910000 PASSWD EQU NLSTTAB+00000008 8 BYTE(S) 31920000 ACCTNO EQU NLSTTAB+00000016 40 BYTE(S) 31930000 PROCNM EQU NLSTTAB+00000056 8 BYTE(S) 31940000 A00002 EQU NLSTTAB+00000064 HALFWORD POINTER 31950000 PWLEN EQU NLSTTAB+00000066 HALFWORD POINTER 31960000 ACTLEN EQU NLSTTAB+00000068 HALFWORD POINTER 31970000 PRLEN EQU NLSTTAB+00000070 HALFWORD POINTER 31980000 CHNGPDL EQU 00000000 88 BYTE(S) ON WORD 31990000 A00003 EQU CHNGPDL+00000000 24 BYTE(S) 32000000 SIZENBR EQU CHNGPDL+00000024 16 BIT(S) 32010000 UNITNBR EQU CHNGPDL+00000026 16 BIT(S) 32020000 DATANBR EQU CHNGPDL+00000028 16 BIT(S) 32030000 A00004 EQU CHNGPDL+00000030 16 BIT(S) 32040000 MAXSUBF EQU CHNGPDL+00000032 8 BYTE(S) ON WORD 32050000 MAXSADR EQU CHNGPDL+00000032 FULLWORD POINTER 32060000 MAXSLNG EQU CHNGPDL+00000036 HALFWORD INTEGER 32070000 MAXSFLGS EQU CHNGPDL+00000038 16 BIT(S) 32080000 MAXSFLG EQU CHNGPDL+00000038 1 BIT(S) 32090000 SIZSUBF EQU CHNGPDL+00000040 8 BYTE(S) ON WORD 32100000 RSIZADR EQU CHNGPDL+00000040 FULLWORD POINTER 32110000 RSIZLNG EQU CHNGPDL+00000044 HALFWORD INTEGER 32120000 RSIZFLGS EQU CHNGPDL+00000046 16 BIT(S) 32130000 RSIZFLG EQU CHNGPDL+00000046 1 BIT(S) 32140000 UNITSUBF EQU CHNGPDL+00000048 8 BYTE(S) ON WORD 32150000 UNITADR EQU CHNGPDL+00000048 FULLWORD POINTER 32160000 UNITLNG EQU CHNGPDL+00000052 HALFWORD INTEGER 32170000 UNITFLGS EQU CHNGPDL+00000054 16 BIT(S) 32180000 UNITFLG EQU CHNGPDL+00000054 1 BIT(S) 32190000 PROCSUBF EQU CHNGPDL+00000056 8 BYTE(S) ON WORD 32200000 DLPTR4 EQU CHNGPDL+00000056 FULLWORD POINTER 32210000 DATALNG4 EQU CHNGPDL+00000060 HALFWORD INTEGER 32220000 A00005 EQU CHNGPDL+00000062 16 BIT(S) 32230000 DLFLG4 EQU CHNGPDL+00000062 1 BIT(S) 32240000 ACCTSUBF EQU CHNGPDL+00000064 8 BYTE(S) ON WORD 32250000 DLPTR3 EQU CHNGPDL+00000064 FULLWORD POINTER 32260000 DATALNG3 EQU CHNGPDL+00000068 HALFWORD INTEGER 32270000 A00006 EQU CHNGPDL+00000070 16 BIT(S) 32280000 DLFLG3 EQU CHNGPDL+00000070 1 BIT(S) 32290000 PASSSUBF EQU CHNGPDL+00000072 8 BYTE(S) ON WORD 32300000 DLPTR2 EQU CHNGPDL+00000072 FULLWORD POINTER 32310000 DATALNG2 EQU CHNGPDL+00000076 HALFWORD INTEGER 32320000 A00007 EQU CHNGPDL+00000078 16 BIT(S) 32330000 DLFLG2 EQU CHNGPDL+00000078 1 BIT(S) 32340000 USIDSUBF EQU CHNGPDL+00000080 8 BYTE(S) ON WORD 32350000 DLPTR1 EQU CHNGPDL+00000080 FULLWORD POINTER 32360000 DATALNG1 EQU CHNGPDL+00000084 HALFWORD INTEGER 32370000 A00008 EQU CHNGPDL+00000086 16 BIT(S) 32380000 DLFLG1 EQU CHNGPDL+00000086 1 BIT(S) 32390000 DLITEM EQU 00000000 40 BYTE(S) 32400000 R1 EQU 00000001 FULLWORD POINTER REGISTER 32410000 R15 EQU 00000015 FULLWORD POINTER REGISTER 32420000 HEDBPTR EQU 00000004 FULLWORD POINTER REGISTER 32430000 DNOBPTR EQU 00000002 FULLWORD POINTER REGISTER 32440000 DROBPTR EQU 00000003 FULLWORD POINTER REGISTER 32450000 DHED EQU 00000000 28 BYTE(S) ON WORD 32460000 UADSMHDR EQU DHED+00000000 14 BYTE(S) ON WORD 32470000 UADSBLNG EQU DHED+00000000 2 BYTE POINTER 32480000 UADSFSQP EQU DHED+00000002 2 BYTE POINTER 32490000 UADSUSER EQU DHED+00000004 8 BYTE(S) 32500000 UADSUSID EQU DHED+00000004 7 BYTE(S) 32510000 UADSIND1 EQU DHED+00000011 1 BYTE POINTER 32520000 UADSBN01 EQU DHED+00000012 1 BYTE POINTER 32530000 UADSBN02 EQU DHED+00000013 1 BYTE(S) 32540000 UADSNUSP EQU DHED+00000013 1 BIT(S) 32550000 A00009 EQU DHED+00000013 1 BIT(S) 32560000 A00010 EQU DHED+00000013 1 BIT(S) 32570000 A00011 EQU DHED+00000013 1 BIT(S) 32580000 A00012 EQU DHED+00000013 1 BIT(S) 32590000 A00013 EQU DHED+00000013 1 BIT(S) 32600000 A00014 EQU DHED+00000013 1 BIT(S) 32610000 A00015 EQU DHED+00000013 1 BIT(S) 32620000 UADSMAXC EQU DHED+00000014 2 BYTE POINTER 32630000 UADSATTR EQU DHED+00000016 4 BYTE(S) 32640000 UADSIBMT EQU DHED+00000016 2 BYTE(S) 32650000 A00016 EQU DHED+00000016 1 BYTE(S) 32660000 USATR00 EQU DHED+00000016 1 BIT(S) 32670000 USATR01 EQU DHED+00000016 1 BIT(S) 32680000 USATR02 EQU DHED+00000016 1 BIT(S) 32690000 A00017 EQU DHED+00000016 1 BIT(S) 32700000 A00018 EQU DHED+00000016 1 BIT(S) 32710000 A00019 EQU DHED+00000016 1 BIT(S) 32720000 A00020 EQU DHED+00000016 1 BIT(S) 32730000 A00021 EQU DHED+00000016 1 BIT(S) 32740000 A00022 EQU DHED+00000017 1 BYTE(S) 32750000 UADSINST EQU DHED+00000018 2 BYTE(S) 32760000 A00023 EQU DHED+00000018 1 BYTE(S) 32770000 A00024 EQU DHED+00000019 1 BYTE(S) 32780000 UADSUPTP EQU DHED+00000020 FULLWORD POINTER 32790000 UADSPWD1 EQU DHED+00000024 FULLWORD POINTER 32800000 DPOB EQU 00000000 12 BYTE(S) ON WORD 32810000 UADSPFLG EQU DPOB+00000000 1 BYTE(S) 32820000 PFLG01 EQU DPOB+00000000 1 BIT(S) 32830000 A00025 EQU DPOB+00000000 1 BIT(S) 32840000 A00026 EQU DPOB+00000000 1 BIT(S) 32850000 A00027 EQU DPOB+00000000 1 BIT(S) 32860000 A00028 EQU DPOB+00000000 1 BIT(S) 32870000 A00029 EQU DPOB+00000000 1 BIT(S) 32880000 A00030 EQU DPOB+00000000 1 BIT(S) 32890000 A00031 EQU DPOB+00000000 1 BIT(S) 32900000 UADSPNEX EQU DPOB+00000001 3 BYTE POINTER 32910000 UADSPSUB EQU DPOB+00000004 FULLWORD POINTER 32920000 UADSPDAT EQU DPOB+00000008 FULLWORD POINTER 32930000 DNOB EQU 00000000 12 BYTE(S) ON WORD 32940000 UADSAFLG EQU DNOB+00000000 1 BYTE(S) 32950000 AFLG01 EQU DNOB+00000000 1 BIT(S) 32960000 A00032 EQU DNOB+00000000 1 BIT(S) 32970000 A00033 EQU DNOB+00000000 1 BIT(S) 32980000 A00034 EQU DNOB+00000000 1 BIT(S) 32990000 A00035 EQU DNOB+00000000 1 BIT(S) 33000000 A00036 EQU DNOB+00000000 1 BIT(S) 33010000 A00037 EQU DNOB+00000000 1 BIT(S) 33020000 A00038 EQU DNOB+00000000 1 BIT(S) 33030000 UADSANEX EQU DNOB+00000001 3 BYTE POINTER 33040000 UADSASUB EQU DNOB+00000004 FULLWORD POINTER 33050000 UADSADAT EQU DNOB+00000008 FULLWORD POINTER 33060000 DROB EQU 00000000 12 BYTE(S) ON WORD 33070000 UADSRFLG EQU DROB+00000000 1 BYTE(S) 33080000 FLGR01 EQU DROB+00000000 1 BIT(S) 33090000 A00039 EQU DROB+00000000 1 BIT(S) 33100000 A00040 EQU DROB+00000000 1 BIT(S) 33110000 A00041 EQU DROB+00000000 1 BIT(S) 33120000 A00042 EQU DROB+00000000 1 BIT(S) 33130000 A00043 EQU DROB+00000000 1 BIT(S) 33140000 A00044 EQU DROB+00000000 1 BIT(S) 33150000 A00045 EQU DROB+00000000 1 BIT(S) 33160000 UADSRNEX EQU DROB+00000001 3 BYTE POINTER 33170000 UADSRSUB EQU DROB+00000004 FULLWORD POINTER 33180000 UADSRDAT EQU DROB+00000008 FULLWORD POINTER 33190000 DPOBD EQU 00000000 12 BYTE(S) ON WORD 33200000 UADSPCTR EQU DPOBD+00000000 1 BYTE POINTER 33210000 UADSPRES EQU DPOBD+00000001 3 BYTE(S) 33220000 UADSPPWD EQU DPOBD+00000004 8 BYTE(S) 33230000 DNOBD EQU 00000000 85 BYTE(S) ON WORD 33240000 UADSACTR EQU DNOBD+00000000 1 BYTE POINTER 33250000 UADSARES EQU DNOBD+00000001 3 BYTE(S) 33260000 UADSADRF EQU DNOBD+00000004 40 BYTE(S) 33270000 UADSALEN EQU DNOBD+00000044 1 BYTE POINTER 33280000 UADSANUM EQU DNOBD+00000045 40 BYTE(S) 33290000 DROBD EQU 00000000 24 BYTE(S) ON WORD 33300000 UADSRCTR EQU DROBD+00000000 1 BYTE POINTER 33310000 UADSRRES EQU DROBD+00000001 3 BYTE(S) 33320000 UADSRNAM EQU DROBD+00000004 8 BYTE(S) 33330000 UADSRNDS EQU DROBD+00000012 1 BYTE(S) 33340000 UADSRRS2 EQU DROBD+00000013 1 BYTE(S) 33350000 UADSRSIZ EQU DROBD+00000014 2 BYTE POINTER 33360000 UADSUNAM EQU DROBD+00000016 8 BYTE(S) 33370000 DS 00000000C 33380000 @L EQU 3 33390000 @DATD DSECT 33400000 @SAV001 EQU @DATD+00000000 72 BYTE(S) ON WORD 33410000 CTABPTR EQU @DATD+00000072 FULLWORD POINTER 33420000 NODELADR EQU @DATD+00000076 FULLWORD POINTER 33430000 CHNPDLAD EQU @DATD+00000080 FULLWORD POINTER 33440000 DLPWD EQU @DATD+00000084 8 BYTE(S) 33450000 GETFREE EQU @DATD+00000092 12 BYTE(S) ON WORD 33460000 READBUFF EQU GETFREE+00000000 FULLWORD POINTER 33470000 NUMBLOKS EQU GETFREE+00000004 HALFWORD POINTER 33480000 AREALNTH EQU GETFREE+00000006 HALFWORD POINTER 33490000 AREAOFST EQU GETFREE+00000008 FULLWORD POINTER 33500000 SAVE14 EQU @DATD+00000104 FULLWORD POINTER 33510000 NLEVL EQU @DATD+00000108 1 BYTE POINTER 33520000 NLPWOBAD EQU @DATD+00000112 FULLWORD POINTER 33530000 DLPWOBAD EQU @DATD+00000116 FULLWORD POINTER 33540000 OACSAVE EQU @DATD+00000120 FULLWORD POINTER 33550000 RNEXSAVE EQU @DATD+00000124 FULLWORD POINTER 33560000 ANEXSAVE EQU @DATD+00000128 FULLWORD POINTER 33570000 PNEXSAVE EQU @DATD+00000132 FULLWORD POINTER 33580000 ADATSAVE EQU @DATD+00000136 FULLWORD POINTER 33590000 RDATSAVE EQU @DATD+00000140 FULLWORD POINTER 33600000 ODFPTR EQU @DATD+00000144 FULLWORD POINTER 33610000 NDFPTR EQU @DATD+00000148 FULLWORD POINTER 33620000 LASTOB EQU @DATD+00000152 FULLWORD POINTER 33630000 NEWDFPTR EQU @DATD+00000156 FULLWORD POINTER 33640000 PRCOMP EQU @DATD+00000160 8 BYTE(S) 33650000 ACTWIN1 EQU @DATD+00000168 FULLWORD POINTER 33660000 ACTWIN2 EQU @DATD+00000172 FULLWORD POINTER 33670000 PRTWIN1 EQU @DATD+00000176 FULLWORD POINTER 33680000 PRTWIN2 EQU @DATD+00000180 FULLWORD POINTER 33690000 CSNSAVE EQU @DATD+00000184 FULLWORD POINTER 33700000 ACSNOFS EQU @DATD+00000188 FULLWORD POINTER 33710000 CSNPTR EQU @DATD+00000192 FULLWORD POINTER 33720000 PRUNOFS EQU @DATD+00000196 FULLWORD POINTER 33730000 SUBOFS EQU @DATD+00000200 FULLWORD POINTER 33740000 RETPTR EQU @DATD+00000204 FULLWORD POINTER 33750000 CFLAGS EQU @DATD+00000208 1 BYTE(S) 33760000 FLGSAVE EQU CFLAGS+00000000 1 BIT(S) 33770000 FLDFLG EQU CFLAGS+00000000 1 BIT(S) 33780000 ALLACFLG EQU CFLAGS+00000000 1 BIT(S) 33790000 NACDFLG EQU CFLAGS+00000000 1 BIT(S) 33800000 ACPRFLG EQU CFLAGS+00000000 1 BIT(S) 33810000 DPOBPTR EQU @DATD+00000212 FULLWORD POINTER 33820000 UADSPPTR EQU @DATD+00000216 FULLWORD POINTER 33830000 UADSAPTR EQU @DATD+00000220 FULLWORD POINTER 33840000 UADSRPTR EQU @DATD+00000224 FULLWORD POINTER 33850000 DS 00000228C 33860000 @TEMPS DS 0F 33870000 @TEMP3 DC F'0' 33880000 @DATEND EQU * 33890000 IKJEFA22 CSECT , 33900000 @9F6 EQU ACMERGE 33910000 @9E9 EQU @9E8 33920000 @9CB EQU CHGEOK 33930000 @9C6 EQU FREACDF 33940000 @9C5 EQU ACNEXT 33950000 @9BE EQU ACHNPR1 33960000 @9BA EQU CHMRG2 33970000 @9B9 EQU CHMRG2 33980000 @9B8 EQU CHGEOK 33990000 WORKEND EQU @EL01 34000000 END IKJEFA22 34010000 ./ ADD SSI=01013558,NAME=IKJEFA23,SOURCE=1 TITLE ' IKJEFA23 CHANGE SUBCOMMAND - PROCNAME ROUTINE ' 00010000 * /*******************************************************************/ 00020000 * /* */ 00030000 * /* P R O L O G U E FOR I K J E F A 2 3 */ 00040000 * /* CHANGE PROCNAME ROUTINE */ 00050000 * /* */ 00060000 * /* STATUS: */ 00070000 * /* CHANGE LEVEL 000 */ 00080000 * /* PTMS INCLUDED: 2581, 2435, 4226 */ 00090000 * /* CHANGE LEVEL 001 */ 00100000 * /* PTMS INCLUDED: */ 00110000 * /* A 69330,69340 M1859 */ 00120000 * /* D 117820 M1859 */ 00130000 * /* A 80420,717420,718920,804820,806920 21974 */ 00140000 * /* D 42320 21974 */ 00150000 * /* */ 00160000 * /* FUNCTION: */ 00170000 * /* THIS ROUTINE PERFORMS THE ADMINISTRATIVE FUNCTION OF */ 00180000 * /* CHANGING CONTROL INFORMATION FIELDS AT THE PROCNAME */ 00190000 * /* LEVEL OF THE UADS STRUCTURE. */ 00200000 * /* */ 00210000 * /* ENTRY POINTS: */ 00220000 * /* IKJEFA23 - ONLY ENTRY POINT */ 00230000 * /* */ 00240000 * /* INPUT: */ 00250000 * /* REGISTER 1 POINTS TO THE CHANGE CONTROL TABLE: */ 00260000 * /* ³------------------------------------------------------³ */ 00270000 * /* +0 ³ PTR TO THE ACCOUNT PARAMETER LIST ³ */ 00280000 * /* ³------------------------------------------------------³ */ 00290000 * /* +4 ³ PTR TO THE PARAMETER DESCRIPTOR LIST (PDL) ³ */ 00300000 * /* ³------------------------------------------------------³ */ 00310000 * /* +8 ³ PTR TO THE NODELIST TABLE ³ */ 00320000 * /* ³------------³-----------------------------------------³ */ 00330000 * /* +12³ BLKCNT ³ PTR TO THE USERID TREE BUFFER ³ */ 00340000 * /* ³------------³-----------------------------------------³ */ 00350000 * /* +16³ ADDR OF THE NODELIST PASSWORD OFFSET BLOCK ³ */ 00360000 * /* ³------------------------------------------------------³ */ 00370000 * /* +20³ ADDR OF THE NODELIST ACCTNMBR OFFSET BLOCK ³ */ 00380000 * /* ³------------------------------------------------------³ */ 00390000 * /* +24³ ADDR OF THE NODELIST PROCNAME OFFSET BLOCK ³ */ 00400000 * /* ³--------------------------³---------------------------³ */ 00410000 * /* +28³ CHANGE LEVEL ³ SEARCH INDICATOR ³ */ 00420000 * /* ³--------------------------³---------------------------³ */ 00430000 * /* +32³ MESSAGE NUMBER ³ CHANGE INDICATOR ³ */ 00440000 * /* ³--------------------------³---------------------------³ */ 00450000 * /* */ 00460000 * /* OUTPUT: */ 00470000 * /* THREE INDICATORS IN THE CHANGE CONTROL TABLE ARE SET: */ 00480000 * /* . SEARCH INDICATOR - INDICATES WHICH SEARCH LOOP TO RE- */ 00490000 * /* ENTER: 1 - ACCTNMBR, 2 - PROCNAME */ 00500000 * /* . MESSAGE NUMBER - INDICATES SUCCESSFUL COMPLETION OR AN */ 00510000 * /* ERROR CONDITION ENCOUNTERED DURING PROCESSING OF THE */ 00520000 * /* USERID TREE. CHANGE CP WILL ISSUE THE ERROR MESSAGE. */ 00530000 * /* . CHANGE INDICATOR - INDICATES WHETHER ANY CHANGES HAVE */ 00540000 * /* BEEN MADE TO THE TREE. */ 00550000 * /* */ 00560000 * /* EXTERNAL REFERENCES: */ 00570000 * /* . IKJEFA53 - ACCOUNT GETSPACE ROUTINE */ 00580000 * /* . IKJEFA54 - ACCOUNT FREESPACE ROUTINE */ 00590000 * /* */ 00600000 * /* EXITS: */ 00610000 * /* . NORMAL: RETURN TO CHANGE CP (IKJEFA20) */ 00620000 * /* . ERROR: RETURN TO CHANGE CP (IKJEFA20) */ 00630000 * /* */ 00640000 * /* TABLES/WORKAREAS: */ 00650000 * /* . BUFFER FOR THE USERID TREE */ 00660000 * /* . PARAMETER DESCRIPTOR LIST (PDL) */ 00670000 * /* . NODELIST TABLE (NLSTTAB) */ 00680000 * /* . CHANGE CONTROL TABLE (CTRLTAB) */ 00690000 * /* */ 00700000 * /* ATTRIBUTES: */ 00710000 * /* REENTRANT, REFRESHABLE */ 00720000 * /* */ 00730000 * /* NOTES: */ 00740000 * /* . CHARACTER DEPENDENCY - CLASS C */ 00750000 * /* THE OPERATION OF THIS MODULE DEPENDS UPON AN INTERNAL RE- */ 00760000 * /* PRESENTATION OF THE EXTERNAL CHARACTER SET WHICH IS EQUI- */ 00770000 * /* VALENT TO THE ONE USED AT ASSEMBLY TIME. THE CODING HAS */ 00780000 * /* BEEN ARRANGED SO THAT REDEFINITION OF 'CHARACTER' CON- */ 00790000 * /* STANTS, BY REASSEMBLY, WILL RESULT IN A CORRECT MODULE FOR */ 00800000 * /* THE NEW DEFINITIONS. */ 00810000 * /* . RELEASE 20 SUPPORT CODE - 20035 */ 00820000 * /* */ 00830000 * /*******************************************************************/ 00840000 * 00850000 * GENERATE; /* ASSIGN SUBPOOL NUMBER */ 00860000 LCLA &T,&SPN 00870000 &SPN SETA 1 00880000 AGO .@001 00890000 * 00900000 **/*IKJEFA23: CHART */ 00910000 **/*HEADER 00920000 **/*CHANGE PROCNAME ROUTINE - IKJEFA23 00930000 **/* PAGE # 11/11/71 */ 00940000 **/* E IKJEFA23 */ 00950000 * 00960000 * IKJEFA23: 00970000 * PROCEDURE (DUMR1) 00980000 * OPTIONS (REENTRANT, 00990000 * DONTSAVE(15)); 01000000 LCLA &T,&SPN 0002 01010000 .@001 ANOP 0002 01020000 IKJEFA23 CSECT , 0002 01030000 ST @E,12(0,@D) 0002 01040000 STM @0,@C,20(@D) 0002 01050000 BALR @B,0 0002 01060000 @PSTART DS 0H 0002 01070000 USING @PSTART+00000,@B 0002 01080000 L @0,@SIZ001 0002 01090000 GETMAIN R,LV=(0) 0002 01100000 LR @C,@1 0002 01110000 USING @DATD+00000,@C 0002 01120000 LM @0,@1,20(@D) 0002 01130000 XC @TEMPS(@L),@TEMPS 0002 01140000 ST @D,@SAV001+4 0002 01150000 LA @F,@SAV001 0002 01160000 ST @F,8(0,@D) 0002 01170000 LR @D,@F 0002 01180000 * 01190000 * GOTO STCODE; /* BYPASS MODULE IDENTIFICATION*/ 01200000 BC 15,STCODE 0003 01210000 * GENERATE; 01220000 DC CL8'IKJEFA23' MODULE NAME 01230000 DC XL4'11111971' DATE OF LAST CHANGE 01240000 DS 0H 01250000 * 01260000 * 01270000 * DECLARE 01280000 * /* EXTERNAL AND INTERNAL ROUTINES USED BY IKJEFA23. */ 01290000 * IKJEFA53 EXTERNAL ENTRY, /* GETSPACE ROUTINE */ 01300000 * IKJEFA54 EXTERNAL ENTRY, /* FREESPACE ROUTINE */ 01310000 * IKJFRSP INTERNAL ENTRY, /* FREESPACE INTERFACE SUBR*/ 01320000 * DLPRLS INTERNAL ENTRY, /* LOCAL CHAIN SEARCH SUBR */ 01330000 * DLPRTS INTERNAL ENTRY, /* TOTAL CHAIN SEARCH SUBR */ 01340000 * NEWPRDF INTERNAL ENTRY, /* CREATE NEW DATAFLD SUBR */ 01350000 * PRDFCH INTERNAL ENTRY, /* ENTER NEW DATA SUBR */ 01360000 * CTRCHK INTERNAL ENTRY, /* CHCK USE CTR SUBR M2581 */ 01370000 * CMPRND INTERNAL ENTRY; /* COMPARE NEW DATA SUBR */ 01380000 * 01390000 * DECLARE 01400000 * /* CONTROL TABLE BUILT BY CHANGE (IKJEFA20). */ 01410000 * CTABPTR PTR, /* PTR TO THE CONTROL TABLE */ 01420000 * 1 CTRLTAB BASED(CTABPTR), 01430000 * 2 ACTPLADR PTR, /* PTR TO ACCOUNT PARMLIST */ 01440000 * 2 CHPDLPTR PTR, /* PTR TO THE PDL */ 01450000 * 2 NODELPTR PTR, /* PTR TO NODELIST ITEMS */ 01460000 * 2 * PTR, 01470000 * 3 BLKCNT PTR(8), /* NO. OF BLOCKS READ IN */ 01480000 * 3 HEADADDR PTR(24),/* PTR TO THE USER HEADER */ 01490000 * 2 PASSADDR PTR, /* UADS ADDR OF NODELIST PWRD */ 01500000 * 2 ACCTADDR PTR, /* UADS ADDR OF NODELST ACTNO */ 01510000 * 2 PROCADDR PTR, /* UADS ADDR OF NODELST PRNAME*/ 01520000 * 2 CHLEVL PTR(15), /* CHANGE LEVEL */ 01530000 * 2 SRCHIND PTR(15), /* INDICATES TO CHANGE WHICH 01540000 * SEARCH LOOP TO REENTER - 01550000 * ..0 NO FURTHER SEARCH 01560000 * ..1 ACCTNMBR 01570000 * ..2 PROCNAME */ 01580000 * 2 MSGNMBR PTR(15), /* MSG NUMBER SET BY IKJEFA23 */ 01590000 * 2 TRCHGE PTR(15), /* ..0 TREE IS UNCHANGED 01600000 * ..1 TREE HAS BEEN CHANGED */ 01610000 * 2 RETCODE FIXED, /* VARIABLE FOR RETURN CODES */ 01620000 * 2 VCHKCODE FIXED; /* VARIABLE FOR RETURN CODES */ 01630000 * 01640000 * DECLARE 01650000 * /* THE NODELIST, CONSTRUCTED FROM THE PDL BY THE */ 01660000 * /* NODELIST VALIDITY CHECK EXIT ROUTINE IN IKJEFA20 */ 01670000 * 1 NLSTTAB BASED(NODELPTR), 01680000 * 2 * CHAR(8), /* NOT PERTINENT */ 01690000 * 2 PASSWD CHAR(8), /* PASSWORD */ 01700000 * 2 ACCTNO CHAR(40), /* ACCOUNT-NUMBER */ 01710000 * 2 PROCNM CHAR(8), /* PROCEDURE NAME */ 01720000 * 2 * PTR(15), /* NOT PERTINENT */ 01730000 * 2 PWLEN PTR(15), /* LENGTH OF THE PASSWORD */ 01740000 * 2 ACTLEN PTR(15), /* LENGTH OF THE ACCTNMBR */ 01750000 * 2 PRLEN PTR(15); /* LENGTH OF THE PROCNAME */ 01760000 * 01770000 * DECLARE 01780000 * /* THE PARAMETER DESCRIPTOR LIST (PDL). */ 01790000 * CHNPDLAD PTR, /* ADDR OF THE PDL */ 01800000 * 1 CHNGPDL BASED(CHNPDLAD), 01810000 * 2 * CHAR(24), /* NOT PERTINENT TO THIS RTNE */ 01820000 * 2 SIZENBR BIT(16), /* PROCSIZE KEY */ 01830000 * 2 UNITNBR BIT(16), /* UNIT NAME KEY */ 01840000 * 2 DATANBR BIT(16), /* DATALIST KEY */ 01850000 * 2 * BIT(16), /* FILLER */ 01860000 * 2 MAXSUBF, /* PDE FOR MAX REGION SIZE */ 01870000 * 3 MAXSADR PTR, /* PTR TO MAXSIZE INTEGERS */ 01880000 * 3 MAXSLNG FIXED(15),/* LENGTH OF MAXSIZE NUMBER */ 01890000 * 3 MAXSFLGS BIT(16),/* MAXSIZE FLAGS */ 01900000 * 4 MAXSFLG BIT(1),/* BIT1 = 1: PARM PRESENT */ 01910000 * 2 SIZSUBF, /* PDE FOR PROCSIZE */ 01920000 * 3 RSIZADR PTR, /* PTR TO SIZE INTEGERS */ 01930000 * 3 RSIZLNG FIXED(15),/* LENGTH OF SIZE INTEGERS */ 01940000 * 3 RSIZFLGS BIT(16),/* PROCSIZE FLAGS */ 01950000 * 4 RSIZFLG BIT(1),/* BIT1 = 1: PARM PRESENT */ 01960000 * 2 UNITSUBF, /* PDE FOR THE UNIT NAME */ 01970000 * 3 UNITADR PTR, /* PTR TO THE UNIT NAME */ 01980000 * 3 UNITLNG FIXED(15),/* LENGTH OF THE UNIT NAME */ 01990000 * 3 UNITFLGS BIT(16),/* UNIT NAME FLAGS */ 02000000 * 4 UNITFLG BIT(1),/* BIT1 = 1: PARM PRESENT */ 02010000 * 2 PROCSUBF, /* PDE FOR THE DATALIST ITEM 02020000 * (NEW PROCNAME) */ 02030000 * 3 DLPTR4 PTR, /* PTR TO THE DATALIST ITEM */ 02040000 * 3 DATALNG4 FIXED(15),/* LENGTH OF DATALIST ITEM */ 02050000 * 3 * BIT(16), /* DATALIST PDE FLAGS */ 02060000 * 4 DLFLG4 BIT(1),/* BIT1 = 1: PARM PRESENT */ 02070000 * 2 ACCTSUBF, /* PDE FOR THE DATALIST ITEM 02080000 * (NEW ACCTNMBR) */ 02090000 * 3 DLPTR3 PTR, /* PTR TO THE DATALIST ITEM */ 02100000 * 3 DATALNG3 FIXED(15),/* LENGTH OF DATALIST ITEM */ 02110000 * 3 * BIT(16), /* DATALIST PDE FLAGS */ 02120000 * 4 DLFLG3 BIT(1),/* BIT1 = 1: PARM PRESENT */ 02130000 * 2 PASSSUBF, /* PDE FOR THE DATALIST ITEM 02140000 * (NEW PASSWORD) */ 02150000 * 3 DLPTR2 PTR, /* PTR TO THE DATALIST ITEM */ 02160000 * 3 DATALNG2 FIXED(15),/* LENGTH OF DATALIST ITEM */ 02170000 * 3 * BIT(16), /* DATALIST PDE FLAGS */ 02180000 * 4 DLFLG2 BIT(1),/* BIT1 = 1: PARM PRESENT */ 02190000 * 2 USIDSUBF, /* PDE FOR THE DATALIST ITEM 02200000 * (NEW USERID) */ 02210000 * 3 DLPTR1 PTR, /* PTR TO THE DATALIST ITEM */ 02220000 * 3 DATALNG1 FIXED(15),/* LENGTH OF DATALIST ITEM */ 02230000 * 3 * BIT(16), /* DATALIST PDE FLAGS */ 02240000 * 4 DLFLG1 BIT(1);/* BIT1 = 1: PARM PRESENT */ 02250000 * 02260000 * DECLARE 02270000 * /* ITEMS ADDRESSED BY PDL POINTERS. */ 02280000 * DLITEM CHAR(8) /* ITEM IN THE DATA SUBFIELD -*/ 02290000 * BASED(DLPTR4), /* NEW PROCNAME */ 02300000 * PDLUNAM CHAR(8) /* UNIT NAME */ 02310000 * BASED(UNITADR); 02320000 * 02330000 * DECLARE 02340000 * /* WORK VARIABLES FOR PDL ITEMS. */ 02350000 * NEWRSIZ PTR(16), /* NEW PROCEDURE SIZE */ 02360000 * EVENCHK BIT(16) /* SAME AS ABOVE, TO CHECK THE*/ 02370000 * BASED(ADDR(NEWRSIZ)),/* LAST BIT FOR EVEN/ODD NO. */ 02380000 * NEWUNAM CHAR(8), /* NEW UNIT NAME */ 02390000 * DLPROC CHAR(8); /* WORK AREA FOR NEW PROCNAME */ 02400000 * 02410000 * DECLARE 02420000 * /* GETSPACE/FREESPACE (IKJEFA53/54) PARAMETER LIST */ 02430000 * 1 GETFREE, 02440000 * 2 READBUFF PTR, /* ADDR OF USERID TREE BUFFER */ 02450000 * 2 NUMBLOKS PTR(15), /* NO. OF BLOCKS IN BUFFER */ 02460000 * 2 AREALNTH PTR(15), /* SIZE OF AREA TO BE FREED, 02470000 * OR ADDED TO THE TREE */ 02480000 * 2 AREAOFST PTR; /* OFFSET TO THIS AREA, FILLED 02490000 * IN BY GETSPACE OR CALLER OF 02500000 * FREESPACE */ 02510000 * 02520000 * DECLARE 02530000 * /* GENERAL VARIABLES */ 02540000 * R1 REG(1) PTR, /* PTR TO PARAMETER LISTS */ 02550000 * R15 REG(15) PTR, /* RETURN CODES */ 02560000 * SAVE14 PTR, /* SAVE AREA FOR REGISTER 14 */ 02570000 * DECSIZE CHAR(8) /* AREA FOR SIZE VALUE IN.. */ 02580000 * BDY(DWORD), /* PACKED DECIMAL */ 02590000 * LNGTHREG REG(5) PTR, /* WORK REGISTER */ 02600000 * OPWSAVE PTR, /* PTR TO PASSWORD OBLK */ 02610000 * OACSAVE PTR, /* PTR TO ACCTNMBR OBLK */ 02620000 * OPRSAVE PTR, /* PTR TO PROCNAME OBLK */ 02630000 * NPRSAVE PTR, /* SAME AS ABOVE */ 02640000 * RNEXSAVE PTR, /* WORK VARIABLE FOR OBLK OFFS*/ 02650000 * ADATSAVE PTR, /* WORK VARIABLE FOR DATA FIELD 02660000 * OFFSETS */ 02670000 * RDATSAVE PTR, /* SAME AS ABOVE */ 02680000 * ODFPTR PTR, /* PTR TO THE DATA FIELD OF A 02690000 * NODELIST ITEM */ 02700000 * NDFPTR PTR, /* PTR TO THE DATA FIELD OF THE 02710000 * DATALIST ITEM */ 02720000 * LASTOB PTR, /* PTR TO THE LAST OFFSET BLOCK 02730000 * IN A LOCAL CHAIN */ 02740000 * NEWDFPTR PTR, /* PTR TO A NEWLY CREATED 02750000 * DATA FIELD */ 02760000 * FRSTDROB PTR, /* ADDR OF 1ST PROCNAME OFFSET 02770000 * BLOCK IN TOTAL CHAIN */ 02780000 * CSNSAVE PTR, /* OFFSET TO COUSIN OBLK */ 02790000 * PRUNOFS PTR; /* OFFSET TO PRUNED OFFSET BLK*/ 02800000 * 02810000 * DECLARE 02820000 * /* INDICATORS FOR LOOP CONTROL */ 02830000 * 1 CFLAGS CHAR(2), 02840000 * 2 STGFLG BIT(1), /* ..1 SIZE > MAXSIZE */ 02850000 * 2 TREECHG BIT(1), /* ..0 TREE IS UNCHANGED 02860000 * ..1 TREE HAS BEEN CHANGED */ 02870000 * 2 FLGSAVE BIT(1), /* CHAIN FLAG SAVE AREA */ 02880000 * 2 FLDFLG BIT(1), /* FOR CONTROL OF LOGIC FLOW */ 02890000 * 2 FLDFLG2 BIT(1), /* SAME AS ABOVE */ 02900000 * 2 FLDFLG3 BIT(1), /* SAME AS ABOVE */ 02910000 * 2 PRDFLG BIT(1); /* SAME AS ABOVE */ 02920000 * 02930000 * DECLARE 02940000 * /* BASE POINTERS FOR THE UADS STRUCTURE. */ 02950000 * HEDBPTR REG(4) PTR, /* PTR TO THE UADS USERID DATA*/ 02960000 * DPOBPTR PTR, /* PTR TO PASSWORD OFFSET BLCK*/ 02970000 * DNOBPTR REG(2) PTR, /* PTR TO ACCTNMBR OFFSET BLCK*/ 02980000 * DROBPTR REG(3) PTR, /* PTR TO PROCNAME OFFSET BLCK*/ 02990000 * UADSPPTR PTR, /* PTR TO THE PASSWORD DATA */ 03000000 * UADSAPTR PTR, /* PTR TO THE ACCTNMBR DATA */ 03010000 * UADSRPTR PTR; /* PTR TO THE PROCNAME DATA */ 03020000 * 03030000 * 03040000 * 03050000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03060000 **/* * * 03070000 **/* * H E A D E R B L O C K * 03080000 **/* * * 03090000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03100000 **/* * * 03110000 **/* * * 03120000 **/* * I---------------------I---------------------I * 03130000 **/* * 0 I UADSBLNG I UADSFSQP I * 03140000 **/* * I---------------------I---------------------I * 03150000 **/* * 4 I UADSUSER I * 03160000 **/* * I I * 03170000 **/* * I I * 03180000 **/* * I----------I----------I---------------------I * 03190000 **/* * 12 I UADSBN01 I UADSBN02 I UADSMAXC I * 03200000 **/* * I----------I----------I---------------------I * 03210000 **/* * 16 I UADSATTR I * 03220000 **/* * I-------------------------------------------I * 03230000 **/* * 20 I UADSUPTP I * 03240000 **/* * I-------------------------------------------I * 03250000 **/* * 24 I UADSPWD1 I * 03260000 **/* * I-------------------------------------------I * 03270000 **/* * * 03280000 ** 03290000 ** 03300000 **DECLARE 03310000 ** 1 DHED BASED(HEDBPTR), 03320000 ** 03330000 ** 03340000 ** 2 UADSMHDR CHAR(14) BDY(WORD), 03350000 ** /* COMMON HEADER AREA * 03360000 ** 3 UADSBLNG PTR(15) BDY(BYTE), 03370000 ** /* BLOCK LENGTH * 03380000 ** 3 UADSFSQP PTR(15) BDY(BYTE), 03390000 ** /* OFFSET TO INITIAL FSQE (FREE * 03400000 **/* ..SPACE QUEUE ELEMENT) * 03410000 ** 3 UADSUSER CHAR(8), /* USERID * 03420000 ** 4 UADSUSID CHAR(7), /* USERID * 03430000 ** 4 UADSIND1 PTR(8), /* RESERVED * 03440000 ** 3 UADSBN01 PTR(8), /* RESERVED * 03450000 ** 3 UADSBN02 CHAR(1), /* FLAGS * 03460000 ** 4 UADSNUSP BIT(1), /*..NO NON-USABLE SPACE * 03470000 **/* ..1 -- ONLY NON-USABLE SPACE * 03480000 **/* .......EXISTS IN THIS BLOCK * 03490000 ** 4 * BIT(1), /* RESERVED * 03500000 ** 4 * BIT(1), /* RESERVED * 03510000 ** 4 * BIT(1), /* RESERVED * 03520000 ** 4 * BIT(1), /* RESERVED * 03530000 ** 4 * BIT(1), /* RESERVED * 03540000 ** 4 * BIT(1), /* RESERVED * 03550000 ** 4 * BIT(1), /* RESERVED * 03560000 ** 2 UADSMAXC PTR(16) BDY(BYTE), 03570000 ** /* MAXIMUM CORE SIZE ALLOTTABLE * 03580000 **/* ..TO THIS USER * 03590000 ** 2 UADSATTR CHAR(4), /* SYSTEM ATTRIBUTES OF USERID * 03600000 ** 3 UADSIBMT CHAR(2), /* IBM FLAG AREA * 03610000 ** 4 * CHAR(1), /* FIRST BYTE OF FLAGS * 03620000 ** 5 USATR00 BIT(1), /* ..0 -- NO OPERATOR 03630000 ** CAPABILITY * 03640000 **/* ..1 -- OPERATOR CAPABILITY * 03650000 ** 5 USATR01 BIT(1), /* ..0 -- NO ACCOUNT CAPABILITY * 03660000 **/* ..1 -- ACCOUNT CAPABILITY * 03670000 ** 5 USATR02 BIT(1), /* ..0 -- NO JCL CAPABILITY * 03680000 **/* ..1 -- JCL CAPABILITY * 03690000 **/* FLAGS 3 THROUGH 15 ARE * 03700000 **/* ..RESERVED FOR IBM USE * 03710000 ** 5 * BIT(1), /* RESERVED * 03720000 ** 5 * BIT(1), /* RESERVED * 03730000 ** 5 * BIT(1), /* RESERVED * 03740000 ** 5 * BIT(1), /* RESERVED * 03750000 ** 5 * BIT(1), /* RESERVED * 03760000 ** 4 * CHAR(1), /* SECOND BYTE OF FLAGS, 8 -- 03770000 ** 15 * 03780000 ** 03790000 ** 3 UADSINST CHAR(2), /* RESERVED * 03800000 **/* FLAGS 16 THROUGH 31 ARE * 03810000 **/* ..RESERVED FOR INSTALLATION * 03820000 **/* ..USE * 03830000 ** 4 * CHAR(1), /* THIRD BYTE OF FLAGS, 16 -- 03840000 ** 23 * 03850000 ** 4 * CHAR(1), /* FOURTH BYTE OF FLAGS * 03860000 ** 2 UADSUPTP PTR(31), /* OFFSET TO CURRENT UPT * 03870000 ** 2 UADSPWD1 PTR(31); /* OFFSET TO 1ST PASSWD OFFSET * 03880000 ** 03890000 ** 03900000 ** 03910000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03920000 **/* * * 03930000 **/* * P A S S W O R D O F F S E T B L O C K * 03940000 **/* * * 03950000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03960000 **/* * * 03970000 **/* * * 03980000 **/* * I----------I--------------------------------I * 03990000 **/* * 0 I UADSPFLG I UADSPNEX I * 04000000 **/* * I----------I--------------------------------I * 04010000 **/* * 4 I UADSPSUB I * 04020000 **/* * I-------------------------------------------I * 04030000 **/* * 8 I UADSPDAT I * 04040000 **/* * I-------------------------------------------I * 04050000 **/* * * 04060000 ** 04070000 ** 04080000 **DECLARE 04090000 ** 1 DPOB BASED(DPOBPTR), 04100000 ** 04110000 ** 2 UADSPFLG CHAR(1), /* PASSWORD BLOCK INDICATORS * 04120000 ** 3 PFLG01 BIT(1), /* ..0 -- CONTINUE CHAINING * 04130000 **/* ..1 -- LAST PASSWORD FOR THIS * 04140000 **/* .......USERID * 04150000 **/* ..FLAGS 1 THRU 7 ARE RESERVED * 04160000 ** 3 * BIT(1), /* RESERVED * 04170000 ** 3 * BIT(1), /* RESERVED * 04180000 ** 3 * BIT(1), /* RESERVED * 04190000 ** 3 * BIT(1), /* RESERVED * 04200000 ** 3 * BIT(1), /* RESERVED * 04210000 ** 3 * BIT(1), /* RESERVED * 04220000 ** 3 * BIT(1), /* RESERVED * 04230000 ** 2 UADSPNEX PTR(24) BDY(BYTE), 04240000 ** /* OFFSET TO NEXT PASSWD OFFSET * 04250000 **/* ..BLOCK * 04260000 ** 2 UADSPSUB PTR(31), /* OFFSET TO ASSOCIATED ACCOUNT * 04270000 **/* ..NUMBER OFFSET BLOCK * 04280000 ** 2 UADSPDAT PTR(31); /* OFFSET TO PASSWORD DATA 04290000 ** BLOCK * 04300000 ** 04310000 ** 04320000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04330000 **/* * * 04340000 **/* * A C C O U N T N U M B E R * 04350000 **/* * O F F S E T B L O C K * 04360000 **/* * * 04370000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04380000 **/* * * 04390000 **/* * * 04400000 **/* * I----------I--------------------------------I * 04410000 **/* * 0 I UADSAFLG I UADSANEX I * 04420000 **/* * I----------I--------------------------------I * 04430000 **/* * 4 I UADSASUB I * 04440000 **/* * I-------------------------------------------I * 04450000 **/* * 8 I UADSADAT I * 04460000 **/* * I-------------------------------------------I * 04470000 **/* * * 04480000 ** 04490000 ** 04500000 **DECLARE 04510000 ** 1 DNOB BASED(DNOBPTR), 04520000 ** 04530000 ** 2 UADSAFLG CHAR(1), /* ACCOUNT NUMBER OFFSET BLOCK * 04540000 **/* ..INDICATORS * 04550000 ** 3 AFLG01 BIT(1), /* ..0 -- CONTINUE CHAINING * 04560000 **/* ..1 -- LAST ACCOUNT NUMBER FO * 04570000 **/* .......THIS PASSWORD CHAIN * 04580000 **/* .. FLAGS 1 THRU 7 ARE RESERVE * 04590000 ** 3 * BIT(1), /* RESERVED * 04600000 ** 3 * BIT(1), /* RESERVED * 04610000 ** 3 * BIT(1), /* RESERVED * 04620000 ** 3 * BIT(1), /* RESERVED * 04630000 ** 3 * BIT(1), /* RESERVED * 04640000 ** 3 * BIT(1), /* RESERVED * 04650000 ** 3 * BIT(1), /* RESERVED * 04660000 ** 2 UADSANEX PTR(24) BDY(BYTE), 04670000 ** /* OFFSET TO NEXT ACCOUNT 04680000 ** NUMBER * 04690000 **/* ..OFFSET BLOCK * 04700000 ** 2 UADSASUB PTR(31), /* OFFSET TO ASSOCIATED 04710000 ** PROCNAME * 04720000 **/* ..OFFSET BLOCK * 04730000 ** 2 UADSADAT PTR(31); /* OFFSET TO ACCOUNT NUMBER 04740000 ** DATA * 04750000 **/* ..BLOCK * 04760000 ** 04770000 ** 04780000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04790000 **/* * * 04800000 **/* * P R O C E D U R E N A M E * 04810000 **/* * O F F S E T B L O C K * 04820000 **/* * * 04830000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04840000 **/* * * 04850000 **/* * * 04860000 **/* * I----------I--------------------------------I * 04870000 **/* * 0 I UADSRFLG I UADSRNEX I * 04880000 **/* * I----------I--------------------------------I * 04890000 **/* * 4 I UADSRSUB I * 04900000 **/* * I-------------------------------------------I * 04910000 **/* * 8 I UADSRDAT I * 04920000 **/* * I-------------------------------------------I * 04930000 **/* * * 04940000 ** 04950000 ** 04960000 **DECLARE 04970000 ** 1 DROB BASED(DROBPTR), 04980000 ** 04990000 ** 2 UADSRFLG CHAR(1), /* PROCNAME OFFSET BLOCK * 05000000 **/* ..INDICATORS * 05010000 ** 3 FLGR01 BIT(1), /* ..0 -- CONTINUE CHAINING * 05020000 **/* ..1 -- LAST PROCNAME FOR THIS * 05030000 **/* .......ACCOUNT NUMBER * 05040000 **/* ..FLAGS 1 THRU 7 ARE RESERVED * 05050000 ** 3 * BIT(1), /* RESERVED * 05060000 ** 3 * BIT(1), /* RESERVED * 05070000 ** 3 * BIT(1), /* RESERVED * 05080000 ** 3 * BIT(1), /* RESERVED * 05090000 ** 3 * BIT(1), /* RESERVED * 05100000 ** 3 * BIT(1), /* RESERVED * 05110000 ** 3 * BIT(1), /* RESERVED * 05120000 ** 2 UADSRNEX PTR(24) BDY(BYTE), 05130000 ** /* OFFSET TO NEXT PROCNAME * 05140000 **/* ..OFFSET BLOCK * 05150000 ** 2 UADSRSUB PTR(31), /* RESERVED BY ACCOUNT * 05160000 ** 2 UADSRDAT PTR(31); /* OFFSET TO PROCNAME DATA 05170000 ** BLOCK * 05180000 ** 05190000 ** 05200000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05210000 **/* * * 05220000 **/* * P A S S W O R D D A T A B L O C K * 05230000 **/* * * 05240000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05250000 **/* * * 05260000 **/* * * 05270000 **/* * I----------I--------------------------------I * 05280000 **/* * 0 I UADSPCTR I UADSPRES I * 05290000 **/* * I----------I--------------------------------I * 05300000 **/* * 4 I UADSPPWD I * 05310000 **/* * I I * 05320000 **/* * 8 I I * 05330000 **/* * I-------------------------------------------I * 05340000 **/* * * 05350000 ** 05360000 ** 05370000 **DECLARE 05380000 ** 1 DPOBD BASED(UADSPPTR), 05390000 ** 05400000 ** 2 UADSPCTR PTR(8), /* COUNT OF REFERENCES TO THIS * 05410000 **/* ..DATA BLOCK * 05420000 ** 2 UADSPRES CHAR(3), /* RESERVED FOR ACCOUNT * 05430000 ** 2 UADSPPWD CHAR(8); /* PASSWORD * 05440000 ** 05450000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05460000 **/* * * 05470000 **/* * A C C O U N T N U M B E R * 05480000 **/* * D A T A B L O C K * 05490000 **/* * * 05500000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05510000 **/* * * 05520000 **/* * * 05530000 **/* * I----------I--------------------------------I * 05540000 **/* * 0 I UADSACTR I UADSARES I * 05550000 **/* * I----------I--------------------------------I * 05560000 **/* * 4 I UADSADRF (40 BYTES) I * 05570000 **/* * I I * 05580000 **/* * I I * 05590000 **/* * I I * 05600000 **/* * I----------I--------------------------------I * 05610000 **/* * 44 I UADSALEN I UADSANUM (MAX OF 40 BYTES) I * 05620000 **/* * I----------I I * 05630000 **/* * I I * 05640000 **/* * I I * 05650000 **/* * I I * 05660000 **/* * = = * 05670000 **/* * I I * 05680000 **/* * I-------------------------------------------I * 05690000 **/* * * 05700000 ** 05710000 ** 05720000 **DECLARE 05730000 ** 1 DNOBD BASED(UADSAPTR), 05740000 ** 05750000 ** 2 UADSACTR PTR(8), /* COUNT OF REFERENCES TO THIS * 05760000 **/* ..DATA BLOCK * 05770000 ** 2 UADSARES CHAR(3), /* RESERVED FOR ACCOUNT * 05780000 ** 2 UADSADRF CHAR(40), /* DRIVER DATA FIELD * 05790000 ** 2 UADSALEN PTR(8), /* LENGTH OF FOLLOWING ACCOUNT * 05800000 **/* ..NUMBER DATA FIELD * 05810000 ** 2 UADSANUM CHAR(40); /* ACCT NMBR DATA FIELD * 05820000 ** 05830000 ** 05840000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05850000 **/* * * 05860000 **/* * P R O C E D U R E N A M E * 05870000 **/* * D A T A B L O C K * 05880000 **/* * * 05890000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05900000 **/* * * 05910000 **/* * * 05920000 **/* * I----------I--------------------------------I * 05930000 **/* * 0 I UADSRCTR I UADSRRES I * 05940000 **/* * I----------I--------------------------------I * 05950000 **/* * 4 I UADSRNAM I * 05960000 **/* * I I * 05970000 **/* * I I * 05980000 **/* * I----------I----------I---------------------I * 05990000 **/* * 12 I UADSRNDS I UADSRRS2 I UADSRSIZ I * 06000000 **/* * I----------I----------I---------------------I * 06010000 **/* * 16 I UADSUNAM I * 06020000 **/* * I I * 06030000 **/* * I I * 06040000 **/* * I-------------------------------------------I * 06050000 **/* * * 06060000 ** 06070000 ** 06080000 **DECLARE 06090000 ** 1 DROBD BASED(UADSRPTR), 06100000 ** 06110000 ** 2 UADSRCTR PTR(8), /* COUNT OF REFERENCES TO THIS * 06120000 **/* DATA BLOCK * 06130000 ** 2 UADSRRES CHAR(3), /* RESERVED FOR ACCOUNT * 06140000 ** 2 UADSRNAM CHAR(8), /* LOGON PROCEDURE NAME * 06150000 ** 2 UADSRNDS CHAR(1), /* RESERVED * 06160000 ** 2 UADSRRS2 CHAR(1), /* RESERVED * 06170000 ** 2 UADSRSIZ PTR(16) BDY(BYTE), 06180000 ** /* REGION SIZE SPECIFIED IN THE * 06190000 **/* ..NAMED PROCEDURE * 06200000 ** 2 UADSUNAM CHAR(8); /* ESOTERIC GROUP UNIT NAME * 06210000 ** 06220000 ** 06230000 * 06240000 * DECLARE 06250000 * /* A WORKING MODEL OF THE PROCNAME DATA FIELD */ 06260000 * 1 DROBDMDL CHAR(24) BDY(WORD), 06270000 * 2 * CHAR(4), /* NOT PERTINENT */ 06280000 * 2 TEMPRNAM CHAR(8), /* PROCEDURE NAME */ 06290000 * 2 * BIT(16), 06300000 * 2 TEMPRSIZ PTR(16), /* PROCEDURE SIZE */ 06310000 * 2 TEMPUNAM CHAR(8); /* UNIT NAME */ 06320000 * 06330000 * 06340000 * STCODE: /**********************************************************/ 06350000 * /* */ 06360000 * /* BEGINNING OF EXECUTABLE CODE */ 06370000 * /* */ 06380000 * /**********************************************************/ 06390000 * 06400000 **/*STCODE: P SET BASE PTR FOR CHANGE CONTROL TABLE */ 06410000 **/* P SET ALL LOGIC CONTROL FLAGS TO 0 */ 06420000 * 06430000 * CTABPTR = R1; /* ADDR OF THE CHANGE 06440000 * CONTROL TABLE */ 06450000 STCODE ST @1,CTABPTR 0023 06460000 * CHNPDLAD = CHPDLPTR; /* TRANSFER BASE PTR FOR PDL */ 06470000 L @8,CTABPTR 0024 06480000 MVC CHNPDLAD(4),4(@8) 0024 06490000 * /* ALLOCATE WORK REGISTERS. */ 06500000 * RESTRICT(HEDBPTR,DNOBPTR,DROBPTR); 06510000 * HEDBPTR = HEADADDR; /* ASSIGN PTR TO USER HEADER */ 06520000 MVC @TEMP3+1(3),13(@8) 0026 06530000 L @4,@TEMP3 0026 06540000 * SRCHIND = 0; /* INIT THE SEARCH INDICATOR */ 06550000 SR @F,@F 0027 06560000 STH @F,30(0,@8) 0027 06570000 * CFLAGS = '0000'X; /* INITIALIZE ALL FLAGS */ 06580000 MVC CFLAGS(2),@X1 0028 06590000 * /* DOES THE COMMAND SPECIFY A NEW PROCNAME? */ 06600000 * IF DLFLG4 = '1'B 06610000 * THEN /* YES, */ 06620000 L @5,CHNPDLAD 0029 06630000 TM 62(@5),B'10000000' 0029 06640000 BC 12,@9FF 0029 06650000 * DLPROC = /* TRANSFER THE DATALIST PROC-*/ 06660000 * DLITEM(1:DATALNG4); /* NAME TO ITS WORK AREA */ 06670000 LH @9,60(0,@5) 0030 06680000 BCTR @9,0 0030 06690000 L @6,CHNPDLAD 0030 06700000 L @6,56(0,@6) CHNGPDL 0030 06710000 LR @E,@6 0030 06720000 LA @A,DLPROC 0030 06730000 MVI 0(@A),C' ' 0030 06740000 MVC 1(007,@A),0(@A) 0030 06750000 EX @9,@MVC 0030 06760000 * /* IF THE COMMAND SPECIFIES A NEW UNIT NAME, TRANSFER IT */ 06770000 * /* TO A WORK VARIABLE, PADDED WITH BLANKS, SO THAT IT CAN */ 06780000 * /* BE MORE EASILY USED FOR COMPARISON. */ 06790000 * IF UNITFLG = '1'B /* NEW UNIT NAME SPECIFIED? */ 06800000 * THEN /* YES, */ 06810000 @9FF L @5,CHNPDLAD 0031 06820000 TM 54(@5),B'10000000' 0031 06830000 BC 12,@9FE 0031 06840000 * NEWUNAM = /* TRANSFER IT, PADDED WITH */ 06850000 * PDLUNAM(1:UNITLNG); /* BLANKS */ 06860000 LH @8,52(0,@5) 0032 06870000 BCTR @8,0 0032 06880000 L @9,CHNPDLAD 0032 06890000 L @9,48(0,@9) CHNGPDL 0032 06900000 LR @E,@9 0032 06910000 LA @A,NEWUNAM 0032 06920000 MVI 0(@A),C' ' 0032 06930000 MVC 1(007,@A),0(@A) 0032 06940000 EX @8,@MVC 0032 06950000 **/* D (NO,%STR,YES,) NEW SIZE SPECIFIED? */ 06960000 * /* DOES THE COMMAND SPECIFY A NEW PROCEDURE SIZE? */ 06970000 * IF RSIZFLG = '0'B 06980000 * THEN /* NO, */ 06990000 @9FE L @5,CHNPDLAD 0033 07000000 TM 46(@5),B'10000000' 0033 07010000 * GOTO BLDGFP; /* BYPASS CONVERSION */ 07020000 BC 08,BLDGFP 0034 07030000 **/* P CONVERT SIZE INTEGER TO BINARY FORM */ 07040000 * /* CONVERT THE NEW PROCSIZE TO BINARY FORM. */ 07050000 * RESTRICT(LNGTHREG); 07060000 * LNGTHREG = RSIZLNG-1; /* SUBTRACT 1 FROM NO. OF INTE- 07070000 * GERS FOR EX INSTRUCTION */ 07080000 LH @5,@D1 0036 07090000 L @8,CHNPDLAD 0036 07100000 AH @5,44(0,@8) 0036 07110000 * R1 = RSIZADR; /* PTR TO SIZE INTEGERS */ 07120000 L @1,40(0,@8) 0037 07130000 * GENERATE; 07140000 EX LNGTHREG,PACKDEC CONVERT INTEGER TO PACKED DECIMAL 07150000 CVB R1,DECSIZE CONVERT INTEGER TO BINARY FORM 07160000 DS 0H 07170000 * RELEASE(LNGTHREG); 07180000 * NEWRSIZ = R1; /* PUT SIZE INTO WORK VARIABLE*/ 07190000 STH @1,NEWRSIZ 0040 07200000 **/* D (NO,%CHKSZ,YES,) IS SIZE AN ODD NUMBER? */ 07210000 **/* P ADD 1 TO MAKE IT EVEN */ 07220000 * /* IF PROCSIZE IS AN ODD NUMBER, ADD 1 TO MAKE IT EVEN. */ 07230000 * IF EVENCHK(16) = '1'B /* PROCSIZE ODD? */ 07240000 * THEN /* YES, */ 07250000 TM EVENCHK+1,B'00000001' 0041 07260000 BC 12,@9FD 0041 07270000 * NEWRSIZ = NEWRSIZ+1; /* ADD 1 TO MAKE IT EVEN */ 07280000 LA @F,1 0042 07290000 MVC @TEMP2+2(2),NEWRSIZ 0042 07300000 A @F,@TEMP2 0042 07310000 STH @F,NEWRSIZ 0042 07320000 **/*%CHKSZ: D (NO,%STR,YES,) SIZE > MAXSIZE? */ 07330000 **/* P REDUCE SIZE TO EXISTING MAXSIZE */ 07340000 * /* PROCSIZE MUST NOT BE GREATER THAN THE MAXIMUM REGION */ 07350000 * /* SIZE SPECIFIED FOR THIS USER. */ 07360000 * /* FIRST CHECK FOR 'NOLIM' MAXSIZE. */ 07370000 * IF UADSMAXC = 0 07380000 * THEN /* MAXSIZE = 'NOLIM', */ 07390000 @9FD SR @F,@F 0043 07400000 MVC @TEMP2+2(2),14(@4) 0043 07410000 C @F,@TEMP2 0043 07420000 * GOTO BLDGFP; /* BYPASS SIZE COMPARISON */ 07430000 BC 08,BLDGFP 0044 07440000 * /* PROC SIZE GREATER THAN MAXSIZE? */ 07450000 * IF NEWRSIZ > UADSMAXC 07460000 * THEN /* IT IS GREATER, */ 07470000 MVC @TEMP2+2(2),14(@4) 0045 07480000 L @F,@TEMP2 0045 07490000 MVC @TEMP2+2(2),NEWRSIZ 0045 07500000 C @F,@TEMP2 0045 07510000 BC 10,@9FC 0045 07520000 * DO; 07530000 * NEWRSIZ = UADSMAXC; /* REDUCE IT TO MAXSIZE */ 07540000 MVC NEWRSIZ(2),14(@4) 0047 07550000 * STGFLG = '1'B; /* THE USER WILL BE INFORMED OF 07560000 * THIS CONDITION IF PROCESSING 07570000 * IS COMPLETED NORMALLY */ 07580000 OI CFLAGS,B'10000000' 0048 07590000 * END; 07600000 * 07610000 * BLDGFP: /* PARTIAL BUILDING OF GETSPACE/FREESPACE PARAMETER LIST. */ 07620000 * /* IT WILL BE COMPLETED AT EACH POINT OF CALL. */ 07630000 * READBUFF = HEADADDR; /* PTR TO USERID TREE BUFFER */ 07640000 @9FC EQU * 0050 07650000 BLDGFP L @5,CTABPTR 0050 07660000 MVC GETFREE+1(3),13(@5) 0050 07670000 MVI GETFREE,X'00' 0050 07680000 * NUMBLOKS = BLKCNT; /* NO. OF BLOCKS IN BUFFER */ 07690000 MVC GETFREE+5(1),12(@5) 0051 07700000 MVI GETFREE+4,X'00' 0051 07710000 * 07720000 * /* SAVE THE ADDR OF THE 1ST PROCNAME OFFSET BLOCK IN THE */ 07730000 * /* TOTAL CHAIN. IT WILL BE NEEDED LATER. */ 07740000 * DPOBPTR = HEDBPTR+UADSPWD1; /* REF THE FIRST PASSWORD OBLK*/ 07750000 L @F,24(0,@4) 0052 07760000 AR @F,@4 0052 07770000 ST @F,DPOBPTR 0052 07780000 * DNOBPTR = HEDBPTR+UADSPSUB; /* REF THE FIRST ACCTNMBR OBLK*/ 07790000 LR @8,@F 0053 07800000 L @2,4(0,@8) 0053 07810000 AR @2,@4 0053 07820000 * DROBPTR = HEDBPTR+UADSASUB; /* REF THE FIRST PROCNAME OBLK*/ 07830000 L @3,4(0,@2) 0054 07840000 AR @3,@4 0054 07850000 * FRSTDROB = DROBPTR; /* SAVE THIS ADDRESS */ 07860000 ST @3,FRSTDROB 0055 07870000 * 07880000 * /* CHECK THE NODELIST TABLE TO DETERMINE WHAT WAS SPECI- */ 07890000 * /* FIED IN THE COMMAND & THEN SET BASE POINTERS ACCOR- */ 07900000 * /* DINGLY. */ 07910000 * 07920000 **/*%STR: D (YES,SETPTRS,NO,) PROCNAME SPECIFIED? */ 07930000 **/* D (YES,%ACC2,NO,) ACTNBR SPECIFIED? */ 07940000 **/* D (YES,%PWW2,NO,) PASSWORD SPECIFIED? */ 07950000 **/* P REFERENCE 1ST PASSWRD OBLK FOR THIS USERID */ 07960000 **/*ACLVL: P REF 1ST ACTNBR OBLK UNDER THIS PASSWORD */ 07970000 **/*PRLVL: P (,SVPTRS) REF 1ST PROCNAME OBLK UNDER THIS ACTNBR */ 07980000 **/*%PWW2: P (,ACLVL) GET ADDR OF PASSWRD OBLK FROM CTRLTAB */ 07990000 **/*%ACC2: P (,PRLVL) GET ADDR OF PASSWRD & ACTNBR OBLKS FROM CTRLTAB*/ 08000000 * 08010000 * /* PROCNAME SPECIFIED? IF YES, THEN ALL THREE ADDRESSES */ 08020000 * /* ARE SUPPLIED IN CTRLTAB ( THE COMPLETE PATH). */ 08030000 * IF PROCNM(1) ª= '*' 08040000 * THEN /* YES, */ 08050000 L @9,CTABPTR 0056 08060000 L @9,8(0,@9) CTRLTAB 0056 08070000 CLI 56(@9),C'*' 0056 08080000 * GOTO SETPTRS; /* GO SET BASE PTRS */ 08090000 BC 07,SETPTRS 0057 08100000 * /* ACCTNMBR SPECIFIED? IF YES, THEN TWO ADDRESSES ARE */ 08110000 * /* SUPPLIED IN CTRLTAB. */ 08120000 * IF ACCTNO(1:2) = '* ' 08130000 * THEN /* NO, CHECK PASSWORD */ 08140000 CLC 16(2,@9),@C5 0058 08150000 BC 07,@9FB 0058 08160000 * /* PASSWORD SPECIFIED? IF NOT, THEN NO ADDRESSES ARE */ 08170000 * /* SUPPLIED. PROCESSING WILL BEGIN WITH THE FIRST */ 08180000 * /* CHAIN IN THE TREE. */ 08190000 * IF PASSWD(1) = '*' 08200000 * THEN /* PASSWD NOT SPECIFIED, */ 08210000 CLI 8(@9),C'*' 0059 08220000 BC 07,@9FA 0059 08230000 * DO; 08240000 * DPOBPTR = /* REF 1ST PASSWORD OBLK IN */ 08250000 * HEDBPTR+UADSPWD1;/* THIS TREE */ 08260000 L @F,24(0,@4) 0061 08270000 AR @F,@4 0061 08280000 ST @F,DPOBPTR 0061 08290000 * ACLVL: DNOBPTR = /* REF 1ST ACCTNMBR OBLK FOR */ 08300000 * HEDBPTR+UADSPSUB;/* THIS PASSWORD */ 08310000 ACLVL L @5,DPOBPTR 0062 08320000 L @2,4(0,@5) 0062 08330000 AR @2,@4 0062 08340000 * PRLVL: DROBPTR = /* REF 1ST PROCNAME OBLK FOR */ 08350000 * HEDBPTR+UADSASUB;/* THIS ACCTNMBR */ 08360000 PRLVL L @3,4(0,@2) 0063 08370000 AR @3,@4 0063 08380000 * GOTO SVPTRS; /* GO SAVE THESE PTRS */ 08390000 BC 15,SVPTRS 0064 08400000 * END; 08410000 * ELSE /* PASSWORD WAS SPECIFIED, */ 08420000 * DO; 08430000 * DPOBPTR = PASSADDR;/* GET ADDR FROM CTRLTAB */ 08440000 @9FA L @5,CTABPTR 0067 08450000 MVC DPOBPTR(4),16(@5) 0067 08460000 * GOTO ACLVL; /* GO SET THE OTHER PTRS */ 08470000 BC 15,ACLVL 0068 08480000 * END; 08490000 * ELSE /* ACCTNMBR WAS SPECIFIED, */ 08500000 * DO; 08510000 * DPOBPTR = PASSADDR; /* GET PASSWD PTR FROM CTRLTAB*/ 08520000 @9FB L @5,CTABPTR 0071 08530000 MVC DPOBPTR(4),16(@5) 0071 08540000 * DNOBPTR = ACCTADDR; /* GET ACTNO PTR FROM CTRLTAB */ 08550000 L @2,20(0,@5) 0072 08560000 * GOTO PRLVL; /* GO SET PROCNAME PTR */ 08570000 BC 15,PRLVL 0073 08580000 * END; 08590000 * 08600000 **/*SETPTRS: P GET ADDR OF PASSWRD, ACTNBR & PROC OBLKS FROM CTRLTAB*/ 08610000 * SETPTRS: /* A PROCNAME WAS SPECIFIED IN THE NODELIST. GET ALL THREE*/ 08620000 * /* POINTERS FROM THE CONTROL TABLE. */ 08630000 * DPOBPTR = PASSADDR; /* GET PASSWORD OBLK ADDR */ 08640000 @9F8 EQU * 0075 08650000 SETPTRS L @5,CTABPTR 0075 08660000 MVC DPOBPTR(4),16(@5) 0075 08670000 * DNOBPTR = ACCTADDR; /* GET ACCTNMBR OBLK ADDR */ 08680000 L @2,20(0,@5) 0076 08690000 * DROBPTR = PROCADDR; /* GET PROCNAME OBLK ADDR */ 08700000 L @3,24(0,@5) 0077 08710000 * 08720000 **/*SVPTRS: P SAVE ALL ABOVE SET ADDRESSES */ 08730000 * SVPTRS: /* SAVE THE ABOVE SET POINTERS. */ 08740000 * OPWSAVE = DPOBPTR; /* SAVE PTR TO PASSWD OBLK */ 08750000 SVPTRS MVC OPWSAVE(4),DPOBPTR 0078 08760000 * OACSAVE = DNOBPTR; /* SAVE PTR TO ACTNO OBLK */ 08770000 ST @2,OACSAVE 0079 08780000 * OPRSAVE = DROBPTR; /* SAVE PTR TO PROCNAME OBLK */ 08790000 ST @3,OPRSAVE 0080 08800000 * 08810000 **/* D (YES,CHALLPR,NO,) PROCNAME = '*'? */ 08820000 * /* CHECK WHETHER THE COMMAND SPECIFIES A PROCNAME OR AN */ 08830000 * /* '*' IN THE PROCNAME POSITION OF THE NODELIST. THE '*' */ 08840000 * /* CASE WILL BE HANDLED BY A SEPARATE SECTION OF CODE. */ 08850000 * IF PROCNM(1) = '*' 08860000 * THEN /* YES, PROCNAME = '*' */ 08870000 L @5,CTABPTR 0081 08880000 L @5,8(0,@5) CTRLTAB 0081 08890000 CLI 56(@5),C'*' 0081 08900000 * GOTO CHALLPR; /* GO HANDLE THIS CASE */ 08910000 BC 08,CHALLPR 0082 08920000 * 08930000 * UADSRPTR = HEDBPTR+UADSRDAT;/* REFERENCE THE DATA FIELD */ 08940000 L @F,8(0,@3) 0083 08950000 AR @F,@4 0083 08960000 ST @F,UADSRPTR 0083 08970000 * ODFPTR = UADSRPTR; /* SAVE THE ABOVE ADDRESS */ 08980000 MVC ODFPTR(4),UADSRPTR 0084 08990000 **/* D (YES,NPRLS,NO,) NEW PROC SPECIFIED? */ 09000000 * /* CHECK WHETHER THE INPUT COMMAND SPECIFIES A DATALIST. */ 09010000 * /* THE COMMAND MUST SPECIFY EITHER A DATALIST (NEW PROCNM)*/ 09020000 * /* OR DATA ITEMS (SIZE OR UNIT), OR BOTH. */ 09030000 * IF DLFLG4 = '1'B /* NEW PROCNAME SPECIFIED? */ 09040000 * THEN /* YES, */ 09050000 L @8,CHNPDLAD 0085 09060000 TM 62(@8),B'10000000' 0085 09070000 * GOTO NPRLS; /* GO SEARCH FOR THE NEW PROC- 09080000 * NAME IN THE LOCAL CHAIN */ 09090000 BC 01,NPRLS 0086 09100000 * ELSE; /* NO, PROCESS THE DATA ITEMS */ 09110000 **/* D (NO,,YES,CHKODF) IS THIS DATAFLD SHARED? */ 09120000 * /* CHECK WHETHER THE DATA FIELD IS SHARED (CTR>1). IF IT */ 09130000 * /* IS, THEN THE NEW DATA MUST BE COMPARED TO THE EXISTING */ 09140000 * /* DATA. IF THEY ARE NOT EQUAL, A NEW DATA FIELD MUST BE */ 09150000 * /* CREATED. */ 09160000 * IF UADSRCTR > 1 /* IS THE DATA FIELD SHARED? */ 09170000 * THEN /* YES, */ 09180000 L @9,UADSRPTR 0088 09190000 CLI 0(@9),1 0088 09200000 * GOTO CHKODF; /* GO COMPARE THE DATA */ 09210000 BC 02,CHKODF 0089 09220000 * ELSE; /* NO, THE EXISTING FIELD CAN 09230000 * BE USED */ 09240000 **/* S PRDFCH: INSERT NEW PROC DATA ITEMS */ 09250000 * CALL PRDFCH; /* GO INSERT NEW DATA ITEMS */ 09260000 BAL @E,PRDFCH 0091 09270000 * 09280000 **/*CHKCSN1: P REF 1ST PROC OBLK IN TOTAL CHAIN */ 09290000 * CHKCSN1: /* IT IS POSSIBLE THAT THIS PROCNAME EXISTS IN ANOTHER */ 09300000 * /* CHAIN AND NOW HAS THE SAME DATAFIELD BECAUSE OF THE */ 09310000 * /* CHANGES. IF SO, THE NODELIST PROCNAME DATAFIELD WILL */ 09320000 * /* BE FREED AND ITS OFFSET BLOCK WILL POINT TO THE COUSIN */ 09330000 * /* DATAFIELD. THE COUSIN USE COUNTER WILL BE INCREMENTED */ 09340000 * /* BY 1. */ 09350000 * DROBPTR = FRSTDROB; /* REF 1ST PROC OBLK IN THE 09360000 * TOTAL CHAIN */ 09370000 CHKCSN1 L @3,FRSTDROB 0092 09380000 * /* IF NO PROCNAME IS BEING CHANGED, THEN THE NODELIST */ 09390000 * /* PROCNAME MUST BE MOVED TO THE FIELD THAT WILL BE USED */ 09400000 * /* FOR COMPARISON IN THE SEARCH. */ 09410000 * IF DLFLG4 = '0'B /* M2435 */ 09420000 * THEN /* NO, NO NEW PROCNAME, */ 09430000 L @5,CHNPDLAD 0093 09440000 TM 62(@5),B'10000000' 0093 09450000 BC 05,@9F7 0093 09460000 * DLPROC = PROCNM; /* TRANSFER NODELIST PROCNAME */ 09470000 L @8,CTABPTR 0094 09480000 L @8,8(0,@8) CTRLTAB 0094 09490000 MVC DLPROC(8),56(@8) 0094 09500000 **/* S DLPRTS: SEARCH TOTAL CHAIN FOR NODELST PROC */ 09510000 * CHKCSN2: /* SEARCH THE TOTAL CHAIN FOR THE NODELIST PROCNAME. */ 09520000 * CALL DLPRTS; /* GO TO SUBRTNE FOR SEARCH */ 09530000 @9F7 EQU * 0095 09540000 CHKCSN2 BAL @E,DLPRTS 0095 09550000 * /* CHECK THE PTR SET BY THE SUBRTNE. THE NODELIST PROC */ 09560000 * /* WILL OF COURSE BE FOUND IN THE CHAIN WHERE THE CHANGES */ 09570000 * /* HAVE BEEN MADE. IGNORE THAT OFFSET BLOCK & CONTINUE. */ 09580000 * IF NPRSAVE = OPRSAVE /* PTR = NODELST PROC PTR? */ 09590000 * THEN /* YES, IGNORE IT, */ 09600000 L @F,OPRSAVE 0096 09610000 C @F,NPRSAVE 0096 09620000 BC 07,@9F6 0096 09630000 * CHKCSN3: /* ARE THERE MORE PROCNAMES IN THE TOTAL CHAIN? */ 09640000 * IF UADSRNEX = 0 09650000 * THEN /* NO, */ 09660000 CHKCSN3 SR @F,@F 0097 09670000 MVC @TEMP3+1(3),1(@3) 0097 09680000 C @F,@TEMP3 0097 09690000 * GOTO PRNEXT; /* GO CHECK WHERE PROCESSING 09700000 * IS TO CONTINUE */ 09710000 BC 08,PRNEXT 0098 09720000 * ELSE /* YES, */ 09730000 * DO; 09740000 * DROBPTR = /* REF THE NEXT PROC OBLK */ 09750000 * HEDBPTR+UADSRNEX; 09760000 MVC @TEMP3+1(3),1(@3) 0100 09770000 L @F,@TEMP3 0100 09780000 AR @F,@4 0100 09790000 LR @3,@F 0100 09800000 * GOTO CHKCSN2; /* CONTINUE THE SEARCH */ 09810000 BC 15,CHKCSN2 0101 09820000 * END; 09830000 **/* D (NO,PRNEXT,YES,) NLPROC EXIST IN COUSIN CHAIN? */ 09840000 * /* IF THE PTR WAS SET TO 0, THEN THE END OF THE TOTAL */ 09850000 * /* CHAIN WAS REACHED WITHOUT FINDING THE NODELIST PROCNAME*/ 09860000 * IF NPRSAVE = 0 /* NOT FOUND? */ 09870000 * /* M2435 */ 09880000 * ³ ODFPTR = NDFPTR /* OR POINTING TO SAME DATFLD?*/ 09890000 * THEN /* YES, ONE OF THE ABOVE, */ 09900000 @9F6 SR @F,@F 0103 09910000 C @F,NPRSAVE 0103 09920000 BC 08,@9F5 0103 09930000 L @F,NDFPTR 0103 09940000 C @F,ODFPTR 0103 09950000 BC 07,@9F4 0103 09960000 * GOTO PRNEXT; /* GO CHECK WHERE TO CONTINUE */ 09970000 BC 08,PRNEXT 0104 09980000 **/* P COMPARE NODELST PROC DATAFLD TO COUSIN DATAFLD */ 09990000 **/* D (NO,PRNEXT,YES,) DATAFLDS EQUAL? */ 10000000 * /* THE PROCNAME WAS FOUND IN A COUSIN CHAIN. COPY ITS */ 10010000 * /* DATAFLD INTO THE MODEL DATAFLD AND THEN COMPARE IT TO */ 10020000 * /* THE NODELIST PROCNAME DATAFLD. */ 10030000 * DROBDMDL = DROBD; /* COPY COUSIN DATAFLD */ 10040000 @9F4 L @5,UADSRPTR 0105 10050000 MVC DROBDMDL(24),0(@5) 0105 10060000 * UADSRPTR = ODFPTR; /* REF NODELST PROC DATAFLD */ 10070000 MVC UADSRPTR(4),ODFPTR 0106 10080000 * /* ONLY THE SIZE AND UNIT NAME HAVE TO BE COMPARED. */ 10090000 * IF UADSRSIZ ª= TEMPRSIZ /* IS SIZE DIFFERENT? */ 10100000 * ³ UADSUNAM ª= TEMPUNAM /* OR UNIT NAME DIFFERENT? */ 10110000 * THEN /* YES, THEREFORE DATAFLDS ARE 10120000 * NOT THE SAME */ 10130000 MVC @TEMP2+2(2),DROBDMDL+14 0107 10140000 L @F,@TEMP2 0107 10150000 L @5,UADSRPTR 0107 10160000 MVC @TEMP2+2(2),14(@5) 0107 10170000 C @F,@TEMP2 0107 10180000 BC 07,@9F3 0107 10190000 CLC 16(8,@5),DROBDMDL+16 0107 10200000 BC 08,@9F2 0107 10210000 * GOTO CHKCSN3; /* CONTINUE THE PROCESS UNTIL 10220000 * END OF TOT CHAIN IS REACHED*/ 10230000 BC 07,CHKCSN3 0108 10240000 **/* P PUT OFFSET TO COUSIN DATAFLD INTO NLPROC OBLK */ 10250000 **/* S CTRCHK: INCREMENT USE COUNTER IF < 255 */ 10260000 **/* S (,PRNEXT) IKJFRSP: FREE NODELST PROC DATAFLD */ 10270000 * /* AN IDENTICAL DATAFLD WAS FOUND. IT WILL BE USED. */ 10280000 * UADSRPTR = NDFPTR; /* REF THE COUSIN DATAFLD */ 10290000 @9F2 MVC UADSRPTR(4),NDFPTR 0109 10300000 * /* GO CHECK THE USE COUNTER AND, IF NOT GREATER THAN 255, */ 10310000 * /* INCREMENT IT BY ONE. */ 10320000 * CALL CTRCHK; /* M2581 */ 10330000 BAL @E,CTRCHK 0110 10340000 * DROBPTR = OPRSAVE; /* REF THE NODELST PROC OBLK */ 10350000 L @3,OPRSAVE 0111 10360000 * AREAOFST = UADSRDAT; /* PUT OFFSET TO DATAFLD INTO 10370000 * FREESPACE RTNE PARMLIST */ 10380000 MVC GETFREE+8(4),8(@3) 0112 10390000 * AREALNTH = 24; /* SAME WITH LNGTH TO BE FREED*/ 10400000 LA @F,24 0113 10410000 STH @F,GETFREE+6 0113 10420000 * CALL IKJFRSP; /* GO FREE THE DATAFLD */ 10430000 BAL @E,IKJFRSP 0114 10440000 * UADSRDAT = RDATSAVE; /* TRANSFER OFFSET TO COUSIN 10450000 * DATAFLD INTO NODELST PROC 10460000 * OFFSET BLOCK */ 10470000 MVC 8(4,@3),RDATSAVE 0115 10480000 * GOTO PRNEXT; /* GO CHECK WHERE PROCESSING 10490000 * IS TO CONTINUE */ 10500000 BC 15,PRNEXT 0116 10510000 **/*CHKODF: S CMPRND: COMPARE NEW DATA TO DATAFLD */ 10520000 **/* D (YES,PRNEXT,NO,) CAN THIS DATAFLD BE USED? */ 10530000 * CHKODF: /* THE NLPROC DATA FIELD IS SHARED WITH COUSINS, BUT SINCE*/ 10540000 * /* NO DATALIST WAS ENTERED, THE FIELD CAN BE USED IF THE */ 10550000 * /* COMMAND DATA ITEMS ARE NOT DIFFERENT FROM THE EXISTING */ 10560000 * /* DATA. IF THEY ARE, THEN A NEW DATA FIELD MUST BE BUILT.*/ 10570000 * CALL CMPRND; /* GO COMPARE THE NEW DATA */ 10580000 CHKODF BAL @E,CMPRND 0117 10590000 * /* IS THE NEW DATA EQUAL TO THE EXISTING DATA? */ 10600000 * IF PRDFLG = '1'B 10610000 * THEN /* YES, */ 10620000 TM CFLAGS,B'00000010' 0118 10630000 * /* M4226 */ 10640000 * GOTO PRNEXT; /* GO CHECK WHERE PROCESSING 10650000 * IS TO CONTINUE */ 10660000 BC 01,PRNEXT 0119 10670000 * 10680000 **/*NPRDF: S NEWPRDF: CREATE A NEW PROC DATAFLD */ 10690000 * NPRDF: /* GO CREATE A NEW DATA FIELD. */ 10700000 * CALL NEWPRDF; 10710000 NPRDF BAL @E,NEWPRDF 0120 10720000 **/* S PRDFCH: INSERT NEW DATA ITEMS */ 10730000 * CALL PRDFCH; /* GO INSERT NEW DATA ITEMS, IF 10740000 * ANY WERE ENTERED */ 10750000 BAL @E,PRDFCH 0121 10760000 **/* D (NO,CHKCSN1,YES,) NEW PROC SPECIFIED? */ 10770000 **/* P INSERT NEW PROCNAME INTO DATAFLD */ 10780000 * /* DOES THE COMMAND SPECIFY A NEW PROCNAME? */ 10790000 * IF DLFLG4 = '0'B 10800000 * THEN /* NO, */ 10810000 L @5,CHNPDLAD 0122 10820000 TM 62(@5),B'10000000' 0122 10830000 BC 05,@9F1 0122 10840000 * DO; 10850000 * ODFPTR = UADSRPTR; /* TRANSFER PTR FOR LATER USE */ 10860000 MVC ODFPTR(4),UADSRPTR 0124 10870000 * GOTO CHKCSN1; /* GO CHECK FOR COUSIN WITH 10880000 * EQUAL DATA */ 10890000 BC 15,CHKCSN1 0125 10900000 * END; 10910000 * UADSRNAM = DLPROC; /* INSERT THE NEW PROCNAME */ 10920000 @9F1 L @5,UADSRPTR 0127 10930000 MVC 4(8,@5),DLPROC 0127 10940000 * 10950000 **/*PRNEXT: P SET INDIC: A BRANCH OF THIS TREE HAS BEEN CHANGED */ 10960000 **/* D (NO,PRNEXT2,YES,) NODELIST ACTNBR = '*'? */ 10970000 **/* D (NO,PRNEXT2,YES,) MORE ACTNBRS IN THIS CHAIN? */ 10980000 **/* P PUT ADDR OF NEXT ACTNBR OBLK INTO CTRLTAB */ 10990000 **/* P (,WORKEND) INDICATE REQUEST FOR ANOTHER PROCNAME SEARCH*/ 11000000 * 11010000 * PRNEXT: /* AT LEAST ONE PROCNAME HAS NOW BEEN PROCESSED AND THIS */ 11020000 * /* USERID TREE HAS BEEN CHANGED (THE COPY ONLY). DETERMINE*/ 11030000 * /* WHERE PROCESSING IS TO CONTINUE. */ 11040000 * TRCHGE = 1; /* 1- THIS TREE HAS BEEN CHNGD*/ 11050000 PRNEXT LA @F,1 0128 11060000 L @5,CTABPTR 0128 11070000 STH @F,34(0,@5) 0128 11080000 * /* CHECK WHETHER MORE ACCTNMBRS HAVE TO BE PROCESSED UNDER*/ 11090000 * /* THE CURRENTLY REFERENCED PASSWORD. THIS IS POSSIBLE */ 11100000 * /* ONLY IF THE NODELIST ACCTNMBR = '*'. */ 11110000 * DNOBPTR = OACSAVE; /* REF ORIGINAL ACCTNMBR AGAIN*/ 11120000 L @2,OACSAVE 0129 11130000 * /* NODELIST ACCTNMBR = '*'? */ 11140000 * IF ACCTNO(1:2) = '* ' 11150000 * THEN /* YES, */ 11160000 L @8,CTABPTR 0130 11170000 L @8,8(0,@8) CTRLTAB 0130 11180000 CLC 16(2,@8),@C5 0130 11190000 BC 07,@9F0 0130 11200000 * /* CHECK THE CHAIN FLAG IN THE OFFSET BLOCK */ 11210000 * IF AFLG01 = '0'B /* MORE ACTNMBRS IN LOC CHAIN?*/ 11220000 * THEN /* YES, */ 11230000 TM 0(@2),B'10000000' 0131 11240000 BC 05,@9EF 0131 11250000 * DO; 11260000 * ACCTADDR = /* PUT PTR TO NEXT ACCTNMBR.. */ 11270000 * HEDBPTR+UADSANEX;/* OBLK INTO CTRLTAB */ 11280000 MVC @TEMP3+1(3),1(@2) 0133 11290000 L @F,@TEMP3 0133 11300000 AR @F,@4 0133 11310000 ST @F,20(0,@5) 0133 11320000 * SRCHIND = 2; /* SIGNAL IKJEFA20 TO REENTER 11330000 * THE PROCNAME SEARCH LOOP */ 11340000 LA @F,2 0134 11350000 STH @F,30(0,@5) 0134 11360000 * RETURN; /* RETURN TO IKJEFA20 */ 11370000 BC 15,@EL01 0135 11380000 * END; 11390000 * 11400000 **/*PRNEXT2: D (NO,CHGEOK,YES,) NODELIST PASSWORD = '*'? */ 11410000 **/* D (NO,CHGEOK,YES,) MORE PASSWRDS FOR THIS USERID? */ 11420000 **/* P PUT ADDR OF NEXT PASSWORD OBLK INTO CTRLTAB */ 11430000 **/* P (,WORKEND) INDICATE REQUEST FOR ANOTHER ACTNBR SEARCH*/ 11440000 * 11450000 * PRNEXT2: /* CHECK WHETHER MORE PASSWORDS HAVE TO BE PROCESSED FOR */ 11460000 * /* THIS USERID. IF YES, THEN SIGNAL IKJEFA20 TO SEARCH FOR*/ 11470000 * /* THE NODELIST PROCNAME AND/OR ACCTNMBR UNDER THE NEXT */ 11480000 * /* PASSWORD. IF AN ACCTNMBR WAS SPECIFIED, IT WILL HAVE TO*/ 11490000 * /* BE FOUND FIRST. */ 11500000 * DPOBPTR = OPWSAVE; /* REF ORIGINAL PASSWD AGAIN */ 11510000 @9EF EQU * 0137 11520000 @9F0 EQU * 0137 11530000 PRNEXT2 MVC DPOBPTR(4),OPWSAVE 0137 11540000 * /* NODELIST PASSWORD = '*'? */ 11550000 * IF PASSWD(1) = '*' 11560000 * THEN /* YES, */ 11570000 L @5,CTABPTR 0138 11580000 L @5,8(0,@5) CTRLTAB 0138 11590000 CLI 8(@5),C'*' 0138 11600000 BC 07,@9EE 0138 11610000 * /* CHECK THE CHAIN FLAG IN THE PASSWORD OFFSET BLOCK. */ 11620000 * IF PFLG01 = '0'B /* MORE PASSWORDS? */ 11630000 * THEN /* YES, */ 11640000 L @8,DPOBPTR 0139 11650000 TM 0(@8),B'10000000' 0139 11660000 BC 05,@9ED 0139 11670000 * DO; 11680000 * PASSADDR = /* PUT PTR TO THE NEXT PASSWD */ 11690000 * HEDBPTR+UADSPNEX;/* OBLK INTO THE CHANGE 11700000 * CONTROL TABLE */ 11710000 MVC @TEMP3+1(3),1(@8) 0141 11720000 L @F,@TEMP3 0141 11730000 AR @F,@4 0141 11740000 L @9,CTABPTR 0141 11750000 ST @F,16(0,@9) 0141 11760000 * SRCHIND = 1; /* SIGNAL IKJEFA20 TO REENTER 11770000 * THE ACCTNMBR SEARCH LOOP */ 11780000 LA @F,1 0142 11790000 STH @F,30(0,@9) 0142 11800000 * RETURN; /* RETURN TO IKJEFA20 */ 11810000 BC 15,@EL01 0143 11820000 * END; 11830000 * /* NO, THEREFORE NO MORE CHANGES ARE NECESSARY FOR THIS */ 11840000 * /* USERID TREE. */ 11850000 * GOTO CHGEOK; /* SET INDICATORS & RETURN */ 11860000 * 11870000 **/*NPRLS: S DLPRLS: SEARCH FOR NEW PROC IN LOCAL CHAIN */ 11880000 **/* D (YES,PRCHGE1,NO,) NEW PROC EXIST IN THIS CHAIN? */ 11890000 * NPRLS: /* GO SEARCH FOR THE NEW PROCNAME IN THIS LOCAL CHAIN. */ 11900000 * /* M2435 */ 11910000 * DROBPTR = HEDBPTR+UADSASUB; /* REF 1ST OBLK IN LOC CHAIN */ 11920000 NPRLS L @3,4(0,@2) 0146 11930000 AR @3,@4 0146 11940000 * CALL DLPRLS; 11950000 BAL @E,DLPRLS 0147 11960000 * /* DOES THE NEW PROCNAME EXIST IN THIS LOCAL CHAIN? */ 11970000 * IF NPRSAVE ª= 0 11980000 * THEN /* YES, */ 11990000 SR @F,@F 0148 12000000 C @F,NPRSAVE 0148 12010000 * GOTO PRCHGE1; /* GO MAKE REQUIRED CHANGES */ 12020000 BC 07,PRCHGE1 0149 12030000 * ELSE; /* NO, SEARCH THE TOTAL CHAIN */ 12040000 **/* P REF. 1ST PROC OFSBLK IN THE TOTAL CHAIN */ 12050000 **/* S DLPRTS: SEARCH FOR NEW PROC IN TOTAL CHAIN */ 12060000 * /* THIS SECTION OF CODE WILL SEARCH FOR A PROCNAME */ 12070000 * /* IN THE TOTAL LATERAL CHAIN (ALL PROCS IN THE TREE). */ 12080000 * DROBPTR = FRSTDROB; /* REF 1ST OBLK IN TOTAL CHAIN*/ 12090000 L @3,FRSTDROB 0151 12100000 * CALL DLPRTS; /* GO TO THE SEARCH RTNE */ 12110000 BAL @E,DLPRTS 0152 12120000 **/* D (YES,CHKDLDF,NO,PRCHGE6) NEW PROC EXIST IN TOTAL CHAIN*/ 12130000 * /* DOES THE PROCNAME EXIST IN THE TOTAL CHAIN? */ 12140000 * IF NPRSAVE = 0 12150000 * THEN /* NO, */ 12160000 SR @F,@F 0153 12170000 C @F,NPRSAVE 0153 12180000 * GOTO PRCHGE6; /* GO CHECK OLD PROC DATAFLD */ 12190000 BC 08,PRCHGE6 0154 12200000 * ELSE /* YES, */ 12210000 * DO; 12220000 * FLDFLG3 = '1'B; /* 1- COUSIN EXISTS */ 12230000 OI CFLAGS,B'00000100' 0156 12240000 * GOTO CHKDLDF; /* GO CHECK ITS DATA FIELD TO 12250000 * SEE IF IT CAN BE USED */ 12260000 BC 15,CHKDLDF 0157 12270000 * END; 12280000 * 12290000 **/*PRCHGE1: D (NO,PRCHGE2,YES,) CAN DATFLD OF NODELST PROC BE USED?*/ 12300000 * PRCHGE1: /* THE NEW (DATALIST) PROCNAME EXISTS IN THE LOCAL CHAIN. */ 12310000 * /* ITS OFFSET BLOCK AND, IF POSSIBLE, ITS DATA FIELD WILL */ 12320000 * /* BE PRUNED FROM THE TREE. */ 12330000 * UADSRPTR = ODFPTR; /* REF THE OLD PROC DATA FLD */ 12340000 PRCHGE1 MVC UADSRPTR(4),ODFPTR 0159 12350000 * /* CHECK THE USE CTR OF THE OLD PROCNAME. IF THE FIELD IS */ 12360000 * /* SHARED WITH COUSINS, THEN IT CANNOT BE USED. */ 12370000 * IF UADSRCTR > 1 12380000 * THEN /* YES, IT IS SHARED AND CANNOT 12390000 * BE USED */ 12400000 L @5,UADSRPTR 0160 12410000 CLI 0(@5),1 0160 12420000 * /* M2435 */ 12430000 * GOTO PRCHGE2; /* GO CHECK WHETHER THE NEW DF 12440000 * CAN BE USED */ 12450000 BC 02,PRCHGE2 0161 12460000 * ELSE; /* NO, IT IS NOT SHARED AND 12470000 * WILL BE USED */ 12480000 * DROBPTR = NPRSAVE; /* REF THE NEW PROC DATA FLD */ 12490000 L @3,NPRSAVE 0163 12500000 * UADSRPTR = NDFPTR; /* REF THE DATA FIELD */ 12510000 MVC UADSRPTR(4),NDFPTR 0164 12520000 **/* D (YES,FREEOB,NO,) IS DATFLD OF NEW PROC SHARED? */ 12530000 * /* CHECK THE USE COUNTER IN THE NEW DATA FIELD. IF THE */ 12540000 * /* FIELD IS BEING SHARED WITH COUSINS, THEN IT CANNOT BE */ 12550000 * /* PRUNED FROM THE TREE. */ 12560000 * IF UADSRCTR > 1 /* IS DATA FIELD BEING SHARED?*/ 12570000 * THEN /* YES, */ 12580000 L @5,UADSRPTR 0165 12590000 CLI 0(@5),1 0165 12600000 BC 12,@9EC 0165 12610000 * DO; 12620000 * UADSRCTR = UADSRCTR-1;/* DECREMENT THE USE COUNTER */ 12630000 LH @F,@D1 0167 12640000 SR @0,@0 0167 12650000 IC @0,0(0,@5) 0167 12660000 AR @F,@0 0167 12670000 STC @F,0(0,@5) 0167 12680000 * GOTO FREEOB; /* GO FREE THE OFFSET BLOCK */ 12690000 BC 15,FREEOB 0168 12700000 * END; 12710000 * ELSE; /* NO, IT CAN BE PRUNED */ 12720000 @9EC EQU * 0170 12730000 * AREAOFST = UADSRDAT; /* OFFSET TO AREA TO BE FREED */ 12740000 @9EB MVC GETFREE+8(4),8(@3) 0171 12750000 * AREALNTH = 24; /* NUMBER OF BYTES TO BE FREED*/ 12760000 LA @F,24 0172 12770000 STH @F,GETFREE+6 0172 12780000 **/* S IKJFRSP: PRUNE DATFLD OF NEW PROC */ 12790000 * CALL IKJFRSP; /* GO FREE THE DATA FIELD */ 12800000 BAL @E,IKJFRSP 0173 12810000 **/*FREEOB: P TRANSFER OFFSETS & CHAIN FLG BEFORE PRUNING OFSBLK */ 12820000 * FREEOB: /* PRUNE THE OFFSET BLOCK AND CHANGE THE AFFECTED */ 12830000 * /* OFFSETS AND CHAIN FLAGS. */ 12840000 * CSNSAVE = UADSRNEX; /* SAVE OFFSET TO NEXT OFFSET 12850000 * BLOCK, WHICH CAN BE A BROTHER 12860000 * OR COUSIN */ 12870000 FREEOB MVC CSNSAVE+1(3),1(@3) 0174 12880000 MVI CSNSAVE,X'00' 0174 12890000 * /* SAVE THE CHAIN FLAG */ 12900000 * IF FLGR01 = '1'B /* CHAIN FLAG = 1? */ 12910000 * THEN /* YES, */ 12920000 TM 0(@3),B'10000000' 0175 12930000 BC 12,@9EA 0175 12940000 * FLGSAVE = '1'B; /* SAVE FLAG = 1 */ 12950000 OI CFLAGS,B'00100000' 0176 12960000 BC 15,@9E9 0177 12970000 * ELSE /* NO, */ 12980000 * FLGSAVE = '0'B; /* SAVE FLAG = 0 */ 12990000 @9EA NI CFLAGS,B'11011111' 0177 13000000 * PRUNOFS = NPRSAVE-HEDBPTR; /* RECALCULATE THE OFFSET TO 13010000 * THE OBLK TO BE PRUNED */ 13020000 @9E9 L @F,NPRSAVE 0178 13030000 SR @F,@4 0178 13040000 ST @F,PRUNOFS 0178 13050000 * AREAOFST = PRUNOFS; /* OFFSET TO OBLK TO BE FREED */ 13060000 MVC GETFREE+8(4),PRUNOFS 0179 13070000 * AREALNTH = 12; /* NUMBER OF BYTES TO BE FREED*/ 13080000 LA @F,12 0180 13090000 STH @F,GETFREE+6 0180 13100000 **/* S IKJFRSP: PRUNE OFSBLK OF NEW PROC */ 13110000 * CALL IKJFRSP; /* GO FREE THE OFFSET BLOCK */ 13120000 BAL @E,IKJFRSP 0181 13130000 * DROBPTR = HEDBPTR+UADSASUB; /* REF THE FIRST PROC OFFSET 13140000 * BLOCK IN THIS LOCAL CHAIN */ 13150000 L @3,4(0,@2) 0182 13160000 AR @3,@4 0182 13170000 * /* IF THE PRUNED OFFSET BLOCK WAS THE FIRST ONE IN THE */ 13180000 * /* LOCAL CHAIN, THEN THE OFFSET TO THE PROC OFFSET BLOCK */ 13190000 * /* IN THE ACCTNMBR OFFSET BLOCK MUST BE CHANGED. ALSO, IF */ 13200000 * /* THIS WAS NOT THE FIRST PROCNAME IN THE TOTAL CHAIN, THE*/ 13210000 * /* COUSIN OFFSET BLOCK MUST BE FOUND AND CHANGED. */ 13220000 * IF DROBPTR = NPRSAVE /* WAS THE PRUNED OB THE FIRST 13230000 * ONE IN THE LOCAL CHAIN? */ 13240000 * THEN /* YES, */ 13250000 C @3,NPRSAVE 0183 13260000 BC 07,@9E8 0183 13270000 * DO; 13280000 * UADSASUB = CSNSAVE; /* PUT THE OFFSET TO THE NEXT 13290000 * OB INTO THE ACCTNMBR OB */ 13300000 MVC 4(4,@2),CSNSAVE 0185 13310000 * GO TO FNDCSN; /* GO SEARCH FOR THE COUSIN IN 13320000 * THE PREVIOUS CHAIN */ 13330000 BC 15,FNDCSN 0186 13340000 * END; 13350000 * ELSE; /* NO, FIND THE BROTHER WHICH 13360000 * POINTS TO THE PRUNED OB */ 13370000 @9E8 EQU * 0188 13380000 * FNDPRBR: /* SEARCH FOR THE BROTHER OFFSET BLOCK THAT POINTS TO THE */ 13390000 * /* PRUNED OFFSET BLOCK. TO DO THIS, FIND THE BLOCK THAT */ 13400000 * /* CONTAINS THE KNOWN OFFSET TO THE PRUNED BLOCK. */ 13410000 * IF PRUNOFS ª= UADSRNEX /* DOES THIS OB CONTAIN THE 13420000 * OFFSET TO THE PRUNED OB? */ 13430000 * THEN /* NO, */ 13440000 @9E7 EQU * 0189 13450000 FNDPRBR MVC @TEMP3+1(3),1(@3) 0189 13460000 L @F,@TEMP3 0189 13470000 C @F,PRUNOFS 0189 13480000 BC 08,@9E6 0189 13490000 * DO; 13500000 * DROBPTR = HEDBPTR /* REF THE NEXT OB */ 13510000 * +UADSRNEX; 13520000 MVC @TEMP3+1(3),1(@3) 0191 13530000 L @F,@TEMP3 0191 13540000 AR @F,@4 0191 13550000 LR @3,@F 0191 13560000 * GOTO FNDPRBR; /* CONTINUE THE SEARCH */ 13570000 BC 15,FNDPRBR 0192 13580000 * END; 13590000 * ELSE; /* YES, CHANGE THIS OB */ 13600000 @9E6 EQU * 0194 13610000 * UADSRNEX = CSNSAVE; /* PUT THE OFFSET TO THE NEXT 13620000 * OB INTO THIS OB */ 13630000 @9E5 MVC 1(3,@3),CSNSAVE+1 0195 13640000 * /* PUT THE CHAIN FLAG FROM THE PRUNED OBLK INTO THIS OBLK */ 13650000 * IF FLGSAVE = '1'B /* WAS FLAG = 1? */ 13660000 * THEN /* YES, */ 13670000 TM CFLAGS,B'00100000' 0196 13680000 BC 12,@9E4 0196 13690000 * FLGR01 = '1'B; /* SET CHAIN FLAG TO 1 */ 13700000 OI 0(@3),B'10000000' 0197 13710000 BC 15,@9E3 0198 13720000 * ELSE /* NO, */ 13730000 * FLGR01 = '0'B; /* SET CHAIN FLAG TO 0 */ 13740000 @9E4 NI 0(@3),B'01111111' 0198 13750000 **/* D (1,NPRDF,0,) CHECK FLAG FLDFLG2 */ 13760000 * /* CHECK THIS CONTROL FLAG. IF IT IS ON, THEN A NEW DATA */ 13770000 * /* FIELD MUST BE CREATED. */ 13780000 * IF FLDFLG2 = '1'B 13790000 * THEN /* YES, */ 13800000 @9E3 TM CFLAGS,B'00001000' 0199 13810000 * GOTO NPRDF; /* GO CREATE A NEW DATA FIELD */ 13820000 BC 01,NPRDF 0200 13830000 **/*PRDFCH2: D (0,%NLP,1,) CHECK FLAG FLDFLG */ 13840000 **/* P (,%DFCH) REF. DATAFLD OF NEW PROC */ 13850000 * PRDFCH2: /* DETERMINE WHICH DATA FIELD IS BEING USED AND THEN SET */ 13860000 * /* APPROPRIATE POINTERS. */ 13870000 * IF FLDFLG = '1'B 13880000 * THEN /* DLPROC DATA FIELD IS USED */ 13890000 PRDFCH2 TM CFLAGS,B'00010000' 0201 13900000 BC 12,@9E2 0201 13910000 * DO; 13920000 * UADSRPTR = NDFPTR; /* ADDR OF DLPROC DATA FIELD */ 13930000 MVC UADSRPTR(4),NDFPTR 0203 13940000 * /* M2435 */ 13950000 * ODFPTR = NDFPTR; /* SWITCH PTRS FOR LATER USE */ 13960000 MVC ODFPTR(4),NDFPTR 0204 13970000 BC 15,@9E1 0206 13980000 * END; 13990000 * ELSE /* NLPROC DATA FIELD IS USED */ 14000000 * DO; 14010000 * UADSRPTR = ODFPTR; /* REF NLPROC DATA FIELD */ 14020000 @9E2 MVC UADSRPTR(4),ODFPTR 0207 14030000 * UADSRNAM = DLPROC; /* INSERT THE NEW PROCNAME */ 14040000 L @5,UADSRPTR 0208 14050000 MVC 4(8,@5),DLPROC 0208 14060000 * END; 14070000 **/*%NLP: P REF. DATAFLD OF NODELIST PROC */ 14080000 **/* P INSERT NEW PROC INTO DATAFLD */ 14090000 **/*%DFCH: S (,PRNEXT) PRDFCH: INSERT NEW DATA ITEMS */ 14100000 * CALL PRDFCH; /* GO INSERT NEW DATA ITEMS, 14110000 * IF ANY WERE ENTERED */ 14120000 @9E1 BAL @E,PRDFCH 0210 14130000 * /* GO CHECK WHETHER AN IDENTICAL COUSIN DATA FIELD EXISTS */ 14140000 * /* IN ANOTHER PART OF THE TOTAL CHAIN. IF SO, THEN THE */ 14150000 * /* COUSIN DATA FIELD MUST BE USED. */ 14160000 * GOTO CHKCSN1; /* M2435 */ 14170000 BC 15,CHKCSN1 0211 14180000 * 14190000 * FNDCSN: /* THIS SECTION OF CODE WILL SEARCH FOR THE PROCNAME OFF- */ 14200000 * /* SET BLOCK WHICH CONTAINS THE OFFSET TO THE PRUNED OFF- */ 14210000 * /* SET BLOCK. THE SEARCH IS MADE IN THE TOTAL CHAIN SINCE */ 14220000 * /* THE PRUNED BLOCK WAS THE FIRST IN ITS LOCAL CHAIN. */ 14230000 * 14240000 * /* IF THE PRUNED OFFSET BLOCK WAS THE 1ST IN THE TOTAL */ 14250000 * /* CHAIN, THEN NO SEARCH IS NECESSARY. */ 14260000 * IF NPRSAVE = FRSTDROB /* M2435 */ 14270000 * THEN /* YES, 1ST IN TOTAL CHAIN, */ 14280000 FNDCSN L @F,FRSTDROB 0212 14290000 C @F,NPRSAVE 0212 14300000 BC 07,@9E0 0212 14310000 * DO; 14320000 * /* RESET ADDR OF 1ST OFFSET BLOCK IN THE TOTAL CHAIN*/ 14330000 * FRSTDROB = HEDBPTR+UADSASUB; /* M2435 */ 14340000 L @F,4(0,@2) 0214 14350000 AR @F,@4 0214 14360000 ST @F,FRSTDROB 0214 14370000 * GOTO PRDFCH2; /* GO CHANGE DATFLD M2435 */ 14380000 BC 15,PRDFCH2 0215 14390000 * END; 14400000 * 14410000 * DROBPTR = FRSTDROB; /* REF 1ST OBLK IN TOTAL CHAIN*/ 14420000 @9E0 L @3,FRSTDROB 0217 14430000 * FNDCSN2: /* CHECK WHETHER THIS OFFSET BLOCK POINTS TO THE PRUNED OB*/ 14440000 * IF PRUNOFS ª= UADSRNEX 14450000 * THEN /* NO, */ 14460000 FNDCSN2 MVC @TEMP3+1(3),1(@3) 0218 14470000 L @F,@TEMP3 0218 14480000 C @F,PRUNOFS 0218 14490000 BC 08,@9DF 0218 14500000 * DO; 14510000 * DROBPTR = HEDBPTR /* REF THE NEXT OB */ 14520000 * +UADSRNEX; 14530000 MVC @TEMP3+1(3),1(@3) 0220 14540000 L @F,@TEMP3 0220 14550000 AR @F,@4 0220 14560000 LR @3,@F 0220 14570000 * GOTO FNDCSN2; /* CONTINUE THE SEARCH */ 14580000 BC 15,FNDCSN2 0221 14590000 * END; 14600000 * ELSE; /* YES, CHANGE THIS OB */ 14610000 @9DF EQU * 0223 14620000 * UADSRNEX = CSNSAVE; /* PUT THE OFFSET TO THE NEXT 14630000 * OB INTO THIS OB */ 14640000 @9DE MVC 1(3,@3),CSNSAVE+1 0224 14650000 * GOTO PRDFCH2; 14660000 BC 15,PRDFCH2 0225 14670000 * PRCHGE2: /* THE DATA FIELD OF THE NODELIST (OLD) PROCNAME CANNOT */ 14680000 * /* BE USED. IF THE USE CTR OF THE DATALIST (NEW) PROCNAME */ 14690000 * /* DATA FIELD IS 1, THEN THIS FIELD WILL BE USED. IF NOT, */ 14700000 * /* THEN A COMPARISON OF DATA IS NECESSARY. */ 14710000 * UADSRPTR = NDFPTR; /* REF THE DLPROC DATA FIELD */ 14720000 PRCHGE2 MVC UADSRPTR(4),NDFPTR 0226 14730000 **/*PRCHGE2: P REF. DATAFLD OF NEW PROC */ 14740000 **/* D (YES,CHKDLDF,NO,) THIS DATAFLD SHARED? */ 14750000 * /* IS THIS DATA FIELD SHARED WITH COUSINS? */ 14760000 * IF UADSRCTR > 1 14770000 * THEN /* YES, */ 14780000 L @5,UADSRPTR 0227 14790000 CLI 0(@5),1 0227 14800000 * GOTO CHKDLDF; /* GO COMPARE THE DATA */ 14810000 BC 02,CHKDLDF 0228 14820000 **/* P COPY DATFLD OF NODELST PROC INTO NEW PROC DATFLD */ 14830000 * /* THIS FIELD IS NOT SHARED AND CAN THEREFORE BE USED. */ 14840000 * UADSRPTR = ODFPTR; /* REF THE NLPROC DATA FIELD */ 14850000 MVC UADSRPTR(4),ODFPTR 0229 14860000 * NDFPTR -> DROBD = DROBD; /* COPY THE NLPROC DF INTO THE 14870000 * DLPROC DATA FLD */ 14880000 L @5,UADSRPTR 0230 14890000 L @8,NDFPTR 0230 14900000 MVC 0(24,@8),0(@5) 0230 14910000 * UADSRCTR = UADSRCTR-1; /* DECREMENT THE NLPROC USECTR*/ 14920000 LH @F,@D1 0231 14930000 SR @0,@0 0231 14940000 IC @0,0(0,@5) 0231 14950000 AR @F,@0 0231 14960000 STC @F,0(0,@5) 0231 14970000 * UADSRPTR = NDFPTR; /* REF THE NEW DATA FIELD */ 14980000 MVC UADSRPTR(4),NDFPTR 0232 14990000 * UADSRCTR = 1; 15000000 L @5,UADSRPTR 0233 15010000 MVI 0(@5),1 0233 15020000 * UADSRNAM = DLPROC; /* INSERT NEW PROCNAME M2435 */ 15030000 MVC 4(8,@5),DLPROC 0234 15040000 * DROBPTR = NPRSAVE; /* REF THE DLPROC OBLK */ 15050000 L @3,NPRSAVE 0235 15060000 **/*PRCHGE3: P TRANSFER DATAFLD OFFSET TO NODELST PROC OFSBLK */ 15070000 * PRCHGE3: RDATSAVE = UADSRDAT; /* SAVE OFFSET TO DATA FIELD */ 15080000 PRCHGE3 MVC RDATSAVE(4),8(@3) 0236 15090000 * DROBPTR = OPRSAVE; /* REF OLD OFFSET BLOCK */ 15100000 L @3,OPRSAVE 0237 15110000 * UADSRDAT = RDATSAVE; /* PUT THE OFFSET TO THE DLPROC 15120000 * DATA FIELD INTO THIS OBLK */ 15130000 MVC 8(4,@3),RDATSAVE 0238 15140000 * DROBPTR = NPRSAVE; /* THE DLPROC OBLK WILL BE 15150000 * PRUNED FROM THE TREE */ 15160000 L @3,NPRSAVE 0239 15170000 **/* P (,FREEOB) FLDFLG=1: DATAFLD OF NEW PROC IS BEING USED */ 15180000 **/**/ 15190000 * FLDFLG = '1'B; /* 1- INDICATES THAT THE DLPROC 15200000 * DATA FIELD IS BEING USED */ 15210000 OI CFLAGS,B'00010000' 0240 15220000 * GOTO FREEOB; /* GO PRUNE THE OBLK */ 15230000 BC 15,FREEOB 0241 15240000 * 15250000 **/*CHKDLDF: P BUILD MODEL OF NODELIST PROC DATAFLD */ 15260000 **/* P INSERT NEW DATA ITEMS INTO MODEL */ 15270000 * CHKDLDF: /* BUILD A WORKING MODEL OF THE NODELIST PROC DATA FIELD. */ 15280000 * /* CHANGE DATA ITEMS THAT WERE SPECIFIED IN THE COMMAND */ 15290000 * /* AND THEN COMPARE THIS MODEL TO THE DATALIST PROC DATA */ 15300000 * /* FIELD, EXCLUDING THE USE COUNTER. */ 15310000 * UADSRPTR = ODFPTR; /* REF THE NLPROC DATA FLD */ 15320000 CHKDLDF MVC UADSRPTR(4),ODFPTR 0242 15330000 * DROBDMDL = DROBD; /* COPY IT INTO MODEL DATA FLD*/ 15340000 L @5,UADSRPTR 0243 15350000 MVC DROBDMDL(24),0(@5) 0243 15360000 * /* DOES THE COMMAND SPECIFY A PROCSIZE? */ 15370000 * IF RSIZFLG = '1'B 15380000 * THEN /* YES, */ 15390000 L @8,CHNPDLAD 0244 15400000 TM 46(@8),B'10000000' 0244 15410000 BC 12,@9DD 0244 15420000 * TEMPRSIZ = NEWRSIZ; /* INSERT THE NEW PROCSIZE */ 15430000 MVC DROBDMDL+14(2),NEWRSIZ 0245 15440000 * /* DOES THE COMMAND SPECIFY A UNIT NAME? */ 15450000 * IF UNITFLG = '1'B 15460000 * THEN /* YES, */ 15470000 @9DD TM 54(@8),B'10000000' 0246 15480000 BC 12,@9DC 0246 15490000 * TEMPUNAM = NEWUNAM; /* INSERT THE NEW UNIT NAME */ 15500000 MVC DROBDMDL+16(8),NEWUNAM 0247 15510000 * UADSRPTR = NDFPTR; /* REF THE DLPROC DATA FLD */ 15520000 @9DC MVC UADSRPTR(4),NDFPTR 0248 15530000 **/* D (1,PRCHGE4,0,) CHECK FLAG FLDFLG3 */ 15540000 * /* CHECK THE LOOP CONTROL FLAG. '1' INDICATES THAT THE */ 15550000 * /* DATALIST PROCNAME EXISTS IN A COUSIN CHAIN, BUT NOT */ 15560000 * /* IN THE SAME LOCAL CHAIN. */ 15570000 * IF FLDFLG3 = '1'B 15580000 * THEN /* DLPROC EXISTS IN COUSIN.. */ 15590000 TM CFLAGS,B'00000100' 0249 15600000 * GOTO PRCHGE4; /* CHAIN, GO COMPARE DATAFLDS */ 15610000 BC 01,PRCHGE4 0250 15620000 **/* D (YES,PRCHGE3,NO,) MODEL = NEW PROC DATFLD? */ 15630000 * /* COMPARE THE MODEL TO THE DATALIST PROCNAME DATAFLD. */ 15640000 * /* ONLY THE SIZE AND UNIT NAME HAVE TO BE COMPARED. */ 15650000 * IF UADSRSIZ = TEMPRSIZ /* IS SIZE THE SAME? */ 15660000 * & UADSUNAM = TEMPUNAM /* AND UNIT NAME EQUAL? */ 15670000 * THEN /* THEY ARE EQUAL */ 15680000 MVC @TEMP2+2(2),DROBDMDL+14 0251 15690000 L @F,@TEMP2 0251 15700000 L @5,UADSRPTR 0251 15710000 MVC @TEMP2+2(2),14(@5) 0251 15720000 C @F,@TEMP2 0251 15730000 BC 07,@9DB 0251 15740000 CLC 16(8,@5),DROBDMDL+16 0251 15750000 BC 07,@9DA 0251 15760000 * DO; 15770000 * UADSRPTR = ODFPTR; /* REF THE NLPROC DATA FIELD */ 15780000 MVC UADSRPTR(4),ODFPTR 0253 15790000 * UADSRCTR = UADSRCTR-1;/* DECREMENT THE USE CTR */ 15800000 LH @F,@D1 0254 15810000 L @5,UADSRPTR 0254 15820000 SR @0,@0 0254 15830000 IC @0,0(0,@5) 0254 15840000 AR @F,@0 0254 15850000 STC @F,0(0,@5) 0254 15860000 * DROBPTR = NPRSAVE; /* REF THE DLPROC OBLK */ 15870000 L @3,NPRSAVE 0255 15880000 * GOTO PRCHGE3; /* GO MAKE NECESSARY CHANGES */ 15890000 BC 15,PRCHGE3 0256 15900000 * END; 15910000 * /* THE DATALIST PROCNAME DATA FIELD CANNOT BE USED. A NEW */ 15920000 * /* DATA FIELD MUST BE CREATED. */ 15930000 * DROBPTR = OPRSAVE; /* REF THE NLPROC OBLK */ 15940000 @9DA EQU * 0258 15950000 @9DB L @3,OPRSAVE 0258 15960000 * UADSRPTR = ODFPTR; /* REF THE NLPROC DATA FIELD */ 15970000 MVC UADSRPTR(4),ODFPTR 0259 15980000 **/* P (,FREEOB) FLDFLG2=1: NEW DATFLD MUST BE CREATED */ 15990000 * FLDFLG2 = '1'B; /* 1 - CREATE NEW DATA FIELD */ 16000000 OI CFLAGS,B'00001000' 0260 16010000 * GOTO FREEOB; /* GO PRUNE THE DLPROC OBLK */ 16020000 BC 15,FREEOB 0261 16030000 **/*PRCHGE4: P COMPARE MODEL TO NEW PROC DATFLD IN COUSIN CHAIN */ 16040000 **/* D (NO,PRCHGE6,YES,) MODEL = COUSIN DATFLD? */ 16050000 * PRCHGE4: /* COMPARE THE MODEL TO THE DATALIST PROCNAME DATA FIELD. */ 16060000 * /* ONLY THE SIZE AND UNIT NAME HAVE TO BE COMPARED. */ 16070000 * FLDFLG3 = '0'B; /* FIRST RESET CONTROL FLAG */ 16080000 PRCHGE4 NI CFLAGS,B'11111011' 0262 16090000 * IF UADSRSIZ ª= TEMPRSIZ /* IS SIZE DIFFERENT? */ 16100000 * ³ UADSUNAM ª= TEMPUNAM /* OR UNIT NAME DIFFERENT? */ 16110000 * THEN /* YES, THEREFORE DATAFLDS ARE 16120000 * NOT THE SAME */ 16130000 MVC @TEMP2+2(2),DROBDMDL+14 0263 16140000 L @F,@TEMP2 0263 16150000 L @5,UADSRPTR 0263 16160000 MVC @TEMP2+2(2),14(@5) 0263 16170000 C @F,@TEMP2 0263 16180000 BC 07,@9D9 0263 16190000 CLC 16(8,@5),DROBDMDL+16 0263 16200000 BC 08,@9D8 0263 16210000 * GOTO PRCHGE6; /* CHECK WHETHER THE NLPROC DATA 16220000 * FIELD CAN BE USED */ 16230000 BC 07,PRCHGE6 0264 16240000 **/* P INSERT OFFSET TO COUSIN DATFLD INTO OFSBLK */ 16250000 * /* THE DATALIST PROCNAME DATA FIELD, EXISTING IN A COUSIN */ 16260000 * /* CHAIN, WILL BE USED. */ 16270000 * DROBPTR = OPRSAVE; /* REF THE NLPROC OBLK */ 16280000 @9D8 L @3,OPRSAVE 0265 16290000 * UADSRDAT = RDATSAVE; /* INSERT OFFSET TO COUSIN DF */ 16300000 MVC 8(4,@3),RDATSAVE 0266 16310000 * UADSRPTR = NDFPTR; /* REF THE DLPROC DATA FIELD */ 16320000 MVC UADSRPTR(4),NDFPTR 0267 16330000 * /* GO CHECK THE USE COUNTER AND, IF NOT GREATER THAN 255, */ 16340000 * /* INCREMENT IT BY ONE. */ 16350000 * CALL CTRCHK; /* M2581 */ 16360000 BAL @E,CTRCHK 0268 16370000 * UADSRPTR = ODFPTR; /* REF THE NLPROC DATA FIELD */ 16380000 MVC UADSRPTR(4),ODFPTR 0269 16390000 **/* D (YES,PRCHGE5,NO,) CAN NDLST PROC DATFLD BE PRUNED? */ 16400000 **/*%AA: P REF. THE NEW PROC DATFLD */ 16410000 **/* S (,PRNEXT) PRDFCH: INSERT NEW DATA ITEMS */ 16420000 * /* IF THE USE COUNTER IN THE NODELIST PROC DATA FIELD IS */ 16430000 * /* 1 (NOT SHARED), THEN THIS FIELD WILL BE PRUNED. */ 16440000 * IF UADSRCTR = 1 16450000 * THEN /* FIELD IS NOT SHARED, */ 16460000 L @5,UADSRPTR 0270 16470000 CLI 0(@5),1 0270 16480000 * GO TO PRCHGE5; /* GO PRUNE IT FROM THE TREE */ 16490000 BC 08,PRCHGE5 0271 16500000 * UADSRCTR = UADSRCTR-1; /* DECREMENT THE USE CTR */ 16510000 LH @F,@D1 0272 16520000 SR @0,@0 0272 16530000 IC @0,0(0,@5) 0272 16540000 AR @F,@0 0272 16550000 STC @F,0(0,@5) 0272 16560000 * /* M2435 */ 16570000 * GOTO PRNEXT; /* GO CHECK WHERE PROCESSING 16580000 * IS TO CONTINUE */ 16590000 BC 15,PRNEXT 0273 16600000 **/*PRCHGE5: S (,%AA) IKJFRSP: PRUNE NODELIST PROC DATAFLD */ 16610000 * PRCHGE5: /* PRUNE THE NODELIST PROCNAME DATA FIELD FROM THE TREE. */ 16620000 * AREAOFST = ODFPTR-HEDBPTR; /* CALCULATE OFFSET TO THE 16630000 * NLPROC DATA FIELD */ 16640000 PRCHGE5 L @F,ODFPTR 0274 16650000 SR @F,@4 0274 16660000 ST @F,GETFREE+8 0274 16670000 * AREALNTH = 24; /* NUMBER OF BYTES TO BE FREED*/ 16680000 LA @F,24 0275 16690000 STH @F,GETFREE+6 0275 16700000 * CALL IKJFRSP; /* FREE THIS DATA FIELD */ 16710000 BAL @E,IKJFRSP 0276 16720000 * /* M2435 */ 16730000 * GOTO PRNEXT; /* GO CHECK WHERE PROCESSING 16740000 * IS TO CONTINUE */ 16750000 BC 15,PRNEXT 0277 16760000 **/*PRCHGE6: P REF DATAFLD OF NODELIST PROCNAME */ 16770000 **/* D (NO,%NSR,YES,) IS NDLST PROC DATFLD SHARED? */ 16780000 **/* S NEWPRDF: CREATE NEW PROC DATAFLD */ 16790000 * PRCHGE6: /* THE DATALIST PROCNAME DOES NOT EXIST IN THIS TREE, OR */ 16800000 * /* ITS DATA FIELD CANNOT BE USED. */ 16810000 * UADSRPTR = ODFPTR; /* REF THE NLPROC DATA FIELD */ 16820000 PRCHGE6 MVC UADSRPTR(4),ODFPTR 0278 16830000 * /* CHECK THE USE COUNTER. IF IT IS 1, THEN THIS FIELD WILL*/ 16840000 * /* BE USED. IF THE FIELD IS SHARED, THEN IT CANNOT BE */ 16850000 * /* USED AND A NEW DATA FIELD MUST BE CREATED. */ 16860000 * IF UADSRCTR > 1 16870000 * THEN /* THIS DATA FLD IS SHARED */ 16880000 L @5,UADSRPTR 0279 16890000 CLI 0(@5),1 0279 16900000 BC 12,@9D7 0279 16910000 * DO; 16920000 * DROBPTR = OPRSAVE; /* REF THE NLPROC OBLK */ 16930000 L @3,OPRSAVE 0281 16940000 * CALL NEWPRDF; /* GO CREATE A NEW DATA FLD */ 16950000 BAL @E,NEWPRDF 0282 16960000 * END; 16970000 * ELSE; /* IT IS NOT SHARED AND WILL 16980000 * BE USED */ 16990000 @9D7 EQU * 0284 17000000 * UADSRNAM = DLPROC; /* INSERT THE NEW PROCNAME */ 17010000 @9D6 L @5,UADSRPTR 0285 17020000 MVC 4(8,@5),DLPROC 0285 17030000 **/*%NSR: S PRDFCH: INSERT NEW DATA ITEMS INTO DATFLD */ 17040000 **/* P (,PRNEXT) INSERT NEW PROCNAME INTO DATFLD */ 17050000 * CALL PRDFCH; /* GO INSERT NEW DATA ITEMS, IF 17060000 * SPECIFIED IN THE COMMAND */ 17070000 BAL @E,PRDFCH 0286 17080000 * GOTO PRNEXT; /* GO CHECK WHERE PROCESSING 17090000 * IS TO CONTINUE */ 17100000 BC 15,PRNEXT 0287 17110000 * CHALLPR: /* AN '*' WAS ENTERED IN THE PROCNAME POSITION OF THE */ 17120000 * /* NODELIST. IF THE PASSWORD AND ACCTNMBR ARE ALSO '*', */ 17130000 * /* THEN THE REQUESTED CHANGE APPLIES TO ALL PROCNAMES IN */ 17140000 * /* THE USERID TREE. IF EITHER A PASSWORD OR AN ACCTNMBR */ 17150000 * /* WAS SPECIFIED, THEN THE CHANGE APPLIES ONLY TO SPECIFIC*/ 17160000 * /* LOCAL CHAINS. */ 17170000 **/*CHALLPR: P CODE TO CHANGE ALL PROCS IN A LOCAL CHAIN */ 17180000 **/* D (NO,ALLPRDF,YES,) NEW PROC SPECIFIED? */ 17190000 * DROBPTR = HEDBPTR+UADSASUB; /* REF THE 1ST PROC OBLK UNDER 17200000 * THE CURRENTLY REFERENCED 17210000 * ACCTNMBR */ 17220000 CHALLPR L @3,4(0,@2) 0288 17230000 AR @3,@4 0288 17240000 * /* IF NO NEW PROCNAME IS SPECIFIED, THEN ONLY DATA FIELDS */ 17250000 * /* HAVE TO BE CHANGED. */ 17260000 * IF DLFLG4 = '0'B 17270000 * THEN /* NO NEW PROCNAME SPECIFIED */ 17280000 L @5,CHNPDLAD 0289 17290000 TM 62(@5),B'10000000' 0289 17300000 * GOTO ALLPRDF; /* GO CHANGE DATA FIELDS */ 17310000 BC 08,ALLPRDF 0290 17320000 * 17330000 * LASTOB = DROBPTR; /* SAVE ADDR FOR LATER USE */ 17340000 ST @3,LASTOB 0291 17350000 **/* S DLPRLS: SEARCH LOCAL CHAIN FOR NEW PROC */ 17360000 **/* D (YES,NPRFND,NO,) NEW PROC IN LOCAL CHAIN? */ 17370000 * CALL DLPRLS; /* SEARCH THIS LOCAL CHAIN FOR 17380000 * THE NEW PROCNAME */ 17390000 BAL @E,DLPRLS 0292 17400000 * /* DOES THE NEW PROCNAME ALREADY EXIST IN THIS CHAIN? */ 17410000 * IF NPRSAVE ª= 0 17420000 * THEN /* YES, */ 17430000 SR @F,@F 0293 17440000 C @F,NPRSAVE 0293 17450000 * GOTO NPRFND; /* GO CHECK THE DATA */ 17460000 BC 07,NPRFND 0294 17470000 * OPRSAVE = 0; /* FOR LATER USE: NEW PROC NOT 17480000 * FOUND IN THIS CHAIN */ 17490000 ST @F,OPRSAVE 0295 17500000 **/*TSPREP: P REF 1ST PROC IN TOTAL CHAIN */ 17510000 * TSPREP: /* PREPARE TO SEARCH THE TOTAL CHAIN FOR THE NEW PROC. */ 17520000 * DROBPTR = FRSTDROB; /* REF 1ST OBLK IN TOTAL CHAIN*/ 17530000 TSPREP L @3,FRSTDROB 0296 17540000 **/*PROCTS: S DLPRTS: SEARCH TOTAL CHAIN FOR NEW PROC */ 17550000 * PROCTS: /* SEARCH THE TOTAL CHAIN FOR THE NEW PROCNAME */ 17560000 * CALL DLPRTS; /* GO TO SEARCH SUBRTNE */ 17570000 PROCTS BAL @E,DLPRTS 0297 17580000 **/* D (NO,PRNFND,YES,) NEW PROC IN TOTAL CHAIN? */ 17590000 * /* DOES THE NEW PROCNAME EXIST IN THIS TREE? */ 17600000 * IF NPRSAVE = 0 17610000 * THEN /* NO, */ 17620000 SR @F,@F 0298 17630000 C @F,NPRSAVE 0298 17640000 * GOTO PRNFND; /* GO MAKE APPROPRIATE CHANGES*/ 17650000 BC 08,PRNFND 0299 17660000 * /* THE NEW PROCNAME WAS FOUND. CHECK WHETHER IT IS THE */ 17670000 * /* SAME ONE ALREADY FOUND IN THE LOCAL CHAIN. IF SO, */ 17680000 * /* IGNORE IT AND CONTINUE THE SEARCH. */ 17690000 * IF NPRSAVE = OPRSAVE 17700000 * THEN /* IT IS THE SAME, */ 17710000 L @F,OPRSAVE 0300 17720000 C @F,NPRSAVE 0300 17730000 * GOTO PROCTS2; /* CONTINUE THE SEARCH */ 17740000 BC 08,PROCTS2 0301 17750000 * /* IT IS NOT THE SAME. COMPARE ITS DATA TO THE NEW DATA, */ 17760000 * /* IF ANY, TO SEE IF ITS DATA FIELD CAN BE USED. */ 17770000 **/* S CMPRND: COMPARE NEW DATA TO COUSIN DATFLD */ 17780000 **/* D (YES,CSNDOK,NO,) CAN COUSIN DATFLD BE USED? */ 17790000 * CALL CMPRND; /* GO TO COMPARE SUBRTNE */ 17800000 BAL @E,CMPRND 0302 17810000 * /* CAN THIS DATA FIELD BE USED? */ 17820000 * IF PRDFLG = '1'B 17830000 * THEN /* YES, */ 17840000 TM CFLAGS,B'00000010' 0303 17850000 * GOTO CSNDOK; /* GO MAKE APPROPRIATE CHANGES*/ 17860000 BC 01,CSNDOK 0304 17870000 **/* D (NO,PRNFND,YES,) MORE PROCS IN TOTAL CHAIN? */ 17880000 **/* P (,PROCTS) REF NEXT PROC OFSBLK */ 17890000 * PROCTS2: /* ARE THERE MORE PROCNAMES IN THIS TOTAL CHAIN? IF SO, */ 17900000 * /* THEN CONTINUE THE SEARCH. */ 17910000 * IF UADSRNEX = 0 17920000 * THEN /* NO, END OF TOTAL CHAIN */ 17930000 PROCTS2 SR @F,@F 0305 17940000 MVC @TEMP3+1(3),1(@3) 0305 17950000 C @F,@TEMP3 0305 17960000 * GOTO PRNFND; /* GO MAKE CHANGES */ 17970000 BC 08,PRNFND 0306 17980000 * DROBPTR = HEDBPTR+UADSRNEX; /* REF THE NEXT PROC OBLK */ 17990000 MVC @TEMP3+1(3),1(@3) 0307 18000000 L @F,@TEMP3 0307 18010000 AR @F,@4 0307 18020000 LR @3,@F 0307 18030000 * GOTO PROCTS; /* GO CONTINUE THE SEARCH */ 18040000 BC 15,PROCTS 0308 18050000 * 18060000 * NPRFND: /* THE NEW PROCNAME EXISTS IN THIS LOCAL CHAIN. COMPARE */ 18070000 * /* ITS DATA TO THE NEW DATA, IF ANY. IF NOT EQUAL, THEN */ 18080000 * /* SEARCH THE TOTAL CHAIN TO SEE IF THIS PROCNAME, WITH */ 18090000 * /* EQUAL DATA, EXISTS SOMEWHERE ELSE IN THIS TREE. */ 18100000 **/*NPRFND: S CMPRND: COMPARE NEW DATA TO BROTHER DATFLD */ 18110000 **/* D (NO,TSPREP,YES,) BROTHER DATFLD OK? */ 18120000 * OPRSAVE = NPRSAVE; /* TRANSFER PTR FOR LATER USE */ 18130000 NPRFND MVC OPRSAVE(4),NPRSAVE 0309 18140000 * CALL CMPRND; /* GO TO COMPARE SUBRTNE */ 18150000 BAL @E,CMPRND 0310 18160000 * /* IS THE DATA EQUAL? */ 18170000 * IF PRDFLG = '0'B 18180000 * THEN /* NO, */ 18190000 TM CFLAGS,B'00000010' 0311 18200000 * GOTO TSPREP; /* GO SEARCH THE TOTAL CHAIN */ 18210000 BC 08,TSPREP 0312 18220000 * /* THIS DATA FIELD WILL BE USED. */ 18230000 * /* M4226 */ 18240000 * 18250000 **/*RCHNPR: P CODE TO PRUNE ALL BUT ONE PROC FROM LOCAL CHAIN */ 18260000 **/* D (YES,PRNEXT3,NO,) ONLY ONE PROC IN THIS CHAIN? */ 18270000 * RCHNPR: /* THIS SECTION WILL CHANGE ONE PROCNAME CHAIN. THE FIRST */ 18280000 * /* OFFSET BLOCK WILL BE RETAINED AND ALL OTHERS WILL BE */ 18290000 * /* PRUNED FROM THE TREE. THEIR DATA FIELDS WILL ALSO BE */ 18300000 * /* FREED IF THEY ARE NOT SHARED. */ 18310000 * DROBPTR = LASTOB; /* REF 1ST OBLK IN THIS CHAIN */ 18320000 RCHNPR L @3,LASTOB 0313 18330000 * /* IS THE NEW PROC OFFSET BLOCK THE 1ST IN THE CHAIN? */ 18340000 * IF NPRSAVE = LASTOB 18350000 * THEN /* YES, */ 18360000 L @F,LASTOB 0314 18370000 C @F,NPRSAVE 0314 18380000 * GOTO CSNDOK2; /* GO CHECK WHERE TO CONTINUE */ 18390000 BC 08,CSNDOK2 0315 18400000 * /* THE NEW PROC OFFSET BLOCK IS NOT THE FIRST IN THE LOCAL*/ 18410000 * /* CHAIN. TRANSFER THE OFFSET TO ITS DATA FIELD TO THE */ 18420000 * /* FIRST OFFSET BLOCK AND VICE VERSA. THIS WILL GREATLY */ 18430000 * /* FACILITATE THE PRUNING OF THE OFFSET BLOCKS. */ 18440000 * ADATSAVE = UADSRDAT; /* SAVE OFFSET TO DATAFLD */ 18450000 MVC ADATSAVE(4),8(@3) 0316 18460000 * DROBPTR = NPRSAVE; /* REF THE NEW PROC OBLK */ 18470000 L @3,NPRSAVE 0317 18480000 * RDATSAVE = UADSRDAT; /* SAVE OFFSET TO ITS DATAFLD */ 18490000 MVC RDATSAVE(4),8(@3) 0318 18500000 * UADSRDAT = ADATSAVE; /* TRANSFER DATAFLD OFFSET */ 18510000 MVC 8(4,@3),ADATSAVE 0319 18520000 * DROBPTR = LASTOB; /* REF THE 1ST OBLK AGAIN */ 18530000 L @3,LASTOB 0320 18540000 * UADSRDAT = RDATSAVE; /* TRANSFER DATAFLD OFFSET */ 18550000 MVC 8(4,@3),RDATSAVE 0321 18560000 * RNEXSAVE = UADSRNEX; /* SAVE OFFSET TO NEXT OBLK */ 18570000 MVC RNEXSAVE+1(3),1(@3) 0322 18580000 MVI RNEXSAVE,X'00' 0322 18590000 **/*RCHNPR2: P REF NEXT PROC IN LOCAL CHAIN */ 18600000 **/* P SAVE CHAIN FLAG & OFFSET TO NEXT OFSBLK */ 18610000 * RCHNPR2: /* BEGINNING OF THE PRUNING LOOP. */ 18620000 * DROBPTR = HEDBPTR+RNEXSAVE; /* REF THE NEXT PROC OBLK */ 18630000 RCHNPR2 L @3,RNEXSAVE 0323 18640000 AR @3,@4 0323 18650000 * /* SAVE THE CHAIN FLAG OF THIS OFFSET BLOCK. */ 18660000 * IF FLGR01 = '1'B 18670000 * THEN 18680000 TM 0(@3),B'10000000' 0324 18690000 BC 12,@9D5 0324 18700000 * FLGSAVE = '1'B; 18710000 OI CFLAGS,B'00100000' 0325 18720000 BC 15,@9D4 0326 18730000 * ELSE 18740000 * FLGSAVE = '0'B; 18750000 @9D5 NI CFLAGS,B'11011111' 0326 18760000 * RNEXSAVE = UADSRNEX; /* SAVE OFFSET TO NEXT OBLK */ 18770000 @9D4 MVC RNEXSAVE+1(3),1(@3) 0327 18780000 MVI RNEXSAVE,X'00' 0327 18790000 * UADSRPTR = HEDBPTR+UADSRDAT;/* REF THIS DATA FIELD */ 18800000 L @F,8(0,@3) 0328 18810000 AR @F,@4 0328 18820000 ST @F,UADSRPTR 0328 18830000 **/* D (YES,RCHNPR3,NO,) IS THIS DATFLD SHARED? */ 18840000 * /* IF THE DATA FIELD IS NOT SHARED, THEN FREE IT. */ 18850000 * IF UADSRCTR > 1 18860000 * THEN /* IT IS SHARED */ 18870000 LR @5,@F 0329 18880000 CLI 0(@5),1 0329 18890000 BC 12,@9D3 0329 18900000 * DO; 18910000 * UADSRCTR = UADSRCTR-1;/* DECREMENT THE USE COUNTER */ 18920000 LH @F,@D1 0331 18930000 SR @0,@0 0331 18940000 IC @0,0(0,@5) 0331 18950000 AR @F,@0 0331 18960000 STC @F,0(0,@5) 0331 18970000 * GOTO RCHNPR3; /* BYPASS DATAFLD PRUNING */ 18980000 BC 15,RCHNPR3 0332 18990000 * END; 19000000 **/* S IKJFRSP: PRUNE THIS DATAFLD */ 19010000 * /* PRUNE THE PROCNAME DATA FIELD FROM THE TREE. */ 19020000 * AREAOFST = UADSRDAT; /* OFFSET TO AREA TO BE FREED */ 19030000 @9D3 MVC GETFREE+8(4),8(@3) 0334 19040000 * AREALNTH = 24; /* LENGTH TO BE FREED */ 19050000 LA @F,24 0335 19060000 STH @F,GETFREE+6 0335 19070000 * CALL IKJFRSP; /* GO FREE THE DATAFLD */ 19080000 BAL @E,IKJFRSP 0336 19090000 **/*RCHNPR3: S IKJFRSP: PRUNE THIS OFSBLK */ 19100000 * RCHNPR3: /* PRUNE THE PROCNAME OFFSET BLOCK FROM THE TREE. */ 19110000 * AREAOFST = DROBPTR-HEDBPTR; /* OFFSET TO AREA TO BE FREED */ 19120000 RCHNPR3 LR @F,@3 0337 19130000 SR @F,@4 0337 19140000 ST @F,GETFREE+8 0337 19150000 * AREALNTH = 12; /* LENGTH TO BE FREED */ 19160000 LA @F,12 0338 19170000 STH @F,GETFREE+6 0338 19180000 * CALL IKJFRSP; /* GO FREE THE OFFSET BLOCK */ 19190000 BAL @E,IKJFRSP 0339 19200000 **/* D (YES,RCHNPR2,NO,) MORE PROCS IN THIS LOCAL CHAIN? */ 19210000 * /* CHECK THE CHAIN FLAG OF THE OFFSET BLOCK JUST PRUNED. */ 19220000 * /* '1' INDICATES END OF LOCAL CHAIN & END OF PRUNING. */ 19230000 * IF FLGSAVE = '0'B 19240000 * THEN /* NO, NOT END OF CHAIN, */ 19250000 TM CFLAGS,B'00100000' 0340 19260000 * GOTO RCHNPR2; /* CONTINUE PRUNING */ 19270000 BC 08,RCHNPR2 0341 19280000 * /* ALL OFFSET BLOCKS IN THIS CHAIN, EXCEPT THE FIRST, */ 19290000 * /* HAVE NOW BEEN PRUNED. */ 19300000 * DROBPTR = LASTOB; /* REF 1ST OBLK AGAIN */ 19310000 L @3,LASTOB 0342 19320000 * FLGR01 = '1'B; /* SET ITS CHAIN FLAG TO '1' */ 19330000 OI 0(@3),B'10000000' 0343 19340000 * UADSRNEX = RNEXSAVE; /* INSERT OFFSET TO THE BEGIN- 19350000 * NING OF THE NEXT CHAIN */ 19360000 MVC 1(3,@3),RNEXSAVE+1 0344 19370000 **/* P (,PRNEXT3) PUT CHAINFLG & OFFSET FROM LAST OFSBLK INTO OFSBLK* 19380000 * GOTO PRNEXT3; /* GO CHECK WHERE PROCESSING 19390000 * IS TO CONTINUE */ 19400000 BC 15,PRNEXT3 0345 19410000 * 19420000 **/*CSNDOK: S CTRCHK: INCREMENT USE COUNTER IF < 255 */ 19430000 **/* P CONNECT COUSIN DATFLD TO 1ST OFSBLK IN LOC CHAIN */ 19440000 **/* D (YES,RCHNPR,NO,) DATFLD OF 1ST OFSBLK SHARED? */ 19450000 * CSNDOK: /* A COUSIN WAS FOUND WHOSE DATA FIELD CAN BE USED. */ 19460000 * /* M4226 */ 19470000 * /* GO CHECK THE USE COUNTER AND, IF NOT GREATER THAN 255, */ 19480000 * /* INCREMENT IT BY ONE. */ 19490000 * CALL CTRCHK; /* M2581 */ 19500000 CSNDOK BAL @E,CTRCHK 0346 19510000 * DROBPTR = LASTOB; /* REF 1ST OBLK IN THIS CHAIN */ 19520000 L @3,LASTOB 0347 19530000 * UADSRPTR = HEDBPTR+UADSRDAT;/* REF ITS DATA FIELD */ 19540000 L @F,8(0,@3) 0348 19550000 AR @F,@4 0348 19560000 ST @F,UADSRPTR 0348 19570000 * /* CAN ITS DATA FIELD BE FREED? */ 19580000 * IF UADSRCTR > 1 19590000 * THEN /* NO, */ 19600000 LR @5,@F 0349 19610000 CLI 0(@5),1 0349 19620000 BC 12,@9D2 0349 19630000 * UADSRCTR = UADSRCTR-1; /* DECREMENT ITS USE CTR */ 19640000 LH @F,@D1 0350 19650000 SR @0,@0 0350 19660000 IC @0,0(0,@5) 0350 19670000 AR @F,@0 0350 19680000 STC @F,0(0,@5) 0350 19690000 BC 15,@9D1 0351 19700000 * ELSE /* YES, */ 19710000 * DO; 19720000 * AREAOFST = UADSRDAT; /* OFFSET TO AREA TO BE FREED */ 19730000 @9D2 MVC GETFREE+8(4),8(@3) 0352 19740000 * AREALNTH = 24; /* LENGTH TO BE FREED */ 19750000 LA @F,24 0353 19760000 STH @F,GETFREE+6 0353 19770000 * CALL IKJFRSP; /* GO FREE THIS DATA FIELD */ 19780000 BAL @E,IKJFRSP 0354 19790000 * END; 19800000 * UADSRDAT = RDATSAVE; /* INSERT OFFSET TO THE COUSIN 19810000 * DATA FIELD */ 19820000 @9D1 MVC 8(4,@3),RDATSAVE 0356 19830000 **/*CSNDOK2: S (,RCHNPR) IKJFRSP: PRUNE ITS DATAFLD */ 19840000 * CSNDOK2: /* IF THIS IS THE ONLY OFFSET BLOCK IN THIS LOCAL CHAIN, */ 19850000 * /* THEN NO FURTHER CHANGES ARE NECESSARY. */ 19860000 * IF FLGR01 ='1'B 19870000 * THEN /* YES, END OF CHAIN */ 19880000 CSNDOK2 TM 0(@3),B'10000000' 0357 19890000 * GOTO PRNEXT3; /* GO CHECK WHERE PROCESSING 19900000 * IS TO CONTINUE */ 19910000 BC 01,PRNEXT3 0358 19920000 * RNEXSAVE = UADSRNEX; /* SAVE OFFSET TO BROTHER */ 19930000 MVC RNEXSAVE+1(3),1(@3) 0359 19940000 MVI RNEXSAVE,X'00' 0359 19950000 * GOTO RCHNPR2; /* GO PRUNE ALL OTHER OFFSET 19960000 * BLOCKS IN THIS CHAIN */ 19970000 BC 15,RCHNPR2 0360 19980000 **/*PRNFND: P REF 1ST PROC IN LOCAL CHAIN */ 19990000 * PRNFND: /* NO PROCNAME WITH THE REQUIRED DATA EXISTS IN THIS */ 20000000 * /* TREE. CHECK WHETHER AN EXISTING DATA FIELD IN THIS */ 20010000 * /* LOCAL CHAIN CAN BE USED. */ 20020000 * /* DOES THE NEW PROCNAME EXIST IN THIS CHAIN (WITH DIF- */ 20030000 * /* FERENT DATA)? */ 20040000 * IF OPRSAVE = 0 20050000 * THEN /* NO, */ 20060000 PRNFND SR @F,@F 0361 20070000 C @F,OPRSAVE 0361 20080000 * GOTO PRNFND2; /* GO REF THE 1ST OBLK */ 20090000 BC 08,PRNFND2 0362 20100000 * DROBPTR = OPRSAVE; /* REF THE NEW PROC OBLK */ 20110000 L @3,OPRSAVE 0363 20120000 * UADSRPTR = HEDBPTR+UADSRDAT;/* REF ITS DATA FIELD */ 20130000 L @F,8(0,@3) 0364 20140000 AR @F,@4 0364 20150000 ST @F,UADSRPTR 0364 20160000 * /* CAN THIS DATA FIELD BE USED? */ 20170000 * IF UADSRCTR > 1 20180000 * THEN /* NO, */ 20190000 LR @5,@F 0365 20200000 CLI 0(@5),1 0365 20210000 BC 12,@9D0 0365 20220000 * CALL NEWPRDF; /* GO CREATE A NEW DATAFLD */ 20230000 BAL @E,NEWPRDF 0366 20240000 * CALL PRDFCH; /* INSERT NEW DATA, IF ANY */ 20250000 @9D0 BAL @E,PRDFCH 0367 20260000 * NPRSAVE = OPRSAVE; /* TRANSFER FOR LATER USE */ 20270000 MVC NPRSAVE(4),OPRSAVE 0368 20280000 * UADSRNAM = DLPROC; /* INSERT THE NEW PROCNAME */ 20290000 L @5,UADSRPTR 0369 20300000 MVC 4(8,@5),DLPROC 0369 20310000 * GOTO RCHNPR; /* GO TO PRUNING SECTION */ 20320000 BC 15,RCHNPR 0370 20330000 * 20340000 * PRNFND2: /* USE THE 1ST PROC OFFSET BLOCK IN THIS CHAIN AND */ 20350000 * /* PRUNE ALL OTHERS. */ 20360000 * DROBPTR = LASTOB; /* REF 1ST OBLK IN THIS CHAIN */ 20370000 PRNFND2 L @3,LASTOB 0371 20380000 * UADSRPTR = HEDBPTR+UADSRDAT;/* REF ITS DATA FIELD */ 20390000 L @F,8(0,@3) 0372 20400000 AR @F,@4 0372 20410000 ST @F,UADSRPTR 0372 20420000 **/* D (NO,%CHNP,YES,) IS ITS DATFLD SHARED? */ 20430000 **/* S NEWPRDF: CREATE A NEW PROC DATAFLD */ 20440000 * /* CAN THIS DATA FIELD BE USED? */ 20450000 * IF UADSRCTR > 1 20460000 * THEN /* NO, */ 20470000 LR @5,@F 0373 20480000 CLI 0(@5),1 0373 20490000 BC 12,@9CF 0373 20500000 * CALL NEWPRDF; /* GO CREATE A NEW DATAFLD */ 20510000 BAL @E,NEWPRDF 0374 20520000 **/*%CHNP: P INSERT DEFAULT VALUES FOR SIZE & UNIT */ 20530000 **/* S PRDFCH: INSERT NEW DATA ITEMS */ 20540000 **/* P (,RCHNPR) INSERT THE NEW PROCNAME */ 20550000 * UADSRSIZ = 0; /* INSERT DEFAULT VALUE */ 20560000 @9CF SR @F,@F 0375 20570000 L @5,UADSRPTR 0375 20580000 STH @F,14(0,@5) 0375 20590000 * UADSUNAM = ' '; /* INSERT DEFAULT VALUE */ 20600000 MVI 16(@5),C' ' 0376 20610000 MVC 17(7,@5),16(@5) 0376 20620000 * CALL PRDFCH; /* GO INSERT NEW DATA, IF ANY */ 20630000 BAL @E,PRDFCH 0377 20640000 * UADSRNAM = DLPROC; /* INSERT THE NEW PROCNAME */ 20650000 L @5,UADSRPTR 0378 20660000 MVC 4(8,@5),DLPROC 0378 20670000 * GOTO CSNDOK2; /* GO CHECK FOR BROTHERS */ 20680000 BC 15,CSNDOK2 0379 20690000 * 20700000 **/*ALLPRDF: P REF 1ST PROC OFSBLK IN LOC CHAIN */ 20710000 * ALLPRDF: /* CHANGE ALL DATA FIELDS IN A LOCAL CHAIN. */ 20720000 * UADSRPTR = HEDBPTR+UADSRDAT;/* REF THE PROC DATAFLD */ 20730000 ALLPRDF L @F,8(0,@3) 0380 20740000 AR @F,@4 0380 20750000 ST @F,UADSRPTR 0380 20760000 **/*%CD: S CMPRND: COMPARE ITS DATFLD TO NEW DATA */ 20770000 **/* D (NO,SRCHND,YES,) DATFLD = NEW DATA? */ 20780000 * CALL CMPRND; /* GO COMPARE THE EXISTING DATA 20790000 * TO THE NEW DATA */ 20800000 BAL @E,CMPRND 0381 20810000 * /* IS THE EXISTING DATA EQUAL TO THE NEW DATA? IF NOT, */ 20820000 * /* THEN THE TOTAL CHAIN MUST BE SEARCHED TO SEE WHETHER */ 20830000 * /* THIS SAME PROCNAME, WITH THE CORRECT DATA, ALREADY */ 20840000 * /* EXISTS IN ANOTHER CHAIN. */ 20850000 * IF PRDFLG = '0'B 20860000 * THEN /* NO, DATA IS NOT EQUAL, */ 20870000 TM CFLAGS,B'00000010' 0382 20880000 * GOTO SRCHND; /* GO SEARCH THE TOTAL CHAIN */ 20890000 BC 08,SRCHND 0383 20900000 **/*NEXTDF: D (NO,PRNEXT3,YES,) MORE PROCS IN THIS CHAIN? */ 20910000 * NEXTDF: /* CHECK FOR MORE PROCNAMES IN THIS CHAIN. */ 20920000 * IF FLGR01 = '1'B 20930000 * THEN /* END OF LOCAL CHAIN */ 20940000 NEXTDF TM 0(@3),B'10000000' 0384 20950000 * GOTO PRNEXT3; /* GO CHECK WHERE PROCESSING IS 20960000 * TO CONTINUE */ 20970000 BC 01,PRNEXT3 0385 20980000 * DROBPTR = HEDBPTR+UADSRNEX; /* REF THE NEXT PROCNAME OBLK */ 20990000 MVC @TEMP3+1(3),1(@3) 0386 21000000 L @F,@TEMP3 0386 21010000 AR @F,@4 0386 21020000 LR @3,@F 0386 21030000 **/* P (,%CD) REF NEXT PROC OFSBLK IN LOC CHAIN */ 21040000 * GOTO ALLPRDF; /* GO PROCESS THIS PROCNAME */ 21050000 BC 15,ALLPRDF 0387 21060000 **/*SRCHND: P SAVE THIS PROC & REF 1ST PROC IN TOTAL CHAIN */ 21070000 * SRCHND: /* SEARCH THE TOTAL CHAIN TO SEE WHETHER THIS PROCNAME, */ 21080000 * /* WITH THE REQUIRED DATA, ALREADY EXISTS IN ANOTHER CHAIN*/ 21090000 * OPRSAVE = DROBPTR; /* SAVE ADDR OF THIS OBLK */ 21100000 SRCHND ST @3,OPRSAVE 0388 21110000 * ODFPTR = UADSRPTR; /* SAVE ADDR OF THIS DATAFLD */ 21120000 MVC ODFPTR(4),UADSRPTR 0389 21130000 * DLPROC = UADSRNAM; /* TRANSFER THE PROCNAME TO 21140000 * ANOTHER VARIABLE */ 21150000 L @5,UADSRPTR 0390 21160000 MVC DLPROC(8),4(@5) 0390 21170000 * DROBPTR = FRSTDROB; /* REF 1ST OBLK IN TOTAL CHAIN*/ 21180000 L @3,FRSTDROB 0391 21190000 **/*SRCHND2: S DLPRTS: SEARCH TOTAL CHAIN FOR THIS PROC */ 21200000 **/* D (NO,CHGDF,YES,) FOUND? */ 21210000 * SRCHND2: /* GO TO THE SEARCH SUBROUTINE TO PERFORM THE SEARCH. */ 21220000 * CALL DLPRTS; 21230000 SRCHND2 BAL @E,DLPRTS 0392 21240000 * /* WAS THE PROCNAME FOUND? */ 21250000 * IF NPRSAVE = 0 21260000 * THEN /* NO, */ 21270000 SR @F,@F 0393 21280000 C @F,NPRSAVE 0393 21290000 * GOTO CHGDF; /* GO MAKE APPROPRIATE CHANGES*/ 21300000 BC 08,CHGDF 0394 21310000 * /* IT WAS FOUND. DOES IT POINT TO THE SAME DATA FIELD? IF */ 21320000 * /* YES, IGNORE IT AND CONTINUE THE SEARCH. */ 21330000 * IF ODFPTR = NDFPTR 21340000 * THEN /* YES, */ 21350000 L @F,NDFPTR 0395 21360000 C @F,ODFPTR 0395 21370000 BC 07,@9CE 0395 21380000 * SRCHND3: /* ARE THERE MORE PROCNAMES IN THE TOTAL CHAIN? */ 21390000 * IF UADSRNEX ª= 0 21400000 * THEN /* YES, */ 21410000 SRCHND3 SR @F,@F 0396 21420000 MVC @TEMP3+1(3),1(@3) 0396 21430000 C @F,@TEMP3 0396 21440000 BC 08,@9CD 0396 21450000 * DO; 21460000 * DROBPTR = /* REF THE NEXT PROCNAME OBLK */ 21470000 * HEDBPTR+UADSRNEX; 21480000 MVC @TEMP3+1(3),1(@3) 0398 21490000 L @F,@TEMP3 0398 21500000 AR @F,@4 0398 21510000 LR @3,@F 0398 21520000 * GOTO SRCHND2; /* GO CONTINUE THE SEARCH */ 21530000 BC 15,SRCHND2 0399 21540000 * END; 21550000 * ELSE /* NO, THEREFORE A USABLE DATA 21560000 * FIELD WAS NOT FOUND */ 21570000 * GOTO CHGDF; /* GO MAKE APPROPRIATE CHANGES*/ 21580000 * 21590000 **/* P COPY CURRENT DATFLD INTO MODEL DATFLD */ 21600000 **/* S PRDFCH: INSERT NEW DATA ITEM(S) */ 21610000 **/* D (YES,%CSOK,NO,) COUSIN DATFLD = MODEL DATFLD? */ 21620000 **/*SRCHND3: D (NO,CHGDF,YES,) MORE PROCS IN TOTAL CHAIN? */ 21630000 **/* P (,SRCHND2) REF THE NEXT PROC OFSBLK */ 21640000 * 21650000 * /* IT POINTS TO A DIFFERENT DATA FIELD. COMPARE THE DATA. */ 21660000 * /* BUILD A MODEL OF THE CURRENT DATA FIELD AND INSERT THE */ 21670000 * /* NEW DATA ITEM(S) FROM THE COMMAND. THEN COMPARE THE */ 21680000 * /* COUSIN DATA FIELD TO THIS MODEL. */ 21690000 * UADSRPTR = ODFPTR; /* REF CURRENT PROC DATAFLD */ 21700000 @9CC EQU * 0402 21710000 @9CE MVC UADSRPTR(4),ODFPTR 0402 21720000 * DROBDMDL = DROBD; /* COPY IT INTO MODEL */ 21730000 L @5,UADSRPTR 0403 21740000 MVC DROBDMDL(24),0(@5) 0403 21750000 * UADSRPTR = ADDR(DROBDMDL); /* SET PTR TO MODEL */ 21760000 LA @F,DROBDMDL 0404 21770000 ST @F,UADSRPTR 0404 21780000 * CALL PRDFCH; /* GO INSERT NEW DATA ITEMS */ 21790000 BAL @E,PRDFCH 0405 21800000 * UADSRPTR = NDFPTR; /* REF COUSIN DATA FIELD */ 21810000 MVC UADSRPTR(4),NDFPTR 0406 21820000 * /* ONLY THE SIZE AND UNIT NAME HAVE TO BE COMPARED. */ 21830000 * IF UADSRSIZ ª= TEMPRSIZ /* IS SIZE DIFFERENT? */ 21840000 * ³ UADSUNAM ª= TEMPUNAM /* OR UNIT NAME DIFFERENT? */ 21850000 * THEN /* YES, THEREFORE COUSIN DATA 21860000 * FIELD CANNOT BE USED */ 21870000 MVC @TEMP2+2(2),DROBDMDL+14 0407 21880000 L @F,@TEMP2 0407 21890000 L @5,UADSRPTR 0407 21900000 MVC @TEMP2+2(2),14(@5) 0407 21910000 C @F,@TEMP2 0407 21920000 BC 07,@9CB 0407 21930000 CLC 16(8,@5),DROBDMDL+16 0407 21940000 BC 08,@9CA 0407 21950000 * GOTO SRCHND3; /* CONTINUE THE PROCESS UNTIL 21960000 * END OF TOT CHAIN IS REACHED*/ 21970000 BC 07,SRCHND3 0408 21980000 * /* A USABLE DATA FIELD WAS FOUND. */ 21990000 * /* GO CHECK THE USE COUNTER AND, IF NOT GREATER THAN 255, */ 22000000 * /* INCREMENT IT BY ONE. */ 22010000 * CALL CTRCHK; /* M2581 */ 22020000 @9CA BAL @E,CTRCHK 0409 22030000 * DROBPTR = OPRSAVE; /* REF THE ORIGINAL OBLK AGAIN*/ 22040000 L @3,OPRSAVE 0410 22050000 * UADSRPTR = ODFPTR; /* REF ITS DATAFLD */ 22060000 MVC UADSRPTR(4),ODFPTR 0411 22070000 **/*%CSOK: S CTRCHK: INCREMENT USE COUNTER IF < 255 */ 22080000 **/* P REF ORIGINAL DATFLD AGAIN */ 22090000 **/* D (YES,%SHRD,NO,) THIS DATFLD SHARED? */ 22100000 **/* S IKJFRSP: PRUNE THIS DATAFLD */ 22110000 * /* CAN ITS DATA FIELD BE FREED? */ 22120000 * IF UADSRCTR = 1 22130000 * THEN /* YES, */ 22140000 L @5,UADSRPTR 0412 22150000 CLI 0(@5),1 0412 22160000 BC 07,@9C9 0412 22170000 * DO; 22180000 * AREAOFST = UADSRDAT; /* OFFSET TO AREA TO BE FREED */ 22190000 MVC GETFREE+8(4),8(@3) 0414 22200000 * AREALNTH = 24; /* LENGTH TO BE FREED */ 22210000 LA @F,24 0415 22220000 STH @F,GETFREE+6 0415 22230000 * CALL IKJFRSP; /* GO FREE THE DATAFLD */ 22240000 BAL @E,IKJFRSP 0416 22250000 BC 15,@9C8 0418 22260000 * END; 22270000 * ELSE /* NO, */ 22280000 * UADSRCTR = UADSRCTR-1; /* DECREMENT THE USE CTR */ 22290000 @9C9 LH @F,@D1 0418 22300000 L @5,UADSRPTR 0418 22310000 SR @0,@0 0418 22320000 IC @0,0(0,@5) 0418 22330000 AR @F,@0 0418 22340000 STC @F,0(0,@5) 0418 22350000 * UADSRDAT = RDATSAVE; /* INSERT OFFSET TO COUSIN 22360000 * DATA FIELD */ 22370000 @9C8 MVC 8(4,@3),RDATSAVE 0419 22380000 **/*%SHRD: P (,NEXTDF) CONNECT COUSIN DATFLD TO THIS OFSBLK */ 22390000 * GOTO NEXTDF; /* GO CONTINUE WITH THE NEXT 22400000 * PROCNAME IN THE LOCAL CHAIN*/ 22410000 BC 15,NEXTDF 0420 22420000 **/*CHGDF: D (NO,%NSHRD,YES,) DATAFLD SHARED? */ 22430000 **/* S NEWPRDF: CREATE A NEW PROC DATAFLD */ 22440000 * CHGDF: /* NO USABLE DATA FIELD WAS FOUND. CHANGE THE EXISTING */ 22450000 * /* DATA FIELD IF IT IS NOT SHARED. IF IT IS SHARED, THEN */ 22460000 * /* CREATE A NEW ONE. */ 22470000 * DROBPTR = OPRSAVE; /* REF THE OBLK IN QUESTION */ 22480000 CHGDF L @3,OPRSAVE 0421 22490000 * UADSRPTR = ODFPTR; /* REF ITS DATAFLD */ 22500000 MVC UADSRPTR(4),ODFPTR 0422 22510000 * /* IS IT SHARED? */ 22520000 * IF UADSRCTR > 1 22530000 * THEN /* YES, */ 22540000 L @5,UADSRPTR 0423 22550000 CLI 0(@5),1 0423 22560000 BC 12,@9C7 0423 22570000 * CALL NEWPRDF; /* CREATE A NEW PROC DATAFLD */ 22580000 BAL @E,NEWPRDF 0424 22590000 **/*%NSHRD: S (,NEXTDF) PRDFCH: INSERT NEW DATA ITEMS */ 22600000 * CALL PRDFCH; /* INSERT THE NEW DATA */ 22610000 @9C7 BAL @E,PRDFCH 0425 22620000 * GOTO NEXTDF; /* GO CONTINUE WITH THE NEXT 22630000 * PROCNAME IN THE LOCAL CHAIN*/ 22640000 BC 15,NEXTDF 0426 22650000 * 22660000 **/*PRNEXT3: D (NO,%NXT4,YES,) NODELIST ACTNBR = '*'? */ 22670000 **/* D (NO,PRNEXT4,YES,) MORE ACTNBRS FOR THIS PASSWORD? */ 22680000 **/* P (,CHALLPR) REF NEXT ACTNBR UNDER CURRENT PASSWORD */ 22690000 **/*%NXT4: P (,PRNEXT2) INDICATE TREE HAS BEEN CHANGED */ 22700000 * 22710000 * PRNEXT3: /* A LOCAL PROCNAME CHAIN HAS BEEN CHANGED. DETERMINE */ 22720000 * /* WHERE PROCESSING IS TO CONTINUE. */ 22730000 * 22740000 * DNOBPTR = OACSAVE; /* REF ORIGINAL ACTNO AGAIN */ 22750000 PRNEXT3 L @2,OACSAVE 0427 22760000 * /* ARE THERE MORE ACCTNMBRS TO BE PROCESSED UNDER THE */ 22770000 * /* CURRENT PASSWORD? THIS IS POSSIBLE ONLY IF THE NODELIST*/ 22780000 * /* ACCTNMBR = '*'. */ 22790000 * IF ACCTNO(1:2) = '* ' 22800000 * THEN /* YES, */ 22810000 L @5,CTABPTR 0428 22820000 L @5,8(0,@5) CTRLTAB 0428 22830000 CLC 16(2,@5),@C5 0428 22840000 BC 07,@9C6 0428 22850000 * /* CHECK THE CHAIN FLAG IN THE ACCTNMBR OFFSET BLOCK. */ 22860000 * IF AFLG01 = '0'B /* MORE ACCTNMBRS? */ 22870000 * THEN /* YES, */ 22880000 TM 0(@2),B'10000000' 0429 22890000 BC 05,@9C5 0429 22900000 * DO; 22910000 * DNOBPTR = /* REF THE NEXT BROTHER OBLK */ 22920000 * HEDBPTR+UADSANEX; 22930000 MVC @TEMP3+1(3),1(@2) 0431 22940000 L @F,@TEMP3 0431 22950000 AR @F,@4 0431 22960000 LR @2,@F 0431 22970000 * OACSAVE = DNOBPTR;/* SAVE THIS ADDR */ 22980000 ST @2,OACSAVE 0432 22990000 * GOTO CHALLPR; /* PROCESS NEXT PROC CHAIN */ 23000000 BC 15,CHALLPR 0433 23010000 * END; 23020000 * ELSE /* NO MORE ACTNOS FOR THIS PWD*/ 23030000 * GOTO PRNEXT4; /* GO CHECK PASSWORDS */ 23040000 * ELSE /* ACCTNMBR WAS SPECIFIED, */ 23050000 * DO; 23060000 * TRCHGE = 1; /* 1- THIS TREE HAS BEEN CHGD */ 23070000 @9C6 LA @F,1 0437 23080000 L @5,CTABPTR 0437 23090000 STH @F,34(0,@5) 0437 23100000 * GOTO PRNEXT2; /* GO CHECK FOR MORE PASSWRDS */ 23110000 BC 15,PRNEXT2 0438 23120000 * END; 23130000 * 23140000 **/*PRNEXT4: D (NO,CHGEOK,YES,) NODELIST PASSWRD = '*'? */ 23150000 **/* D (NO,CHGEOK,YES,) MORE PASSWRDS FOR THIS USERID? */ 23160000 **/* P (,ACLVL) REFERENCE NEXT PASSWORD OBLK */ 23170000 * 23180000 * PRNEXT4: /* THE END OF A LOCAL ACCTNMBR CHAIN HAS BEEN REACHED, */ 23190000 * /* CHECK FOR MORE PASSWORDS. */ 23200000 * DPOBPTR = OPWSAVE; /* REF CURRENT PASSWD OBLK */ 23210000 @9C3 EQU * 0440 23220000 PRNEXT4 MVC DPOBPTR(4),OPWSAVE 0440 23230000 * /* NODELIST PASSWORD = '*'? */ 23240000 * IF PASSWD(1) = '*' 23250000 * THEN /* YES, */ 23260000 L @5,CTABPTR 0441 23270000 L @5,8(0,@5) CTRLTAB 0441 23280000 CLI 8(@5),C'*' 0441 23290000 BC 07,@9C2 0441 23300000 * /* CHECK THE CHAIN FLAG IN THE PASSWORD OFFSET BLOCK. */ 23310000 * IF PFLG01 = '0'B /* MORE PASSWORDS? */ 23320000 * THEN /* YES, */ 23330000 L @8,DPOBPTR 0442 23340000 TM 0(@8),B'10000000' 0442 23350000 BC 05,@9C1 0442 23360000 * DO; 23370000 * DPOBPTR = /* REF NEXT PASSWORD BROTHER */ 23380000 * HEDBPTR+UADSPNEX; 23390000 MVC @TEMP3+1(3),1(@8) 0444 23400000 L @F,@TEMP3 0444 23410000 AR @F,@4 0444 23420000 ST @F,DPOBPTR 0444 23430000 * GOTO ACLVL; /* CONTINUE WITH NEXT PASSWORD*/ 23440000 BC 15,ACLVL 0445 23450000 * END; 23460000 * /* NO, THEREFORE NO MORE CHANGES ARE NECESSARY FOR THIS */ 23470000 * /* USERID TREE. */ 23480000 * GOTO CHGEOK; /* GO SET INDICATORS & RETURN */ 23490000 * 23500000 * GENERATE; 23510000 PACKDEC PACK DECSIZE(8),0(1,R1) 23520000 DS 0H 23530000 * 23540000 **/*CHGEOK: P INDICATE SUCCESSFUL COMPLETION */ 23550000 * CHGEOK: /* THIS TREE HAS BEEN CHANGED SUCCESSFULLY. SET APPROPRI- */ 23560000 * /* ATE INDICATORS AND RETURN TO CHANGE (IKJEFA20). */ 23570000 * SRCHIND = 0; /* NO FURTHER SEARCH REQUIRED */ 23580000 CHGEOK SR @F,@F 0449 23590000 L @5,CTABPTR 0449 23600000 STH @F,30(0,@5) 0449 23610000 * /* CHECK WHETHER SIZE WAS REDUCED TO MAXSIZE. IF SO, */ 23620000 * /* IKJEFA20 WILL INFORM THE USER OF THIS ACTION. */ 23630000 * IF STGFLG = '1'B 23640000 * THEN /* YES, MSG IS NECESSARY */ 23650000 TM CFLAGS,B'10000000' 0450 23660000 BC 12,@9C0 0450 23670000 * MSGNMBR = 14; /* SET MSG NUMBER FOR IKJEFA20*/ 23680000 LA @F,14 0451 23690000 STH @F,32(0,@5) 0451 23700000 BC 15,@9BF 0452 23710000 * ELSE /* NO, */ 23720000 * MSGNMBR = 0; /* INDIC SUCCESSFUL COMPLETION*/ 23730000 @9C0 SR @F,@F 0452 23740000 STH @F,32(0,@5) 0452 23750000 * 23760000 **/*WORKEND: R RETURN TO IKJEFA20 */ 23770000 * WORKEND: /* THIS ROUTINE HAS COMPLETED PROCESSING. RETURN TO */ 23780000 * /* CHANGE (IKJEFA20) WITH EITHER A REQUEST TO WRITE THIS */ 23790000 * /* TREE BACK INTO THE UADS, OR A REQUEST TO PERFORM */ 23800000 * /* ANOTHER SEARCH, OR A REQUEST TO ISSUE AN ERROR MESSAGE.*/ 23810000 * RETURN; 23820000 BC 15,@EL01 0453 23830000 * 23840000 * /**********************************************************/ 23850000 * /* */ 23860000 * /* SUBROUTINES */ 23870000 * /* */ 23880000 * /**********************************************************/ 23890000 * 23900000 **/* E DLPRLS */ 23910000 **/* P SEARCH A LOCAL CHAIN FOR A GIVEN PROCNAME */ 23920000 * DLPRLS: /**********************************************************/ 23930000 * /* THIS SUBROUTINE WILL SEARCH FOR A GIVEN PROCNAME IN A */ 23940000 * /* LOCAL LATERAL CHAIN. IF FOUND, A POINTER WILL RECEIVE */ 23950000 * /* THE ADDRESS OF ITS OFFSET BLOCK. IF NOT FOUND, THE */ 23960000 * /* POINTER WILL BE SET TO ZERO. */ 23970000 * /**********************************************************/ 23980000 * 23990000 * PROCEDURE OPTIONS(NOSAVEAREA,DONTSAVE); 24000000 @EL01 L @D,4(0,@D) 0454 24010000 LR @1,@C 0454 24020000 L @0,@SIZ001 0454 24030000 FREEMAIN R,LV=(0),A=(1) 0454 24040000 L @E,12(0,@D) 0454 24050000 LM @0,@C,20(@D) 0454 24060000 BCR 15,@E 0454 24070000 DLPRLS EQU * 0454 24080000 * RESTRICT(HEDBPTR,DROBPTR); 24090000 **/*DLPRLS1: D (NO,%LSMPR,YES,) PROCNAME FOUND? */ 24100000 **/* P (,%LSRTN) SET PTR TO ITS OFSBLK */ 24110000 * DLPRLS1: /* BEGINNING OF THE SEARCH LOOP. */ 24120000 * UADSRPTR = HEDBPTR+UADSRDAT;/* REF THE PROC DATA FIELD */ 24130000 DLPRLS1 L @F,8(0,@3) 0456 24140000 AR @F,@4 0456 24150000 ST @F,UADSRPTR 0456 24160000 * /* COMPARE THE GIVEN PROCNAME TO THE UADS PROCNAME. */ 24170000 * IF DLPROC = UADSRNAM 24180000 * THEN /* YES, THEY ARE EQUAL */ 24190000 LR @1,@F 0457 24200000 CLC DLPROC(8),4(@1) 0457 24210000 BC 07,@9BE 0457 24220000 * DO; 24230000 * NPRSAVE = DROBPTR; /* SAVE ADDR OF THIS OBLK */ 24240000 ST @3,NPRSAVE 0459 24250000 * NDFPTR = UADSRPTR; /* SAVE ADDR OF THIS DATA FLD */ 24260000 MVC NDFPTR(4),UADSRPTR 0460 24270000 * RETURN; /* GO BACK TO POINT OF CALL */ 24280000 BC 15,@EL02 0461 24290000 * END; 24300000 * ELSE; /* NO, CONTINUE CHECKING */ 24310000 @9BE EQU * 0463 24320000 **/*%LSMPR: D (NO,%NFND,YES,) MORE PROCS IN LOC CHAIN? */ 24330000 **/* P (,DLPRLS1) REF NEXT PROC OFSBLK */ 24340000 * /* ARE THERE MORE BROTHERS IN THIS LOCAL CHAIN? */ 24350000 * IF FLGR01 = '0'B 24360000 * THEN /* YES, */ 24370000 @9BD TM 0(@3),B'10000000' 0464 24380000 BC 05,@9BC 0464 24390000 * DO; 24400000 * DROBPTR = HEDBPTR /* REF THE NEXT PROCNAME IN.. */ 24410000 * +UADSRNEX; /* THIS LOCAL CHAIN */ 24420000 MVC @TEMP3+1(3),1(@3) 0466 24430000 L @F,@TEMP3 0466 24440000 AR @F,@4 0466 24450000 LR @3,@F 0466 24460000 * GOTO DLPRLS1; /* CONTINUE THE SEARCH */ 24470000 BC 15,DLPRLS1 0467 24480000 * END; 24490000 **/*%NFND: P INDICATE PROCNAME NOT FOUND */ 24500000 * /* THE PROCNAME DOES NOT EXIST IN THIS LOCAL CHAIN. */ 24510000 * NPRSAVE = 0; /* 0- PROCNAME NOT FOUND */ 24520000 @9BC SR @F,@F 0469 24530000 ST @F,NPRSAVE 0469 24540000 **/*%LSRTN: R RETURN TO POINT OF CALL */ 24550000 **/*DLPRLS: END */ 24560000 * END DLPRLS; /* GO BACK TO POINT OF CALL */ 24570000 @EL02 BCR 15,@E 0470 24580000 * 24590000 * NEWPRDF: /**********************************************************/ 24600000 * /* THIS SUBROUTINE WILL GET SPACE FOR A NEW PROCNAME DATA */ 24610000 * /* FIELD AND THEN INSERT THE APPROPRIATE DATA. */ 24620000 * /**********************************************************/ 24630000 **/* E NEWPRDF */ 24640000 **/* P CREATE A NEW PROCNAME DATAFLD */ 24650000 * 24660000 * PROCEDURE OPTIONS(NOSAVEAREA,DONTSAVE); 24670000 NEWPRDF EQU * 0471 24680000 * RESTRICT(HEDBPTR,DROBPTR); 24690000 * GEN(ST @E,SAVE14); /* SAVE REGISTER 14 */ 24700000 ST @E,SAVE14 24710000 DS 0H 24720000 * UADSRCTR = UADSRCTR-1; /* DECREMENT THE USE COUNTER IN 24730000 * THE EXISTING FIELD */ 24740000 LH @F,@D1 0474 24750000 L @1,UADSRPTR 0474 24760000 SR @0,@0 0474 24770000 IC @0,0(0,@1) 0474 24780000 AR @F,@0 0474 24790000 STC @F,0(0,@1) 0474 24800000 * AREALNTH = 24; /* NUMBER OF BYTES NECESSARY 24810000 * FOR THE NEW DATA FIELD */ 24820000 LA @F,24 0475 24830000 STH @F,GETFREE+6 0475 24840000 * RESTRICT(R1); 24850000 * R1 = ADDR(GETFREE); /* PTR TO GETSPACE PARMLIST */ 24860000 LA @1,GETFREE 0477 24870000 **/* S IKJEFA53: GET THE REQUIRED SPACE */ 24880000 * CALL IKJEFA53; /* GET THE REQUIRED SPACE */ 24890000 L @F,@V1 ADDRESS OF IKJEFA53 0478 24900000 BALR @E,@F 0478 24910000 * RELEASE(R1); 24920000 * RETCODE = R15; /* SAVE THE RETURN CODE */ 24930000 L @1,CTABPTR 0480 24940000 ST @F,36(0,@1) 0480 24950000 **/* D (YES,%GTSPOK,NO,) GETSPACE SUCCESSFUL? */ 24960000 **/* P (,WORKEND) SET ERROR MSGNMBR */ 24970000 * /* CHECK THE GETSPACE RETURN CODE. */ 24980000 * IF RETCODE ª= 0 /* GETSPACE SUCCESSFUL? */ 24990000 * THEN /* NO, */ 25000000 SR @F,@F 0481 25010000 C @F,36(0,@1) 0481 25020000 BC 08,@9BB 0481 25030000 * DO; 25040000 * SRCHIND = 0; /* 0- PROCESSING OF THIS USERID 25050000 * IS COMPLETED */ 25060000 STH @F,30(0,@1) 0483 25070000 * MSGNMBR = 24; /* SET ERROR MSG NUMBER */ 25080000 LA @F,24 0484 25090000 STH @F,32(0,@1) 0484 25100000 * GOTO WORKEND; /* CHANGE CP WILL ISSUE THE 25110000 * ERROR MSG & CONTINUE WITH 25120000 * THE NEXT USERID, IF ANY */ 25130000 BC 15,WORKEND 0485 25140000 * END; 25150000 * NEWDFPTR = HEDBPTR+AREAOFST;/* CALCULATE ADDR OF THE NEW 25160000 * DATA FIELD */ 25170000 @9BB L @F,GETFREE+8 0487 25180000 AR @F,@4 0487 25190000 ST @F,NEWDFPTR 0487 25200000 **/*%GTSPOK: P COPY OLD DATFLD INTO NEW DATFLD */ 25210000 **/* P PUT NEW OFFSET INTO OFSTBLK */ 25220000 * NEWDFPTR->DROBD = /* COPY THE EXISTING DATAFIELD*/ 25230000 * UADSRPTR->DROBD; /* INTO THE NEW DATA FIELD */ 25240000 L @1,UADSRPTR 0488 25250000 LR @2,@F 0488 25260000 MVC 0(24,@2),0(@1) 0488 25270000 * UADSRDAT = AREAOFST; /* PUT THE NEW OFFSET INTO THE 25280000 * OFFSET BLOCK */ 25290000 MVC 8(4,@3),GETFREE+8 0489 25300000 * UADSRPTR = NEWDFPTR; /* THE ORIGINAL DATA FIELD IS 25310000 * NOW UNHOOKED FROM THIS LOCAL 25320000 * PROC CHAIN */ 25330000 MVC UADSRPTR(4),NEWDFPTR 0490 25340000 * UADSRCTR = 1; /* SET USE CTR TO 1 */ 25350000 L @1,UADSRPTR 0491 25360000 MVI 0(@1),1 0491 25370000 * GEN(L @E,SAVE14); /* RESTORE REGISTER 14 */ 25380000 L @E,SAVE14 25390000 DS 0H 25400000 * END NEWPRDF; /* RETURN TO POINT OF CALL */ 25410000 @EL03 BCR 15,@E 0493 25420000 **/* R RETURN TO POINT OF CALL */ 25430000 **/*NEWPRDF: END */ 25440000 * 25450000 * PRDFCH: /**********************************************************/ 25460000 * /* THIS SUBROUTINE WILL PUT THE NEW PROCSIZE AND/OR THE */ 25470000 * /* NEW UNIT NAME INTO THE PROCNAME DATA FIELD. */ 25480000 * /**********************************************************/ 25490000 **/* E PRDFCH */ 25500000 **/* P PUT NEW SIZE AND/OR UNIT NAME INTO DATFLD */ 25510000 * 25520000 * PROCEDURE OPTIONS(NOSAVEAREA,DONTSAVE); 25530000 * RESTRICT(DROBPTR); 25540000 **/* D (NO,%NUN,YES,) NEW SIZE SPECIFIED? */ 25550000 **/* P INSERT NEW SIZE INTO DATAFLD */ 25560000 * /* IS A PROCSIZE SPECIFIED IN THE COMMAND? */ 25570000 * IF RSIZFLG = '1'B 25580000 * THEN /* YES, */ 25590000 PRDFCH L @1,CHNPDLAD 0496 25600000 TM 46(@1),B'10000000' 0496 25610000 BC 12,@9BA 0496 25620000 * UADSRSIZ = NEWRSIZ; /* INSERT THE NEW PROCSIZE */ 25630000 L @2,UADSRPTR 0497 25640000 MVC 14(2,@2),NEWRSIZ 0497 25650000 **/*%NUN: D (NO,%DFRTN,YES,) NEW UNIT NAME SPECIFD? */ 25660000 **/* P INSERT NEW UNIT NAME INTO DATAFLD */ 25670000 * /* IS A UNIT NAME SPECIFIED IN THE COMMAND? */ 25680000 * IF UNITFLG = '1'B 25690000 * THEN /* YES, */ 25700000 @9BA TM 54(@1),B'10000000' 0498 25710000 BC 12,@9B9 0498 25720000 * UADSUNAM = NEWUNAM; /* INSERT THE NEW UNIT NAME */ 25730000 L @2,UADSRPTR 0499 25740000 MVC 16(8,@2),NEWUNAM 0499 25750000 **/*%DFRTN: R RETURN TO POINT OF CALL */ 25760000 **/*PRDFCH: END */ 25770000 * END PRDFCH; /* GO BACK TO POINT OF CALL */ 25780000 @9B9 EQU * 0500 25790000 @EL04 BCR 15,@E 0500 25800000 * 25810000 * CMPRND: /**********************************************************/ 25820000 * /* THIS SUBROUTINE WILL COMPARE THE NEW PROCSIZE, OR THE */ 25830000 * /* NEW UNIT NAME, OR BOTH, TO THE EXISTING VALUES IN A */ 25840000 * /* PROCNAME DATA FIELD AND SET A FLAG INDICATING EQUAL OR */ 25850000 * /* NOT EQUAL. */ 25860000 * /**********************************************************/ 25870000 **/* E CMPRND */ 25880000 **/* P COMPARE NEW DATA ITEMS TO THOSE IN A GIVEN DATFLD */ 25890000 * 25900000 * PROCEDURE OPTIONS(NOSAVEAREA,DONTSAVE); 25910000 CMPRND EQU * 0501 25920000 * 25930000 * RESTRICT(HEDBPTR,DROBPTR); 25940000 * /* M4226 */ 25950000 * PRDFLG = '0'B; /* INIT THIS CONTROL FLAG */ 25960000 NI CFLAGS,B'11111101' 0503 25970000 * UADSRPTR = HEDBPTR+UADSRDAT;/* REF THE PROCNAME DATAFLD */ 25980000 L @F,8(0,@3) 0504 25990000 AR @F,@4 0504 26000000 ST @F,UADSRPTR 0504 26010000 **/* D (NO,%NU,YES,) NEW SIZE SPECIFIED? */ 26020000 * /* DOES THE COMMAND SPECIFY A PROCSIZE? */ 26030000 * IF RSIZFLG = '1'B 26040000 * THEN /* YES, */ 26050000 L @1,CHNPDLAD 0505 26060000 TM 46(@1),B'10000000' 0505 26070000 BC 12,@9B8 0505 26080000 **/* D (NO,%CRTN,YES,) EQUAL TO DATFLD SIZE? */ 26090000 * /* COMPARE IT TO THE EXISTING PROCSIZE. */ 26100000 * IF NEWRSIZ ª= UADSRSIZ 26110000 * THEN /* THEY ARE NOT EQUAL */ 26120000 LR @2,@F 0506 26130000 MVC @TEMP2+2(2),14(@2) 0506 26140000 L @F,@TEMP2 0506 26150000 MVC @TEMP2+2(2),NEWRSIZ 0506 26160000 C @F,@TEMP2 0506 26170000 * RETURN; /* LEAVE FLAG AT '0' & RETURN */ 26180000 BC 07,@EL05 0507 26190000 **/*%NU: D (NO,%NDOKK,YES,) NEW UNIT NAME SPECIFD? */ 26200000 * /* DOES THE COMMAND SPECIFY A UNIT NAME? */ 26210000 * IF UNITFLG = '1'B 26220000 * THEN /* YES, */ 26230000 @9B7 EQU * 0508 26240000 @9B8 L @1,CHNPDLAD 0508 26250000 TM 54(@1),B'10000000' 0508 26260000 BC 12,@9B6 0508 26270000 **/* D (NO,%CRTN,YES,) EQUAL TO DATFLD UNTNAM? */ 26280000 * /* COMPARE IT TO THE EXISTING UNIT NAME. */ 26290000 * IF NEWUNAM ª= UADSUNAM 26300000 * THEN /* THEY ARE NOT EQUAL */ 26310000 L @2,UADSRPTR 0509 26320000 CLC NEWUNAM(8),16(@2) 0509 26330000 * RETURN; /* LEAVE FLAG AT '0' & RETURN */ 26340000 BC 07,@EL05 0510 26350000 **/*%NDOKK: P INDICATE DATAFLD EQUAL TO NEW DATA */ 26360000 * PRDFLG = '1'B; /* 1- EQUAL, OR NO NEW DATA 26370000 * SPECIFIED IN THE COMMAND */ 26380000 @9B5 EQU * 0511 26390000 @9B6 OI CFLAGS,B'00000010' 0511 26400000 **/*%CRTN: R RETURN TO POINT OF CALL */ 26410000 **/*CMPRND: END */ 26420000 * END CMPRND; /* RETURN TO POINT OF CALL */ 26430000 @EL05 BCR 15,@E 0512 26440000 * 26450000 * DLPRTS: /**********************************************************/ 26460000 * /* THIS SUBROUTINE WILL SEARCH FOR A PROCNAME IN THE */ 26470000 * /* TOTAL LATERAL CHAIN (ALL PROCS IN THE TREE). */ 26480000 * /**********************************************************/ 26490000 **/* E DLPRTS */ 26500000 **/* P SEARCH TOTAL CHAIN FOR A GIVEN PROCNAME */ 26510000 * 26520000 * PROCEDURE OPTIONS(NOSAVEAREA,DONTSAVE); 26530000 DLPRTS EQU * 0513 26540000 * RESTRICT(HEDBPTR,DROBPTR); 26550000 **/*DLPRTS2: D (NO,%TSMPR,YES,) PROCNAME FOUND? */ 26560000 **/* P (,%TSRTN) SET PTR TO ITS OFSBLK */ 26570000 * DLPRTS2: /* BEGINNING OF THE SEARCH LOOP. */ 26580000 * UADSRPTR = HEDBPTR+UADSRDAT;/* REF THE PROCNAME DATA FIELD*/ 26590000 DLPRTS2 L @F,8(0,@3) 0515 26600000 AR @F,@4 0515 26610000 ST @F,UADSRPTR 0515 26620000 * /* IS THIS THE DESIRED PROCNAME? */ 26630000 * IF DLPROC = UADSRNAM 26640000 * THEN /* YES, */ 26650000 LR @1,@F 0516 26660000 CLC DLPROC(8),4(@1) 0516 26670000 BC 07,@9B4 0516 26680000 * DO; 26690000 * RDATSAVE = UADSRDAT; /* SAVE OFFSET TO ITS DATAFLD */ 26700000 MVC RDATSAVE(4),8(@3) 0518 26710000 * NPRSAVE = DROBPTR; /* SAVE ADDR OF THIS OFFSET BK*/ 26720000 ST @3,NPRSAVE 0519 26730000 * NDFPTR = UADSRPTR; /* SAVE ADDR OF THIS DATA FLD */ 26740000 MVC NDFPTR(4),UADSRPTR 0520 26750000 * RETURN; /* RETURN TO POINT OF CALL */ 26760000 BC 15,@EL06 0521 26770000 * END; 26780000 * ELSE; /* NO, CONTINUE THE SEARCH */ 26790000 @9B4 EQU * 0523 26800000 **/*%TSMPR: D (NO,%TSNS,YES,) MORE PROCS IN TOT CHAIN? */ 26810000 **/* P (,DLPRTS2) REF NEXT PROC OFSBLK */ 26820000 * /* ARE THERE MORE PROCNAMES? CHECK THE PTR TO THE NEXT */ 26830000 * /* PROCNAME OFFSET BLOCK. ZERO INDICATES END OF TOTAL */ 26840000 * /* LATERAL CHAIN. */ 26850000 * IF UADSRNEX ª= 0 26860000 * THEN /* THERE ARE MORE PROCNAMES */ 26870000 @9B3 SR @F,@F 0524 26880000 MVC @TEMP3+1(3),1(@3) 0524 26890000 C @F,@TEMP3 0524 26900000 BC 08,@9B2 0524 26910000 * DO; 26920000 * DROBPTR = HEDBPTR /* REF THE NEXT PROCNAME OFF- */ 26930000 * +UADSRNEX; /* SET BLOCK */ 26940000 MVC @TEMP3+1(3),1(@3) 0526 26950000 L @F,@TEMP3 0526 26960000 AR @F,@4 0526 26970000 LR @3,@F 0526 26980000 * GOTO DLPRTS2; /* CONTINUE THE SEARCH */ 26990000 BC 15,DLPRTS2 0527 27000000 * END; 27010000 * ELSE /* THE PROCNAME DOES NOT EXIST 27020000 * IN THIS TREE */ 27030000 **/*%TSNS: P INDICATE PROCNAME NOT FOUND */ 27040000 * NPRSAVE = 0; /* 0- PROCNAME NOT FOUND */ 27050000 @9B2 SR @F,@F 0529 27060000 ST @F,NPRSAVE 0529 27070000 **/*%TSRTN: R RETURN TO POINT OF CALL */ 27080000 **/*DLPRTS: END */ 27090000 * END DLPRTS; /* RETURN TO POINT OF CALL */ 27100000 @9B1 EQU * 0530 27110000 @EL06 BCR 15,@E 0530 27120000 * 27130000 * CTRCHK: /**********************************************************/ 27140000 * /* THIS SUBROUTINE WILL CHECK THE USE COUNTER IN THE PROC-*/ 27150000 * /* NAME DATA FIELD. IT CANNOT EXCEED 255. IF IT DOES, */ 27160000 * /* CONTROL RETURNS TO IKJEFA20 WITH MSGNMBR IN CTRLTAB */ 27170000 * /* SET TO 30. IF THE COUNTER IS < 255, IT IS INCREMENTED. */ 27180000 * /**********************************************************/ 27190000 **/* E CTRCHK */ 27200000 **/* P COMPARE USE COUNTER TO 255 (MAX) */ 27210000 * 27220000 * /* M2581 */ 27230000 * PROCEDURE OPTIONS(NOSAVEAREA,DONTSAVE); 27240000 * RESTRICT(HEDBPTR,DROBPTR); 27250000 * 27260000 **/* D (NO,%INCR,YES,) USE COUNTER = 255? */ 27270000 **/* P (,WORKEND) SET ERROR MSGNMBR */ 27280000 * /* IS THE USE CTR 255 (MAXIMUM)? */ 27290000 * IF UADSRCTR = 255 /* M2581 */ 27300000 * THEN /* CTR LIMIT HAS BEEN REACHED */ 27310000 CTRCHK L @1,UADSRPTR 0533 27320000 CLI 0(@1),255 0533 27330000 BC 07,@9B0 0533 27340000 * DO; 27350000 * MSGNMBR = 30; /* SET MSGNO IN CTRLTAB M2581 */ 27360000 LA @F,30 0535 27370000 L @2,CTABPTR 0535 27380000 STH @F,32(0,@2) 0535 27390000 * GOTO WORKEND; /* RETURN TO IKJEFA20 M2581 */ 27400000 BC 15,WORKEND 0536 27410000 * END; 27420000 **/*%INCR: P INCREMENT THE USE COUNTER BY 1 */ 27430000 * /* M2581 */ 27440000 * UADSRCTR = UADSRCTR+1; /* INCREMENT THE USE COUNTER */ 27450000 @9B0 LA @F,1 0538 27460000 L @1,UADSRPTR 0538 27470000 SR @0,@0 0538 27480000 IC @0,0(0,@1) 0538 27490000 AR @F,@0 0538 27500000 STC @F,0(0,@1) 0538 27510000 * /* M2581 */ 27520000 **/* R RETURN TO POINT OF CALL */ 27530000 **/*CTRCHK: END */ 27540000 * END CTRCHK; /* RETURN TO POINT OF CALL */ 27550000 @EL07 BCR 15,@E 0539 27560000 * 27570000 * IKJFRSP: /**********************************************************/ 27580000 * /* THIS SUBROUTINE WILL INTERFACE WITH THE FREESPACE */ 27590000 * /* ROUTINE (IKJEFA54) AND CHECK ITS RETURN CODE. IF */ 27600000 * /* FREESPACE WAS SUCCESSFUL, CONTROL WILL BE PASSED BACK */ 27610000 * /* TO THE POINT OF CALL. IF NOT, CONTROL WILL BE RETURNED */ 27620000 * /* TO THE CHANGE CP (IKJEFA20) WHICH WILL ISSUE THE */ 27630000 * /* APPROPRIATE ERROR MESSAGE. */ 27640000 * /**********************************************************/ 27650000 **/* E IKJFRSP */ 27660000 **/* P PRUNE AN OFSBLK OR A DATAFLD */ 27670000 * 27680000 * PROCEDURE OPTIONS(NOSAVEAREA,DONTSAVE); 27690000 IKJFRSP EQU * 0540 27700000 * 27710000 * RESTRICT (R1); 27720000 * GEN(ST @E,SAVE14); /* SAVE REGISTER 14 */ 27730000 ST @E,SAVE14 27740000 DS 0H 27750000 * R1 = ADDR(GETFREE); /* PTR TO FREESPACE PARMLIST */ 27760000 LA @1,GETFREE 0543 27770000 **/* S IKJEFA54: FREE THE SPACE */ 27780000 * CALL IKJEFA54; /* GO TO THE FREESPACE ROUTINE*/ 27790000 L @F,@V2 ADDRESS OF IKJEFA54 0544 27800000 BALR @E,@F 0544 27810000 * RELEASE (R1); 27820000 * RETCODE = R15; /* SAVE THE RETURN CODE */ 27830000 L @1,CTABPTR 0546 27840000 ST @F,36(0,@1) 0546 27850000 **/* D (YES,%FRSPS,NO,) FREESPACE SUCCESSFUL? */ 27860000 **/* P (,WORKEND) SET ERROR MSGNMBR */ 27870000 * /* CHECK THE FREESPACE RETURN CODE. */ 27880000 * IF RETCODE ª= 0 27890000 * THEN /* FREESPACE UNSUCCESSFUL */ 27900000 SR @F,@F 0547 27910000 C @F,36(0,@1) 0547 27920000 BC 08,@9AF 0547 27930000 * DO; 27940000 * SRCHIND = 0; /* 0- PROCESSING OF THIS USERID 27950000 * IS COMPLETED */ 27960000 STH @F,30(0,@1) 0549 27970000 * MSGNMBR = 25; /* SET ERROR MSG NUMBER */ 27980000 LA @F,25 0550 27990000 STH @F,32(0,@1) 0550 28000000 * GOTO WORKEND; /* CHANGE CP WILL ISSUE THE 28010000 * ERROR MSG & CONTINUE WITH 28020000 * THE NEXT USERID, IF ANY */ 28030000 BC 15,WORKEND 0551 28040000 * END; 28050000 * ELSE; /* FREESPACE WAS SUCCESSFUL */ 28060000 @9AF EQU * 0553 28070000 * GEN(L @E,SAVE14); /* RESTORE REGISTER 14 */ 28080000 @9AE EQU * 0554 28090000 L @E,SAVE14 28100000 DS 0H 28110000 **/*%FRSPS: R RETURN TO POINT OF CALL */ 28120000 **/*IKJFRSP: END */ 28130000 * END IKJFRSP; /* GO BACK TO POINT OF CALL */ 28140000 @EL08 BCR 15,@E 0555 28150000 * 28160000 **/*IKJEFA23: END END OF CHANGE PROCNAME RTNE */ 28170000 * END IKJEFA23 28180000 * /* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. 28190000 * /*%INCLUDE SYSLIB (IKJEFUAD) 28200000 * ; 28210000 @DATA1 EQU * 28220000 @0 EQU 00 EQUATES FOR REGISTERS 0-15 28230000 @1 EQU 01 28240000 @2 EQU 02 28250000 @3 EQU 03 28260000 @4 EQU 04 28270000 @5 EQU 05 28280000 @6 EQU 06 28290000 @7 EQU 07 28300000 @8 EQU 08 28310000 @9 EQU 09 28320000 @A EQU 10 28330000 @B EQU 11 28340000 @C EQU 12 28350000 @D EQU 13 28360000 @E EQU 14 28370000 @F EQU 15 28380000 @D1 DC H'-1' 28390000 @MVC MVC 0(1,@A),0(@E) 28400000 @V1 DC V(IKJEFA53) 28410000 @V2 DC V(IKJEFA54) 28420000 DS 0F 28430000 @SIZ001 DC AL1(&SPN) 28440000 DC AL3(@DATEND-@DATD) 28450000 DS 0F 28460000 @X1 DC X'0000' 28470000 @C5 DC C'* ' 28480000 DS 0D 28490000 @DATA EQU * 28500000 DUMR1 EQU 00000000 FULLWORD INTEGER 28510000 CTRLTAB EQU 00000000 44 BYTE(S) ON WORD 28520000 ACTPLADR EQU CTRLTAB+00000000 FULLWORD POINTER 28530000 CHPDLPTR EQU CTRLTAB+00000004 FULLWORD POINTER 28540000 NODELPTR EQU CTRLTAB+00000008 FULLWORD POINTER 28550000 A00000 EQU CTRLTAB+00000012 FULLWORD POINTER 28560000 BLKCNT EQU CTRLTAB+00000012 1 BYTE POINTER 28570000 HEADADDR EQU CTRLTAB+00000013 3 BYTE POINTER ON WORD+1 28580000 PASSADDR EQU CTRLTAB+00000016 FULLWORD POINTER 28590000 ACCTADDR EQU CTRLTAB+00000020 FULLWORD POINTER 28600000 PROCADDR EQU CTRLTAB+00000024 FULLWORD POINTER 28610000 CHLEVL EQU CTRLTAB+00000028 HALFWORD POINTER 28620000 SRCHIND EQU CTRLTAB+00000030 HALFWORD POINTER 28630000 MSGNMBR EQU CTRLTAB+00000032 HALFWORD POINTER 28640000 TRCHGE EQU CTRLTAB+00000034 HALFWORD POINTER 28650000 RETCODE EQU CTRLTAB+00000036 FULLWORD INTEGER 28660000 VCHKCODE EQU CTRLTAB+00000040 FULLWORD INTEGER 28670000 NLSTTAB EQU 00000000 72 BYTE(S) ON WORD 28680000 A00001 EQU NLSTTAB+00000000 8 BYTE(S) 28690000 PASSWD EQU NLSTTAB+00000008 8 BYTE(S) 28700000 ACCTNO EQU NLSTTAB+00000016 40 BYTE(S) 28710000 PROCNM EQU NLSTTAB+00000056 8 BYTE(S) 28720000 A00002 EQU NLSTTAB+00000064 HALFWORD POINTER 28730000 PWLEN EQU NLSTTAB+00000066 HALFWORD POINTER 28740000 ACTLEN EQU NLSTTAB+00000068 HALFWORD POINTER 28750000 PRLEN EQU NLSTTAB+00000070 HALFWORD POINTER 28760000 CHNGPDL EQU 00000000 88 BYTE(S) ON WORD 28770000 A00003 EQU CHNGPDL+00000000 24 BYTE(S) 28780000 SIZENBR EQU CHNGPDL+00000024 16 BIT(S) 28790000 UNITNBR EQU CHNGPDL+00000026 16 BIT(S) 28800000 DATANBR EQU CHNGPDL+00000028 16 BIT(S) 28810000 A00004 EQU CHNGPDL+00000030 16 BIT(S) 28820000 MAXSUBF EQU CHNGPDL+00000032 8 BYTE(S) ON WORD 28830000 MAXSADR EQU CHNGPDL+00000032 FULLWORD POINTER 28840000 MAXSLNG EQU CHNGPDL+00000036 HALFWORD INTEGER 28850000 MAXSFLGS EQU CHNGPDL+00000038 16 BIT(S) 28860000 MAXSFLG EQU CHNGPDL+00000038 1 BIT(S) 28870000 SIZSUBF EQU CHNGPDL+00000040 8 BYTE(S) ON WORD 28880000 RSIZADR EQU CHNGPDL+00000040 FULLWORD POINTER 28890000 RSIZLNG EQU CHNGPDL+00000044 HALFWORD INTEGER 28900000 RSIZFLGS EQU CHNGPDL+00000046 16 BIT(S) 28910000 RSIZFLG EQU CHNGPDL+00000046 1 BIT(S) 28920000 UNITSUBF EQU CHNGPDL+00000048 8 BYTE(S) ON WORD 28930000 UNITADR EQU CHNGPDL+00000048 FULLWORD POINTER 28940000 UNITLNG EQU CHNGPDL+00000052 HALFWORD INTEGER 28950000 UNITFLGS EQU CHNGPDL+00000054 16 BIT(S) 28960000 UNITFLG EQU CHNGPDL+00000054 1 BIT(S) 28970000 PROCSUBF EQU CHNGPDL+00000056 8 BYTE(S) ON WORD 28980000 DLPTR4 EQU CHNGPDL+00000056 FULLWORD POINTER 28990000 DATALNG4 EQU CHNGPDL+00000060 HALFWORD INTEGER 29000000 A00005 EQU CHNGPDL+00000062 16 BIT(S) 29010000 DLFLG4 EQU CHNGPDL+00000062 1 BIT(S) 29020000 ACCTSUBF EQU CHNGPDL+00000064 8 BYTE(S) ON WORD 29030000 DLPTR3 EQU CHNGPDL+00000064 FULLWORD POINTER 29040000 DATALNG3 EQU CHNGPDL+00000068 HALFWORD INTEGER 29050000 A00006 EQU CHNGPDL+00000070 16 BIT(S) 29060000 DLFLG3 EQU CHNGPDL+00000070 1 BIT(S) 29070000 PASSSUBF EQU CHNGPDL+00000072 8 BYTE(S) ON WORD 29080000 DLPTR2 EQU CHNGPDL+00000072 FULLWORD POINTER 29090000 DATALNG2 EQU CHNGPDL+00000076 HALFWORD INTEGER 29100000 A00007 EQU CHNGPDL+00000078 16 BIT(S) 29110000 DLFLG2 EQU CHNGPDL+00000078 1 BIT(S) 29120000 USIDSUBF EQU CHNGPDL+00000080 8 BYTE(S) ON WORD 29130000 DLPTR1 EQU CHNGPDL+00000080 FULLWORD POINTER 29140000 DATALNG1 EQU CHNGPDL+00000084 HALFWORD INTEGER 29150000 A00008 EQU CHNGPDL+00000086 16 BIT(S) 29160000 DLFLG1 EQU CHNGPDL+00000086 1 BIT(S) 29170000 DLITEM EQU 00000000 8 BYTE(S) 29180000 PDLUNAM EQU 00000000 8 BYTE(S) 29190000 R1 EQU 00000001 FULLWORD POINTER REGISTER 29200000 R15 EQU 00000015 FULLWORD POINTER REGISTER 29210000 LNGTHREG EQU 00000005 FULLWORD POINTER REGISTER 29220000 HEDBPTR EQU 00000004 FULLWORD POINTER REGISTER 29230000 DNOBPTR EQU 00000002 FULLWORD POINTER REGISTER 29240000 DROBPTR EQU 00000003 FULLWORD POINTER REGISTER 29250000 DHED EQU 00000000 28 BYTE(S) ON WORD 29260000 UADSMHDR EQU DHED+00000000 14 BYTE(S) ON WORD 29270000 UADSBLNG EQU DHED+00000000 2 BYTE POINTER 29280000 UADSFSQP EQU DHED+00000002 2 BYTE POINTER 29290000 UADSUSER EQU DHED+00000004 8 BYTE(S) 29300000 UADSUSID EQU DHED+00000004 7 BYTE(S) 29310000 UADSIND1 EQU DHED+00000011 1 BYTE POINTER 29320000 UADSBN01 EQU DHED+00000012 1 BYTE POINTER 29330000 UADSBN02 EQU DHED+00000013 1 BYTE(S) 29340000 UADSNUSP EQU DHED+00000013 1 BIT(S) 29350000 A00009 EQU DHED+00000013 1 BIT(S) 29360000 A00010 EQU DHED+00000013 1 BIT(S) 29370000 A00011 EQU DHED+00000013 1 BIT(S) 29380000 A00012 EQU DHED+00000013 1 BIT(S) 29390000 A00013 EQU DHED+00000013 1 BIT(S) 29400000 A00014 EQU DHED+00000013 1 BIT(S) 29410000 A00015 EQU DHED+00000013 1 BIT(S) 29420000 UADSMAXC EQU DHED+00000014 2 BYTE POINTER 29430000 UADSATTR EQU DHED+00000016 4 BYTE(S) 29440000 UADSIBMT EQU DHED+00000016 2 BYTE(S) 29450000 A00016 EQU DHED+00000016 1 BYTE(S) 29460000 USATR00 EQU DHED+00000016 1 BIT(S) 29470000 USATR01 EQU DHED+00000016 1 BIT(S) 29480000 USATR02 EQU DHED+00000016 1 BIT(S) 29490000 A00017 EQU DHED+00000016 1 BIT(S) 29500000 A00018 EQU DHED+00000016 1 BIT(S) 29510000 A00019 EQU DHED+00000016 1 BIT(S) 29520000 A00020 EQU DHED+00000016 1 BIT(S) 29530000 A00021 EQU DHED+00000016 1 BIT(S) 29540000 A00022 EQU DHED+00000017 1 BYTE(S) 29550000 UADSINST EQU DHED+00000018 2 BYTE(S) 29560000 A00023 EQU DHED+00000018 1 BYTE(S) 29570000 A00024 EQU DHED+00000019 1 BYTE(S) 29580000 UADSUPTP EQU DHED+00000020 FULLWORD POINTER 29590000 UADSPWD1 EQU DHED+00000024 FULLWORD POINTER 29600000 DPOB EQU 00000000 12 BYTE(S) ON WORD 29610000 UADSPFLG EQU DPOB+00000000 1 BYTE(S) 29620000 PFLG01 EQU DPOB+00000000 1 BIT(S) 29630000 A00025 EQU DPOB+00000000 1 BIT(S) 29640000 A00026 EQU DPOB+00000000 1 BIT(S) 29650000 A00027 EQU DPOB+00000000 1 BIT(S) 29660000 A00028 EQU DPOB+00000000 1 BIT(S) 29670000 A00029 EQU DPOB+00000000 1 BIT(S) 29680000 A00030 EQU DPOB+00000000 1 BIT(S) 29690000 A00031 EQU DPOB+00000000 1 BIT(S) 29700000 UADSPNEX EQU DPOB+00000001 3 BYTE POINTER 29710000 UADSPSUB EQU DPOB+00000004 FULLWORD POINTER 29720000 UADSPDAT EQU DPOB+00000008 FULLWORD POINTER 29730000 DNOB EQU 00000000 12 BYTE(S) ON WORD 29740000 UADSAFLG EQU DNOB+00000000 1 BYTE(S) 29750000 AFLG01 EQU DNOB+00000000 1 BIT(S) 29760000 A00032 EQU DNOB+00000000 1 BIT(S) 29770000 A00033 EQU DNOB+00000000 1 BIT(S) 29780000 A00034 EQU DNOB+00000000 1 BIT(S) 29790000 A00035 EQU DNOB+00000000 1 BIT(S) 29800000 A00036 EQU DNOB+00000000 1 BIT(S) 29810000 A00037 EQU DNOB+00000000 1 BIT(S) 29820000 A00038 EQU DNOB+00000000 1 BIT(S) 29830000 UADSANEX EQU DNOB+00000001 3 BYTE POINTER 29840000 UADSASUB EQU DNOB+00000004 FULLWORD POINTER 29850000 UADSADAT EQU DNOB+00000008 FULLWORD POINTER 29860000 DROB EQU 00000000 12 BYTE(S) ON WORD 29870000 UADSRFLG EQU DROB+00000000 1 BYTE(S) 29880000 FLGR01 EQU DROB+00000000 1 BIT(S) 29890000 A00039 EQU DROB+00000000 1 BIT(S) 29900000 A00040 EQU DROB+00000000 1 BIT(S) 29910000 A00041 EQU DROB+00000000 1 BIT(S) 29920000 A00042 EQU DROB+00000000 1 BIT(S) 29930000 A00043 EQU DROB+00000000 1 BIT(S) 29940000 A00044 EQU DROB+00000000 1 BIT(S) 29950000 A00045 EQU DROB+00000000 1 BIT(S) 29960000 UADSRNEX EQU DROB+00000001 3 BYTE POINTER 29970000 UADSRSUB EQU DROB+00000004 FULLWORD POINTER 29980000 UADSRDAT EQU DROB+00000008 FULLWORD POINTER 29990000 DPOBD EQU 00000000 12 BYTE(S) ON WORD 30000000 UADSPCTR EQU DPOBD+00000000 1 BYTE POINTER 30010000 UADSPRES EQU DPOBD+00000001 3 BYTE(S) 30020000 UADSPPWD EQU DPOBD+00000004 8 BYTE(S) 30030000 DNOBD EQU 00000000 85 BYTE(S) ON WORD 30040000 UADSACTR EQU DNOBD+00000000 1 BYTE POINTER 30050000 UADSARES EQU DNOBD+00000001 3 BYTE(S) 30060000 UADSADRF EQU DNOBD+00000004 40 BYTE(S) 30070000 UADSALEN EQU DNOBD+00000044 1 BYTE POINTER 30080000 UADSANUM EQU DNOBD+00000045 40 BYTE(S) 30090000 DROBD EQU 00000000 24 BYTE(S) ON WORD 30100000 UADSRCTR EQU DROBD+00000000 1 BYTE POINTER 30110000 UADSRRES EQU DROBD+00000001 3 BYTE(S) 30120000 UADSRNAM EQU DROBD+00000004 8 BYTE(S) 30130000 UADSRNDS EQU DROBD+00000012 1 BYTE(S) 30140000 UADSRRS2 EQU DROBD+00000013 1 BYTE(S) 30150000 UADSRSIZ EQU DROBD+00000014 2 BYTE POINTER 30160000 UADSUNAM EQU DROBD+00000016 8 BYTE(S) 30170000 DS 00000000C 30180000 @L EQU 6 30190000 @DATD DSECT 30200000 @SAV001 EQU @DATD+00000000 72 BYTE(S) ON WORD 30210000 CTABPTR EQU @DATD+00000072 FULLWORD POINTER 30220000 CHNPDLAD EQU @DATD+00000076 FULLWORD POINTER 30230000 NEWRSIZ EQU @DATD+00000080 HALFWORD POINTER 30240000 EVENCHK EQU @DATD+00000080 16 BIT(S) ON BYTE 30250000 NEWUNAM EQU @DATD+00000082 8 BYTE(S) 30260000 DLPROC EQU @DATD+00000090 8 BYTE(S) 30270000 GETFREE EQU @DATD+00000100 12 BYTE(S) ON WORD 30280000 READBUFF EQU GETFREE+00000000 FULLWORD POINTER 30290000 NUMBLOKS EQU GETFREE+00000004 HALFWORD POINTER 30300000 AREALNTH EQU GETFREE+00000006 HALFWORD POINTER 30310000 AREAOFST EQU GETFREE+00000008 FULLWORD POINTER 30320000 SAVE14 EQU @DATD+00000112 FULLWORD POINTER 30330000 DECSIZE EQU @DATD+00000120 8 BYTE(S) ON DWORD 30340000 OPWSAVE EQU @DATD+00000128 FULLWORD POINTER 30350000 OACSAVE EQU @DATD+00000132 FULLWORD POINTER 30360000 OPRSAVE EQU @DATD+00000136 FULLWORD POINTER 30370000 NPRSAVE EQU @DATD+00000140 FULLWORD POINTER 30380000 RNEXSAVE EQU @DATD+00000144 FULLWORD POINTER 30390000 ADATSAVE EQU @DATD+00000148 FULLWORD POINTER 30400000 RDATSAVE EQU @DATD+00000152 FULLWORD POINTER 30410000 ODFPTR EQU @DATD+00000156 FULLWORD POINTER 30420000 NDFPTR EQU @DATD+00000160 FULLWORD POINTER 30430000 LASTOB EQU @DATD+00000164 FULLWORD POINTER 30440000 NEWDFPTR EQU @DATD+00000168 FULLWORD POINTER 30450000 FRSTDROB EQU @DATD+00000172 FULLWORD POINTER 30460000 CSNSAVE EQU @DATD+00000176 FULLWORD POINTER 30470000 PRUNOFS EQU @DATD+00000180 FULLWORD POINTER 30480000 CFLAGS EQU @DATD+00000184 2 BYTE(S) 30490000 STGFLG EQU CFLAGS+00000000 1 BIT(S) 30500000 TREECHG EQU CFLAGS+00000000 1 BIT(S) 30510000 FLGSAVE EQU CFLAGS+00000000 1 BIT(S) 30520000 FLDFLG EQU CFLAGS+00000000 1 BIT(S) 30530000 FLDFLG2 EQU CFLAGS+00000000 1 BIT(S) 30540000 FLDFLG3 EQU CFLAGS+00000000 1 BIT(S) 30550000 PRDFLG EQU CFLAGS+00000000 1 BIT(S) 30560000 DPOBPTR EQU @DATD+00000188 FULLWORD POINTER 30570000 UADSPPTR EQU @DATD+00000192 FULLWORD POINTER 30580000 UADSAPTR EQU @DATD+00000196 FULLWORD POINTER 30590000 UADSRPTR EQU @DATD+00000200 FULLWORD POINTER 30600000 DROBDMDL EQU @DATD+00000204 24 BYTE(S) ON WORD 30610000 A00046 EQU DROBDMDL+00000000 4 BYTE(S) 30620000 TEMPRNAM EQU DROBDMDL+00000004 8 BYTE(S) 30630000 A00047 EQU DROBDMDL+00000012 16 BIT(S) 30640000 TEMPRSIZ EQU DROBDMDL+00000014 HALFWORD POINTER 30650000 TEMPUNAM EQU DROBDMDL+00000016 8 BYTE(S) 30660000 DS 00000228C 30670000 @TEMPS DS 0F 30680000 @TEMP2 DC F'0' 30690000 @TEMP3 DC F'0' 30700000 @DATEND EQU * 30710000 IKJEFA23 CSECT , 30720000 @9F9 EQU @9F8 30730000 @9F5 EQU PRNEXT 30740000 @9F3 EQU CHKCSN3 30750000 @9EE EQU CHGEOK 30760000 @9ED EQU CHGEOK 30770000 @9D9 EQU PRCHGE6 30780000 @9CD EQU CHGDF 30790000 @9CB EQU SRCHND3 30800000 @9C5 EQU PRNEXT4 30810000 @9C4 EQU @9C3 30820000 @9C2 EQU CHGEOK 30830000 @9C1 EQU CHGEOK 30840000 WORKEND EQU @EL01 30850000 @9BF EQU @EL01 30860000 END IKJEFA23 30870000 ./ ADD SSI=01013559,NAME=IKJEFA24,SOURCE=1 TITLE ' IKJEFA24 - CHANGE/PARSE INTERFACE ROUTINE' 00010000 * /*******************************************************************/ 00020000 * /* */ 00030000 * /* P R O L O G U E FOR I K J E F A 2 4 */ 00040000 * /* CHANGE/PARSE INTERFACE ROUTINE */ 00050000 * /* */ 00060000 * /* STATUS: */ 00070000 * /* CHANGE LEVEL 000 */ 00080000 * /* PTMS INCLUDED: 4475 */ 00090000 * /* CHANGE LEVEL 001 */ 00100000 * /* APARS INCLUDED: 45306 */ 00110000 * /* PTMS INCLUDED: 1859 */ 00120000 * /* C 295500,296000,310500 A45306 */ 00130000 * /* A 80510,80520,390600 M1859 */ 00140000 * /* C 264000-267500,357500,386000-388500 M1859 */ 00150000 * /* D 61500,62000,260500-263500,382500-385500 M1859 */ 00160000 * /* A 175600 21974 */ 00170000 * /* C 346500,502000 21974 */ 00180000 * /* D 46920 21974 */ 00190000 * /* */ 00200000 * /* FUNCTION: */ 00210000 * /* THIS ROUTINE PERFORMS THE FOLLOWING FUNCTIONS FOR THE CHANGE */ 00220000 * /* SUBCOMMAND OF ACCOUNT - */ 00230000 * /* . INTERFACES WITH THE PARSE SERVICE ROUTINE TO CHECK THE */ 00240000 * /* SYNTAX OF THE INPUT COMMAND PARAMETERS. */ 00250000 * /* . BUILDS THE NODELIST TABLE FROM THE PARAMETER DESCRIPTOR */ 00260000 * /* LIST (PDL) RETURNED BY PARSE IN THE NODELIST VALIDITY */ 00270000 * /* CHECK EXIT ROUTINE (IKJEFA25). */ 00280000 * /* . DETERMINES THE CHANGE LEVEL BY COUNTING THE NUMBER OF */ 00290000 * /* ITEMS IN THE NODELIST OF THE INPUT COMMAND. */ 00300000 * /* . ASSURES THAT THE SIZE AND/OR MAXSIZE INTEGER IS NOT GREATER*/ 00310000 * /* THAN 65534, VIA THE VALIDITY CHECK EXIT RTNE IKJEFA26. */ 00320000 * /* */ 00330000 * /* ENTRY POINTS: */ 00340000 * /* IKJEFA24 - MAIN ENTRY POINT */ 00350000 * /* IKJEFA25 - NODELIST VALIDITY CHECK EXIT ROUTINE, */ 00360000 * /* ENTERED FROM THE PARSE SERVICE ROUTINE. */ 00370000 * /* IKJEFA26 - 'MAXSIZE' AND 'SIZE' VALIDITY CHECK EXIT ROUTINE, */ 00380000 * /* ENTERED FROM THE PARSE SERVICE ROUTINE. */ 00390000 * /* */ 00400000 * /* INPUT: */ 00410000 * /* REGISTER 1 POINTS TO THE CHANGE CONTROL TABLE, */ 00420000 * /* DESCRIBED UNDER TABLES/WORKAREAS. */ 00430000 * /* */ 00440000 * /* OUTPUT: */ 00450000 * /* THE FOLLOWING FIELDS IN THE CHANGE CONTROL TABLE ARE SET: */ 00460000 * /* . PTR TO THE PARAMETER DESCRIPTOR LIST (PDL) */ 00470000 * /* . THE CHANGE LEVEL */ 00480000 * /* . THE MESSAGE NUMBER */ 00490000 * /* */ 00500000 * /* EXTERNAL REFERENCES: */ 00510000 * /* . PARSE SERVICE ROUTINE */ 00520000 * /* . ACCOUNT NUMBER VALIDITY CHECK RTNE (IKJEFA55) */ 00530000 * /* */ 00540000 * /* EXITS: */ 00550000 * /* . NORMAL: RETURN TO CHANGE CP (IKJEFA20) */ 00560000 * /* . ERROR: RETURN TO CHANGE CP (IKJEFA20) */ 00570000 * /* */ 00580000 * /* TABLES/WORKAREAS: */ 00590000 * /* . THE CHANGE CONTROL TABLE, DESCRIBED BELOW */ 00600000 * /* . THE PARAMETER DESCRIPTOR LIST (PDL) */ 00610000 * /* . THE NODELIST TABLE (NLSTTAB) */ 00620000 * /* THE CHANGE CONTROL TABLE (CTRLTAB) - */ 00630000 * /* ³------------------------------------------------------³ */ 00640000 * /* +0 ³ PTR TO THE ACCOUNT PARAMETER LIST ³ */ 00650000 * /* ³------------------------------------------------------³ */ 00660000 * /* +4 ³ PTR TO THE PARAMETER DESCRIPTOR LIST (PDL) ³ */ 00670000 * /* ³------------------------------------------------------³ */ 00680000 * /* +8 ³ PTR TO THE NODELIST TABLE ³ */ 00690000 * /* ³------------³-----------------------------------------³ */ 00700000 * /* +12³ BLKCNT ³ PTR TO THE USERID TREE BUFFER ³ */ 00710000 * /* ³------------³-----------------------------------------³ */ 00720000 * /* +16³ UADS ADDR OF THE NODELIST PASSWORD OFFSET BLOCK ³ */ 00730000 * /* ³------------------------------------------------------³ */ 00740000 * /* +20³ UADS ADDR OF THE NODELIST ACCTNMBR OFFSET BLOCK ³ */ 00750000 * /* ³------------------------------------------------------³ */ 00760000 * /* +24³ UADS ADDR OF THE NODELIST PROCNAME OFFSET BLOCK ³ */ 00770000 * /* ³--------------------------³---------------------------³ */ 00780000 * /* +28³ CHANGE LEVEL ³ SEARCH INDICATOR ³ */ 00790000 * /* ³--------------------------³---------------------------³ */ 00800000 * /* +32³ MESSAGE NUMBER ³ CHANGE INDICATOR ³ */ 00810000 * /* ³--------------------------³---------------------------³ */ 00820000 * /* NOTE: FOR THE DEFINITION OF THE ABOVE FIELDS SEE IKJEFA20. */ 00830000 * /* */ 00840000 * /* ATTRIBUTES: */ 00850000 * /* REENTRANT, REFRESHABLE */ 00860000 * /* */ 00870000 * /* NOTES: */ 00880000 * /* . CHARACTER DEPENDENCY - CLASS C */ 00890000 * /* THE OPERATION OF THIS MODULE DEPENDS UPON AN INTERNAL RE- */ 00900000 * /* PRESENTATION OF THE EXTERNAL CHARACTER SET WHICH IS EQUI- */ 00910000 * /* VALENT TO THE ONE USED AT ASSEMBLY TIME. THE CODING HAS */ 00920000 * /* BEEN ARRANGED SO THAT REDEFINITION OF 'CHARACTER' CON- */ 00930000 * /* STANTS, BY REASSEMBLY, WILL RESULT IN A CORRECT MODULE FOR */ 00940000 * /* THE NEW DEFINITIONS. */ 00950000 * /* . RELEASE 20 SUPPORT CODE - 20035 */ 00960000 * /* */ 00970000 * /*******************************************************************/ 00980000 * 00990000 * GENERATE; /* ASSIGN SUBPOOL NUMBER */ 01000000 LCLA &T,&SPN 01010000 &SPN SETA 1 01020000 AGO .@001 01030000 * 01040000 **/*IKJEFA24: CHART */ 01050000 **/*HEADER 01060000 **/*CHANGE/PARSE INTERFACE RTNE 01070000 **/* PAGE # 11/11/71 */ 01080000 **/* E IKJEFA24 */ 01090000 * 01100000 * 01110000 * IKJEFA24: 01120000 * PROCEDURE (DUMR1) 01130000 * OPTIONS (REENTRANT, 01140000 * DONTSAVE(15)); 01150000 LCLA &T,&SPN 0002 01160000 .@001 ANOP 0002 01170000 IKJEFA24 CSECT , 0002 01180000 ST @E,12(0,@D) 0002 01190000 STM @0,@C,20(@D) 0002 01200000 BALR @B,0 0002 01210000 @PSTART DS 0H 0002 01220000 USING @PSTART+00000,@B 0002 01230000 L @0,@SIZ001 0002 01240000 GETMAIN R,LV=(0) 0002 01250000 LR @C,@1 0002 01260000 USING @DATD+00000,@C 0002 01270000 LM @0,@1,20(@D) 0002 01280000 XC @TEMPS(@L),@TEMPS 0002 01290000 ST @D,@SAV001+4 0002 01300000 LA @F,@SAV001 0002 01310000 ST @F,8(0,@D) 0002 01320000 LR @D,@F 0002 01330000 * 01340000 * GOTO STCODE; /* BYPASS MODULE IDENTIFIER */ 01350000 BC 15,STCODE 0003 01360000 * GENERATE; 01370000 DC CL8'IKJEFA24' MODULE NAME 01380000 DC XL4'11111971' DATE OF LAST CHANGE 01390000 DS 0H 01400000 * 01410000 * /* GENERATE EXTRN FOR THE ACCTNMBR VALIDITY CHECK ROUTINE.*/ 01420000 * GENERATE; 01430000 EXTRN IKJEFA55 01440000 DS 0H 01450000 * 01460000 * DECLARE 01470000 * /* GENERAL VARIABLES FOR IKJEFA24 */ 01480000 * R0 REG(0) PTR, /* WORK REGISTER */ 01490000 * R1 REG(1) PTR, /* PTR TO PARAMETER LISTS */ 01500000 * R15 REG(15) PTR, /* RETURN CODES */ 01510000 * ACTPLPTR PTR, /* PTR TO THE ACCOUNT PARMLST */ 01520000 * PPLPTR REG(1) PTR, /* BASE PTR FOR PARSE PARMLIST*/ 01530000 * CTABPTR PTR; /* BASE PTR FOR THE CHANGE 01540000 * CONTROL TABLE */ 01550000 * 01560000 * DECLARE 01570000 * /* ACCOUNT CP PARAMETER LIST */ 01580000 * 1 ACCTPLST BASED(ACTPLPTR), 01590000 * 2 UPTPTR PTR, /* PTR TO THE UPT */ 01600000 * 2 ECTPTR PTR, /* PTR TO THE ECT */ 01610000 * 2 AECBPTR PTR, /* PTR TO THE ACCOUNT ECB */ 01620000 * 2 BUFPTR PTR, /* PTR TO THE COMMAND BUFFER */ 01630000 * 2 UIDLPTR PTR; /* PTR TO THE USERID DATA LIST, 01640000 * FILLED IN BY CHANGE WHENEVER 01650000 * A USERID IS CHANGED */ 01660000 * 01670000 * DECLARE 01680000 * /* THE CHANGE CONTROL TABLE. */ 01690000 * 1 CTRLTAB BASED(CTABPTR), 01700000 * 2 ACTPLADR PTR, /* PTR TO ACCOUNT PARMLIST */ 01710000 * 2 CHPDLPTR PTR, /* PTR TO THE PDL */ 01720000 * 2 NODELPTR PTR, /* PTR TO NODELIST ITEMS */ 01730000 * 2 * PTR, 01740000 * 3 BLOKCNT PTR(8), /* NO. OF BLOCKS READ IN */ 01750000 * 3 HEADADDR PTR(24),/* PTR TO THE USER HEADER */ 01760000 * 2 PASSADDR PTR, /* UADS ADDR OF NODELIST PWRD */ 01770000 * 2 ACCTADDR PTR, /* UADS ADDR OF NODELST ACTNO */ 01780000 * 2 PROCADDR PTR, /* UADS ADDR OF NODELST PRNAME*/ 01790000 * 2 CHLEVL PTR(15), /* CHANGE LEVEL */ 01800000 * 2 SRCHIND PTR(15), /* SET BY IKJEFA22/23, INDICATES 01810000 * WHICH SEARCH LOOP TO REENTER 01820000 * ..0 NONE 01830000 * ..1 ACCTNMBR 01840000 * ..2 PROCNAME */ 01850000 * 2 MSGNMBR PTR(15), /* MSG NUMBER, SET BY IKJEFA22, 01860000 * IKJEFA23, OR IKJEFA24 */ 01870000 * 2 TRCHGE PTR(15), /* ..1 TREE HAS BEEN CHANGED */ 01880000 * 2 RETCODE FIXED, /* VARIABLE FOR RETURN CODES */ 01890000 * 2 VCHKCODE FIXED; /* RETCODE FROM VALCHECK RTNES*/ 01900000 * 01910000 * /* THE FOLLOWING IS A MAPPING OF THE PARSE SERVICE ROUTINE*/ 01920000 * /* PARAMETER LIST (PPL). */ 01930000 ** DECLARE 01940000 ** 1 PPL BASED(PPLPTR), 01950000 ** /* *************************************************************** * 01960000 ** /* THE PARSE PARAMETER LIST (PPL) IS A LIST OF ADDRESSES PASSED * 01970000 ** /* FROM THE INVOKER TO PARSE VIA REGISTER 1 * 01980000 ** /* *************************************************************** * 01990000 ** 02000000 ** 02010000 ** 02020000 ** 02030000 ** 02040000 ** 02050000 ** 02060000 ** 02070000 ** 02080000 ** 02090000 ** 2 PPLUPT PTR(31), /* PTR TO UPT * 02100000 ** 2 PPLECT PTR(31), /* PTR TO ECT * 02110000 ** 2 PPLECB PTR(31), /* PTR TO CP'S ECB * 02120000 ** 2 PPLPCL PTR(31), /* PTR TO PCL * 02130000 ** 2 PPLANS PTR(31), /* PTR TO ANS PLACE * 02140000 ** 2 PPLCBUF PTR(31), /* PTR TO CMD BUFFER * 02150000 ** 2 PPLUWA PTR(31); /* PTR TO USER WORK AREA (FOR 02160000 ** VALIDITY CK RTNS) * 02170000 ** 02180000 * 02190000 * DECLARE 02200000 * /* VARIABLES FOR THE INTERFACE WITH THE PARSE */ 02210000 * /* SERVICE ROUTINE. */ 02220000 * PARSPARM CHAR(28) /* SPACE FOR PARSE PARMLIST */ 02230000 * BDY(WORD), /* DESCRIBED ABOVE */ 02240000 * PCLMODEL GEND LABEL, /* NAME OF PARSE MODEL PCL */ 02250000 * PCLMDLAD PTR /* BASE PTR FOR THE PCL */ 02260000 * INIT(ADDR(PCLMODEL)), 02270000 * PCLLNGTH FIXED(15) /* LENGTH OF THE PCL */ 02280000 * BASED(PCLMDLAD), 02290000 * PMACSPTR PTR, /* BASE PTR FOR DYNAMIC PCL */ 02300000 * SORCPTR PTR(24) REG(2),/* INDEX PTR FOR DATA MOVES */ 02310000 * RCVRPTR PTR(24) REG(3),/* INDEX PTR FOR DATA MOVES */ 02320000 * PARSBLOK CHAR(256) BASED,/* ANOTHER NAME FOR THE PCL*/ 02330000 * PPL3WDS CHAR(12) /* ANOTHER NAME FOR THE 1ST 3 */ 02340000 * BASED(ADDR(PPL)), /* WORDS OF THE PPL */ 02350000 * NDBUFPTR PTR, /* BASE PTR FOR NODELIST BUFFR*/ 02360000 * /* SPACE FOR A BUFFER CONTAINING ONLY THE NODELIST. */ 02370000 * 1 NDBUFFER /* NDBUFPTR SET BY GETMAIN */ 02380000 * BASED(NDBUFPTR), 02390000 * 2 NDBUFLNG FIXED(15),/* LENGTH OF NODELIST BUFFER */ 02400000 * 2 NDBFOFST PTR(15), /* OFFSET TO DATA AREA */ 02410000 * NUMOFLVL PTR(8), /* NO. OF DATA ITEMS IN NODELT*/ 02420000 * CHNPDLAD PTR, /* ANSWER PLACE INTO WHICH PARSE 02430000 * PUTS THE ADDR TO THE PDL */ 02440000 * NODEPLAD PTR, /* ANSWER PLACE FOR NESTED CALLS 02450000 * TO PARSE. THIS PTR LOCATES 02460000 * THE PDLS FOR THE CONTENTS OF 02470000 * THE NODELIST */ 02480000 * NODPDPTR PTR, /* PTR TO PDE IN NODELIST PDLS*/ 02490000 * /* PDE FOR 'IKJIDENT' IN THE NODELIST PDLS. */ 02500000 * 1 NODPDE BASED(NODPDPTR),/* NODPDPTR IS SET IN THE 02510000 * NODELST VALCHK EXIT RTNE*/ 02520000 * 2 NODEPTR PTR, /* PTR TO NODE ITEM */ 02530000 * 2 NODELEN PTR(15), /* LENGTH OF NODE ITEM */ 02540000 * 2 NODEFLGS BIT(16), /* BIT0 = 1: PARM PRESENT */ 02550000 * NODEITEM CHAR(40) /* NODE ITEM FROM NODELIST */ 02560000 * BASED(NODEPTR), 02570000 * SERVLIST CHAR(12) /* 1ST 4 WORDS OF THE ACCOUNT */ 02580000 * BASED(ACTPLPTR), /* PARAMETER LIST */ 02590000 * LNGTHREG PTR REG(4), /* LENGTH OF AREA REQUESTED */ 02600000 * LOOPREG FIXED REG(5), /* CNTRL VARIABLE FOR DO LOOPS*/ 02610000 * REG13 PTR REG(13), /* ADDR OF REG SAVE AREA */ 02620000 * DECSIZE CHAR(8) /* SIZE VALUE IN PACKED DECIML*/ 02630000 * BDY(DWORD), 02640000 * CALLRSAV PTR /* ADDR OF CALLER'S SAVE AREA */ 02650000 * BASED(REG13+4), 02660000 * RETNCODE FIXED /* REG15 POSITION */ 02670000 * BASED(CALLRSAV+16), 02680000 * /* MAPPING OF REG0 FOR THE GETMAIN MACRO. */ 02690000 * 1 FREELVAL FIXED, /* LENGTH OF AREA TO BE FREED */ 02700000 * 2 FRLVSUBP PTR(8); /* HIGH-ORDER BYTE = SP NO. */ 02710000 * 02720000 * DECLARE 02730000 * /* INPUT PARAMETERS FROM PARSE TO VALIDITY CHECK */ 02740000 * /* EXIT ROUTINE. */ 02750000 * INPUTPTR PTR REG(2), /* PTR TO SAVE REG1 ON ENTRY */ 02760000 * 1 VALCKLST /* PARMLIST POINTED TO BY REG1*/ 02770000 * BASED(INPUTPTR), 02780000 * 2 PDEPTR PTR, /* ADDR OF PSTRING PDE */ 02790000 * 2 USERWORD PTR; /* USER WORD FROM PPL */ 02800000 * 02810000 * DECLARE 02820000 * /* NODELIST PSTRING PDE */ 02830000 * 1 PSTRPDE BASED(PDEPTR), 02840000 * 2 PSTRPTR PTR, /* ADDR OF PSTRING ORIGIN */ 02850000 * 2 PSTRLNG FIXED(15),/* LENGTH OF PSTRING */ 02860000 * 2 PSTRFLGS BIT(16); /* BIT0 = 1: PARAM IS PRESENT */ 02870000 * 02880000 * DECLARE 02890000 * /* DATA ITEMS RELATED TO NESTED CALLS TO PARSE */ 02900000 * NDPARSPC CHAR(28) /* SPACE FOR PARMLIST */ 02910000 * BDY(WORD), 02920000 * NODEPARS GEND LABEL, /* NAME OF NODELIST PCL */ 02930000 * USERPARS GEND LABEL, /* NAME OF USERID PCL */ 02940000 * PASSPARS GEND LABEL, /* NAME OF PASSWORD PCL */ 02950000 * ACCTPARS GEND LABEL, /* NAME OF ACCTNMBR PCL */ 02960000 * PROCPARS GEND LABEL, /* NAME OF PROCNAME PCL */ 02970000 * NDPCLPTR PTR /* PTR TO NODELIST PCL */ 02980000 * INIT(ADDR(NODEPARS)), 02990000 * USPCLPTR PTR /* PTR TO THE USERID PCL */ 03000000 * INIT(ADDR(USERPARS)), 03010000 * PSPCLPTR PTR /* PTR TO THE PASSWORD PCL */ 03020000 * INIT(ADDR(PASSPARS)), 03030000 * ACPCLPTR PTR /* PTR TO THE ACCTNMBR PCL */ 03040000 * INIT(ADDR(ACCTPARS)), 03050000 * PRPCLPTR PTR /* PTR TO THE PROCNAME PCL */ 03060000 * INIT(ADDR(PROCPARS)), 03070000 * NDBUFSPC CHAR(256) BASED,/* ANOTHER NAME FOR BUFFER */ 03080000 * NDFLGPTR PTR, /* WORK PTR FOR NODELIST PDL */ 03090000 * NDPDEFLG BIT(16) /* PARS FLAGS IN EACH NODE PDE*/ 03100000 * BASED(NDFLGPTR); 03110000 * 03120000 * DECLARE 03130000 * /* MISCELLANEOUS PTRS, WORK AREAS, ETC. */ 03140000 * NPRSRTCD FIXED(15), /* NESTED PARSE RETURN CODE */ 03150000 * /* MAIN PARSE PCL */ 03160000 * 1 PARSMACS /* STRUCTURE TO PROVIDE BSL */ 03170000 * BASED(PMACSPTR), /* ADDRESSABILITY FOR THE MAIN 03180000 * PCL GENERATED BY THE PARSE 03190000 * MACROS */ 03200000 * 2 PARMPCE CHAR(6), /* PCL HEADER (FROM IKJPARM) */ 03210000 * 2 NDLPCE CHAR(21), /* NODELIST PSTRING PCE */ 03220000 * 2 OPKEYPCE CHAR(26),/* OPER KEYWORD & NAME PCES */ 03230000 * 2 ACKEYPCE CHAR(26),/* ACCT KEYWORD & NAME PCES */ 03240000 * 2 JCKEYPCE CHAR(24),/* JCL KEYWORD & NAME PCES */ 03250000 * 2 MSKEYPCE CHAR(6), /* MAXSIZE KEYWORD PCE */ 03260000 * 2 MSNAMPCE CHAR(14),/* 'MAXSIZE' NAME PCE */ 03270000 * 2 NLNAMPCE CHAR(10),/* 'NOLIM' NAME PCE */ 03280000 * 3 NLNAMFLG CHAR(2),/* NOLIM NAME FLAGS */ 03290000 * 3 NLNAMLNG /* NOLIM NAME PCE LENGTH - */ 03300000 * FIXED(15) BDY(BYTE),/* THIS FIELD MAY BE MODI- 03310000 * FIED BY IKJEFA25 */ 03320000 * 3 NLNAMELN CHAR(1),/* 'NOLIM' NAME LENGTH */ 03330000 * 3 NLNAME CHAR(5), /* 'NOLIM' NAME */ 03340000 * 2 SZKEYPCE CHAR(17),/* SIZE KEYWORD & NAME PCES */ 03350000 * 2 UNKEYPCE CHAR(6), /* UNIT KEYWORD PCE */ 03360000 * 2 UNNAMPCE CHAR(11),/* 'UNIT' NAME PCE */ 03370000 * 3 UNNAMFLG CHAR(2),/* UNIT NAME FLAGS */ 03380000 * 3 UNNAMLNG FIXED(15)/* UNIT NAME PCE LENGTH - */ 03390000 * BDY(BYTE), /* THIS FIELD MAY BE MODIFIED 03400000 * BY IKJEFA25 */ 03410000 * 3 UNNAMELN CHAR(1),/* 'UNIT' NAME LENGTH */ 03420000 * 3 UNNAME CHAR(4), /* 'UNIT' NAME */ 03430000 * 3 UNNAMSUB CHAR(2),/* UNIT NAME SUBFIELD OFFSET */ 03440000 * 2 DAKEYPCE CHAR(11),/* DATA KEYWORD PCE */ 03450000 * 3 DAKEYFLG BIT(16),/* DATA KEYWORD FLAGS - BIT 5 03460000 * MEANS DEFAULT SPECIFIED - 03470000 * MAY BE TURNED OFF BY 03480000 * IKJEFA26 */ 03490000 * 2 DANAMPCE CHAR(11),/* 'DATA' NAME PCE */ 03500000 * 3 DANAMFLG CHAR(2),/* DATA NAME PCE FLAGS */ 03510000 * 3 DANAMLNG CHAR(2),/* DATA NAME PCE LENGTH */ 03520000 * 3 DANAMELN CHAR(1),/* 'DATA' NAME LENGTH */ 03530000 * 3 DANAME CHAR(4), /* 'DATA' NAME */ 03540000 * 3 DANAMSUB PTR(15)/* DATA NAME SUBFLD OFFSET - */ 03550000 * BDY(BYTE), /* THIS FIELD MAY BE MODIFIED 03560000 * BY IKJEFA25 */ 03570000 * 2 MSSUBPCE CHAR(3), /* MAXSIZE SUBFIELD HEADER */ 03580000 * 2 MSNUMPCE CHAR(95),/* MAXSIZE SUBFIELD (IKJIDENT)*/ 03590000 * 2 SZSUBPCE CHAR(3), /* SIZE SUBFIELD HEADER */ 03600000 * 2 SZNUMPCE CHAR(85),/* SIZE SUBFIELD (IKJIDENT) */ 03610000 * 2 UNSUBPCE CHAR(3), /* UNIT SUBFIELD HEADER */ 03620000 * 2 UNNMEPCE CHAR(41),/* UNIT SUBFIELD (IKJIDENT) */ 03630000 * 2 PRSUBPCE CHAR(3), /* PROCNAME SUBFIELD HEADER */ 03640000 * 2 PROCDPCE CHAR(56),/* PROCNAME SUBFLD (IKJIDENT) */ 03650000 * 2 ACSUBPCE CHAR(3), /* ACCTNMBR SUBFIELD HEADER */ 03660000 * 2 ACCTDPCE CHAR(59),/* ACCTNMBR SUBFLD (IKJIDENT) */ 03670000 * 2 PASUBPCE CHAR(3), /* PASSWORD SUBFIELD HEADER */ 03680000 * 2 PASSDPCE CHAR(44),/* PASSWORD SUBFLD (IKJIDENT) */ 03690000 * 2 USSUBPCE CHAR(3), /* USERID SUBFIELD HEADER */ 03700000 * 2 USERDPCE CHAR(40),/* USERID SUBFLD (IKJIDENT) */ 03710000 * 2 ENDPPCE CHAR(1), /* PCL END-OF-FIELD INDICATOR */ 03720000 * SZUNSKIP FIXED(15) /* THIS LENGTH WILL REPLACE */ 03730000 * INIT(ADDR(UNNAMSUB) /* THE 'NOLIM' NAME PCE LENGTH*/ 03740000 * -ADDR(NLNAMPCE)+2), /* IF CHANGE LEVEL ª= PROCNAME*/ 03750000 * SZUNDASK FIXED(15) /* THIS LENGTH WILL REPLACE */ 03760000 * INIT(ADDR(DANAMSUB) /* THE 'UNIT' NAME PCE LENGTH */ 03770000 * -ADDR(NLNAMPCE)+2), /* IF CHANGE LEVEL = USERID & 03780000 * USERID = '*' */ 03790000 * ACSUBOF FIXED(15) /* THIS OFFSET WILL REPLACE */ 03800000 * INIT(ADDR(ACSUBPCE) /* THE DATA SUBFIELD OFFSET.. */ 03810000 * -ADDR(PARMPCE)+1), /* (DANAMSUB) WHEN THE CHANGE 03820000 * LEVEL = ACCTNMBR */ 03830000 * PASUBOF FIXED(15) /* THIS OFFSET WILL REPLACE */ 03840000 * INIT(ADDR(PASUBPCE) /* THE DATA SUBFIELD OFFSET.. */ 03850000 * -ADDR(PARMPCE)+1), /* (DANAMSUB) WHEN THE CHANGE 03860000 * LEVEL = PASSWORD */ 03870000 * USSUBOF FIXED(15) /* THIS OFFSET WILL REPLACE */ 03880000 * INIT(ADDR(USSUBPCE) /* THE DATA SUBFIELD OFFSET.. */ 03890000 * -ADDR(PARMPCE)+1); /* (DANAMSUB) WHEN THE CHANGE 03900000 * LEVEL = PROCNAME */ 03910000 * 03920000 * DECLARE 03930000 * /* THE PARAMETER DESCRIPTOR LIST (PDL). */ 03940000 * 1 CHNGPDL BASED(CHNPDLAD), 03950000 * 2 * CHAR(8), /* CONTROL FIELD FOR PARSE */ 03960000 * 2 NODEPDE1 CHAR(8), /* PDE FOR NODELIST PSTRING */ 03970000 * 2 OPERNBR BIT(16), /* OPERATOR ATTR KEY */ 03980000 * 2 ACCTNBR BIT(16), /* ACCOUNT ATTR KEY */ 03990000 * 2 JCLNBR BIT(16), /* SUBMIT ATTR KEY */ 04000000 * 2 MAXSNBR BIT(16), /* MAX REGION SIZE KEY */ 04010000 * 2 SIZENBR BIT(16), /* PROCSIZE KEY */ 04020000 * 2 UNITNBR BIT(16), /* UNIT NAME KEY */ 04030000 * 2 DATANBR BIT(16), /* DATALIST KEY */ 04040000 * 2 * BIT(16), /* FILLER */ 04050000 * 2 MAXSUBF, /* PDE FOR MAX REGION SIZE */ 04060000 * 3 MAXSADR PTR, /* PTR TO MAXSIZE INTEGERS */ 04070000 * 3 MAXSLNG FIXED(15),/* LENGTH OF INTEGERS */ 04080000 * 3 MAXSFLGS BIT(16),/* MAXSIZE FLAGS */ 04090000 * 4 MAXSFLG BIT(1),/* BIT1 = 1: PARM PRESENT */ 04100000 * 2 SIZSUBF, /* PDE FOR PROCSIZE */ 04110000 * 3 RSIZADR PTR, /* PTR TO SIZE INTEGERS */ 04120000 * 3 RSIZLNG FIXED(15),/* LENGTH OF SIZE NUMBER */ 04130000 * 3 RSIZFLGS BIT(16),/* PROCSIZE FLAGS */ 04140000 * 4 RSIZFLG BIT(1),/* BIT1 = 1: PARM PRESENT */ 04150000 * 2 UNITSUBF, /* PDE FOR UNIT NAME */ 04160000 * 3 UNITADR PTR, /* PTR TO THE UNIT NAME */ 04170000 * 3 UNITLNG FIXED(15),/* LENGTH OF UNIT NAME */ 04180000 * 3 UNITFLGS BIT(16),/* UNIT NAME FLAGS */ 04190000 * 4 UNITFLG BIT(1),/* BIT1 = 1: PARM PRESENT */ 04200000 * 2 PROCSUBF, /* PDE FOR THE DATALIST ITEM 04210000 * (NEW PROCNAME) */ 04220000 * 3 DLPTR4 PTR, /* PTR TO THE DATALIST ITEM */ 04230000 * 3 DATALNG4 FIXED(15),/* LENGTH OF DATALIST ITEM */ 04240000 * 3 * BIT(16), /* DATALIST FLAGS */ 04250000 * 4 DLFLG4 BIT(1),/* BIT1 = 1: PARM PRESENT */ 04260000 * 2 ACCTSUBF, /* PDE FOR THE DATALIST ITEM 04270000 * (NEW ACCTNMBR) */ 04280000 * 3 DLPTR3 PTR, /* PTR TO THE DATALIST ITEM */ 04290000 * 3 DATALNG3 FIXED(15),/* LENGTH OF DATALIST ITEM */ 04300000 * 3 * BIT(16), /* DATALIST FLAGS */ 04310000 * 4 DLFLG3 BIT(1),/* BIT1 = 1: PARM PRESENT */ 04320000 * 2 PASSSUBF, /* PDE FOR THE DATALIST ITEM 04330000 * (NEW PASSWORD) */ 04340000 * 3 DLPTR2 PTR, /* PTR TO THE DATALIST ITEM */ 04350000 * 3 DATALNG2 FIXED(15),/* LENGTH OF DATALIST ITEM */ 04360000 * 3 * BIT(16), /* DATALIST FLAGS */ 04370000 * 4 DLFLG2 BIT(1),/* BIT1 = 1: PARM PRESENT */ 04380000 * 2 USIDSUBF, /* PDE FOR THE DATALIST ITEM 04390000 * (NEW USERID) */ 04400000 * 3 DLPTR1 PTR, /* PTR TO THE DATALIST ITEM */ 04410000 * 3 DATALNG1 FIXED(15),/* LENGTH OF DATALIST ITEM */ 04420000 * 3 * BIT(16), /* DATALIST FLAGS */ 04430000 * 4 DLFLG1 BIT(1);/* BIT1 = 1: PARM PRESENT */ 04440000 * 04450000 * DECLARE 04460000 * /* THE NODELIST TABLE, CONSTRUCTED BY THE NODELIST */ 04470000 * /* VALIDITY CHECK EXIT ROUTINE, IKJEFA25. */ 04480000 * NODELADR PTR, /* BASE PTR FOR NODELIST TABLE*/ 04490000 * 1 NLSTTAB BASED(NODELADR), 04500000 * 2 USRID CHAR(7), /* USERID */ 04510000 * 2 * CHAR(1), /* BOUNDARY BYTE */ 04520000 * 2 PASSWD CHAR(8), /* PASSWORD */ 04530000 * 2 ACCTNO CHAR(40), /* ACCOUNT-NUMBER */ 04540000 * 2 PROCNM CHAR(8), /* PROCEDURE NAME */ 04550000 * 2 USRLEN PTR(15), /* LENGTH OF THE USERID */ 04560000 * 2 PWLEN PTR(15), /* LENGTH OF THE PASSWORD */ 04570000 * 2 ACTLEN PTR(15), /* LENGTH OF THE ACCTNMBR */ 04580000 * 2 PRLEN PTR(15); /* LENGTH OF THE PROCNAME */ 04590000 * 04600000 * DECLARE 04610000 * /* PARAMETER LIST FOR CONDITIONAL GETMAIN. */ 04620000 * GTMLIST GEND CHAR(10),/* GENERATED GETMAIN LIST */ 04630000 * DYNGTLST CHAR(10) /* DYNAMIC GETMAIN LIST */ 04640000 * BDY(WORD); 04650000 * 04660000 * /* GENERATE LIST FORMS OF REQUIRED SYSTEM MACROS. */ 04670000 * GEN DATA; 04680000 * 04690000 **/*STCODE: P SET BASE PTR FOR CHANGE CONTROL TABLE */ 04700000 * STCODE: /**********************************************************/ 04710000 * /* */ 04720000 * /* BEGINNING OF EXECUTABLE CODE */ 04730000 * /* */ 04740000 * /**********************************************************/ 04750000 * 04760000 * CTABPTR = R1; /* PTR TO THE CHANGE CNTRL TAB 04770000 * IS PASSED IN REG1 */ 04780000 STCODE ST @1,CTABPTR 0019 04790000 * NODELADR = NODELPTR; /* SET BASE PTR FOR NODELSTTAB*/ 04800000 L @8,CTABPTR 0020 04810000 MVC NODELADR(4),8(@8) 0020 04820000 * ACTPLPTR = ACTPLADR; /* ADDR OF ACCOUNT PARMLIST */ 04830000 MVC ACTPLPTR(4),0(@8) 0021 04840000 * DYNGTLST = GTMLIST; /* INIT DYNAMIC GETMAIN BLOCK */ 04850000 MVC DYNGTLST(10),GTMLIST 0022 04860000 * /* OBTAIN DYNAMIC STORAGE FOR PARSE PARAMETER CONTROL LIST*/ 04870000 **/* P OBTAIN DYNAMIC CORE FOR MAIN PARSE PCL */ 04880000 * RESTRICT(LNGTHREG); /* RESERVE REG FOR GETMAIN */ 04890000 * LNGTHREG = PCLLNGTH; /* SET LENGTH OF PARSE PCL */ 04900000 L @5,PCLMDLAD 0024 04910000 LH @4,0(0,@5) 0024 04920000 * R1 = ADDR(DYNGTLST); /* PTR TO GETMAIN PARMLIST */ 04930000 LA @1,DYNGTLST 0025 04940000 * GENERATE; 04950000 GETMAIN ,LV=(LNGTHREG),A=PMACSPTR,SP=1,MF=(E,(1)) 04960000 DS 0H 04970000 * RETCODE = R15; /* ASSIGN THE RETURN CODE */ 04980000 ST @F,36(0,@8) 0027 04990000 **/* D (YES,%GTOK,NO,) GETMAIN SUCCESSFUL? */ 05000000 **/* P (,%RTRN) SET ERROR MSGNMBR */ 05010000 * /* CHECK THE RETURN CODE */ 05020000 * IF RETCODE ª= 0 /* GETMAIN SUCCESSFUL? */ 05030000 * THEN /* NO, SPACE UNAVAILABLE */ 05040000 SR @F,@F 0028 05050000 C @F,36(0,@8) 0028 05060000 BC 08,@9FF 0028 05070000 * DO; 05080000 * MSGNMBR = 3; /* SET ERROR MSG NUMBER AND.. */ 05090000 LA @F,3 0030 05100000 STH @F,32(0,@8) 0030 05110000 * RETURN; /* RETURN TO IKJEFA20 */ 05120000 BC 15,@EL01 0031 05130000 * END; 05140000 * /* INITIALIZE THE PARSE PCL FROM THE MODEL. */ 05150000 * RESTRICT(SORCPTR,RCVRPTR,LOOPREG);/* ALLOCATE REGISTERS */ 05160000 * SORCPTR = PCLMDLAD; /* SORCPTR IS INDEX FOR LOOP */ 05170000 @9FF L @2,PCLMDLAD 0034 05180000 * RCVRPTR = PMACSPTR; /* RCVRPTR IS ALSO AN INDEX */ 05190000 L @3,PMACSPTR 0035 05200000 * LOOPREG = LNGTHREG/256; /* PCL LENGTH */ 05210000 LR @E,@4 0036 05220000 SRA @E,8 0036 05230000 LR @5,@E 0036 05240000 * LNGTHREG = LNGTHREG//256-1; /* PREPARE REMAINDER FOR EXEC */ 05250000 LR @E,@4 0037 05260000 SRDA @E,32 0037 05270000 LA @0,256 0037 05280000 DR @E,@0 0037 05290000 BCTR @E,0 0037 05300000 LR @4,@E 0037 05310000 **/*%GTOK: P MOVE PCL TO ALLOW MODIFICATION */ 05320000 * /* PCL MUST BE MOVED INTO DYNAMIC STORAGE SINCE IT WILL BE*/ 05330000 * /* MODIFIED IN THE NODELIST VALIDITY CHECK EXIT ROUTINE - */ 05340000 * /* IKJEFA25. */ 05350000 * DO LOOPREG = LOOPREG /* OPTIMUM LOOP CONTROLS */ 05360000 * TO 1 BY -1; 05370000 LTR @5,@5 0038 05380000 BC 12,@DO9FD 0038 05390000 * RCVRPTR -> PARSBLOK = /* MOVE 256 BYTES */ 05400000 * SORCPTR -> PARSBLOK; 05410000 @DO9FE MVC 0(256,@3),0(@2) 0039 05420000 * RCVRPTR = RCVRPTR+256; /* INCR. BASE PTR FOR DYN. PCL*/ 05430000 LA @3,256(0,@3) 0040 05440000 * SORCPTR = SORCPTR+256; /* INCR BASE PTR FOR MODEL PCL*/ 05450000 LA @2,256(0,@2) 0041 05460000 * END; 05470000 * /* MOVE ODD REMAINDER BY EXECUTING AN MVC INSTRUCTION */ 05480000 * GENERATE; 05490000 BCT @5,@DO9FE 0042 05500000 @DO9FD EQU * 0042 05510000 EX LNGTHREG,MOVER MOVE REMAINDER 05520000 DS 0H 05530000 * RELEASE(SORCPTR,RCVRPTR,LNGTHREG,LOOPREG); 05540000 **/* P BUILD PARSE PARMLIST (PPL) */ 05550000 * /* BUILD PARSE PARAMETER LIST (PPL). */ 05560000 * PPLPTR = ADDR(PARSPARM); /* PPL ADDRESSABILITY */ 05570000 LA @1,PARSPARM 0045 05580000 * PPL3WDS = SERVLIST; /* 1ST 3 WORDS OF ACCOUNT PARA- 05590000 * METER LIST */ 05600000 L @8,ACTPLPTR 0046 05610000 MVC 0(12,@1),0(@8) 0046 05620000 * PPLPCL = PMACSPTR; /* ADDR OF DYNAMIC PCL */ 05630000 MVC 12(4,@1),PMACSPTR 0047 05640000 * PPLANS = ADDR(CHNPDLAD); /* CHNPDLAD WILL CONTAIN ADDR 05650000 * OF PDL AFTER PARSE */ 05660000 LA @F,CHNPDLAD 0048 05670000 ST @F,16(0,@1) 0048 05680000 * PPLCBUF = BUFPTR; /* PTR TO CHANGE CMND BUFFER */ 05690000 MVC 20(4,@1),12(@8) 0049 05700000 * PPLUWA = REG13; /* ADDR OF THIS PGM'S REG SAVE 05710000 * AREA SO THAT VALIDITY CHECK 05720000 * EXIT ROUTINE CAN RESTORE 05730000 * CERTAIN OF THIS PGM'S REGS */ 05740000 ST @D,24(0,@1) 0050 05750000 **/* S IKJPARS: PARSE COMMAND PARAMETERS */ 05760000 **/* S IKJEFA25: NODELIST VAL CHK EXIT RTNE */ 05770000 **/* S IKJEFA26: SIZE/MAXSIZE VAL CHK EXIT RTNE */ 05780000 **/* S IKJEFA55: ACTNBR VAL CHK EXIT RTNE */ 05790000 * /* LINK TO THE PARSE SERVICE ROUTINE. */ 05800000 * GENERATE; 05810000 LINK EP=IKJPARS,MF=(E,(1)) 05820000 DS 0H 05830000 * RETCODE = R15; /* SAVE THE RETURN CODE */ 05840000 L @9,CTABPTR 0052 05850000 ST @F,36(0,@9) 0052 05860000 **/* P RELEASE MAIN PCL CORE */ 05870000 * /* RELEASE DYNAMIC STORAGE OBTAINED FOR PARSE PCL. */ 05880000 * FREELVAL = PCLLNGTH; /* LENGTH FROM PARSE PCL */ 05890000 L @6,PCLMDLAD 0053 05900000 LH @F,0(0,@6) 0053 05910000 ST @F,FREELVAL 0053 05920000 * FRLVSUBP = 1; /* SUBPOOL = 1 */ 05930000 MVI FREELVAL,1 0054 05940000 * R0 = FREELVAL; /* LOAD REG0 */ 05950000 L @0,FREELVAL 0055 05960000 * R1 = PMACSPTR; /* ADDR OF DYNAMIC PCL */ 05970000 L @1,PMACSPTR 0056 05980000 * /* ISSUE FREEMAIN MACRO TO RELEASE DYNAMIC PCL */ 05990000 * GENERATE; 06000000 FREEMAIN R,LV=(0),A=(1) 06010000 DS 0H 06020000 **/* D (YES,PRSOK,NO,) PARSE SUCCESSFUL? */ 06030000 **/* P (,%RTRN) SET ERROR MSGNMBR */ 06040000 * /* CHECK THE PARSE RETURN CODE. */ 06050000 * IF RETCODE = 0 /* PARSE SUCCESSFUL? */ 06060000 * THEN /* YES, */ 06070000 SR @F,@F 0058 06080000 C @F,36(0,@9) 0058 06090000 * GOTO PRSOK; /* GO FILL IN CONTROL TABLE */ 06100000 BC 08,PRSOK 0059 06110000 * /* ATTENTION EXIT? */ 06120000 * IF RETCODE = 8 06130000 * THEN /* YES, */ 06140000 LA @F,8 0060 06150000 C @F,36(0,@9) 0060 06160000 * RETURN; /* RETURN TO IKJEFA20 */ 06170000 BC 08,@EL01 0061 06180000 * /* GETMAIN FAILURE? */ 06190000 * IF RETCODE = 16 06200000 * THEN /* YES, */ 06210000 @9FA LA @F,16 0062 06220000 C @F,36(0,@9) 0062 06230000 BC 07,@9F9 0062 06240000 * DO; 06250000 * MSGNMBR = 3; /* SET ERROR MSG NUMBER */ 06260000 LA @F,3 0064 06270000 STH @F,32(0,@9) 0064 06280000 * RETURN; /* RETURN TO IKJEFA20 */ 06290000 BC 15,@EL01 0065 06300000 * END; 06310000 * /* ERROR DURING VALIDITY CHECK? M1859 */ 06320000 * IF RETCODE = 20 06330000 * THEN /* YES, M1859 */ 06340000 @9F9 LA @F,20 0067 06350000 L @8,CTABPTR 0067 06360000 C @F,36(0,@8) 0067 06370000 BC 07,@9F8 0067 06380000 * RETCODE = VCHKCODE; /* SET VALIDITY CHECK CODE 06390000 * M1859 */ 06400000 MVC 36(4,@8),40(@8) 0068 06410000 * ELSE; /* NO, INVALID RETURN CODE 06420000 * FROM PARSE M1859 */ 06430000 @9F8 EQU * 0069 06440000 * MSGNMBR = 21; /* SET ERROR MSG NUMBER M1859 */ 06450000 @9F7 LA @F,21 0070 06460000 STH @F,32(0,@8) 0070 06470000 * RETURN; /* RETURN TO IKJEFA20 M1859 */ 06480000 BC 15,@EL01 0071 06490000 **/*PRSOK: P SET PERTINENT FIELDS IN CHANGE CNTRL TAB */ 06500000 * PRSOK: /* PARSE WAS SUCCESSFUL. FILL IN THE APPROPRIATE FIELDS */ 06510000 * /* IN THE CHANGE CONTROL TABLE & RETURN TO IKJEFA20. */ 06520000 * CHLEVL = NUMOFLVL; /* NO. OF ITEMS FOUND IN THE 06530000 * NODELIST = CHANGE LEVEL */ 06540000 PRSOK L @8,CTABPTR 0072 06550000 MVC 29(1,@8),NUMOFLVL 0072 06560000 MVI 28(@8),X'00' 0072 06570000 * CHPDLPTR = CHNPDLAD; /* PTR TO THE PDL */ 06580000 MVC 4(4,@8),CHNPDLAD 0073 06590000 * MSGNMBR = 0; /* 0- SUCCESSFUL COMPLETION */ 06600000 SR @F,@F 0074 06610000 STH @F,32(0,@8) 0074 06620000 **/*%RTRN: R RETURN TO IKJEFA20 */ 06630000 * RETURN; /* RETURN TO IKJEFA20 */ 06640000 BC 15,@EL01 0075 06650000 * 06660000 * /* CHANGE SUBCOMMAND SYNTAX - PARSE MACROS */ 06670000 * GENERATE; /* 06680000 PCLMODEL IKJPARM DSECT=CHNGPDLD 06690000 NODEPDE IKJPOSIT PSTRING,PROMPT='(NODELIST)',VALIDCK=IKJEFA25 06700000 OPERPDE IKJKEYWD 06710000 IKJNAME 'OPER' 06720000 IKJNAME 'NOOPER' 06730000 ACCTPDE IKJKEYWD 06740000 IKJNAME 'ACCT' 06750000 IKJNAME 'NOACCT' 06760000 JCLPDE IKJKEYWD 06770000 IKJNAME 'JCL' 06780000 IKJNAME 'NOJCL' 06790000 MAXSZPDE IKJKEYWD 06800000 IKJNAME 'MAXSIZE',SUBFLD=MAXSUB 06810000 IKJNAME 'NOLIM' 06820000 * THE FOLLOWING STATEMENTS MUST IMMEDIATELY FOLLOW * 06830000 * THE 'MAXSZPDE' GROUP SINCE THE PCE LENGTH OF THE * 06840000 * 'NOLIM' PCE MAY BE MODIFIED TO OVERLAP 'SIZEPDE', * 06850000 * 'UNITPDE' & POSSIBLY 'DATAPDE' - SEE IKJEFA25 * 06860000 SIZEPDE IKJKEYWD 06870000 IKJNAME 'SIZE',SUBFLD=SIZESUB 06880000 UNITPDE IKJKEYWD 06890000 IKJNAME 'UNIT',SUBFLD=UNITSUB 06900000 DATAPDE IKJKEYWD DEFAULT='DATA' 06910000 IKJNAME 'DATA',SUBFLD=PROCSUB 06920000 MAXSUB IKJSUBF 06930000 MAXSZ IKJIDENT 'MAXSIZE VALUE',MAXLNTH=5,FIRST=NUMERIC, S06940000 OTHER=NUMERIC, S06950000 PROMPT='MAXIMUM REGION SIZE FOR THIS USERID', S06960000 HELP=('NUMBER LESS THAN 65535'),VALIDCK=IKJEFA26 06970000 SIZESUB IKJSUBF 06980000 SIZNO IKJIDENT 'SIZE VALUE',MAXLNTH=5,FIRST=NUMERIC,OTHER=NUMERIC, S06990000 PROMPT='REGION SIZE FOR PROCEDURE(S)', S07000000 HELP=('NUMBER LESS THAN 65535'),VALIDCK=IKJEFA26 07010000 UNITSUB IKJSUBF 07020000 UNITNAM IKJIDENT 'UNIT NAME',MAXLNTH=8,FIRST=ALPHANUM, S07030000 OTHER=ALPHANUM,PROMPT='DEVICE GROUP NAME' 07040000 PROCSUB IKJSUBF 07050000 PROCD IKJIDENT 'DATALIST-PROCEDURE NAME',MAXLNTH=8,OTHER=ALPHANUM, S07060000 PROMPT='NEW PROCEDURE NAME' 07070000 ACCTSUB IKJSUBF 07080000 ACCTD IKJIDENT 'DATALIST-ACCOUNT NUMBER',MAXLNTH=40,FIRST=ANY, S07090000 OTHER=ANY,PROMPT='NEW ACCOUNT NUMBER',VALIDCK=IKJEFA55 07100000 PASSSUB IKJSUBF 07110000 PASSD IKJIDENT 'DATALIST-PASSWORD',MAXLNTH=8,FIRST=ALPHANUM, S07120000 OTHER=ALPHANUM,PROMPT='NEW PASSWORD' 07130000 USERSUB IKJSUBF 07140000 USERD IKJIDENT 'DATALIST-USERID',MAXLNTH=7,OTHER=ALPHANUM, S07150000 PROMPT='NEW USERID' 07160000 IKJENDP 07170000 SPACE 07180000 NODEPARS IKJPARM DSECT=NDPDLD 07190000 USERN IKJIDENT 'NODELIST-USERID',ASTERISK,MAXLNTH=50, S07200000 FIRST=ANY,OTHER=ANY 07210000 PASSN IKJIDENT 'NODELIST-PASSWORD',ASTERISK,MAXLNTH=50, S07220000 FIRST=ANY,OTHER=ANY 07230000 ACCTN IKJIDENT 'NODELIST-ACCOUNT NUMBER',ASTERISK,MAXLNTH=50, S07240000 FIRST=ANY,OTHER=ANY 07250000 PROCN IKJIDENT 'NODELIST-PROCEDURE NAME',ASTERISK,MAXLNTH=50, S07260000 FIRST=ANY,OTHER=ANY 07270000 IKJENDP 07280000 SPACE 07290000 USERPARS IKJPARM DSECT=USPDLD 07300000 USERN1 IKJIDENT 'NODELIST-USERID',ASTERISK,MAXLNTH=7,OTHER=ALPHANUM, S07310000 PROMPT=' VALID USERID ' 07320000 PASSN1 IKJIDENT 'DUM',ASTERISK,MAXLNTH=50,FIRST=ANY,OTHER=ANY 07330000 ACCTN1 IKJIDENT 'DUM',ASTERISK,MAXLNTH=50,FIRST=ANY,OTHER=ANY 07340000 PROCN1 IKJIDENT 'DUM',ASTERISK,MAXLNTH=50,FIRST=ANY,OTHER=ANY 07350000 DUMMY1 IKJIDENT 'DUM',ASTERISK,MAXLNTH=50,FIRST=ANY,OTHER=ANY 07360000 IKJENDP 07370000 SPACE 07380000 PASSPARS IKJPARM DSECT=PAPDLD 07390000 USERN2 IKJIDENT 'DUM',ASTERISK,MAXLNTH=50,FIRST=ANY,OTHER=ANY 07400000 PASSN2 IKJIDENT 'NODELIST-PASSWORD',ASTERISK,MAXLNTH=8, S07410000 FIRST=ALPHANUM,OTHER=ALPHANUM,PROMPT=' VALID PASSWORD ' 07420000 ACCTN2 IKJIDENT 'DUM',ASTERISK,MAXLNTH=50,FIRST=ANY,OTHER=ANY 07430000 PROCN2 IKJIDENT 'DUM',ASTERISK,MAXLNTH=50,FIRST=ANY,OTHER=ANY 07440000 DUMMY2 IKJIDENT 'DUM',ASTERISK,MAXLNTH=50,FIRST=ANY,OTHER=ANY 07450000 IKJENDP 07460000 SPACE 07470000 ACCTPARS IKJPARM DSECT=ACPDLD 07480000 USERN3 IKJIDENT 'DUM',ASTERISK,MAXLNTH=50,FIRST=ANY,OTHER=ANY 07490000 PASSN3 IKJIDENT 'DUM',ASTERISK,MAXLNTH=50,FIRST=ANY,OTHER=ANY 07500000 ACCTN3 IKJIDENT 'NODELIST-ACCOUNT NUMBER',ASTERISK,MAXLNTH=40, S07510000 FIRST=ANY,OTHER=ANY,PROMPT=' VALID ACCOUNT NUMBER ', S07520000 VALIDCK=IKJEFA55 07530000 PROCN3 IKJIDENT 'DUM',ASTERISK,MAXLNTH=50,FIRST=ANY,OTHER=ANY 07540000 DUMMY3 IKJIDENT 'DUM',ASTERISK,MAXLNTH=50,FIRST=ANY,OTHER=ANY 07550000 IKJENDP 07560000 SPACE 07570000 PROCPARS IKJPARM DSECT=PRPDLD 07580000 USERN4 IKJIDENT 'DUM',ASTERISK,MAXLNTH=50,FIRST=ANY,OTHER=ANY 07590000 PASSN4 IKJIDENT 'DUM',ASTERISK,MAXLNTH=50,FIRST=ANY,OTHER=ANY 07600000 ACCTN4 IKJIDENT 'DUM',ASTERISK,MAXLNTH=50,FIRST=ANY,OTHER=ANY 07610000 PROCN4 IKJIDENT 'NODELIST-PROCEDURE NAME',ASTERISK,MAXLNTH=8, S07620000 OTHER=ALPHANUM,PROMPT=' VALID PROCEDURE NAME ' 07630000 DUMMY4 IKJIDENT 'DUM',ASTERISK,MAXLNTH=50,FIRST=ANY,OTHER=ANY 07640000 IKJENDP 07650000 DS 0H 07660000 * 07670000 * 07680000 * /**********************************************************/ 07690000 * /* */ 07700000 * /* THE FOLLOWING INTERNAL PROCEDURES ARE VALIDITY CHECK */ 07710000 * /* EXIT ROUTINES WHICH ARE ENTERED FROM THE PARSE SERVICE */ 07720000 * /* ROUTINE DURING THE PARSE PROCESS. ASSEMBLY LANGUAGE */ 07730000 * /* PRECEDES EACH PROCEDURE TO ESTABLISH ADDRESSABILITY */ 07740000 * /* FOR BOTH CODE AND AUTOMATIC STORAGE. */ 07750000 * /* */ 07760000 * /**********************************************************/ 07770000 * 07780000 **/* E IKJEFA25: NODELST VAL CHK EXIT RTNE */ 07790000 * IKJEFA25:/* ENTRY POINT FOR NODELIST VALIDITY CHECK EXIT ROUTINE. */ 07800000 * GENERATE; /* 07810000 IKJEFA25 EQU * 0077 07820000 STM @E,@C,WD4(@D) SAVE PARSE REGISTERS 07830000 L @C,WD2(,@1) ADDR OF MAINLINE SAVE AREA 07840000 LM @9,@C,REGSV9(@C) ADDRESSABILITY FOR CODE & DATA 07850000 WD2 EQU 4 2ND WORD IN EXIT RTNE PARMLIST 07860000 WD4 EQU 12 ORIGIN OF SAVE AREA FOR R14-12 07870000 REGSV9 EQU 56 REG9 POSITION IN SAVE AREA 07880000 DS 0H 07890000 * GOTO IKJNEXIT; /* BRANCH AROUND EPILOGUE */ 07900000 BC 15,IKJNEXIT 0078 07910000 * IKJNEXIT:/**********************************************************/ 07920000 * /* NODELIST VALIDITY CHECK EXIT ROUTINE - */ 07930000 * /* . ANALYZES THE CHANGE COMMAND NODELIST VIA A SERIES */ 07940000 * /* OF NESTED CALLS TO PARSE, USING ONLY THE CONTENTS */ 07950000 * /* OF THE PSTRING AS THE COMMAND BUFFER */ 07960000 * /* . COUNTS THE NUMBER OF ITEMS IN THE NODELIST */ 07970000 * /* . IF THE COUNT IS 1 (USERID ONLY) AND THE USERID IS */ 07980000 * /* '*', THE PARSE PCL WILL BE MODIFIED SO THAT THE */ 07990000 * /* KEYWORDS 'SIZE', 'UNIT' & 'DATA' ARE BYPASSED LATER*/ 08000000 * /* ON IN THE PARSING PROCESS. IF THE USERID IS NOT '*'*/ 08010000 * /* THE PARSE PCL WILL BE MODIFIED SO THAT ONLY 'SIZE' */ 08020000 * /* & 'UNIT' ARE BYPASSED. ALSO, THE SUBFIELD OFFSET */ 08030000 * /* OF THE 'DATA' NAME PCE IS MODIFIED TO LOCATE A SUB-*/ 08040000 * /* FIELD WITH A USERID DEFINITION. */ 08050000 * /* . IF THE COUNT IS 2, THE PCL WILL BE MODIFIED SO THAT*/ 08060000 * /* THE 'SIZE' & 'UNIT' KEYWORDS ARE BYPASSED AND THE */ 08070000 * /* 'DATA' SUBFIELD LOCATES A PASSWORD DEFINITION. */ 08080000 * /* . IF THE COUNT IS 3, THE PCL WILL BE MODIFIED SO THAT*/ 08090000 * /* THE 'SIZE' & 'UNIT' KEYWORDS ARE BYPASSED AND THE */ 08100000 * /* 'DATA' SUBFIELD LOCATES AN ACCTNMBR DEFINITION. */ 08110000 * /* . IF THE COUNT IS 4, THE PCL WILL BE MODIFIED SO THAT*/ 08120000 * /* 'DATA' SUBFIELD LOCATES A PROCNAME DEFINITION. */ 08130000 * /**********************************************************/ 08140000 * 08150000 * PROCEDURE OPTIONS(SAVE(13,14)); 08160000 @EL01 L @D,4(0,@D) 0079 08170000 LR @1,@C 0079 08180000 L @0,@SIZ001 0079 08190000 FREEMAIN R,LV=(0),A=(1) 0079 08200000 L @E,12(0,@D) 0079 08210000 LM @0,@C,20(@D) 0079 08220000 BCR 15,@E 0079 08230000 IKJNEXIT ST @E,12(0,@D) 0079 08240000 ST @D,@SAV002+4 0079 08250000 LA @F,@SAV002 0079 08260000 ST @F,8(0,@D) 0079 08270000 LR @D,@F 0079 08280000 * 08290000 * RESTRICT(R1,INPUTPTR); /* RESERVE PARMLIST REGISTERS */ 08300000 **/* P SET BASE PTR FOR INPUT PARMLIST */ 08310000 **/* P INIT COUNT OF NODELIST ITEMS */ 08320000 **/* P OBTAIN DYNAMIC CORE FOR NODELIST PCL */ 08330000 * INPUTPTR = R1; /* TRANSFER PTR TO PARMLIST */ 08340000 LR @2,@1 0081 08350000 * NUMOFLVL = 0; /* INIT COUNT OF NODELST ITEMS*/ 08360000 MVI NUMOFLVL,0 0082 08370000 * /* OBTAIN DYNAMIC STORAGE FOR THE NODELIST BUFFER. */ 08380000 * RESTRICT(LNGTHREG); /* RESERVE REG FOR GETMAIN */ 08390000 * LNGTHREG = PSTRLNG+4; /* LENGTH OF NODELIST + HEADER*/ 08400000 LA @4,4 0084 08410000 L @3,0(0,@2) 0084 08420000 AH @4,4(0,@3) 0084 08430000 * GENERATE; 08440000 GETMAIN ,LV=(LNGTHREG),A=NDBUFPTR,SP=1,MF=(E,DYNGTLST) 08450000 DS 0H 08460000 * RETCODE = R15; /* SAVE GETMAIN RETURN CODE */ 08470000 L @5,CTABPTR 0086 08480000 ST @F,36(0,@5) 0086 08490000 **/* D (YES,%GTMOK,NO,) GETMAIN SUCCESSFUL? */ 08500000 **/* P SAVE THE ERROR CODE */ 08510000 **/* P (,%VRTRN) INDICATE VALCHK RTNE FAILURE TO PARSE */ 08520000 * /* CHECK THE GETMAIN RETURN CODE. */ 08530000 * IF RETCODE ª= 0 /* GETMAIN SUCCESSFUL? */ 08540000 * THEN /* NO, */ 08550000 SR @F,@F 0087 08560000 C @F,36(0,@5) 0087 08570000 BC 08,@9F6 0087 08580000 * DO; 08590000 * MSGNMBR = 3; /* SAVE ERROR MSG NUMBER */ 08600000 LA @F,3 0089 08610000 STH @F,32(0,@5) 0089 08620000 * RETNCODE = 12; /* SET RETCODE FOR PARSE */ 08630000 LA @F,12 0090 08640000 L @8,4(0,@D) 0090 08650000 ST @F,16(0,@8) 0090 08660000 * GOTO NXITEXIT; /* GO RETURN TO PARSE */ 08670000 BC 15,NXITEXIT 0091 08680000 * END; 08690000 * NDBUFLNG = LNGTHREG; /* FILL IN BUFFER HEADER */ 08700000 @9F6 L @3,NDBUFPTR 0093 08710000 STH @4,0(0,@3) 0093 08720000 * NDBFOFST = 0; /* SET OFFSET TO START OF DATA*/ 08730000 SR @F,@F 0094 08740000 STH @F,2(0,@3) 0094 08750000 * RESTRICT(SORCPTR,RCVRPTR,LOOPREG); 08760000 * SORCPTR = PSTRPTR; /* ADDR OF PSTRING FROM PDE */ 08770000 L @8,0(0,@2) 0096 08780000 L @2,0(0,@8) 0096 08790000 * RCVRPTR = NDBUFPTR+4; /* POINT TO DATA IN RECVR */ 08800000 LA @3,4 0097 08810000 A @3,NDBUFPTR 0097 08820000 * LOOPREG = PSTRLNG/256; /* DIVIDE THE LENGTH INTO 256- 08830000 * BYTE SECTIONS */ 08840000 LH @E,4(0,@8) 0098 08850000 SRDA @E,32 0098 08860000 LA @0,256 0098 08870000 DR @E,@0 0098 08880000 LR @5,@F 0098 08890000 * LNGTHREG = PSTRLNG//256-1; /* PREPARE REMAINDER FOR EXEC */ 08900000 LH @E,4(0,@8) 0099 08910000 SRDA @E,32 0099 08920000 LA @0,256 0099 08930000 DR @E,@0 0099 08940000 BCTR @E,0 0099 08950000 LR @4,@E 0099 08960000 **/*%GTMOK: P MOVE PCL TO ALLOW MODIFICATION */ 08970000 * /* MOVE THE NODELIST PSTRING INTO THE BUFFER. */ 08980000 * DO LOOPREG = LOOPREG TO 1 BY -1; 08990000 LTR @5,@5 0100 09000000 BC 12,@DO9F4 0100 09010000 * RCVRPTR -> NDBUFSPC = /* MOVE 256 BYTES */ 09020000 * SORCPTR -> NDBUFSPC; 09030000 @DO9F5 MVC 0(256,@3),0(@2) 0101 09040000 * RCVRPTR = RCVRPTR+256; /* BUMP BASE PTR FOR BUFFER */ 09050000 LA @3,256(0,@3) 0102 09060000 * SORCPTR = SORCPTR+256; /* SAME FOR SOURCE FIELD */ 09070000 LA @2,256(0,@2) 0103 09080000 * END; 09090000 * /* MAKE SURE THAT LNGTHREG DOES NOT CONTAIN A M4475 */ 09100000 * /* NEGATIVE NUMBER (IF THE REMAINDER WAS 0). M4475 */ 09110000 * IF LNGTHREG ª< 0 /* M4475 */ 09120000 * THEN /* NOT NEGATIVE, M4475 */ 09130000 BCT @5,@DO9F5 0104 09140000 @DO9F4 LTR @4,@4 0105 09150000 BC 04,@9F1 0105 09160000 * /* MOVE ODD REMAINDER BY EXECUTING AN MVC INSTRUCTION.*/ 09170000 * GENERATE; 09180000 EX LNGTHREG,MOVER MOVE REMAINDER 09190000 DS 0H 09200000 * RELEASE(SORCPTR,RCVRPTR,LNGTHREG,LOOPREG); 09210000 **/* P BUILD PARSE PARMLIST (PPL) */ 09220000 * /* BUILD PARSE PARAMETER LIST (PPL) FOR NESTED PARSE. */ 09230000 * PPLPTR = ADDR(NDPARSPC); /* ESTABLISH PPL ADDRESSABILTY*/ 09240000 @9F1 LA @1,NDPARSPC 0108 09250000 * PPL3WDS = SERVLIST; /* 1ST 3 WORDS OF ACCOUNT PARA- 09260000 * METER LIST */ 09270000 L @8,ACTPLPTR 0109 09280000 MVC 0(12,@1),0(@8) 0109 09290000 * PPLPCL = NDPCLPTR; /* ADDR OF GENERAL NODELST PCL*/ 09300000 MVC 12(4,@1),NDPCLPTR 0110 09310000 * PPLANS = ADDR(NODEPLAD); /* NODEPLAD WILL POINT TO NODE- 09320000 * LIST PDL AFTER PARSE */ 09330000 LA @F,NODEPLAD 0111 09340000 ST @F,16(0,@1) 0111 09350000 * PPLCBUF = NDBUFPTR; /* ADDR OF NODELIST BUFFER */ 09360000 MVC 20(4,@1),NDBUFPTR 0112 09370000 **/* S IKJPARS: PARSE THE NODELIST */ 09380000 * /* LINK TO THE PARSE SERVICE ROUTINE. */ 09390000 * GENERATE; 09400000 LINK EP=IKJPARS,MF=(E,(1)) 09410000 DS 0H 09420000 * RETCODE = R15; /* SAVE THE PARSE RETURN CODE */ 09430000 L @9,CTABPTR 0114 09440000 ST @F,36(0,@9) 0114 09450000 **/* D (YES,NDLOK,NO,) PARSE SUCCESSFUL? */ 09460000 * /* CHECK THE PARSE RETURN CODE. */ 09470000 * IF RETCODE = 0 /* SUCCESSFUL? */ 09480000 * THEN /* YES, */ 09490000 SR @F,@F 0115 09500000 C @F,36(0,@9) 0115 09510000 * GOTO NDLOK; /* CONTINUE NORMALLY */ 09520000 BC 08,NDLOK 0116 09530000 **/*RCCHK: P DETERMINE THE ERROR CONDITION & SAVE THE CODE */ 09540000 * RCCHK: /* ATTENTION EXIT? */ 09550000 * IF RETCODE = 8 09560000 * THEN 09570000 RCCHK LA @F,8 0117 09580000 L @8,CTABPTR 0117 09590000 C @F,36(0,@8) 0117 09600000 * GOTO SETCDE; /* GO SET PARSE RETCODE */ 09610000 BC 08,SETCDE 0118 09620000 * /* GETMAIN ERROR? M1859 */ 09630000 * IF RETCODE = 16 09640000 * THEN /* YES, M1859 */ 09650000 LA @F,16 0119 09660000 C @F,36(0,@8) 0119 09670000 BC 07,@9F0 0119 09680000 * MSGNMBR = 3; /* GETMAIN ERROR M1859 */ 09690000 LA @F,3 0120 09700000 STH @F,32(0,@8) 0120 09710000 BC 15,@9EF 0121 09720000 * ELSE 09730000 * /* INVALID PARAMETERS OR INVALID RETURN CODE M1859 */ 09740000 * MSGNMBR = 21; /* SET ERROR MSG NUMBER M1859 */ 09750000 @9F0 LA @F,21 0121 09760000 STH @F,32(0,@8) 0121 09770000 **/*SETCDE: P (,CLEANUPA) INDICATE VALCHK RTNE FAILURE TO PARSE */ 09780000 * SETCDE: /* SET THE PARSE ERROR CODE TO 12. THIS WILL SIGNAL PARSE */ 09790000 * /* TO RETURN TO THE MAIN CALLER, IKJEFA24, WITH A RETURN */ 09800000 * /* CODE OF 20 - VALIDITY CHECK EXIT RTNE FAILURE. */ 09810000 * VCHKCODE = RETCODE; /* SAVE ERROR RETURN CODE M1859*/ 09820000 @9EF EQU * 0122 09830000 SETCDE L @8,CTABPTR 0122 09840000 MVC 40(4,@8),36(@8) 0122 09850000 * RETNCODE = 12; 09860000 LA @F,12 0123 09870000 L @9,4(0,@D) 0123 09880000 ST @F,16(0,@9) 0123 09890000 * GOTO CLEANUPA; /* GO CLEAN UP & RETURN */ 09900000 BC 15,CLEANUPA 0124 09910000 * 09920000 **/*NDLOK: P COUNT ITEMS FOUND IN NODELIST */ 09930000 * NDLOK: /* GENERAL PARSE OF NODELIST WAS SUCCESSFUL. */ 09940000 * NDFLGPTR = NODEPLAD+14; /* PTR TO FLAG FIELD IN PDL */ 09950000 NDLOK LA @F,14 0125 09960000 A @F,NODEPLAD 0125 09970000 ST @F,NDFLGPTR 0125 09980000 * RESTRICT(LOOPREG); /* RESERVE REG FOR LOOP CONTRL*/ 09990000 * /* COUNT THE ITEMS FOUND BY PARSE IN THE NODELIST. */ 10000000 * DO LOOPREG = 4 TO 1 BY -1; 10010000 LA @5,4 0127 10020000 * /* CHECK PDE FLAGS TO ASCERTAIN PRESENCE OF NODE ITEMS. */ 10030000 * IF NDPDEFLG(1) = '0'B 10040000 * THEN /* END OF NODE ITEMS */ 10050000 @DO9EE L @4,NDFLGPTR 0128 10060000 TM 0(@4),B'10000000' 0128 10070000 * GOTO NCHK; /* GO CHECK FOR EMPTY NODELIST*/ 10080000 BC 08,NCHK 0129 10090000 * ELSE; /* CONTINUE - ITEM PRESENT */ 10100000 * NUMOFLVL = NUMOFLVL+1; /* COUNT THIS NODE LEVEL */ 10110000 LA @F,1 0131 10120000 SR @0,@0 0131 10130000 IC @0,NUMOFLVL 0131 10140000 AR @F,@0 0131 10150000 STC @F,NUMOFLVL 0131 10160000 * NDFLGPTR = NDFLGPTR+8; /* INCR. TO NEXT NODE ITEM PDE*/ 10170000 LA @F,8 0132 10180000 A @F,NDFLGPTR 0132 10190000 ST @F,NDFLGPTR 0132 10200000 * END; 10210000 **/* D (NO,%NLOK,YES,) NODELIST EMPTY? */ 10220000 **/* P (,CLEANUPA) SIGNAL PARSE TO PROMPT */ 10230000 * NCHK: /* MAKE CERTAIN THAT THE NODELIST IS NOT EMPTY. */ 10240000 * IF NUMOFLVL = 0 10250000 * THEN /* THE NODELIST IS EMPTY */ 10260000 BCT @5,@DO9EE 0133 10270000 NCHK CLI NUMOFLVL,0 0134 10280000 BC 07,@9EA 0134 10290000 * DO; 10300000 * RETNCODE = 4; /* SIGNAL PARSE TO PROMPT */ 10310000 LA @F,4 0136 10320000 L @4,4(0,@D) 0136 10330000 ST @F,16(0,@4) 0136 10340000 * GOTO CLEANUPA; /* GO CLEAN UP AND EXIT */ 10350000 BC 15,CLEANUPA 0137 10360000 * END; 10370000 * ELSE; /* CONTINUE, NODELST NOT EMPTY*/ 10380000 @9EA EQU * 0139 10390000 * /* RELEASE PDL SPACE FOR GENERAL NODELIST PARSE. */ 10400000 * GEN(IKJRLSA NODEPLAD); 10410000 @9E9 EQU * 0140 10420000 IKJRLSA NODEPLAD 10430000 DS 0H 10440000 * NLSTTAB = NLSTTAB&&NLSTTAB; /* CLEAR NODELIST TABLE */ 10450000 L @4,NODELADR 0141 10460000 XC 0(72,@4),0(@4) 0141 10470000 * 10480000 * /* PARSE FOR THE USERID. */ 10490000 * PPLPTR = ADDR(NDPARSPC); /* POINT TO THE PPL */ 10500000 LA @1,NDPARSPC 0142 10510000 * PPLPCL = USPCLPTR; /* USERID PCL */ 10520000 MVC 12(4,@1),USPCLPTR 0143 10530000 * NDBFOFST = 0; /* SET PTR TO DATA ORIGIN */ 10540000 SR @F,@F 0144 10550000 L @8,NDBUFPTR 0144 10560000 STH @F,2(0,@8) 0144 10570000 **/*%NLOK: S IKJPARS: PARSE THE USERID */ 10580000 **/* P MOVE USERID INTO NODELIST TABLE */ 10590000 **/* D (YES,PSWDPARS,NO,) ANOTHER ITEM IN NODELIST? */ 10600000 * /* LINK TO THE PARSE SERVICE ROUTINE TO PARSE THE USERID. */ 10610000 * GENERATE; 10620000 LINK EP=IKJPARS,MF=(E,(1)) 10630000 DS 0H 10640000 * RETCODE = R15; /* SAVE THE PARSE RETURN CODE */ 10650000 L @9,CTABPTR 0146 10660000 ST @F,36(0,@9) 0146 10670000 **/* D (NO,RCCHK,YES,) PARSE OK? */ 10680000 * /* CHECK THE PARSE RETURN CODE. */ 10690000 * IF RETCODE ª= 0 /* SUCCESSFUL? */ 10700000 * THEN /* NO, */ 10710000 SR @F,@F 0147 10720000 C @F,36(0,@9) 0147 10730000 * GOTO RCCHK; /* GO CHECK RETURN CODE */ 10740000 BC 07,RCCHK 0148 10750000 * NODPDPTR = NODEPLAD+8; /* POINT TO THE USERID PDE */ 10760000 LA @F,8 0149 10770000 A @F,NODEPLAD 0149 10780000 ST @F,NODPDPTR 0149 10790000 * USRID = NODEITEM(1:NODELEN);/* MOVE USERID TO WORK NODELST*/ 10800000 LR @6,@F 0150 10810000 LH @7,4(0,@6) 0150 10820000 BCTR @7,0 0150 10830000 LR @2,@F 0150 10840000 L @2,0(0,@2) NODPDE 0150 10850000 LR @E,@2 0150 10860000 LR @A,@4 0150 10870000 MVI 0(@A),C' ' 0150 10880000 MVC 1(006,@A),0(@A) 0150 10890000 EX @7,@MVC 0150 10900000 * USRLEN = NODELEN; /* LENGTH OF USERID FROM PDE */ 10910000 MVC 64(2,@4),4(@6) 0151 10920000 * /* RELEASE THE PDL SPACE FOR THE USERID PARSE. */ 10930000 * GEN(IKJRLSA NODEPLAD); 10940000 IKJRLSA NODEPLAD 10950000 DS 0H 10960000 * /* ANY MORE ITEMS IN THE NODELIST? */ 10970000 * IF NUMOFLVL > 1 10980000 * THEN /* YES, PARSE NEXT ITEM */ 10990000 CLI NUMOFLVL,1 0153 11000000 * GOTO PSWDPARS; /* NEXT ITEM - PASSWORD */ 11010000 BC 02,PSWDPARS 0154 11020000 **/* D (NO,%NAST,YES,) USERID = '*'? */ 11030000 **/* P (,SKIPSZUN) MAKE 'DATA' KEYWRD INVALID */ 11040000 * /* IS THE USERID AN ASTERISK? */ 11050000 * IF USRID(1) = '*' 11060000 * THEN /* YES, USERID = '*' */ 11070000 CLI 0(@4),C'*' 0155 11080000 BC 07,@9E8 0155 11090000 * DO; 11100000 * NLNAMLNG = SZUNDASK; /* MODIFY 'NOLIM' PCE LENGTH SO 11110000 * THAT PARSE WILL BYPASS THE 11120000 * SIZE, UNIT, & DATA KEYWORDS*/ 11130000 L @3,PMACSPTR 0157 11140000 MVC 125(2,@3),SZUNDASK 0157 11150000 * GOTO CLEANUP; /* GO CLEAN UP AND EXIT */ 11160000 BC 15,CLEANUP 0158 11170000 * END; 11180000 * ELSE; /* CONTINUE, USERID ª= '*' */ 11190000 @9E8 EQU * 0160 11200000 * DAKEYFLG(5) = '0'B; /* TURN OFF DEFAULT BIT FOR THE 11210000 * 'DATA' KEYWORD - THIS MAKES 11220000 * THE KEYWORD OPTIONAL */ 11230000 @9E7 L @4,PMACSPTR 0161 11240000 NI 167(@4),B'11110111' 0161 11250000 * DANAMSUB = USSUBOF; /* SET SUBFIELD OFFSET TO 11260000 * USERID IKJSUBF & IKJIDENT */ 11270000 MVC 187(2,@4),USSUBOF 0162 11280000 * GOTO SKIPSZUN; /* GO SET BYPASS OF SZE & UNIT*/ 11290000 BC 15,SKIPSZUN 0163 11300000 **/*%NAST: P (,SKIPSZUN) MAKE 'DATA' KEYWRD OPTIONAL */ 11310000 * 11320000 **/*PSWDPARS: S IKJPARS: PARSE THE PASSWORD */ 11330000 * PSWDPARS:/* PARSE FOR THE PASSWORD. */ 11340000 * PPLPTR = ADDR(NDPARSPC); /* POINT TO THE PPL */ 11350000 PSWDPARS LA @1,NDPARSPC 0164 11360000 * PPLPCL = PSPCLPTR; /* POINT TO THE PASSWORD PCL */ 11370000 MVC 12(4,@1),PSPCLPTR 0165 11380000 * NDBFOFST = 0; /* SET OFFSET TO DATA ORIGIN */ 11390000 SR @F,@F 0166 11400000 L @4,NDBUFPTR 0166 11410000 STH @F,2(0,@4) 0166 11420000 * /* LINK TO PARSE */ 11430000 * GENERATE; 11440000 LINK EP=IKJPARS,MF=(E,(1)) 11450000 DS 0H 11460000 * RETCODE = R15; /* SAVE THE PARSE RETURN CODE */ 11470000 L @8,CTABPTR 0168 11480000 ST @F,36(0,@8) 0168 11490000 **/* D (NO,RCCHK,YES,) PARSE OK? */ 11500000 * /* CHECK THE PARSE RETURN CODE. */ 11510000 * IF RETCODE ª= 0 /* SUCCESSFUL? */ 11520000 * THEN /* NO, */ 11530000 SR @F,@F 0169 11540000 C @F,36(0,@8) 0169 11550000 * GOTO RCCHK; /* GO CHECK RETURN CODE */ 11560000 BC 07,RCCHK 0170 11570000 * NODPDPTR = NODEPLAD+16; /* POINT TO THE PASSWORD PDE */ 11580000 LA @F,16 0171 11590000 A @F,NODEPLAD 0171 11600000 ST @F,NODPDPTR 0171 11610000 **/* P MOVE PASSWORD TO NODELIST TABLE */ 11620000 * PASSWD = NODEITEM(1:NODELEN);/* MOVE PWRD TO WORK NODELIST*/ 11630000 LR @9,@F 0172 11640000 LH @6,4(0,@9) 0172 11650000 BCTR @6,0 0172 11660000 LR @7,@F 0172 11670000 L @7,0(0,@7) NODPDE 0172 11680000 LR @E,@7 0172 11690000 L @2,NODELADR 0172 11700000 LA @A,8(0,@2) 0172 11710000 MVI 0(@A),C' ' 0172 11720000 MVC 1(007,@A),0(@A) 0172 11730000 EX @6,@MVC 0172 11740000 * PWLEN = NODELEN; /* LENGTH OF PASSWRD FROM PDE */ 11750000 MVC 66(2,@2),4(@9) 0173 11760000 * /* RELEASE THE PDL SPACE FOR THE PASSWORD PARSE. */ 11770000 * GEN(IKJRLSA NODEPLAD); 11780000 IKJRLSA NODEPLAD 11790000 DS 0H 11800000 **/* D (NO,SKIPSZUN,YES,) ANOTHER ITEM IN NODELIST? */ 11810000 * /* ANY MORE ITEMS IN THE NODELIST? */ 11820000 * IF NUMOFLVL > 2 11830000 * THEN /* YES, PARSE NEXT ITEM */ 11840000 CLI NUMOFLVL,2 0175 11850000 * GOTO ACTNPARS; /* NEXT ITEM - ACCTNMBR */ 11860000 BC 02,ACTNPARS 0176 11870000 * DANAMSUB = PASUBOF; /* SET SUBFIELD OFFSET TO 11880000 * PASSWORD IKJSUBF & IKJIDENT*/ 11890000 L @3,PMACSPTR 0177 11900000 MVC 187(2,@3),PASUBOF 0177 11910000 * GOTO SKIPSZUN; /* GO SET BYPASS OF SZE & UNIT*/ 11920000 BC 15,SKIPSZUN 0178 11930000 **/*ACTNPARS: S IKJPARS: PARSE THE ACTNBR */ 11940000 * ACTNPARS:/* PARSE FOR THE ACCTNMBR. */ 11950000 * PPLPTR = ADDR(NDPARSPC); /* POINT TO THE PPL */ 11960000 ACTNPARS LA @1,NDPARSPC 0179 11970000 * PPLPCL = ACPCLPTR; /* PTR TO THE ACCTNMBR PCL */ 11980000 MVC 12(4,@1),ACPCLPTR 0180 11990000 * NDBFOFST = 0; /* SET OFFSET TO DATA ORIGIN */ 12000000 SR @F,@F 0181 12010000 L @4,NDBUFPTR 0181 12020000 STH @F,2(0,@4) 0181 12030000 * GENERATE; 12040000 LINK EP=IKJPARS,MF=(E,(1)) 12050000 DS 0H 12060000 * RETCODE = R15; /* SAVE THE PARSE RETURN CODE */ 12070000 L @8,CTABPTR 0183 12080000 ST @F,36(0,@8) 0183 12090000 **/* D (NO,RCCHK,YES,) PARSE OK? */ 12100000 * /* CHECK THE PARSE RETURN CODE. */ 12110000 * IF RETCODE ª= 0 /* SUCCESSFUL? */ 12120000 * THEN /* NO, */ 12130000 SR @F,@F 0184 12140000 C @F,36(0,@8) 0184 12150000 * GOTO RCCHK; /* GO CHECK RETURN CODE */ 12160000 BC 07,RCCHK 0185 12170000 **/* P MOVE ACTNBR TO NODELIST TABLE */ 12180000 * NODPDPTR = NODEPLAD+24; /* POINT TO ACCTNMBR PDE */ 12190000 LA @F,24 0186 12200000 A @F,NODEPLAD 0186 12210000 ST @F,NODPDPTR 0186 12220000 * ACCTNO = NODEITEM(1:NODELEN);/* MOVE ACTNO TO WORK NODELST*/ 12230000 LR @9,@F 0187 12240000 LH @6,4(0,@9) 0187 12250000 BCTR @6,0 0187 12260000 LR @7,@F 0187 12270000 L @7,0(0,@7) NODPDE 0187 12280000 LR @E,@7 0187 12290000 L @2,NODELADR 0187 12300000 LA @A,16(0,@2) 0187 12310000 MVI 0(@A),C' ' 0187 12320000 MVC 1(039,@A),0(@A) 0187 12330000 EX @6,@MVC 0187 12340000 * ACTLEN = NODELEN; /* LENGTH OF ACCTNMBR FROM PDE*/ 12350000 MVC 68(2,@2),4(@9) 0188 12360000 * /* RELEASE THE PDL SPACE FOR THE ACCTNMBR PARSE. */ 12370000 * GEN(IKJRLSA NODEPLAD); 12380000 IKJRLSA NODEPLAD 12390000 DS 0H 12400000 **/* D (NO,SKIPSZUN,YES,) ANOTHER ITEM IN NODELIST? */ 12410000 * /* ANY MORE ITEMS IN THE NODELIST? */ 12420000 * IF NUMOFLVL > 3 12430000 * THEN /* YES, PARSE NEXT ITEM */ 12440000 CLI NUMOFLVL,3 0190 12450000 * GOTO PRCDPARS; /* NEXT ITEM - PROCNAME */ 12460000 BC 02,PRCDPARS 0191 12470000 * DANAMSUB = ACSUBOF; /* SET SUBFIELD OFFSET TO 12480000 * ACCTNMBR IKJSUBF & IKJIDENT*/ 12490000 L @3,PMACSPTR 0192 12500000 MVC 187(2,@3),ACSUBOF 0192 12510000 * GOTO SKIPSZUN; /* GO SET BYPASS OF SZE & UNIT*/ 12520000 BC 15,SKIPSZUN 0193 12530000 **/*PRCDPARS: S IKJPARS: PARSE THE PROCNAME */ 12540000 * PRCDPARS:/* PARSE FOR THE PROCNAME. */ 12550000 * PPLPTR = ADDR(NDPARSPC); /* POINT TO THE PPL */ 12560000 PRCDPARS LA @1,NDPARSPC 0194 12570000 * PPLPCL = PRPCLPTR; /* PTR TO THE PROCNAME PCL */ 12580000 MVC 12(4,@1),PRPCLPTR 0195 12590000 * NDBFOFST = 0; /* SET OFFSET TO DATA ORIGIN */ 12600000 SR @F,@F 0196 12610000 L @4,NDBUFPTR 0196 12620000 STH @F,2(0,@4) 0196 12630000 * /* LINK TO PARSE. */ 12640000 * GENERATE; 12650000 LINK EP=IKJPARS,MF=(E,(1)) 12660000 DS 0H 12670000 * RETCODE = R15; /* SAVE THE PARSE RETURN CODE */ 12680000 L @8,CTABPTR 0198 12690000 ST @F,36(0,@8) 0198 12700000 **/* D (NO,RCCHK,YES,) PARSE OK? */ 12710000 * /* CHECK THE PARSE RETURN CODE. */ 12720000 * IF RETCODE ª= 0 /* SUCCESSFUL? */ 12730000 * THEN /* NO, */ 12740000 SR @F,@F 0199 12750000 C @F,36(0,@8) 0199 12760000 * GOTO RCCHK; /* GO CHECK RETURN CODE */ 12770000 BC 07,RCCHK 0200 12780000 **/* P MOVE PROCNAME TO NODELIST TABLE */ 12790000 * NODPDPTR = NODEPLAD+32; /* POINT TO THE PROCNAME PCE */ 12800000 LA @F,32 0201 12810000 A @F,NODEPLAD 0201 12820000 ST @F,NODPDPTR 0201 12830000 * PROCNM = NODEITEM(1:NODELEN);/* MOVE PROC TO WORK NODELIST*/ 12840000 LR @9,@F 0202 12850000 LH @6,4(0,@9) 0202 12860000 BCTR @6,0 0202 12870000 LR @7,@F 0202 12880000 L @7,0(0,@7) NODPDE 0202 12890000 LR @E,@7 0202 12900000 L @2,NODELADR 0202 12910000 LA @A,56(0,@2) 0202 12920000 MVI 0(@A),C' ' 0202 12930000 MVC 1(007,@A),0(@A) 0202 12940000 EX @6,@MVC 0202 12950000 * PRLEN = NODELEN; /* LENGTH OF PROC FROM PDE */ 12960000 MVC 70(2,@2),4(@9) 0203 12970000 * /* RELEASE THE PDL SPACE FOR THE PROCNAME PARSE. */ 12980000 * GEN(IKJRLSA NODEPLAD); 12990000 IKJRLSA NODEPLAD 13000000 DS 0H 13010000 * DAKEYFLG(5) = '0'B; /* TURN OFF DEFAULT FLAG FOR THE 13020000 * 'DATA' KEYWORD - THIS MAKES 13030000 * THE KEYWORD OPTIONAL */ 13040000 L @3,PMACSPTR 0205 13050000 NI 167(@3),B'11110111' 0205 13060000 **/* P (,CLEANUP) MAKE 'DATA' KEYWRD OPTIONAL */ 13070000 * GOTO CLEANUP; /* GO CLEAN UP AND EXIT */ 13080000 BC 15,CLEANUP 0206 13090000 * 13100000 **/*SKIPSZUN: P MAKE 'SIZE' & 'UNIT' KEYWRDS INVALID */ 13110000 * SKIPSZUN:/* SET 'NOLIM' NAME PCE LENGTH SO THAT PARSE BYPASSES */ 13120000 * /* THE SIZE AND UNIT KEYWORD DEFINITIONS. */ 13130000 * NLNAMLNG = SZUNSKIP; /* FOR USERID, PASSWORD, AND 13140000 * ACCTNMBR */ 13150000 SKIPSZUN L @4,PMACSPTR 0207 13160000 MVC 125(2,@4),SZUNSKIP 0207 13170000 * 13180000 **/*CLEANUP: P SET RETCODE FOR PARSE: NODELIST OK */ 13190000 * CLEANUP: /* NO ERROR RETURN CODE RECEIVED FROM PARSE. */ 13200000 * RETNCODE = 0; /* SIGNAL PARSE - NODELIST OK */ 13210000 CLEANUP SR @F,@F 0208 13220000 L @4,4(0,@D) 0208 13230000 ST @F,16(0,@4) 0208 13240000 **/*CLEANUPA: P RELEASE NODELIST PCL CORE */ 13250000 * CLEANUPA:/* CLEAN UP AND EXIT. */ 13260000 * FREELVAL = NDBUFLNG; /* BUFFER SIZE FOR FREEMAIN */ 13270000 CLEANUPA L @4,NDBUFPTR 0209 13280000 LH @F,0(0,@4) 0209 13290000 ST @F,FREELVAL 0209 13300000 * FRLVSUBP = 1; /* SUBPOOL = 1 */ 13310000 MVI FREELVAL,1 0210 13320000 * R0 = FREELVAL; /* PUT LENGTH INTO REG0 */ 13330000 L @0,FREELVAL 0211 13340000 * R1 = NDBUFPTR; /* ADDR OF BUFFER INTO REG1 */ 13350000 L @1,NDBUFPTR 0212 13360000 * /* ISSUE THE FREEMAIN MACRO TO RELEASE THE BUFFER. */ 13370000 * GENERATE; 13380000 FREEMAIN R,LV=(0),A=(1) 13390000 DS 0H 13400000 * 13410000 **/*%VRTRN: R RETURN TO PARSE */ 13420000 * NXITEXIT:/* RESTORE REGISTERS. */ 13430000 * GENERATE; /* 13440000 NXITEXIT EQU * 0214 13450000 L @D,WD2(,@D) ADDR OF CALLER'S SAVE AREA 13460000 LM @E,@C,WD4(@D) RESTORE REGISTERS 13470000 BR @E RETURN TO PARSE 13480000 DS 0H 13490000 * 13500000 **/* E IKJEFA26: SIZE/MAXSIZE VALCHK EXIT RTNE */ 13510000 * IKJEFA26:/* ENTRY POINT FOR REGION SIZE ('SIZE' & 'MAXSIZE' KEYWDS)*/ 13520000 * /* VALIDITY CHECK EXIT ROUTINE. */ 13530000 * 13540000 * /* ESTABLISH ADDRESSABILITY. */ 13550000 * GENERATE; /* 13560000 IKJEFA26 EQU * 0215 13570000 STM @E,@C,WD4(@D) SAVE PARSE'S REGISTERS 13580000 L @C,WD2(,@1) ADDR OF MAINLINE SAVE AREA 13590000 LM @9,@C,REGSV9(@C) ADDRESSABILITY FOR CODE AND DATA 13600000 DS 0H 13610000 * GOTO IKJSEXIT; /* BRANCH AROUND POSSIBLE 13620000 * EPILOGUE CODE */ 13630000 BC 15,IKJSEXIT 0216 13640000 * 13650000 * IKJSEXIT:/**********************************************************/ 13660000 * /* REGION SIZE VALIDITY CHECK EXIT ROUTINE - */ 13670000 * /* . CONVERTS THE VALUE TO BINARY */ 13680000 * /* . MAKES CERTAIN THAT THE VALUE IS < 64K-1, */ 13690000 * /* (65,535), THE CAPACITY OF TWO BYTES. */ 13700000 * /* . IF THE VALUE IS > 64K, PARSE WILL BE ASKED */ 13710000 * /* TO PROMPT FOR A NEW VALUE. */ 13720000 * /* */ 13730000 * /* IKJEFA26 IS ENTERED FROM PARSE WITH REG1 POINTING */ 13740000 * /* TO TWO WORDS: */ 13750000 * /* WORD1 - THE ADDR OF THE 'SIZE' OR 'MAXSIZE' PDE */ 13760000 * /* WORD2 - THE USER WORD PASSED IN THE PARMLIST */ 13770000 * /* */ 13780000 * /* IKJEFA26 RETURNS TO PARSE WITH A RETURN CODE IN REG15: */ 13790000 * /* 0 - PARAMETER (SIZE-VALUE) IS VALID */ 13800000 * /* 4 - PARAMETER INVALID, ISSUE MESSAGE AND PROMPT */ 13810000 * /* 8 - PARAMETER INVALID, JUST PROMPT (NOT USED) */ 13820000 * /**********************************************************/ 13830000 * 13840000 * PROCEDURE 13850000 * OPTIONS(SAVE(13,14)); /* SET UP SAVE AREA CHAINING */ 13860000 @EL02 L @D,4(0,@D) 0217 13870000 L @E,12(0,@D) 0217 13880000 BCR 15,@E 0217 13890000 IKJSEXIT ST @E,12(0,@D) 0217 13900000 ST @D,@SAV003+4 0217 13910000 LA @F,@SAV003 0217 13920000 ST @F,8(0,@D) 0217 13930000 LR @D,@F 0217 13940000 * 13950000 * DECLARE 13960000 * /* SIZE VALUE PDE */ 13970000 * 1 SZVAPDE BASED(PDEPTR),/* PDE SUPPLIED BY PARSE */ 13980000 * 2 SZVAPTR PTR, /* ADDR OF THE SIZE VALUE */ 13990000 * 2 SZVALNTH FIXED(15),/* LENGTH OF SIZE VALUE */ 14000000 * 2 SZVAFLGS BIT(16); /* BIT0 = 1: VALUE PRESENT */ 14010000 * 14020000 * RESTRICT(R1,INPUTPTR); /* ALLOCATE REGISTERS */ 14030000 * INPUTPTR = R1; /* SAVE PARAMETER REG */ 14040000 LR @2,@1 0220 14050000 **/* P SET BASE PTR FOR INPUT PARMLIST */ 14060000 * 14070000 * R1 = SZVAPTR; /* POINT TO UNPACKED VALUE */ 14080000 L @3,0(0,@2) 0221 14090000 L @1,0(0,@3) 0221 14100000 * RESTRICT(LNGTHREG); /* RESERVE REG FOR PACK LENGTH*/ 14110000 * LNGTHREG = SZVALNTH-1; /* SET UP LENGTH FOR EX INSTR.*/ 14120000 LH @4,@D1 0223 14130000 AH @4,4(0,@3) 0223 14140000 **/* P CONVERT INTEGER TO BINARY */ 14150000 * /* PACK THE SIZE VALUE AND CONVERT TO BINARY. */ 14160000 * GENERATE; /* 14170000 EX LNGTHREG,PACKER PACK VALUE INTO DECSIZE 14180000 CVB R1,DECSIZE CONVERT DECSIZE TO BINARY 14190000 DS 0H 14200000 * RELEASE(LNGTHREG); /* GIVE BACK REGISTER */ 14210000 * RETNCODE = 0; /* ASSUME VALUE IS OK */ 14220000 SR @F,@F 0226 14230000 L @8,4(0,@D) 0226 14240000 ST @F,16(0,@8) 0226 14250000 * 14260000 **/* D (NO,%VALTB,YES,) INTEGER < 64K-1? */ 14270000 **/* P (,%VRTRN) SIGNAL PARSE: SIZE/MAXSIZE OK */ 14280000 * /* MAKE SURE THAT THE VALUE IS < 64K-1 */ 14290000 * IF R1 < 65535 14300000 * THEN /* VALUE IS VALID */ 14310000 C @1,@D2 0227 14320000 * GOTO NXITEXIT; /* GO RETURN TO PARSE */ 14330000 BC 04,NXITEXIT 0228 14340000 * ELSE; /* VALUE IS INVALID, CONTINUE */ 14350000 **/*%VALTB: P (,%VRTRN) SIGNAL PARSE TO PROMPT */ 14360000 * RETNCODE = 4; /* SIGNAL PARSE TO PROMPT */ 14370000 LA @F,4 0230 14380000 ST @F,16(0,@8) 0230 14390000 * GOTO NXITEXIT; /* GO RETURN TO PARSE */ 14400000 BC 15,NXITEXIT 0231 14410000 * 14420000 * GENERATE; 14430000 ZERO EQU 0 14440000 ONE EQU 1 14450000 EIGHT EQU 8 14460000 MOVER MVC ZERO(ONE,RCVRPTR),ZERO(SORCPTR) MODEL MOVE CHARACTER 14470000 PACKER PACK DECSIZE(EIGHT),ZERO(ONE,R1) MODEL PACK INSTRUCTION 14480000 DS 0H 14490000 * 14500000 **/*IKJEFA26: END END OF SIZE/MAXSIZE VALCHK EXIT RTNE */ 14510000 **/*IKJEFA25: END END OF NODELIST VALCHK EXIT RTNE */ 14520000 **/*IKJEFA24: END END OF CHANGE/PARSE INTERFACE RTNE */ 14530000 * 14540000 * END IKJSEXIT; /* END OF SIZE VALUE VALIDITY 14550000 * CHECK EXIT ROUTINE */ 14560000 @EL03 L @D,4(0,@D) 0233 14570000 L @E,12(0,@D) 0233 14580000 BCR 15,@E 0233 14590000 * END IKJNEXIT; /* END OF NODELIST VALIDITY 14600000 * CHECK EXIT ROUTINE */ 14610000 * END IKJEFA24 /* END OF CHANGE/PARSE INTERFACE 14620000 * ROUTINE */ 14630000 * /* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. 14640000 * /*%INCLUDE SYSLIB (IKJPPL ) 14650000 * ; 14660000 @DATA1 EQU * 14670000 @0 EQU 00 EQUATES FOR REGISTERS 0-15 14680000 @1 EQU 01 14690000 @2 EQU 02 14700000 @3 EQU 03 14710000 @4 EQU 04 14720000 @5 EQU 05 14730000 @6 EQU 06 14740000 @7 EQU 07 14750000 @8 EQU 08 14760000 @9 EQU 09 14770000 @A EQU 10 14780000 @B EQU 11 14790000 @C EQU 12 14800000 @D EQU 13 14810000 @E EQU 14 14820000 @F EQU 15 14830000 @D2 DC F'65535' 14840000 @D1 DC H'-1' 14850000 @MVC MVC 0(1,@A),0(@E) 14860000 DS 0F 14870000 @SIZ001 DC AL1(&SPN) 14880000 DC AL3(@DATEND-@DATD) 14890000 DS 0F 14900000 DS 0D 14910000 @DATA EQU * 14920000 DUMR1 EQU 00000000 FULLWORD INTEGER 14930000 R0 EQU 00000000 FULLWORD POINTER REGISTER 14940000 R1 EQU 00000001 FULLWORD POINTER REGISTER 14950000 R15 EQU 00000015 FULLWORD POINTER REGISTER 14960000 PPLPTR EQU 00000001 FULLWORD POINTER REGISTER 14970000 ACCTPLST EQU 00000000 20 BYTE(S) ON WORD 14980000 UPTPTR EQU ACCTPLST+00000000 FULLWORD POINTER 14990000 ECTPTR EQU ACCTPLST+00000004 FULLWORD POINTER 15000000 AECBPTR EQU ACCTPLST+00000008 FULLWORD POINTER 15010000 BUFPTR EQU ACCTPLST+00000012 FULLWORD POINTER 15020000 UIDLPTR EQU ACCTPLST+00000016 FULLWORD POINTER 15030000 CTRLTAB EQU 00000000 44 BYTE(S) ON WORD 15040000 ACTPLADR EQU CTRLTAB+00000000 FULLWORD POINTER 15050000 CHPDLPTR EQU CTRLTAB+00000004 FULLWORD POINTER 15060000 NODELPTR EQU CTRLTAB+00000008 FULLWORD POINTER 15070000 A00000 EQU CTRLTAB+00000012 FULLWORD POINTER 15080000 BLOKCNT EQU CTRLTAB+00000012 1 BYTE POINTER 15090000 HEADADDR EQU CTRLTAB+00000013 3 BYTE POINTER ON WORD+1 15100000 PASSADDR EQU CTRLTAB+00000016 FULLWORD POINTER 15110000 ACCTADDR EQU CTRLTAB+00000020 FULLWORD POINTER 15120000 PROCADDR EQU CTRLTAB+00000024 FULLWORD POINTER 15130000 CHLEVL EQU CTRLTAB+00000028 HALFWORD POINTER 15140000 SRCHIND EQU CTRLTAB+00000030 HALFWORD POINTER 15150000 MSGNMBR EQU CTRLTAB+00000032 HALFWORD POINTER 15160000 TRCHGE EQU CTRLTAB+00000034 HALFWORD POINTER 15170000 RETCODE EQU CTRLTAB+00000036 FULLWORD INTEGER 15180000 VCHKCODE EQU CTRLTAB+00000040 FULLWORD INTEGER 15190000 PPL EQU 00000000 28 BYTE(S) ON WORD 15200000 PPLUPT EQU PPL+00000000 FULLWORD POINTER 15210000 PPLECT EQU PPL+00000004 FULLWORD POINTER 15220000 PPLECB EQU PPL+00000008 FULLWORD POINTER 15230000 PPLPCL EQU PPL+00000012 FULLWORD POINTER 15240000 PPLANS EQU PPL+00000016 FULLWORD POINTER 15250000 PPLCBUF EQU PPL+00000020 FULLWORD POINTER 15260000 PPLUWA EQU PPL+00000024 FULLWORD POINTER 15270000 PCLMDLAD EQU * FULLWORD POINTER 15280000 DC AL4(PCLMODEL) 15290000 PCLLNGTH EQU 00000000 HALFWORD INTEGER 15300000 SORCPTR EQU 00000002 3 BYTE POINTER REGISTER 15310000 RCVRPTR EQU 00000003 3 BYTE POINTER REGISTER 15320000 PARSBLOK EQU 00000000 256 BYTE(S) 15330000 PPL3WDS EQU 00000000 12 BYTE(S) 15340000 NDBUFFER EQU 00000000 4 BYTE(S) ON WORD 15350000 NDBUFLNG EQU NDBUFFER+00000000 HALFWORD INTEGER 15360000 NDBFOFST EQU NDBUFFER+00000002 HALFWORD POINTER 15370000 NODPDE EQU 00000000 8 BYTE(S) ON WORD 15380000 NODEPTR EQU NODPDE+00000000 FULLWORD POINTER 15390000 NODELEN EQU NODPDE+00000004 HALFWORD POINTER 15400000 NODEFLGS EQU NODPDE+00000006 16 BIT(S) 15410000 NODEITEM EQU 00000000 40 BYTE(S) 15420000 SERVLIST EQU 00000000 12 BYTE(S) 15430000 LNGTHREG EQU 00000004 FULLWORD POINTER REGISTER 15440000 LOOPREG EQU 00000005 FULLWORD INTEGER REGISTER 15450000 REG13 EQU 00000013 FULLWORD POINTER REGISTER 15460000 CALLRSAV EQU 00000004 FULLWORD POINTER 15470000 RETNCODE EQU 00000016 FULLWORD INTEGER 15480000 INPUTPTR EQU 00000002 FULLWORD POINTER REGISTER 15490000 VALCKLST EQU 00000000 8 BYTE(S) ON WORD 15500000 PDEPTR EQU VALCKLST+00000000 FULLWORD POINTER 15510000 USERWORD EQU VALCKLST+00000004 FULLWORD POINTER 15520000 PSTRPDE EQU 00000000 8 BYTE(S) ON WORD 15530000 PSTRPTR EQU PSTRPDE+00000000 FULLWORD POINTER 15540000 PSTRLNG EQU PSTRPDE+00000004 HALFWORD INTEGER 15550000 PSTRFLGS EQU PSTRPDE+00000006 16 BIT(S) 15560000 NDPCLPTR EQU * FULLWORD POINTER 15570000 DC AL4(NODEPARS) 15580000 USPCLPTR EQU * FULLWORD POINTER 15590000 DC AL4(USERPARS) 15600000 PSPCLPTR EQU * FULLWORD POINTER 15610000 DC AL4(PASSPARS) 15620000 ACPCLPTR EQU * FULLWORD POINTER 15630000 DC AL4(ACCTPARS) 15640000 PRPCLPTR EQU * FULLWORD POINTER 15650000 DC AL4(PROCPARS) 15660000 NDBUFSPC EQU 00000000 256 BYTE(S) 15670000 NDPDEFLG EQU 00000000 16 BIT(S) ON BYTE 15680000 PARSMACS EQU 00000000 631 BYTE(S) ON WORD 15690000 PARMPCE EQU PARSMACS+00000000 6 BYTE(S) 15700000 NDLPCE EQU PARSMACS+00000006 21 BYTE(S) 15710000 OPKEYPCE EQU PARSMACS+00000027 26 BYTE(S) 15720000 ACKEYPCE EQU PARSMACS+00000053 26 BYTE(S) 15730000 JCKEYPCE EQU PARSMACS+00000079 24 BYTE(S) 15740000 MSKEYPCE EQU PARSMACS+00000103 6 BYTE(S) 15750000 MSNAMPCE EQU PARSMACS+00000109 14 BYTE(S) 15760000 NLNAMPCE EQU PARSMACS+00000123 10 BYTE(S) 15770000 NLNAMFLG EQU PARSMACS+00000123 2 BYTE(S) 15780000 NLNAMLNG EQU PARSMACS+00000125 2 BYTE INTEGER 15790000 NLNAMELN EQU PARSMACS+00000127 1 BYTE(S) 15800000 NLNAME EQU PARSMACS+00000128 5 BYTE(S) 15810000 SZKEYPCE EQU PARSMACS+00000133 17 BYTE(S) 15820000 UNKEYPCE EQU PARSMACS+00000150 6 BYTE(S) 15830000 UNNAMPCE EQU PARSMACS+00000156 11 BYTE(S) 15840000 UNNAMFLG EQU PARSMACS+00000156 2 BYTE(S) 15850000 UNNAMLNG EQU PARSMACS+00000158 2 BYTE INTEGER 15860000 UNNAMELN EQU PARSMACS+00000160 1 BYTE(S) 15870000 UNNAME EQU PARSMACS+00000161 4 BYTE(S) 15880000 UNNAMSUB EQU PARSMACS+00000165 2 BYTE(S) 15890000 DAKEYPCE EQU PARSMACS+00000167 11 BYTE(S) 15900000 DAKEYFLG EQU PARSMACS+00000167 16 BIT(S) 15910000 DANAMPCE EQU PARSMACS+00000178 11 BYTE(S) 15920000 DANAMFLG EQU PARSMACS+00000178 2 BYTE(S) 15930000 DANAMLNG EQU PARSMACS+00000180 2 BYTE(S) 15940000 DANAMELN EQU PARSMACS+00000182 1 BYTE(S) 15950000 DANAME EQU PARSMACS+00000183 4 BYTE(S) 15960000 DANAMSUB EQU PARSMACS+00000187 2 BYTE POINTER 15970000 MSSUBPCE EQU PARSMACS+00000189 3 BYTE(S) 15980000 MSNUMPCE EQU PARSMACS+00000192 95 BYTE(S) 15990000 SZSUBPCE EQU PARSMACS+00000287 3 BYTE(S) 16000000 SZNUMPCE EQU PARSMACS+00000290 85 BYTE(S) 16010000 UNSUBPCE EQU PARSMACS+00000375 3 BYTE(S) 16020000 UNNMEPCE EQU PARSMACS+00000378 41 BYTE(S) 16030000 PRSUBPCE EQU PARSMACS+00000419 3 BYTE(S) 16040000 PROCDPCE EQU PARSMACS+00000422 56 BYTE(S) 16050000 ACSUBPCE EQU PARSMACS+00000478 3 BYTE(S) 16060000 ACCTDPCE EQU PARSMACS+00000481 59 BYTE(S) 16070000 PASUBPCE EQU PARSMACS+00000540 3 BYTE(S) 16080000 PASSDPCE EQU PARSMACS+00000543 44 BYTE(S) 16090000 USSUBPCE EQU PARSMACS+00000587 3 BYTE(S) 16100000 USERDPCE EQU PARSMACS+00000590 40 BYTE(S) 16110000 ENDPPCE EQU PARSMACS+00000630 1 BYTE(S) 16120000 SZUNSKIP EQU * HALFWORD INTEGER 16130000 DC AL2(UNNAMSUB-NLNAMPCE+000002) 16140000 SZUNDASK EQU * HALFWORD INTEGER 16150000 DC AL2(DANAMSUB-NLNAMPCE+000002) 16160000 ACSUBOF EQU * HALFWORD INTEGER 16170000 DC AL2(ACSUBPCE-PARMPCE+000001) 16180000 PASUBOF EQU * HALFWORD INTEGER 16190000 DC AL2(PASUBPCE-PARMPCE+000001) 16200000 USSUBOF EQU * HALFWORD INTEGER 16210000 DC AL2(USSUBPCE-PARMPCE+000001) 16220000 CHNGPDL EQU 00000000 88 BYTE(S) ON WORD 16230000 A00001 EQU CHNGPDL+00000000 8 BYTE(S) 16240000 NODEPDE1 EQU CHNGPDL+00000008 8 BYTE(S) 16250000 OPERNBR EQU CHNGPDL+00000016 16 BIT(S) 16260000 ACCTNBR EQU CHNGPDL+00000018 16 BIT(S) 16270000 JCLNBR EQU CHNGPDL+00000020 16 BIT(S) 16280000 MAXSNBR EQU CHNGPDL+00000022 16 BIT(S) 16290000 SIZENBR EQU CHNGPDL+00000024 16 BIT(S) 16300000 UNITNBR EQU CHNGPDL+00000026 16 BIT(S) 16310000 DATANBR EQU CHNGPDL+00000028 16 BIT(S) 16320000 A00002 EQU CHNGPDL+00000030 16 BIT(S) 16330000 MAXSUBF EQU CHNGPDL+00000032 8 BYTE(S) ON WORD 16340000 MAXSADR EQU CHNGPDL+00000032 FULLWORD POINTER 16350000 MAXSLNG EQU CHNGPDL+00000036 HALFWORD INTEGER 16360000 MAXSFLGS EQU CHNGPDL+00000038 16 BIT(S) 16370000 MAXSFLG EQU CHNGPDL+00000038 1 BIT(S) 16380000 SIZSUBF EQU CHNGPDL+00000040 8 BYTE(S) ON WORD 16390000 RSIZADR EQU CHNGPDL+00000040 FULLWORD POINTER 16400000 RSIZLNG EQU CHNGPDL+00000044 HALFWORD INTEGER 16410000 RSIZFLGS EQU CHNGPDL+00000046 16 BIT(S) 16420000 RSIZFLG EQU CHNGPDL+00000046 1 BIT(S) 16430000 UNITSUBF EQU CHNGPDL+00000048 8 BYTE(S) ON WORD 16440000 UNITADR EQU CHNGPDL+00000048 FULLWORD POINTER 16450000 UNITLNG EQU CHNGPDL+00000052 HALFWORD INTEGER 16460000 UNITFLGS EQU CHNGPDL+00000054 16 BIT(S) 16470000 UNITFLG EQU CHNGPDL+00000054 1 BIT(S) 16480000 PROCSUBF EQU CHNGPDL+00000056 8 BYTE(S) ON WORD 16490000 DLPTR4 EQU CHNGPDL+00000056 FULLWORD POINTER 16500000 DATALNG4 EQU CHNGPDL+00000060 HALFWORD INTEGER 16510000 A00003 EQU CHNGPDL+00000062 16 BIT(S) 16520000 DLFLG4 EQU CHNGPDL+00000062 1 BIT(S) 16530000 ACCTSUBF EQU CHNGPDL+00000064 8 BYTE(S) ON WORD 16540000 DLPTR3 EQU CHNGPDL+00000064 FULLWORD POINTER 16550000 DATALNG3 EQU CHNGPDL+00000068 HALFWORD INTEGER 16560000 A00004 EQU CHNGPDL+00000070 16 BIT(S) 16570000 DLFLG3 EQU CHNGPDL+00000070 1 BIT(S) 16580000 PASSSUBF EQU CHNGPDL+00000072 8 BYTE(S) ON WORD 16590000 DLPTR2 EQU CHNGPDL+00000072 FULLWORD POINTER 16600000 DATALNG2 EQU CHNGPDL+00000076 HALFWORD INTEGER 16610000 A00005 EQU CHNGPDL+00000078 16 BIT(S) 16620000 DLFLG2 EQU CHNGPDL+00000078 1 BIT(S) 16630000 USIDSUBF EQU CHNGPDL+00000080 8 BYTE(S) ON WORD 16640000 DLPTR1 EQU CHNGPDL+00000080 FULLWORD POINTER 16650000 DATALNG1 EQU CHNGPDL+00000084 HALFWORD INTEGER 16660000 A00006 EQU CHNGPDL+00000086 16 BIT(S) 16670000 DLFLG1 EQU CHNGPDL+00000086 1 BIT(S) 16680000 NLSTTAB EQU 00000000 72 BYTE(S) ON WORD 16690000 USRID EQU NLSTTAB+00000000 7 BYTE(S) 16700000 A00007 EQU NLSTTAB+00000007 1 BYTE(S) 16710000 PASSWD EQU NLSTTAB+00000008 8 BYTE(S) 16720000 ACCTNO EQU NLSTTAB+00000016 40 BYTE(S) 16730000 PROCNM EQU NLSTTAB+00000056 8 BYTE(S) 16740000 USRLEN EQU NLSTTAB+00000064 HALFWORD POINTER 16750000 PWLEN EQU NLSTTAB+00000066 HALFWORD POINTER 16760000 ACTLEN EQU NLSTTAB+00000068 HALFWORD POINTER 16770000 PRLEN EQU NLSTTAB+00000070 HALFWORD POINTER 16780000 SZVAPDE EQU 00000000 8 BYTE(S) ON WORD 16790000 SZVAPTR EQU SZVAPDE+00000000 FULLWORD POINTER 16800000 SZVALNTH EQU SZVAPDE+00000004 HALFWORD INTEGER 16810000 SZVAFLGS EQU SZVAPDE+00000006 16 BIT(S) 16820000 ORG @DATA 16830000 DS 00000034C 16840000 @L EQU 1 16850000 @DATD DSECT 16860000 @SAV001 EQU @DATD+00000000 72 BYTE(S) ON WORD 16870000 ACTPLPTR EQU @DATD+00000072 FULLWORD POINTER 16880000 CTABPTR EQU @DATD+00000076 FULLWORD POINTER 16890000 PARSPARM EQU @DATD+00000080 28 BYTE(S) ON WORD 16900000 PMACSPTR EQU @DATD+00000108 FULLWORD POINTER 16910000 NDBUFPTR EQU @DATD+00000112 FULLWORD POINTER 16920000 NUMOFLVL EQU @DATD+00000116 1 BYTE POINTER 16930000 CHNPDLAD EQU @DATD+00000120 FULLWORD POINTER 16940000 NODEPLAD EQU @DATD+00000124 FULLWORD POINTER 16950000 NODPDPTR EQU @DATD+00000128 FULLWORD POINTER 16960000 DECSIZE EQU @DATD+00000136 8 BYTE(S) ON DWORD 16970000 FREELVAL EQU @DATD+00000144 FULLWORD INTEGER 16980000 FRLVSUBP EQU FREELVAL+00000000 1 BYTE POINTER 16990000 NDPARSPC EQU @DATD+00000148 28 BYTE(S) ON WORD 17000000 NDFLGPTR EQU @DATD+00000176 FULLWORD POINTER 17010000 NPRSRTCD EQU @DATD+00000180 HALFWORD INTEGER 17020000 NODELADR EQU @DATD+00000184 FULLWORD POINTER 17030000 DYNGTLST EQU @DATD+00000188 10 BYTE(S) ON WORD 17040000 @SAV002 EQU @DATD+00000200 72 BYTE(S) ON WORD 17050000 @SAV003 EQU @DATD+00000272 72 BYTE(S) ON WORD 17060000 DS 00000344C 17070000 @TEMPS DS 0F 17080000 DS C 17090000 IKJEFA24 CSECT 17100000 GTMLIST GETMAIN EC,MF=L 17110000 @DATD DSECT REESTABLISH AUTOMATIC DSECT 17120000 @DATD DSECT 17130000 @DATEND EQU * 17140000 IKJEFA24 CSECT , 17150000 END IKJEFA24 17160000 ./ ADD SSI=01010047,NAME=IKJEFA30,SOURCE=1 TITLE 'I K J E F A 3 0 -- ACCOUNT-DELETE EXECUTOR ROUTINE' 00010000 * /******************************************************************** 00020000 * /* * 00030000 * /* P R O L O G U E FOR I K J E F A 3 0 * 00040000 * /* ACCOUNT/DELETE EXECUTOR ROUTINE * 00050000 * /* * 00060000 * /* STATUS -- * 00070000 * /* CHANGE LEVEL 000 * 00080000 * /* PTMS INCLUDED: 3050,3651,3772,4175,4478,4479,4480,4483,5522 * 00090000 * /* CHANGE LEVEL 001 * 00100000 * /* APARS INCLUDED: 45306 * 00110000 * /* PTMS INCLUDED: 1859 * 00120000 * /* A 77910-77950,161530,196300-196337 M1859 * 00130000 * /* C 153700-154740,223512-223548 M1859 * 00140000 * /* D 117300-117900 M1859 * 00150000 * /* A 38910-39330,54104-52130,54502-54530,162212,215110, 21974 * 00160000 * /* A 316110,317510 21974 * 00170000 * /* C 26100,27900,38900,59500,84700,84900,146716,147717, 21974 * 00180000 * /* C 180700,182500,216300,218300,324900 21974 * 00190000 * /* D 26300-26700,39300-45308,53100-53700 21974 * 00200000 * /* * 00210000 * /* FUNCTION -- * 00220000 * /* * 00230000 * /* THE DELETE/EXECUTOR ROUTINE DETERMINES THE VALIDITY OF THE * 00240000 * /* COMMAND PASSED TO IT AND DELETES THE SINGLE SPECIFIED * 00250000 * /* USERID ( IF THAT IS THE COMMAND ENTRY) OR PASSES CONTROL TO * 00260000 * /* IKJEFA32 FOR DELETIONS BELOW THE USERID LEVEL. THE DELETE/ * 00270000 * /* EXECUTOR CALLS IKJPARS TO ESTABLISH THE VALIDITY OF THE * 00280000 * /* COMMAND ENTRY (IF ENTRY IS FOR A SINGLE USERID NAME), EXE- * 00290000 * /* CUTES A STOW/DELETE TO REMOVE THE NAME FROM THE UADS PDS * 00300000 * /* DIRECTORY, INCORPORATES THE COMMAND ENTRY INFORMATION INTO * 00310000 * /* THE DELETE POINT LIST (DPL), OPENS THE UADS DCB, ENQUEUES * 00320000 * /* ON THE UADS (SYSIKJUA-OPENUADS), OPENS THE UADS DCB, PASSES * 00330000 * /* CONTROL TO IKJEFA32 FOR LOW LEVEL DELETIONS, BUILDS THE * 00340000 * /* USERID DATA LIST (DUIDL) TO PASS DELETED USERID NAMES TO * 00350000 * /* THE BROADCAST DATA SET INTERFACE ROUTINE, CLOSES THE UADS * 00360000 * /* DCB, ISSUES A TERMINATION MESSAGE, DEQUEUES THE UADS DCB * 00370000 * /* (SYSIKJUA-OPENUADS), AND RETURNS TO CALLER. * 00380000 * /* * 00390000 * /* ENTRY POINTS -- * 00400000 * /* * 00410000 * /* IKJEFA30 -- MAIN ENTRY POINT * 00420000 * /* CONTROL IS RECEIVED HERE FROM ACCOUNT/EXECUTOR * 00430000 * /* ROUTINE, IKJEFA00 * 00440000 * /* * 00450000 * /* INPUT -- * 00460000 * /* * 00470000 * /* * 00480000 * /* AT ENTRY POINT IKJEFA30 -- * 00490000 * /* REGISTER 1 POINTS TO A PARAMETER LIST SUPPLIED BY * 00500000 * /* IKJEFA00. FOR FORMAT, SEE NAME ACCTPL IN LISTING. * 00510000 * /* STANDARD LINKAGE/SAVE CONVENTION IS FOLLOWED * 00520000 * /* * 00530000 * /* * 00540000 * /* OUTPUT -- * 00550000 * /* * 00560000 * /* AT EXIT ENDOUT -- NONE * 00570000 * /* * 00580000 * /* AT EXIT TO TSO SERVICE ROUTINES -- * 00590000 * /* REGISTER 1 POINTS TO THE PARAMETER LIST FOR THE GIVEN * 00600000 * /* ROUTINE. EACH SUCH PARAMETER LIST MAY CONTAIN A POINTER * 00610000 * /* TO A CORRESPONDING PARAMETER BLOCK. FOR FORMATS, SEE * 00620000 * /* THE FOLLOWING NAMES IN THE LISTING * 00630000 * /* * 00640000 * /* SERVICE ROUTINE PARAMETER LIST PARAMETER BLOCK * 00650000 * /* * 00660000 * /* PUTLINE PUTLPL PTPBF * 00670000 * /* IKJPARS CPPL --- * 00680000 * /* * 00690000 * /* * 00700000 * /* EXTERNAL REFERENCES -- * 00710000 * /* * 00720000 * /* FOR FORMATS AND EXPANSIONS, SEE FOLLOWING NAMES IN LISTING * 00730000 * /* * 00740000 * /* COMMUNICATION BLOCKS -- * 00750000 * /* ECT -- ENVIRONMENT CONTROL TABLE * 00760000 * /* * 00770000 * /* EXTERNAL DATA AREAS * 00780000 * /* ANDXL -- DELETE MESSAGE INDEX AND DATA (CONTAINED IN * 00790000 * /* IKJEFA31) * 00800000 * /* NUCBUFN -- INPUT COMMAND BUFFER * 00810000 * /* * 00820000 * /* EXTERNAL ROUTINES -- * 00830000 * /* IKJDEL2 -- SECOND PART OF ACCOUNT/DELETE PROCESSOR * 00840000 * /* DELREC -- ROUTINE TO POST THE DELETE STATUS AND * 00850000 * /* PRINT DELETE FAILURE MESSAGES * 00860000 * /* ANDXL -- DELETE MESSAGE DATA MODULE * 00870000 * /* IKJEFA55 -- VALIDITY CHECK EXIT ROUTINE FOR PARSING * 00880000 * /* ACCOUNT MEMBERS * 00890000 * /* * 00900000 * /* MACROS CALLED -- * 00910000 * /* GETMAIN -- ACQUIRE MAIN STORAGE AREA * 00920000 * /* OPEN -- CREATE PARAMETER BLOCK FOR OPEN, OPEN DCB * 00930000 * /* FOR UADS * 00940000 * /* STOW -- UPDATE UADS PDS DIRECTORY * 00950000 * /* CLOSE -- CREATE PARAMETER BLOCK FOR CLOSE, CLOSE * 00960000 * /* FOR UADS * 00970000 * /* LINK -- CREATE PARAMETER LIST FOR LINK, PASS CONTROL * 00980000 * /* TO SPECIFIED MODULE * 00990000 * /* IKJRLSA -- FREE MAIN STORAGE AREA ACQUIRED BY PARSE * 01000000 * /* DCB -- CREATE DATA CONTROL BLOCK * 01010000 * /* ENQ -- CREATE PARAMETER BLOCK FOR ENQUEUE, ENQUEUE * 01020000 * /* ON UADS * 01030000 * /* DEQ -- CREATE PARAMETER BLOCK FOR DEQUEUE, DEQUEUE * 01040000 * /* FROM UADS * 01050000 * /* CLOSE -- CREATE PARAMETER BLOCK FOR CLOSE, CLOSE * 01060000 * /* DCB FOR UADS * 01070000 * /* PUTLINE -- CREATE PARAMETER BLOCK FOR PUTLINE, ISSUE * 01080000 * /* LINE OF OUTPUT * 01090000 * /* DCBD -- CREATE MASK FOR DCB * 01100000 * /* IKJECT -- CREATE MASK FOR ENVIRONMENT CONTROL TABLE * 01110000 * /* IKJPTPB -- CREATE MASK FOR PUTLINE PARAMETER BLOCK * 01120000 * /* IKJPPL -- CREATE MASK FOR PARAMETER LIST FOR IKJPARS * 01130000 * /* IKJIOPL -- CREATE MASK FOR PARAMETER LIST FOR SERVICE * 01140000 * /* ROUTINES * 01150000 * /* IKJPARM,-- CREATE SYNTAX CHECKER DEFINITION BLOCKS * 01160000 * /* IKJPOSIT, AND LISTS FOR IKJPARS * 01170000 * /* IKJKEYWD, * 01180000 * /* IKJNAME, * 01190000 * /* IKJSUBF, * 01200000 * /* IKJIDENT, * 01210000 * /* IKJENDP * 01220000 * /* * 01230000 * /* PRIVATE MACROS CALLED -- * 01240000 * /* IKJEFUAD -- CREATE MASKS FOR UADS AREAS * 01250000 * /* IKJEFUDL -- CREATE MASK FOR UADS IDENTITY LIST INTER- * 01260000 * /* FACE FOR THE BROADCAST DATA SET INTERFACE * 01270000 * /* ROUTINE * 01280000 * /* IKJEFA3A -- CONSTANT DEFINITION STATEMENTS FOR DELETE * 01290000 * /* ROUTINES, IKJEFA30,IKJEFA32 * 01300000 * /* * 01310000 * /* EXTERNAL MODULES CALLED -- * 01320000 * /* IKJEFT40 -- PUTLINE SERVICE ROUTINE * 01330000 * /* IKJPARS -- SYNTAX CHECKING ROUTINE * 01340000 * /* * 01350000 * /* * 01360000 * /* * 01370000 * /* EXITS, NORMAL -- * 01380000 * /* * 01390000 * /* ENDOUT -- RETURN TO CALLER AT LOCATION RECEIVED IN * 01400000 * /* REGISTER 14. NO OUTPUT OR CODES. STANDARD * 01410000 * /* LINKAGE/SAVE CONVENTION IS FOLLOWED * 01420000 * /* * 01430000 * /* * 01440000 * /* EXITS, ERROR -- * 01450000 * /* NONE * 01460000 * /* * 01470000 * /* * 01480000 * /* TABLES/WORK AREAS -- * 01490000 * 01500000 * /* * 01510000 * /* DLCTLR -- TABLE OF FLAGS REGISTERING CONTROL AND STATUS * 01520000 * /* OF PROCESSING WITHIN IKJEFA30, THE DELETE/EXECUTOR. * 01530000 * /* FOR FORMAT, SEE NAME ACCTLF IN LISTING * 01540000 * /* * 01550000 * /* ACCTECB -- STANDARD FORMAT EVENT COMMUNICATION BLOCK * 01560000 * /* USED BETWEEN THE ACCOUNT/EXECUTOR AND ITS SUB-CPS * 01570000 * /* * 01580000 * /* NUCBUF -- AREA TO CONTAIN COMMAND SUPPLIED BY INPUT * 01590000 * /* FROM CALLER. FOR FORMAT, SEE NAMES NUCBUF AND * 01600000 * /* CBUF IN LISTING * 01610000 * /* * 01620000 * /* ANDXL -- INDEX TABLE TO DELETE MESSAGE DATA (CONTAINED * 01630000 * /* IN IKJEFA31) * 01640000 * /* * 01650000 * /* PPL -- PARAMETER LIST FOR PARSE. FOR FORMAT SEE NAME * 01660000 * /* PPL IN LISTING * 01670000 * /* * 01680000 * /* FOR ONE OR MORE USER IDENTITIES, A POINTER IN THE * 01690000 * /* ACCOUNT PARAMETER LIST, ACCTPL, WILL HOLD THE LOCATION * 01700000 * /* OF THE USER IDENTITY LIST, DUIDL, GENERATED BY THE * 01710000 * /* DELETE SUBCOMMAND PROCESSOR, IKJEFA30. FOR FORMATS, * 01720000 * /* SEE NAMES ACCTPL AND DUIDL IN THE LISTING * 01730000 * /* * 01740000 * /* ATTRIBUTES -- * 01750000 * /* * 01760000 * /* REENTRANT * 01770000 * /* REFRESHABLE * 01780000 * /* * 01790000 * /* * 01800000 * /* NOTES -- * 01810000 * /* * 01820000 * /* . MODULE SUPPORT CODE -- 20035 * 01830000 * /* * 01840000 * /* . THE OPERATION OF THIS MODULE DEPENDS UPON AN INTERNAL * 01850000 * /* REPRESENTATION OF THE EXTERNAL CHARACTER SET WHICH IS * 01860000 * /* EQUIVALENT TO THE ONE USED AT ASSEMBLY TIME. * 01870000 * /* CLASS C. * 01880000 * /* * 01890000 * /* * 01900000 * /******************************************************************** 01910000 * /******************************************************************** 01920000 **/* * 01930000 **/*IKJEFA30: CHART * 01940000 **/* HEADER * 01950000 **/*IKJEFA30 -- ACCOUNT-DELETE EXECUTOR ROUTINE 01960000 **/* PAGE # 11/08/71 * 01970000 * GENERATE; 01980000 LCLA &T,&SPN 01990000 LCLC &SECTN1 02000000 LCLC &SECTN2 02010000 LCLC &XSECT 02020000 &SPN SETA 1 SET PRIME SUBPOOL NUMBER 02030000 &XSECT SETC 'CSECT' 02040000 &SECTN1 SETC '@DATX' 02050000 &SECTN2 SETC 'IKJEFA30' 02060000 AGO .@001 02070000 * 02080000 * 02090000 * 02100000 * IKJEFA30: /* ENTRY POINT OF DELETE 02110000 * PROCEDURE 02120000 * (DUMIR1) /* DUMMY PARM TO PRESERVE REG1 * 02130000 * OPTIONS( 02140000 * REENTRANT); 02150000 LCLA &T,&SPN 0002 02160000 .@001 ANOP 0002 02170000 IKJEFA30 CSECT , 0002 02180000 STM @E,@C,12(@D) 0002 02190000 BALR @B,0 0002 02200000 @PSTART DS 0H 0002 02210000 USING @PSTART+00000,@B 0002 02220000 L @0,@SIZ001 0002 02230000 GETMAIN R,LV=(0) 0002 02240000 LR @C,@1 0002 02250000 USING @DATD+00000,@C 0002 02260000 LM @0,@1,20(@D) 0002 02270000 XC @TEMPS(@L),@TEMPS 0002 02280000 ST @D,@SAV001+4 0002 02290000 LA @F,@SAV001 0002 02300000 ST @F,8(0,@D) 0002 02310000 LR @D,@F 0002 02320000 * 02330000 * /* ESTABLISH ADDRESSABILITY FOR DATA * 02340000 * GENERATE; 02350000 USING &SECTN1+00000,@8 SET BASE REGISTER FOR STATIC DATA 02360000 DS 0H 02370000 * 02380000 * GOTO NMPLUS; /* SKIP IDENTITY * 02390000 BC 15,NMPLUS 0004 02400000 * GENERATE; /* CREATE IDENTIFIER * 02410000 DC CL8'IKJEFA30' MODULE NAME 02420000 DC X'11111971' UPDATE LEVEL 02430000 DS 0H 02440000 * NMPLUS: ; /* SKIP IDENTITY TARGET LABEL * 02450000 * GENERATE DATA; 02460000 NMPLUS EQU * 0007 02470000 * /* DEFINE ROUTINE NAMES * 02480000 * 02490000 * DECLARE 02500000 * /* IDENTIFY EXTERNAL ENTRIES AND NAMES * 02510000 * IKJEFA31 ENTRY EXTERNAL, /* DELETE MESSAGES * 02520000 * ANDXL NONLOCAL EXTERNAL ; /* MESSAGE INDEX * 02530000 * 02540000 * 02550000 * DECLARE 02560000 * /* REGISTER ASSIGNMENTS * 02570000 * R0 REG(0) PTR(31),/* GP REGISTER 0 * 02580000 * R1 REG(1) PTR(31),/* GP REGISTER 1 * 02590000 * POSTR PTR(31) REG(1), /* PTR TO ECB FOR POST * 02600000 * R2 REG(2) PTR(31), /* GP REGISTER 2 * 02610000 * PLPTR PTR(31) REG(2),/* PTR TO ACCOUNT PARM LIST * 02620000 * IOPLPTR PTR(31) REG(2), /* PTR TO SERV RTN PL * 02630000 * R3 REG(3) PTR(31),/* GP REGISTER 3 * 02640000 * RECBP PTR(31) REG(3), /* PTR TO ECB FOR WAIT * 02650000 * CHRPTR PTR(31) REG(3), /* PTR TO SCAN CHAR * 02660000 * R4 REG(4) PTR(31),/* GP REGISTER 4 * 02670000 * PDLPTR PTR(31) REG(4), /* PTR TO PARSE DESC LIST * 02680000 * GMSPP PTR(31) REG(4), /* PTR TO GOTMAIN AREA * 02690000 * R5 REG(5) PTR(31),/* GP REGISTER 5 * 02700000 * PDLPTRA PTR(31) REG(5), /* PTR TO PARSE DESC LIST * 02710000 * QLNGR PTR(31) REG(5), /* ENQUEUE NAME LENGTH * 02720000 * R6 REG(6) PTR(31),/* GP REGISTER 6 * 02730000 * QNAMR PTR(31) REG(6), /* PTR TO ENQUEUE NAME * 02740000 * CHRCTR PTR(31) REG(6), /* SCAN COUNTER * 02750000 * R7 REG(7) PTR(31),/* GP REGISTER 7 * 02760000 * R8 REG(8) PTR(31),/* GP REGISTER 8 * 02770000 * R9 REG(9) PTR(31),/* GP REGISTER 9 * 02780000 * R10 REG(10) PTR(31),/* GP REGISTER 10 * 02790000 * R11 REG(11) PTR(31),/* GP REGISTER 11 * 02800000 * R12 REG(12) PTR(31),/* GP REGISTER 12 * 02810000 * R13 REG(13) PTR(31),/* GP REGISTER 13 * 02820000 * R14 REG(14) PTR(31),/* GP REGISTER 14 * 02830000 * R15 REG(15) PTR(31);/* GP REGISTER 15 * 02840000 * 02850000 * RESTRICT (PLPTR); /* RESERVE FOR POINTER SERVICE * 02860000 * RESTRICT (R8); /* BASE PTR FOR STATIC DATA * 02870000 * RESTRICT (R9); /* BASE PTR FOR IKJDEL2 * 02880000 * RESTRICT (R7); /* 2ND BASE PTR FOR IKJDEL2 * 02890000 * 02900000 * 02910000 * DECLARE 02920000 * /* SAVE AREAS FOR LINK REGISTER * 02930000 * SAV14A PTR(31), 02940000 * SAV14AB PTR(31), 02950000 * SAV14CL PTR(31), 02960000 * SAV14DC PTR(31), 02970000 * SAV14DL PTR(31), 02980000 * SAV14DS PTR(31), 02990000 * SAV14FM PTR(31), 03000000 * SAV14FR PTR(31), 03010000 * SAV14GB PTR(31), 03020000 * SAV14GL PTR(31), 03030000 * SAV14LC PTR(31), 03040000 * SAV14MF PTR(31), 03050000 * SAV14PT PTR(31), 03060000 * SAV14SP PTR(31), 03070000 * SAV14V PTR(31); 03080000 * 03090000 * DECLARE 03100000 * /* PROCESSOR FLOW POINTERS * 03110000 * 1 FLOPTRS BDY(WORD), /* FLOW POINTER AREA * 03120000 * 2 SAV14E PTR(31), /* FOR ERRFLO * 03130000 * 2 SAV14DR PTR(31), /* FOR DRDFLO * 03140000 * 2 SAV14NC PTR(31), /* FOR FOR RD DIREC FLOW M * 03150000 * 2 SAV14NQ PTR(31); /* FOR ENQUEUE FLOW M2582 * 03160000 * 03170000 * DECLARE 03180000 * /* PSEUDO-LABEL FLOW SWITCHES * 03190000 * ERRFLO LABEL BASED(SAV14E), 03200000 * DRDFLO LABEL BASED(SAV14DR), 03210000 * INCFLO LABEL BASED(SAV14NC), /* M * 03220000 * NQFLO LABEL BASED(SAV14NQ); /* M2582 * 03230000 * 03240000 * DECLARE 03250000 * /* LOCATE RETURN CODE * 03260000 * RCPTR PTR(31), /* PTR TO RTN CODE LIST * 03270000 * 1 RTCLIST BASED(RCPTR), /* NAME OF RTN CODE LIST * 03280000 * 2 RCLRES CHAR(3), /* RESERVED * 03290000 * 2 RCLC1 PTR(8), /* 1ST RETURN CODE * 03300000 * SAVAR PTR(31) BASED(R13+4), /* CALLER'S SAVE PTR* 03310000 * RETRNCD PTR(31) BASED(SAVAR+16); /* RETURN CODE * 03320000 * 03330000 * DECLARE 03340000 * DPLPTR PTR(31), /* FOR DELETE POINT LIST * 03350000 * DNMIDP PTR(31), /* FOR DPL ENTRY * 03360000 * DPLNDP PTR(31), /* FOR END OF DPL * 03370000 * NAMPTR PTR(31); /* FOR CURRENT PDE * 03380000 * 03390000 * DECLARE 03400000 * /* SAVE AREA FOR NODELIST PARSE VALIDITY CHK EXIT * 03410000 * SVCHKPS CHAR(72) BDY(WORD); 03420000 * 03430000 * 03440000 * DECLARE 03450000 * /* POINTERS FOR MAPPING FORMATS * 03460000 * HEDBPTR PTR(31), /* HEADER BLOCK * 03470000 * UADSNPTR PTR(31), /* PROTOTYPE OFFSET BLOCK * 03480000 * DPOBPTR PTR(31), /* PASSWORD OFFSET BLOCK * 03490000 * DNOBPTR PTR(31), /* ACCOUNT NUMBER OFFSET BLOCK * 03500000 * DROBPTR PTR(31), /* PROCEDURE NAME OFFSET BLOCK * 03510000 * UADSPPTR PTR(31), /* PASSWORD DATA BLOCK * 03520000 * UADSAPTR PTR(31), /* ACCOUNT NUMBER DATA BLOCK * 03530000 * UADSRPTR PTR(31), /* PROCEDURE NAME DATA BLOCK * 03540000 * UADSDPTR PTR(31), /* PROTOTYPE NAME DATA BLOCK * 03550000 * FSQEPTR PTR(31), /* FREE SPACE QUEUE ELEMENT * 03560000 * UIDLPTR PTR(31); /* DELETE POINT LIST * 03570000 * 03580000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03590000 **/* * * 03600000 **/* * H E A D E R B L O C K * 03610000 **/* * * 03620000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 03630000 **/* * * 03640000 **/* * * 03650000 **/* * I---------------------I---------------------I * 03660000 **/* * 0 I UADSBLNG I UADSFSQP I * 03670000 **/* * I---------------------I---------------------I * 03680000 **/* * 4 I UADSUSER I * 03690000 **/* * I I * 03700000 **/* * I I * 03710000 **/* * I----------I----------I---------------------I * 03720000 **/* * 12 I UADSBN01 I UADSBN02 I UADSMAXC I * 03730000 **/* * I----------I----------I---------------------I * 03740000 **/* * 16 I UADSATTR I * 03750000 **/* * I-------------------------------------------I * 03760000 **/* * 20 I UADSUPTP I * 03770000 **/* * I-------------------------------------------I * 03780000 **/* * 24 I UADSPWD1 I * 03790000 **/* * I-------------------------------------------I * 03800000 **/* * * 03810000 ** 03820000 ** 03830000 **DECLARE 03840000 ** 1 DHED BASED(HEDBPTR), 03850000 ** 03860000 ** 03870000 ** 2 UADSMHDR CHAR(14) BDY(WORD), 03880000 ** /* COMMON HEADER AREA * 03890000 ** 3 UADSBLNG PTR(15) BDY(BYTE), 03900000 ** /* BLOCK LENGTH * 03910000 ** 3 UADSFSQP PTR(15) BDY(BYTE), 03920000 ** /* OFFSET TO INITIAL FSQE (FREE * 03930000 **/* ..SPACE QUEUE ELEMENT) * 03940000 ** 3 UADSUSER CHAR(8), /* USERID * 03950000 ** 4 UADSUSID CHAR(7), /* USERID * 03960000 ** 4 UADSIND1 PTR(8), /* RESERVED * 03970000 ** 3 UADSBN01 PTR(8), /* RESERVED * 03980000 ** 3 UADSBN02 CHAR(1), /* FLAGS * 03990000 ** 4 UADSNUSP BIT(1), /*..NO NON-USABLE SPACE * 04000000 **/* ..1 -- ONLY NON-USABLE SPACE * 04010000 **/* .......EXISTS IN THIS BLOCK * 04020000 ** 4 * BIT(1), /* RESERVED * 04030000 ** 4 * BIT(1), /* RESERVED * 04040000 ** 4 * BIT(1), /* RESERVED * 04050000 ** 4 * BIT(1), /* RESERVED * 04060000 ** 4 * BIT(1), /* RESERVED * 04070000 ** 4 * BIT(1), /* RESERVED * 04080000 ** 4 * BIT(1), /* RESERVED * 04090000 ** 2 UADSMAXC PTR(16) BDY(BYTE), 04100000 ** /* MAXIMUM CORE SIZE ALLOTTABLE * 04110000 **/* ..TO THIS USER * 04120000 ** 2 UADSATTR CHAR(4), /* SYSTEM ATTRIBUTES OF USERID * 04130000 ** 3 UADSIBMT CHAR(2), /* IBM FLAG AREA * 04140000 ** 4 * CHAR(1), /* FIRST BYTE OF FLAGS * 04150000 ** 5 USATR00 BIT(1), /* ..0 -- NO OPERATOR 04160000 ** CAPABILITY * 04170000 **/* ..1 -- OPERATOR CAPABILITY * 04180000 ** 5 USATR01 BIT(1), /* ..0 -- NO ACCOUNT CAPABILITY * 04190000 **/* ..1 -- ACCOUNT CAPABILITY * 04200000 ** 5 USATR02 BIT(1), /* ..0 -- NO JCL CAPABILITY * 04210000 **/* ..1 -- JCL CAPABILITY * 04220000 **/* FLAGS 3 THROUGH 15 ARE * 04230000 **/* ..RESERVED FOR IBM USE * 04240000 ** 5 * BIT(1), /* RESERVED * 04250000 ** 5 * BIT(1), /* RESERVED * 04260000 ** 5 * BIT(1), /* RESERVED * 04270000 ** 5 * BIT(1), /* RESERVED * 04280000 ** 5 * BIT(1), /* RESERVED * 04290000 ** 4 * CHAR(1), /* SECOND BYTE OF FLAGS, 8 -- 04300000 ** 15 * 04310000 ** 04320000 ** 3 UADSINST CHAR(2), /* RESERVED * 04330000 **/* FLAGS 16 THROUGH 31 ARE * 04340000 **/* ..RESERVED FOR INSTALLATION * 04350000 **/* ..USE * 04360000 ** 4 * CHAR(1), /* THIRD BYTE OF FLAGS, 16 -- 04370000 ** 23 * 04380000 ** 4 * CHAR(1), /* FOURTH BYTE OF FLAGS * 04390000 ** 2 UADSUPTP PTR(31), /* OFFSET TO CURRENT UPT * 04400000 ** 2 UADSPWD1 PTR(31); /* OFFSET TO 1ST PASSWD OFFSET * 04410000 ** 04420000 ** 04430000 ** 04440000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04450000 **/* * * 04460000 **/* * G E N E R A L O F F S E T B L O C K * 04470000 **/* * * 04480000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04490000 **/* * * 04500000 **/* * * 04510000 **/* * I----------I--------------------------------I * 04520000 **/* * 0 I UADSNNFL I UADSNNEX I * 04530000 **/* * I----------I--------------------------------I * 04540000 **/* * 4 I UADSNSFL I UADSNSUB I * 04550000 **/* * I----------I--------------------------------I * 04560000 **/* * 8 I UADSNDFL I UADSNDAT I * 04570000 **/* * I----------I--------------------------------I * 04580000 **/* * * 04590000 ** 04600000 ** 04610000 **DECLARE 04620000 ** 1 UADSNODE BASED(UADSNPTR), 04630000 ** 04640000 ** 2 UADSNWD1 PTR(31), /* NAME OF FIRST WORD * 04650000 ** 3 UADSNNFL CHAR(1), /* GENERAL OFFSET BLOCK * 04660000 **/* ..INDICATORS * 04670000 ** 4 UADSNFLG BIT(1), /* ..0 -- CONTINUE CHAINING * 04680000 **/* ..1 -- LAST OFFSET BLOCK FOR * 04690000 **/* .......THIS OFFSET CHAIN * 04700000 **/* .. FLAGS 1 THRU 7 ARE RESERVE * 04710000 ** 4 * BIT(1), /* RESERVED * 04720000 ** 4 * BIT(1), /* RESERVED * 04730000 ** 4 * BIT(1), /* RESERVED * 04740000 ** 4 * BIT(1), /* RESERVED * 04750000 ** 4 * BIT(1), /* RESERVED * 04760000 ** 4 * BIT(1), /* RESERVED * 04770000 ** 4 * BIT(1), /* RESERVED * 04780000 ** 3 UADSNNEX PTR(24) BDY(BYTE), 04790000 ** /* OFFSET TO NEXT OFFSET BLOCK * 04800000 ** 2 UADSNWD2 PTR(31), /* NAME OF SECOND WORD * 04810000 ** 3 UADSNSFL CHAR(1), /* RESERVED * 04820000 ** 3 UADSNSUB PTR(24) BDY(BYTE), 04830000 ** /* OFFSET TO ASSOCIATED OFFSET * 04840000 ** 2 UADSNWD3 PTR(31), /* NAME OF THIRD WORD * 04850000 ** 3 UADSNDFL CHAR(1), /* RESERVED * 04860000 ** 3 UADSNDAT PTR(24) BDY(BYTE); 04870000 ** /* OFFSET TO DATA BLOCK * 04880000 ** 04890000 ** 04900000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04910000 **/* * * 04920000 **/* * P A S S W O R D O F F S E T B L O C K * 04930000 **/* * * 04940000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 04950000 **/* * * 04960000 **/* * * 04970000 **/* * I----------I--------------------------------I * 04980000 **/* * 0 I UADSPFLG I UADSPNEX I * 04990000 **/* * I----------I--------------------------------I * 05000000 **/* * 4 I UADSPSUB I * 05010000 **/* * I-------------------------------------------I * 05020000 **/* * 8 I UADSPDAT I * 05030000 **/* * I-------------------------------------------I * 05040000 **/* * * 05050000 ** 05060000 ** 05070000 **DECLARE 05080000 ** 1 DPOB BASED(DPOBPTR), 05090000 ** 05100000 ** 2 UADSPFLG CHAR(1), /* PASSWORD BLOCK INDICATORS * 05110000 ** 3 PFLG01 BIT(1), /* ..0 -- CONTINUE CHAINING * 05120000 **/* ..1 -- LAST PASSWORD FOR THIS * 05130000 **/* .......USERID * 05140000 **/* ..FLAGS 1 THRU 7 ARE RESERVED * 05150000 ** 3 * BIT(1), /* RESERVED * 05160000 ** 3 * BIT(1), /* RESERVED * 05170000 ** 3 * BIT(1), /* RESERVED * 05180000 ** 3 * BIT(1), /* RESERVED * 05190000 ** 3 * BIT(1), /* RESERVED * 05200000 ** 3 * BIT(1), /* RESERVED * 05210000 ** 3 * BIT(1), /* RESERVED * 05220000 ** 2 UADSPNEX PTR(24) BDY(BYTE), 05230000 ** /* OFFSET TO NEXT PASSWD OFFSET * 05240000 **/* ..BLOCK * 05250000 ** 2 UADSPSUB PTR(31), /* OFFSET TO ASSOCIATED ACCOUNT * 05260000 **/* ..NUMBER OFFSET BLOCK * 05270000 ** 2 UADSPDAT PTR(31); /* OFFSET TO PASSWORD DATA 05280000 ** BLOCK * 05290000 ** 05300000 ** 05310000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05320000 **/* * * 05330000 **/* * A C C O U N T N U M B E R * 05340000 **/* * O F F S E T B L O C K * 05350000 **/* * * 05360000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05370000 **/* * * 05380000 **/* * * 05390000 **/* * I----------I--------------------------------I * 05400000 **/* * 0 I UADSAFLG I UADSANEX I * 05410000 **/* * I----------I--------------------------------I * 05420000 **/* * 4 I UADSASUB I * 05430000 **/* * I-------------------------------------------I * 05440000 **/* * 8 I UADSADAT I * 05450000 **/* * I-------------------------------------------I * 05460000 **/* * * 05470000 ** 05480000 ** 05490000 **DECLARE 05500000 ** 1 DNOB BASED(DNOBPTR), 05510000 ** 05520000 ** 2 UADSAFLG CHAR(1), /* ACCOUNT NUMBER OFFSET BLOCK * 05530000 **/* ..INDICATORS * 05540000 ** 3 AFLG01 BIT(1), /* ..0 -- CONTINUE CHAINING * 05550000 **/* ..1 -- LAST ACCOUNT NUMBER FO * 05560000 **/* .......THIS PASSWORD CHAIN * 05570000 **/* .. FLAGS 1 THRU 7 ARE RESERVE * 05580000 ** 3 * BIT(1), /* RESERVED * 05590000 ** 3 * BIT(1), /* RESERVED * 05600000 ** 3 * BIT(1), /* RESERVED * 05610000 ** 3 * BIT(1), /* RESERVED * 05620000 ** 3 * BIT(1), /* RESERVED * 05630000 ** 3 * BIT(1), /* RESERVED * 05640000 ** 3 * BIT(1), /* RESERVED * 05650000 ** 2 UADSANEX PTR(24) BDY(BYTE), 05660000 ** /* OFFSET TO NEXT ACCOUNT 05670000 ** NUMBER * 05680000 **/* ..OFFSET BLOCK * 05690000 ** 2 UADSASUB PTR(31), /* OFFSET TO ASSOCIATED 05700000 ** PROCNAME * 05710000 **/* ..OFFSET BLOCK * 05720000 ** 2 UADSADAT PTR(31); /* OFFSET TO ACCOUNT NUMBER 05730000 ** DATA * 05740000 **/* ..BLOCK * 05750000 ** 05760000 ** 05770000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05780000 **/* * * 05790000 **/* * P R O C E D U R E N A M E * 05800000 **/* * O F F S E T B L O C K * 05810000 **/* * * 05820000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 05830000 **/* * * 05840000 **/* * * 05850000 **/* * I----------I--------------------------------I * 05860000 **/* * 0 I UADSRFLG I UADSRNEX I * 05870000 **/* * I----------I--------------------------------I * 05880000 **/* * 4 I UADSRSUB I * 05890000 **/* * I-------------------------------------------I * 05900000 **/* * 8 I UADSRDAT I * 05910000 **/* * I-------------------------------------------I * 05920000 **/* * * 05930000 ** 05940000 ** 05950000 **DECLARE 05960000 ** 1 DROB BASED(DROBPTR), 05970000 ** 05980000 ** 2 UADSRFLG CHAR(1), /* PROCNAME OFFSET BLOCK * 05990000 **/* ..INDICATORS * 06000000 ** 3 FLGR01 BIT(1), /* ..0 -- CONTINUE CHAINING * 06010000 **/* ..1 -- LAST PROCNAME FOR THIS * 06020000 **/* .......ACCOUNT NUMBER * 06030000 **/* ..FLAGS 1 THRU 7 ARE RESERVED * 06040000 ** 3 * BIT(1), /* RESERVED * 06050000 ** 3 * BIT(1), /* RESERVED * 06060000 ** 3 * BIT(1), /* RESERVED * 06070000 ** 3 * BIT(1), /* RESERVED * 06080000 ** 3 * BIT(1), /* RESERVED * 06090000 ** 3 * BIT(1), /* RESERVED * 06100000 ** 3 * BIT(1), /* RESERVED * 06110000 ** 2 UADSRNEX PTR(24) BDY(BYTE), 06120000 ** /* OFFSET TO NEXT PROCNAME * 06130000 **/* ..OFFSET BLOCK * 06140000 ** 2 UADSRSUB PTR(31), /* RESERVED BY ACCOUNT * 06150000 ** 2 UADSRDAT PTR(31); /* OFFSET TO PROCNAME DATA 06160000 ** BLOCK * 06170000 ** 06180000 ** 06190000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06200000 **/* * * 06210000 **/* * P A S S W O R D D A T A B L O C K * 06220000 **/* * * 06230000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06240000 **/* * * 06250000 **/* * * 06260000 **/* * I----------I--------------------------------I * 06270000 **/* * 0 I UADSPCTR I UADSPRES I * 06280000 **/* * I----------I--------------------------------I * 06290000 **/* * 4 I UADSPPWD I * 06300000 **/* * I I * 06310000 **/* * 8 I I * 06320000 **/* * I-------------------------------------------I * 06330000 **/* * * 06340000 ** 06350000 ** 06360000 **DECLARE 06370000 ** 1 DPOBD BASED(UADSPPTR), 06380000 ** 06390000 ** 2 UADSPCTR PTR(8), /* COUNT OF REFERENCES TO THIS * 06400000 **/* ..DATA BLOCK * 06410000 ** 2 UADSPRES CHAR(3), /* RESERVED FOR ACCOUNT * 06420000 ** 2 UADSPPWD CHAR(8); /* PASSWORD * 06430000 ** 06440000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06450000 **/* * * 06460000 **/* * A C C O U N T N U M B E R * 06470000 **/* * D A T A B L O C K * 06480000 **/* * * 06490000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06500000 **/* * * 06510000 **/* * * 06520000 **/* * I----------I--------------------------------I * 06530000 **/* * 0 I UADSACTR I UADSARES I * 06540000 **/* * I----------I--------------------------------I * 06550000 **/* * 4 I UADSADRF (40 BYTES) I * 06560000 **/* * I I * 06570000 **/* * I I * 06580000 **/* * I I * 06590000 **/* * I----------I--------------------------------I * 06600000 **/* * 44 I UADSALEN I UADSANUM (MAX OF 40 BYTES) I * 06610000 **/* * I----------I I * 06620000 **/* * I I * 06630000 **/* * I I * 06640000 **/* * I I * 06650000 **/* * = = * 06660000 **/* * I I * 06670000 **/* * I-------------------------------------------I * 06680000 **/* * * 06690000 ** 06700000 ** 06710000 **DECLARE 06720000 ** 1 DNOBD BASED(UADSAPTR), 06730000 ** 06740000 ** 2 UADSACTR PTR(8), /* COUNT OF REFERENCES TO THIS * 06750000 **/* ..DATA BLOCK * 06760000 ** 2 UADSARES CHAR(3), /* RESERVED FOR ACCOUNT * 06770000 ** 2 UADSADRF CHAR(40), /* DRIVER DATA FIELD * 06780000 ** 2 UADSALEN PTR(8), /* LENGTH OF FOLLOWING ACCOUNT * 06790000 **/* ..NUMBER DATA FIELD * 06800000 ** 2 UADSANUM CHAR(40); /* ACCT NMBR DATA FIELD * 06810000 ** 06820000 ** 06830000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06840000 **/* * * 06850000 **/* * P R O C E D U R E N A M E * 06860000 **/* * D A T A B L O C K * 06870000 **/* * * 06880000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 06890000 **/* * * 06900000 **/* * * 06910000 **/* * I----------I--------------------------------I * 06920000 **/* * 0 I UADSRCTR I UADSRRES I * 06930000 **/* * I----------I--------------------------------I * 06940000 **/* * 4 I UADSRNAM I * 06950000 **/* * I I * 06960000 **/* * I I * 06970000 **/* * I----------I----------I---------------------I * 06980000 **/* * 12 I UADSRNDS I UADSRRS2 I UADSRSIZ I * 06990000 **/* * I----------I----------I---------------------I * 07000000 **/* * 16 I UADSUNAM I * 07010000 **/* * I I * 07020000 **/* * I I * 07030000 **/* * I-------------------------------------------I * 07040000 **/* * * 07050000 ** 07060000 ** 07070000 **DECLARE 07080000 ** 1 DROBD BASED(UADSRPTR), 07090000 ** 07100000 ** 2 UADSRCTR PTR(8), /* COUNT OF REFERENCES TO THIS * 07110000 **/* DATA BLOCK * 07120000 ** 2 UADSRRES CHAR(3), /* RESERVED FOR ACCOUNT * 07130000 ** 2 UADSRNAM CHAR(8), /* LOGON PROCEDURE NAME * 07140000 ** 2 UADSRNDS CHAR(1), /* RESERVED * 07150000 ** 2 UADSRRS2 CHAR(1), /* RESERVED * 07160000 ** 2 UADSRSIZ PTR(16) BDY(BYTE), 07170000 ** /* REGION SIZE SPECIFIED IN THE * 07180000 **/* ..NAMED PROCEDURE * 07190000 ** 2 UADSUNAM CHAR(8); /* ESOTERIC GROUP UNIT NAME * 07200000 ** 07210000 ** 07220000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07230000 **/* * * 07240000 **/* * F R E E S P A C E Q U E U E * 07250000 **/* * E L E M E N T * 07260000 **/* * * 07270000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07280000 **/* * * 07290000 **/* * * 07300000 **/* * I---------------------I---------------------I * 07310000 **/* * 0 I FSQELNTH I FSQENEXT I * 07320000 **/* * I---------------------I---------------------I * 07330000 **/* * * 07340000 ** 07350000 ** 07360000 ** 07370000 **DECLARE 07380000 ** 1 UADSFSQE BASED(FSQEPTR), 07390000 ** 2 FSQELNTH PTR(15) BDY(BYTE), 07400000 ** /* LENGTH OF FREE SPACE AREA * 07410000 ** 2 FSQENEXT PTR(15) BDY(BYTE); 07420000 ** /* OFFSET TO NEXT FSQE * 07430000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07440000 **/* * 07450000 **/* D E L E T E P O I N T L I S T * 07460000 **/* * 07470000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 07480000 **/* * 07490000 **/* I-----------------------------------------------I * 07500000 **/* 0 I DADP I * 07510000 **/* I-----------------------------------------------I * 07520000 **/* 4 I DCDP I * 07530000 **/* -I-----------------------------------------------I- * 07540000 **/* 8 I DUSERID (DUSRID1,DUSRIDN) I * 07550000 **/* I I * 07560000 **/* I-----------------------------------------------I * 07570000 **/* 16 I DUOFFS (DUOFFLG,DUOFNEX,DUOFSUB,DUOFDAT) I * 07580000 **/* I I * 07590000 **/* I-----------I-----------------------------------I * 07600000 **/* 28 I DUCLS I DUFLOC I * 07610000 **/* I-----------I-----------I-----------------------I * 07620000 **/* 32 I DUSRDTN I DUSRDCN I * 07630000 **/* -I-----------------------I-----------------------I- * 07640000 **/* 36 I DPASWD (DPSWD1,DPSWDN) I * 07650000 **/* I I * 07660000 **/* I-----------------------------------------------I * 07670000 **/* 44 I DPOFFS (DPOFFLG,DPOFNEX,DPOFSUB,DPOFDAT) I * 07680000 **/* I I * 07690000 **/* I-----------I-----------------------------------I * 07700000 **/* 56 I DPCLS I DPFLOC I * 07710000 **/* I-----------I-----------I-----------------------I * 07720000 **/* 60 I DPSWDTN I DPSWDCN I * 07730000 **/* -I-----------------------I-----------------------I- * 07740000 **/* 64 I DACCTN (DACCTN1,DACCTNN) I * 07750000 **/* I I * 07760000 **/* I-----------------------------------------------I * 07770000 **/* 72 I DAOFFS (DAOFFLG,DAOFNEX,DAOFSUB,DAOFDAT) I * 07780000 **/* I I * 07790000 **/* I-----------I-----------------------------------I * 07800000 **/* 84 I DACLS I DAFLOC I * 07810000 **/* I-----------I-----------I-----------------------I * 07820000 **/* 88 I DACCTTN I DACCTCN I * 07830000 **/* -I-----------------------I-----------------------I- * 07840000 **/* 92 I DROCNM (DROCNM1,DROCNMN) I * 07850000 **/* I-----------------------------------------------I * 07860000 **/* 100 I DROFFS (DROFFLG,DROFNEX,DROFSUB,DROFDAT) I * 07870000 **/* I I * 07880000 **/* I-----------I-----------------------------------I * 07890000 **/* 112 I DRCLS I DRFLOC I * 07900000 **/* I-----------I-----------I-----------------------I * 07910000 **/* 116 I DRCNMTN I DRCNMCN I * 07920000 **/* I-----------I-----------I-----------------------I * 07930000 **/* 120 I DEND I * 07940000 **/* I-----------I * 07950000 **/* * 07960000 **/* * 07970000 ** 07980000 ** 07990000 **DECLARE 08000000 ** 1 DPLB BASED(DPLPTR), 08010000 ** 08020000 ** 08030000 ** 2 DADP PTR(31) BDY(WORD), 08040000 ** /* PTR WITHIN DPL TO LEVEL * 08050000 **/* ..ORIGINALLY ASSIGNED AS * 08060000 **/* ..POINT OF DELETION * 08070000 ** 2 DCDP PTR(31), /* PTR WITHIN DPL TO LEVEL * 08080000 **/* ..CURRENTLY ACTIVE AS THE * 08090000 **/* ..POINT OF DELETION * 08100000 ** 08110000 ** 2 DUSERID CHAR(8) BDY(WORD), /* CURRENT USERID LIST * 08120000 ** 3 DUSRID1 PTR(31), /* PTR TO FIRST USERID PDE * 08130000 ** 3 DUSRIDN PTR(31), /* PTR TO CURRENT USERID PDE * 08140000 ** 2 DUOFFS CHAR(12) BDY(WORD), /* DUMMY USERID OFFSET BLOCK * 08150000 ** 3 DUOFFLG CHAR(1), /* DUMMY OFFSET CONTROL FLAGS * 08160000 ** 4 DUOFLG1 BIT(1), /* DUMMY CHAINING FLAG * 08170000 ** 4 * BIT(1), /* RESERVED * 08180000 ** 4 * BIT(1), /* RESERVED * 08190000 ** 4 * BIT(1), /* RESERVED * 08200000 ** 4 * BIT(1), /* RESERVED * 08210000 ** 4 * BIT(1), /* RESERVED * 08220000 ** 4 DUOFLG7 BIT(1), /* DUMMY USERID DELETION * 08230000 ** 4 DUOFLG8 BIT(1), /* DUMMY DELETION FAILURE * 08240000 ** 3 DUOFNEX PTR(24) BDY(WORD,2), 08250000 ** /* DUMMY OFFSET TO NEXT OFFSET * 08260000 ** 3 DUOFSUB PTR(31), /* DUMMY OFFSET TO SUB-LEVEL * 08270000 ** 3 DUOFDAT PTR(31), /* DUMMY OFFSET TO DATA BLOCK * 08280000 ** 2 DUCLS CHAR(1), /* USERID COMMAND LIST FLAGS * 08290000 ** 3 DUCLSF1 BIT(1), /* ..0 -- IF USERID IS SUPPLIED * 08300000 **/* ..1 -- IF * IN COMMAND FIELD * 08310000 **/* ..FLAGS 2 - 5 RESERVED * 08320000 ** 3 * BIT(1), /* RESERVED * 08330000 ** 3 * BIT(1), /* RESERVED * 08340000 ** 3 * BIT(1), /* RESERVED * 08350000 ** 3 * BIT(1), /* RESERVED * 08360000 ** 3 * BIT(1), /* RESERVED * 08370000 ** 3 * BIT(1), /* RESERVED * 08380000 ** 3 * BIT(1), /* RESERVED * 08390000 ** 2 DUFLOC PTR(24) BDY(BYTE), /* DUMMY PTR TO OFFSET BLOCK * 08400000 ** 2 DUSRDTN PTR(16), /* DUMMY TOTAL NUMBER OF NAMES * 08410000 ** 2 DUSRDCN PTR(16), /* DUMMY NUMBER OF CURRENT NAME * 08420000 ** 08430000 ** 2 DPASWD CHAR(8) BDY(WORD), /* CURRENT PASSWORD LIST * 08440000 ** 3 DPASWD1 PTR(31), /* PTR TO FIRST PASSWORD PDE * 08450000 ** 3 DPASWDN PTR(31), /* PTR TO CURRENT PASSWORD PDE * 08460000 ** 2 DPOFFS CHAR(12) BDY(WORD), /* PASSWORD OFFSET BLOCK * 08470000 ** 3 DPOFFLG CHAR(1), /* PASSWD OFFSET CONTROL FLGS * 08480000 ** 4 DPOFLG1 BIT(1), /* PASSWD OFFSET CHAINING FLG * 08490000 **/* ..0 -- CONTINUE CHAINING * 08500000 **/* ..1 -- LAST PASSWORD FOR * 08510000 **/* .......THIS USERID * 08520000 **/* FLAGS 2 - 5 RESERVED * 08530000 ** 4 * BIT(1), /* RESERVED * 08540000 ** 4 * BIT(1), /* RESERVED * 08550000 ** 4 * BIT(1), /* RESERVED * 08560000 ** 4 * BIT(1), /* RESERVED * 08570000 ** 4 * BIT(1), /* RESERVED * 08580000 ** 4 DPOFLG7 BIT(1), /* PASSWORD DELETION OCCURENCE * 08590000 ** 4 DPOFLG8 BIT(1), /* PASSWORD DELETION FAILURE * 08600000 ** 3 DPOFNEX PTR(24) BDY(WORD,2), 08610000 ** /* OFFSET TO NEXT PASSWD OFFSET * 08620000 ** 3 DPOFSUB PTR(31), /* OFFSET TO ASSOCIATED ACCOUNT * 08630000 **/* ..NUMBER OFFSET * 08640000 ** 3 DPOFDAT PTR(31), /* OFFSET TO PASSWD DATA BLOCK * 08650000 ** 2 DPCLS CHAR(1), /* PASSWORD COMMAND LIST FLAGS * 08660000 ** 3 DPCLSF1 BIT(1), /* ..0 IF PASSWORD SUPPLIED * 08670000 **/* ..1 -- IF * IN COMMAND FIELD * 08680000 ** 3 DPCLSF2 BIT(1), /* ..0 IF SINGLE PASSWORD * 08690000 **/* ..1 IF PASSWORD LIST * 08700000 ** 3 * BIT(1), /* RESERVED * 08710000 ** 3 * BIT(1), /* RESERVED * 08720000 ** 3 * BIT(1), /* RESERVED * 08730000 ** 3 * BIT(1), /* RESERVED * 08740000 ** 3 * BIT(1), /* RESERVED * 08750000 ** 3 * BIT(1), /* RESERVED * 08760000 ** 2 DPFLOC PTR(24) BDY(WORD,2), /* POINTER TO CURRENT PASSWORD * 08770000 **/* ..OFFSET BLOCK (DPOFFS) * 08780000 ** 2 DPSWDTN PTR(16), /* TOTAL NUMBER OF PASSWORDS * 08790000 ** 2 DPSWDCN PTR(16), /* NUMBER OF CURRENT PASSWORD * 08800000 ** 08810000 ** 2 DACCTN CHAR(8) BDY(WORD), /* CURRENT ACCOUNT NUMBER LIST * 08820000 ** 3 DACCTN1 PTR(31), /* PTR TO FIRST ACCT NMBR PDE * 08830000 ** 3 DACCTNN PTR(31), /* PTR TO CURRENT ACCT NMBR PDE * 08840000 ** 2 DAOFFS CHAR(12) BDY(WORD), /* ACCOUNT NUMBER OFFSET BLOCK * 08850000 ** 3 DAOFFLG CHAR(1), /* ACCT NMBR OFFSET CNTRL FLAGS * 08860000 ** 4 DAOFLG1 BIT(1), /* ACCTN OFFSET CHAINING FLG * 08870000 **/* ..0 -- CONTINUE CHAINING * 08880000 **/* ..1 -- LAST PASSWORD FOR * 08890000 **/* .......THIS USERID * 08900000 **/* FLAGS 2 - 5 RESERVED * 08910000 ** 4 * BIT(1), /* RESERVED * 08920000 ** 4 * BIT(1), /* RESERVED * 08930000 ** 4 * BIT(1), /* RESERVED * 08940000 ** 4 * BIT(1), /* RESERVED * 08950000 ** 4 * BIT(1), /* RESERVED * 08960000 ** 4 DAOFLG7 BIT(1), /* ACCTN DELETION OCCURENCE * 08970000 ** 4 DAOFLG8 BIT(1), /* ACCTN DELETION FAILURE * 08980000 ** 3 DAOFNEX PTR(24) BDY(WORD,2), 08990000 ** /* OFFSET TO NEXT ACCT NMBR * 09000000 **/* ..OFFSET BLOCK * 09010000 ** 3 DAOFSUB PTR(31), /* OFFSET TO ASSOCIATED * 09020000 **/* ..PROCNAME OFFSET BLOCK * 09030000 ** 3 DAOFDAT PTR(31), /* OFFSET TO ACCOUNT NUMBER 09040000 ** DATA * 09050000 ** 2 DACLS CHAR(1), /* ACCT NMBR COMMAND LIST FLAGS * 09060000 ** 3 DACLSF1 BIT(1), /* ..0 -- IF ACCT NMBR SUPPLIED * 09070000 **/* ..1 -- IF * IN COMMAND FIELD * 09080000 ** 3 * BIT(1), /* RESERVED * 09090000 ** 3 * BIT(1), /* RESERVED * 09100000 ** 3 * BIT(1), /* RESERVED * 09110000 ** 3 * BIT(1), /* RESERVED * 09120000 ** 3 * BIT(1), /* RESERVED * 09130000 ** 3 * BIT(1), /* RESERVED * 09140000 ** 3 * BIT(1), /* RESERVED * 09150000 ** 2 DAFLOC PTR(24) BDY(BYTE), /* POINTER TO CURRENT ACCOUNT * 09160000 **/* ..NUMBER OFFSET BLOCK (DAOFF * 09170000 ** 2 DACCTTN PTR(16), /* TOTAL NUMBER OF ACCT NMBRS * 09180000 ** 2 DACCTCN PTR(16), /* NUMBER OF CURRENT ACCT NMBR * 09190000 ** 09200000 ** 2 DROCNM CHAR(8) BDY(WORD), /* CURRENT PROCNAME LIST * 09210000 ** 3 DROCNM1 PTR(31), /* PTR TO FIRST PROCNAME PDE * 09220000 ** 3 DROCNMN PTR(31), /* PTR TO CURRENT PROCNAME PDE * 09230000 ** 2 DROFFS CHAR(12) BDY(WORD), /* PROCNAME OFFSET BLOCK * 09240000 ** 3 DROFFLG CHAR(1), /* PROCNAME OFFSET CNTRL FLAGS * 09250000 ** 4 DROFLG1 BIT(1), /* PROCNAME OFFSET CHAINING FLG * 09260000 **/* ..0 -- CONTINUE CHAINING * 09270000 **/* ..1 -- LAST PROC NAME FOR * 09280000 **/* .......THIS ACCOUNT NUMBER * 09290000 **/* FLAGS 2 - 5 RESERVED * 09300000 ** 4 * BIT(1), /* RESERVED * 09310000 ** 4 * BIT(1), /* RESERVED * 09320000 ** 4 * BIT(1), /* RESERVED * 09330000 ** 4 * BIT(1), /* RESERVED * 09340000 ** 4 * BIT(1), /* RESERVED * 09350000 ** 4 DROFLG7 BIT(1), /* PROCNAME DELETION OCCURENCE * 09360000 ** 4 DROFLG8 BIT(1), /* PROCNAME DELETION FAILURE * 09370000 ** 3 DROFNEX PTR(24) BDY(BYTE), 09380000 ** /* OFFSET TO NEXT PROCNAME * 09390000 **/* ..OFFSET BLOCK * 09400000 ** 3 DROFSUB PTR(31), /* DUMMY SUBLEVEL OFFSET * 09410000 ** 3 DROFDAT PTR(31), /* OFFSET TO PROCNAME DATA 09420000 ** BLOCK * 09430000 ** 2 DRCLS CHAR(1), /* PROCNAME COMMAND LIST FLAGS * 09440000 ** 3 DRCLSF1 BIT(1), /* ..0 -- IF PROCNAME SUPPLIED * 09450000 **/* ..1 -- IF * IN COMMAND FIELD * 09460000 ** 3 * BIT(1), /* RESERVED * 09470000 ** 3 * BIT(1), /* RESERVED * 09480000 ** 3 * BIT(1), /* RESERVED * 09490000 ** 3 * BIT(1), /* RESERVED * 09500000 ** 3 * BIT(1), /* RESERVED * 09510000 ** 3 * BIT(1), /* RESERVED * 09520000 ** 3 * BIT(1), /* RESERVED * 09530000 ** 2 DRFLOC PTR(24) BDY(BYTE), /* POINTER TO CURRENT PROCNAME * 09540000 **/* ..OFFSET BLOCK (DROFFS) * 09550000 ** 2 DRCNMTN PTR(16), /* TOTAL NUMBER OF PROCNAMES * 09560000 ** 2 DRCNMCN PTR(16), /* NUMBER OF CURRENT PROCNAME * 09570000 ** 09580000 ** 2 DEND BIT(8); /* END-OF-DPL FLAG -- 'FF' * 09590000 ** 09600000 * DECLARE 09610000 * /* PTR TO CURRENT ACTIVE LEVEL * 09620000 * LEVLP PTR(31); 09630000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 09640000 **/* * 09650000 **/* D P L E N T R Y P R O T O T Y P E * 09660000 **/* * 09670000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 09680000 **/* * 09690000 **/* I-----------------------------------------------I * 09700000 **/* 0 I NAMIDA (NAMID1) I * 09710000 **/* I - - - - - - - - - - - - - - - - - - - - - - - I * 09720000 **/* 4 I (NAMIDN1) I * 09730000 **/* I-----------I-----------------------------------I * 09740000 **/* 8 I NMOFFS1 I (NMFNEX1) I * 09750000 **/* I (NMFLG11) I I * 09760000 **/* I - - - - - I - - - - - - - - - - - - - - - - - I * 09770000 **/* 12 I (NMFSUB1) I * 09780000 **/* I - - - - - - - - - - - - - - - - - - - - - - - I * 09790000 **/* 16 I (NMFDAT1) I * 09800000 **/* I-----------I-----------------------------------I * 09810000 **/* 20 I NMCLS1 I NMFLOC1 I * 09820000 **/* I-----------I-----------I-----------------------I * 09830000 **/* 24 I NMDTN1 I NMDCN1 I * 09840000 **/* -I-----------------------I-----------------------I- * 09850000 **/* 28 I NAMIDB (NAMID2) (NMTST1) I * 09860000 **/* I - - - - - - - - - - - - - - - - - - - - - - - I * 09870000 **/* 32 I (NAMIDN2) I * 09880000 **/* I-----------I-----------------------------------I * 09890000 **/* 36 I NMOFFS2 I (NMFNEX2) I * 09900000 **/* I (NMFLG21) I I * 09910000 **/* I - - - - - I - - - - - - - - - - - - - - - - - I * 09920000 **/* 40 I (NMFSUB2) I * 09930000 **/* I - - - - - - - - - - - - - - - - - - - - - - - I * 09940000 **/* 44 I (NMFDAT2) I * 09950000 **/* I-----------I-----------------------------------I * 09960000 **/* 48 I NMCLS2 I NMFLOC2 I * 09970000 **/* I-----------I-----------I-----------------------I * 09980000 **/* 52 I NMDTN2 I NMDCN2 I * 09990000 **/* I-----------I-----------I-----------------------I * 10000000 **/* 56 I NMTST2 I * 10010000 **/* I-----------I * 10020000 **/* * 10030000 **/* * 10040000 ** 10050000 **DECLARE 10060000 ** 1 DNAMID BASED(DNMIDP), 10070000 ** 10080000 ** 2 NAMIDA CHAR(8) BDY(WORD), 10090000 ** /* DPL ENTRY NAME LIST * 10100000 ** 3 NAMID1 PTR(31), /* PTR TO FIRST NAME PDE * 10110000 ** 3 NAMIDN1 PTR(31), /* PTR TO CURRENT NAME PDE * 10120000 ** 2 NMOFFS1 CHAR(12) BDY(WORD), /* NAME OFFSET BLOCK * 10130000 ** 3 NMFLG1S CHAR(1), /* NAME OFFSET CONTROL FLAGS * 10140000 ** 4 NMFLG11 BIT(1), /* ITEM OFFSET CHAINING FLAG * 10150000 **/* ..0 -- CONTINUE CHAINING * 10160000 **/* ..1 -- LAST NAME OF LEVEL * 10170000 ** 4 * BIT(1), /* RESERVED * 10180000 ** 4 * BIT(1), /* RESERVED * 10190000 ** 4 * BIT(1), /* RESERVED * 10200000 ** 4 * BIT(1), /* RESERVED * 10210000 ** 4 * BIT(1), /* RESERVED * 10220000 ** 4 NMFLG17 BIT(1), /* ITEM DELETION OCCURENCE * 10230000 ** 4 NMFLG18 BIT(1), /* ITEM DELETION FAILURE * 10240000 ** 3 NMFNEX1 PTR(24) BDY(WORD,2), 10250000 ** /* OFFSET TO NEXT NAME OFFSET * 10260000 ** 3 NMFSUB1 PTR(31), /* OFFSET TO SUBLEVEL OFFSET * 10270000 ** 3 NMFDAT1 PTR(31), /* OFFSET TO NAME DATA BLOCK * 10280000 ** 2 NMCLS1 CHAR(1), /* NAME COMMAND LIST FLAGS * 10290000 ** 3 NMBLDG1 BIT(1), /* ..0 -- IF NAME SUPPLIED * 10300000 **/* ..1 -- IF * IN COMMAND FIELD * 10310000 ** 3 * BIT(1), /* RESERVED * 10320000 ** 3 * BIT(1), /* RESERVED * 10330000 ** 3 * BIT(1), /* RESERVED * 10340000 ** 3 * BIT(1), /* RESERVED * 10350000 ** 3 * BIT(1), /* RESERVED * 10360000 ** 3 * BIT(1), /* RESERVED * 10370000 ** 3 * BIT(1), /* RESERVED * 10380000 ** 2 NMFLOC1 PTR(24) BDY(BYTE), /* PTR TO CURRENT NAME OFFSET * 10390000 **/* ..(NMOFFS) * 10400000 ** 2 NMDXN1 PTR(32) BDY(WORD), /* NUMBER OF NAMES AREA M4483 * 10410000 ** 3 NMDTN1 PTR(16), /* TOTAL NUMBER OF NAMES * 10420000 ** 3 NMDCN1 PTR(16), /* NUMBER OF CURRENT NAME * 10430000 ** 10440000 ** 10450000 ** 2 NAMIDB CHAR(8) BDY(WORD), 10460000 ** /* DPL ENTRY NAME LIST * 10470000 ** 3 NAMID2 PTR(31), /* PTR TO FIRST NAME PDE * 10480000 ** 4 NMTST1 PTR(8), /* END OF DPL FLAG -- 'FF' * 10490000 ** 3 NAMIDN2 PTR(31), /* PTR TO CURRENT NAME PDE * 10500000 ** 2 NMOFFS2 CHAR(12) BDY(WORD), /* NAME OFFSET BLOCK * 10510000 ** 3 NMFLG2S CHAR(1), /* NAME OFFSET CONTROL FLAGS * 10520000 **/* 4 NMFLG21 BIT(1), ..0 -- CONTINUE CHAINING * 10530000 **/* ..1 -- LAST NAME OF LEVEL * 10540000 ** 4 * BIT(1), /* RESERVED * 10550000 ** 4 * BIT(1), /* RESERVED * 10560000 ** 4 * BIT(1), /* RESERVED * 10570000 ** 4 * BIT(1), /* RESERVED * 10580000 ** 4 * BIT(1), /* RESERVED * 10590000 ** 4 NMFLG27 BIT(1), /* ITEM DELETION OCCURENCE * 10600000 ** 4 NMFLG28 BIT(1), /* ITEM DELETION FAILURE * 10610000 ** 3 NMFNEX2 PTR(24) BDY(WORD,2), 10620000 ** /* OFFSET TO NEXT NAME OFFSET * 10630000 ** 3 NMFSUB2 PTR(31), /* OFFSET TO SUBLEVEL OFFSET * 10640000 ** 3 NMFDAT2 PTR(31), /* OFFSET TO NAME DATA BLOCK * 10650000 ** 2 NMCLS2 CHAR(1), /* NAME COMMAND LIST FLAGS * 10660000 ** 3 NMBLDG2 BIT(1), /* ..0 -- IF NAME SUPPLIED * 10670000 **/* ..1 -- IF * IN COMMAND FIELD * 10680000 ** 3 * BIT(1), /* RESERVED * 10690000 ** 3 * BIT(1), /* RESERVED * 10700000 ** 3 * BIT(1), /* RESERVED * 10710000 ** 3 * BIT(1), /* RESERVED * 10720000 ** 3 * BIT(1), /* RESERVED * 10730000 ** 3 * BIT(1), /* RESERVED * 10740000 ** 3 * BIT(1), /* RESERVED * 10750000 ** 2 NMFLOC2 PTR(24) BDY(BYTE), /* PTR,TO CURRENT NAME OFFSET * 10760000 **/* ..(NMOFFS) * 10770000 ** 2 NMDXN2 PTR(32) BDY(WORD), /* NUMBER OF NAMES AREA M4483 * 10780000 ** 3 NMDTN2 PTR(16), /* TOTAL NUMBER OF NAMES * 10790000 ** 3 NMDCN2 PTR(16), /* NUMBER OF CURRENT NAME * 10800000 ** 2 NMTST2 PTR(8); /* END OF DPL FLAG -- 'FF' * 10810000 ** 10820000 * DECLARE 10830000 * /* RESERVE NAME MEMBER * 10840000 * SAVCT PTR(31), 10850000 * /* CURRENT TEST NAME NUMBER * 10860000 * TSTCTN PTR(16); 10870000 * 10880000 * DECLARE 10890000 * /* PTR TO ITEM NAME CHARACTER STRING * 10900000 * NAMECP PTR(31); 10910000 * 10920000 * DECLARE 10930000 * /* CURRENT UADS NAME CHARACTER STRING * 10940000 * NAMEC CHAR(8) BASED(NAMECP); 10950000 * 10960000 * DECLARE 10970000 * /* ELEMENT INCREMENT FOR DELETE POINT LIST * 10980000 * LSPAN FIXED(31) BDY(WORD) 10990000 * INIT(ADDR(DPASWD)-ADDR(DUSERID)); 11000000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ** 11010000 **/* * * 11020000 **/* * P R E V I O U S O F F S E T B L O C K * 11030000 **/* * * 11040000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ** 11050000 **/* * * 11060000 **/* * * 11070000 **/* * I----------I--------------------------------I * 11080000 **/* * 0 I LASUNNFL I LASUNNEX I * 11090000 **/* * I----------I--------------------------------I * 11100000 **/* * 4 I LASUNSFL I LASUNSUB I * 11110000 **/* * I----------I--------------------------------I * 11120000 **/* * 8 I LASUNDFL I LASUNDAT I * 11130000 **/* * I----------I--------------------------------I * 11140000 **/* * * 11150000 ** 11160000 **DECLARE 11170000 ** 1 LASUNODE BASED(NMFLOC1), 11180000 ** 11190000 ** 2 LASUNWD1 PTR(31), /* NAME OF FIRST WORD * 11200000 ** 3 LASUNNFL CHAR(1), /* GENERAL OFFSET BLOCK * 11210000 **/* ..INDICATORS * 11220000 ** 4 LASUNFLG BIT(1), /* ..0 -- CONTINUE CHAINING * 11230000 **/* ..1 -- LAST OFFSET BLOCK FOR * 11240000 **/* .......THIS OFFSET CHAIN * 11250000 **/* .. FLAGS 1 THRU 7 ARE RESERVE * 11260000 ** 4 * BIT(1), /* RESERVED * 11270000 ** 4 * BIT(1), /* RESERVED * 11280000 ** 4 * BIT(1), /* RESERVED * 11290000 ** 4 * BIT(1), /* RESERVED * 11300000 ** 4 * BIT(1), /* RESERVED * 11310000 ** 4 * BIT(1), /* RESERVED * 11320000 ** 4 * BIT(1), /* RESERVED * 11330000 ** 3 LASUNNEX PTR(24) BDY(WORD,2), 11340000 ** /* OFFSET TO NEXT OFFSET BLOCK * 11350000 ** 2 LASUNWD2 PTR(31), /* NAME OF SECOND WORD * 11360000 ** 3 LASUNSFL CHAR(1), /* RESERVED * 11370000 ** 3 LASUNSUB PTR(24) BDY(WORD,2), 11380000 ** /* OFFSET TO ASSOCIATED OFFSET * 11390000 ** 2 LASUNWD3 PTR(31), /* NAME OF THIRD WORD * 11400000 ** 3 LASUNDFL CHAR(1), /* RESERVED * 11410000 ** 3 LASUNDAT PTR(24) BDY(WORD,2); 11420000 ** /* OFFSET TO DATA BLOCK * 11430000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 11440000 **/* * 11450000 **/* N A M E L I S T P D E * 11460000 **/* P R O T O T Y P E * 11470000 **/* * 11480000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 11490000 **/* * 11500000 **/* I-----------------------------------------------I * 11510000 **/* 0 I NAMPTR1 I * 11520000 **/* I-----------------------I-----------I-----------I * 11530000 **/* 4 I NAMLNG I NAMFLGS I RESERVED I * 11540000 **/* I-----------------------I-----------I-----------I * 11550000 **/* 8 I NPTRNEX (NPNEXC) I * 11560000 **/* I-----------------------------------------------I * 11570000 **/* * 11580000 **/* * 11590000 ** 11600000 **DECLARE 11610000 ** 1 NAMPDE BASED(NAMPTR), 11620000 ** 11630000 ** 11640000 ** 2 NAMPTR1 PTR(31) BDY(WORD), 11650000 ** /* PTR TO NAME (CHAR STRING) * 11660000 ** 2 NAMLNG PTR(16) BDY(WORD), 11670000 ** /* LENGTH OF NAME STRING * 11680000 ** 2 NAMFLGS CHAR(1), /* NAME OF FLAG AREA * 11690000 ** 3 NAMFLG1 BIT(1), /* ..0 -- PARAMETER OMITTED * 11700000 **/* ..1 -- PARAMETER SUPPLIED * 11710000 **/* ..FLAGS 2 - 6 RESERVED * 11720000 ** 3 * BIT(1), /* RESERVED * 11730000 ** 3 * BIT(1), /* RESERVED * 11740000 ** 3 * BIT(1), /* RESERVED * 11750000 ** 3 * BIT(1), /* RESERVED * 11760000 ** 3 * BIT(1), /* RESERVED * 11770000 ** 3 NAMFLGC BIT(2), /* DELETE CONTROL FLAGS * 11780000 ** 4 NAMFLG7 BIT(1), /* ITEM DELETED * 11790000 ** 4 NAMFLG8 BIT(1), /* ITEM DELETE FAILURE * 11800000 ** 2 * CHAR(1), /* RESERVED * 11810000 ** 2 NPNEXC CHAR(4) BDY(WORD), /* END OF LIST CHARACTER FLAGS * 11820000 ** 3 NPTRNEX PTR(31); /* PTR TO NEXT PDE IN LIST * 11830000 **/* ..NOTE -- THIS FIELD DOES * 11840000 **/* .......NOT EXIST IN SINGLE * 11850000 **/* .......UNCHAINED ENTRY * 11860000 ** 11870000 * DECLARE 11880000 * /* CURRENT PDE NAME CHARACTER STRING * 11890000 * NAMPTRC CHAR(40) BASED(NAMPTR1); 11900000 * 11910000 * DECLARE 11920000 * /* DPL END FLAG * 11930000 * DENDF BIT(8) INIT('FF'X); 11940000 * 11950000 * 11960000 * DECLARE 11970000 * /* CONTENTS OF OFFSET BLOCKS * 11980000 * NMOFFC1 CHAR(12) BASED(NMFLOC1), 11990000 * NMOFFC2 CHAR(12) BASED(NMFLOC2); 12000000 * 12010000 * DECLARE 12020000 * /* IDENTITY LIST * 12030000 * STOLST CHAR(8) BDY(HWORD), /* FOR STOW * 12040000 * UDLMOD CHAR(8) BDY(HWORD); /* FOR UDL * 12050000 * 12060000 * DECLARE 12070000 * /* DELETE CONTROL-DATA ITEMS * 12080000 * DWDMSK BIT(16) INIT('FFF8'X), /* MASK FOR DBL WD * 12090000 * HWDMSK BIT(16) INIT('FFFE'X), /* MASK FOR HALFWORD * 12100000 * 1 DLCTLR BIT(32), /* DELETE CONTROL AREA * 12110000 * 2 DELECF BIT(32), /* NAME OF CONTROL FLAG AREA * 12120000 * 3 PLNOW BIT(1), /* BIT0 = 1 FOR PUTLINE ACTIVE * 12130000 * 3 DELRS1 BIT(1), /* BIT1 = RESERVED M4478 * 12140000 * 3 DELRS2 BIT(1), /* BIT2 = RESERVED M4478 * 12150000 * 3 PLFAIL BIT(1), /* BIT3 = 1 FOR PUTLINE FAILS * 12160000 * 3 UIDNTR BIT(1), /* BIT4 = 1 FOR USERID ENTERED * 12170000 * 3 PWDNTR BIT(1), /* BIT5 = 1 FOR PASSWD ENTERED * 12180000 * 3 ACNNTR BIT(1), /* BIT6 = 1 FOR ACCTNR ENTERED * 12190000 * 3 NODLIN BIT(1), /* BIT7 = 1 FOR NODELIST ENTRY * 12200000 * 3 DATLIN BIT(1), /* BIT8 = 1 FOR DATALIST ENTRY * 12210000 * 3 ALEVEL BIT(1), /* BIT9 = 1 FOR ACCTN DP LEVEL * 12220000 * 3 DELERR BIT(1), /* BIT10 = 1 FOR ERROR COND * 12230000 * 3 PBUFLG BIT(1), /* BIT11 = 1 FOR PSEUDO-BUFFER * 12240000 * 3 DELRSP BIT(1), /* BIT12 = 1 FOR ID DELETED * 12250000 * 3 ENQNOW BIT(1), /* BIT13 = 1 FOR ENQ ACTIVE * 12260000 * 3 PNTRYF BIT(1), /* BIT14 = 1 FOR PARSE ENTRY * 12270000 * 3 FLGNST BIT(1), /* BIT15 = 1 FOR NO ASTERISK * 12280000 * 3 PRTNOW BIT(1), /* BIT16 = 1 FOR DELETED * 12290000 * 3 DELNOW BIT(1), /* BIT17 = 1 FOR DELETE FAILED * 12300000 * 3 SUPFGS BIT(2), /* SUPPORT FLAGS * 12310000 * 4 PWDSUP BIT(1), /* BIT18 FOR PASSWD SUPPRT * 12320000 * 4 ACNSUP BIT(1), /* BIT19 FOR ACCTN SUPPORT * 12330000 * 3 NODELR BIT(1), /* BIT20 = 1 FOR NO STATUS CHK * 12340000 * 3 FRENOW BIT(1), /* BIT21 = 1 FOR FREEMAIN ACTV * 12350000 * 3 RDDONE BIT(1), /* BIT22 = 1 FOR READ SUCCESS * 12360000 * 3 STRNOW BIT(1), /* BIT23 = 1 FOR ASTERISK NOW * 12370000 * 3 DATNOW BIT(1), /* BIT24 = 1 FOR DATL GETMAIN * 12380000 * 3 WRKDON BIT(2), /* GENERAL WORK DONE FLAGS * 12390000 * 4 DELDON BIT(1), /* BIT25 FOR DELETE ACTION * 12400000 * 4 WRTDON BIT(1), /* BIT26 FOR WRITE ACTION * 12410000 * 3 RDINTL BIT(1), /* BIT27 = 1 FOR INITIAL READ * 12420000 * 3 GSUPFS BIT(2), /* GENERAL SUPPORT FLAGS M2582 * 12430000 * 4 GPWDSP BIT(1), /* BIT 28 FOR GENL PSWD SP * 12440000 * 4 GACNSP BIT(1), /* BIT 29 FOR GENL ACTN SP * 12450000 * 3 STODON BIT(1), /* BIT30 = STOW DELETION M5522 * 12460000 * 3 DELEFR BIT(1), /* RESERVED FLAGS M5522 * 12470000 * NAMCTR FIXED(15), /* NAME LIST COUNTER * 12480000 * STRNGLN FIXED(15), /* LENGTH OF PSTRING * 12490000 * GOTMNP PTR(31), /* PTR TO GOTMAIN LIST * 12500000 * DPFLOC1 PTR(31), /* PTR TO 1ST PASSWORD OB * 12510000 * DAFLOC1 PTR(31), /* PTR TO 1ST ACCOUNT NNMBR * 12520000 * DRFLOC1 PTR(31), /* PTR TO 1ST PROCNAME OB * 12530000 * RTNCODE FIXED(31), /* RETURN CODE AREA M1859 * 12540000 * SAVGR0 PTR(31), /* SAVE AREA FOR REGISTER 0 * 12550000 * SAVGR1 PTR(31), /* SAVE AREA FOR REGISTER 1 * 12560000 * DBUFPTR PTR(31), /* PTR TO IMPORTED DATALIST * 12570000 * UDLSTP PTR(31), /* PTR TO LAST PREVIOUS UDL * 12580000 * UIDLAST PTR(31) /* LAST PREVIOUS ENTRY * 12590000 * BASED(UDLSTP), 12600000 * SOFFS PTR(15), /* RESERVE SEGMENT OFFSET * 12610000 * SPAREH PTR(15); /* RESERVED HALF WORD * 12620000 * 12630000 * DECLARE 12640000 * /* DOUBLE WORD AREA USED BY CVD INSTRUCTION * 12650000 * 1 DBLWORD BDY(DWORD) CHAR(8), /* NAME OF AREA * 12660000 * 2 DBLWD1 CHAR(4), /* FIRST WORD OF AREA * 12670000 * 2 DBLWD2 CHAR(4); /* SECOND WORD OF AREA * 12680000 * 12690000 * /* CREATE SUBPOOL IDENTIFIER * 12700000 * GENERATE DATA; 12710000 * 12720000 * DECLARE 12730000 * /* DEFINE NAME OF SUBPOOL IDENTIFIER * 12740000 * SPN1 GENERATED CHAR(4); 12750000 * 12760000 * DECLARE 12770000 * /* FIRST 8 BYTES OF NEW UDL * 12780000 * GOTMSPZ BIT(64) BASED(GOTMNP); 12790000 * 12800000 * /* CREATE MODEL PARAMETER LISTS, CONTROL BLOCKS * 12810000 * GENERATE DATA; 12820000 * 12830000 * DECLARE 12840000 * /* DEFINE NAMES OF MODEL PARM LISTS, CONTROL BLOCKS * 12850000 * PTPBKM GENERATED CHAR(40), /* FOR PUTLINE * 12860000 * PTPBKMM GENERATED CHAR(40), /* FOR PUTLINE * 12870000 * MPTLCPL GENERATED CHAR(48), /* FOR PUTLINE * 12880000 * MPRSCPL GENERATED CHAR(48); /* FOR PARSE * 12890000 * 12900000 * /* CREATE PARAMETER LISTS, CONTROL BLOCKS * 12910000 * GENERATE DATA; 12920000 * 12930000 * DECLARE 12940000 * /* DEFINE NAMES OF PARM LISTS, CONTROL BLOCKS * 12950000 * DPLBA GENERATED CHAR(121), /* FOR DPL SAVE * 12960000 * DPLBAB BIT(968) BASED(ADDR(DPLBA)),/* FOR CLEARING * 12970000 * DPLBS GENERATED CHAR(121), /* FOR DPL SAVE * 12980000 * NQOPN GENERATED CHAR(24), /* FOR OPEN ENQUEUE * 12990000 * NQMBR GENERATED CHAR(8), /* FOR MEMBER ENQUEUE * 13000000 * DQMBR GENERATED CHAR(8), /* FOR MEMBER DEQUEUE * 13010000 * DQOPN GENERATED CHAR(24), /* FOR OPEN DEQUEUE * 13020000 * DELDCB GENERATED CHAR(48), /* FOR DCB * 13030000 * DLCLSL GENERATED CHAR(24), /* FOR CLOSE * 13040000 * DLOPNL GENERATED CHAR(24), /* FOR OPEN * 13050000 * DDOPNL GENERATED CHAR(24), /* FOR OPEN * 13060000 * PTPBK GENERATED CHAR(40), /* FOR PUTLINE EXIT * 13070000 * PTLCPL GENERATED CHAR(48), /* FOR PUTLINE * 13080000 * PRSCPL GENERATED CHAR(48); /* FOR PARSE * 13090000 * 13100000 * DECLARE 13110000 * /* AREA FOR GETMAIN RESPONSE * 13120000 * GMAINA PTR(31); 13130000 * 13140000 * /* CREATE MASK FOR DCB * 13150000 * GENERATE DATA; 13160000 * 13170000 * GENERATE DATA; 13180000 * 13190000 * DECLARE 13200000 * /* READ/WRITE PARAMETER BLOCK * 13210000 * 1 RWPB BDY(WORD), /* NAME OF PARM BLOCK * 13220000 * 2 RWPBA BIT(192) BDY(WORD), /* AREA TO CLEAR * 13230000 * 3 RWPFGS BIT(8), /* CONTROL FLAGS * 13240000 * 4 RWPF1 BIT(1),/* 0 = LOGICAL MEMBER * 13250000 * /* 1 = SINGLE PHYSICAL MEMBER * 13260000 * 4 RWPF2 BIT(1),/* 0 = RWPNBR IS PTR TO MEMBER * 13270000 * /* NAME * 13280000 * /* 1 = RWPNBR IS PTR TO BLDL * 13290000 * /* ENTRY * 13300000 * 4 RWPF3 BIT(1),/* 0 = RWPWAP IS NONPERTINENT * 13310000 * /* 1 = RWPWAP IS PTR TO DIRWA * 13320000 * 4 RWPF4 BIT(1),/* 0 = BUFFER FOR EXISTING * 13330000 * /* BLOCKS * 13340000 * /* 1 = BUFFER FOR EXISTING * 13350000 * /* BLOCKS + 1 * 13360000 * 4 RWPF5 BIT(1),/* 0 = NOT WRITE REQUEST * 13370000 * /* 1 = WRITE REQUEST * 13380000 * 4 RWPF6 BIT(1),/* 0 = READ DIRECTORY AND MBR * 13390000 * /* 1 = READ DIRECTORY ONLY * 13400000 * 4 RWPF7 BIT(1),/* 0 = NO ENQ/DEQ * 13410000 * /* 1 = ENQ/DEQ REQUESTED * 13420000 * 4 RWPF8 BIT(1),/* RESERVED * 13430000 * 3 RWPUDP PTR(24),/* PTR TO UADS DCB * 13440000 * 3 RWPNBP PTR(31),/* PTR TO MEMBERNAME/BLDLENTRY * 13450000 * 3 RWPWAP PTR(31),/* PTR TO DIRECTORY WORK AREA * 13460000 * 3 RWPRBP PTR(31),/* PTR TO READ BLDL ENTRY * 13470000 * 3 RWPNOM PTR(8), /* NO OF MEMBERS READ/TO WRITE * 13480000 * 3 RWPBUF PTR(24),/* PTR TO BUFFER (EXCL DECB) * 13490000 * 3 RWPAPL PTR(31),/* PTR TO ACCOUNT PARM LIST * 13500000 * 4 RWPCHR CHAR(1),/* MODULE IDENTIFIER CHAR * 13510000 * 4 RWPARP PTR(24);/* PTR TO ACCOUNT PARM LIST * 13520000 * 13530000 * DECLARE 13540000 * /* MEMBER NAME CHARACTER STRING * 13550000 * RDNAMC CHAR(8) BASED(RWPNBP); 13560000 * 13570000 * DECLARE 13580000 * /* DIRECTORY WORK AREA FOR READ/WRITE ROUTINE * 13590000 * 1 DIRWA BDY(WORD), /* NAME OF AREA * 13600000 * 2 DIRDCB CHAR(88), /* BSAM DCB AREA (INPUT) * 13610000 * 2 DIRBLK CHAR(256);/* PDS DIRECTORY AREA * 13620000 * 13630000 * DECLARE 13640000 * /* NAME OF FIRST MEMBER IN UADS * 13650000 * RDNAMD CHAR(8) BASED(ADDR(DIRBLK)+2); 13660000 * 13670000 * DECLARE 13680000 * /* COMPARISON FACTORS IN DIRECTORY PROCESSING M * 13690000 * DIRBLKP PTR(31), /* PTR TO DIRECTORY ENTRY * 13700000 * DRBLASP PTR(31), /* PTR TO PREVIOUS ENTRY NAME * 13710000 * DIRBDAP PTR(31), /* PTR TO TEST ENTRY NAME * 13720000 * COMPNAM CHAR(8); /* CURRENT TEST NAME * 13730000 * 13740000 * DECLARE 13750000 * /* FIRST ENTRY IN DIRECTORY BLOCK M * 13760000 * 1 DIRBLKA BASED(ADDR(DIRBLK)) BDY(BYTE), /* NAME * 13770000 * 2 DIRBLNG CHAR(2), /*LENGTH OF BLOCK * 13780000 * 2 DIRBNAM1 CHAR(8), /* 1ST ENTRY NAME * 13790000 * 2 DIRBTTR1 CHAR(3), /* TTR OF 1ST MEMBER * 13800000 * 2 DIRBCA1 CHAR(1), /* COUNT OF USER AREA * 13810000 * 3 DIRBAL1 BIT(1), /* ALIAS FLAG M * 13820000 * 3 DIRBTT1 BIT(2), /* COUNT OF TTRNS M * 13830000 * 3 DIRBCB1 BIT(5); /* COUNT OF USER DATA M * 13840000 * 13850000 * DECLARE 13860000 * /* CURRENT TEST ENTRY IN DIRECTORY BLOCK M * 13870000 * 1 DIRBDA BDY(BYTE) BASED(DIRBDAP), /* NAME * 13880000 * 2 DIRBNAM CHAR(8), /* CURRENT TEST NAME * 13890000 * 2 DIRBTTR CHAR(3), /* TTR TO TEST ENTRY * 13900000 * 2 DIRBCA CHAR(1), /* COUNT OF USER AREA * 13910000 * 3 DIRBAL BIT(1), /* ALIAS FLAG M * 13920000 * 3 DIRBTT BIT(2), /* COUNT OF TTRNS M * 13930000 * 3 DIRBCB BIT(5); /* COUNT OF USER DATA M * 13940000 * 13950000 * DECLARE 13960000 * /* CURRENT PREVIOUS TEST ENTRY IN DIRECTORY M * 13970000 * 1 DRBLAS BDY(BYTE) BASED(DRBLASP), /* NAME * 13980000 * 2 DRBLNAM CHAR(8), /* PREVIOUS TEST NAME * 13990000 * 2 DRBLTTR CHAR(3), /* TTR TO PREVIOUS ENTRY * 14000000 * 2 DRBLC CHAR(1), /* COUNT OF USER AREA * 14010000 * 3 DRBLAL BIT(1), /* ALIAS FLAG M * 14020000 * 3 DRBLTT BIT(2), /* COUNT OF TTRNS M * 14030000 * 3 DRBLCB BIT(5); /* COUNT OF USER DATA M * 14040000 * 14050000 * DECLARE 14060000 * /* LOCATION TO ISOLATE USER DATA COUNT M * 14070000 * 1 DIRBCAX BDY(BYTE), /* NAME OF AREA M * 14080000 * 2 DIRBTX BIT(3), /* ZERO AREA M * 14090000 * 2 DIRBCX BIT(5); /* VALUE AREA M * 14100000 * 14110000 * DECLARE 14120000 * /* ARITHMETIC VALUE OF USER DATA COUNT M * 14130000 * DIRBC PTR(8) BASED(ADDR(DIRBCAX)); /* VALUE M * 14140000 * 14150000 * DECLARE 14160000 * /* PARSE INPUT P P PARAMETER LIST MASK * 14170000 * 1 PARSNPL BASED(R1), /* NAME OF INPUT PARM LIST * 14180000 * 2 PARSNL1 PTR(31), /* PTR TO PDE * 14190000 * 2 PARSNL2 PTR(31), /* PTR TO DELETE BASE PTRS * 14200000 * 2 PARSNL3 PTR(31); /* PTR TO 2ND LEVEL MESSAGE * 14210000 * /* M2582 * 14220000 * 14230000 * DECLARE 14240000 * /* PARAMETER LIST PASSED TO PARSE EXIT ROUTINE * 14250000 * 1 DELPRMS BASED(PARSNL2), /* NAME OF PARAMETER AREA * 14260000 * 2 DLPRM1 PTR(31), /* DELETE BASE PTR * 14270000 * 2 DLPRM2 PTR(31); /* DELETE RENT AREA PTR * 14280000 * 14290000 * 14300000 * DECLARE 14310000 * /* TEST CHARACTER IN PSTRING * 14320000 * PSCHAR CHAR(1) BASED(CHRPTR); 14330000 * 14340000 * 14350000 * 14360000 * DECLARE 14370000 * /* DEFINE NAME OF FLAG FIELD IN DCB * 14380000 * DCBOFLGS GENERATED LABEL; 14390000 * 14400000 * DECLARE 14410000 * /* DCB FLAGS USED BY OPEN * 14420000 * 1 DCBFLGS BASED(ADDR(DCBOFLGS)), 14430000 * 2 * BIT(3), /* SPACER * 14440000 * 2 DCBOFLG BIT(1); /* 1 = SUCCESSFUL OPEN * 14450000 * 14460000 * 14470000 * DECLARE 14480000 * /* ENQUEUE NAMES FOR OPEN * 14490000 * EQNAM1 CHAR(8) INIT('SYSIKJUA'),/* MAJOR RESOURCE * 14500000 * ERNAM1 CHAR(8) INIT('OPENUADS');/* MINOR RESOURCE * 14510000 * 14520000 * DECLARE 14530000 * /* ACCOUNT-TO-SUBCP PARAMETER LIST * 14540000 * 1 ACCTPL BDY(WORD) /* NAME OF PARM LIST * 14550000 * BASED(SAVGR1), 14560000 * 2 AUPTP PTR(31), /* PTR TO CURRENT UPT * 14570000 * 2 AECTP PTR(31), /* PTR TO ENVIRONMENT CT * 14580000 * 2 AECBP PTR(31), /* PTR TO ACCOUNT EVENT CB * 14590000 * 2 ACBFP PTR(31), /* PTR TO ACCOUNT COMMAND BUFR * 14600000 * 2 ARESP PTR(31); /* PTR TO RESPONSE AREA * 14610000 * 14620000 * DECLARE 14630000 * /* ACCOUNT COMMUNICATIONS ECB * 14640000 * 1 ACCTECB BDY(WORD) /* NAME OF ECB AREA * 14650000 * BASED(AECBP), 14660000 * 2 ECBCODE PTR(31), /* COMPLETION CODE AREA * 14670000 * 3 ECBWT BIT(1), /* BIT0 = 1 FOR WAITING * 14680000 * 3 ECBCPL BIT(1); /* BIT1 = 1 FOR COMPLETE * 14690000 * 14700000 * DECLARE 14710000 * /* STAE PARAMETER LIST * 14720000 * 1 STAEPL1, /* NAME OF STAE PARM LIST * 14730000 * 2 STAPRM1 PTR(31),/* DEL CODE BASE PTR (11) * 14740000 * 2 STAPRM2 PTR(31),/* RENT DATA PTR (12) * 14750000 * 2 STAPRM3 PTR(31),/* 2ND DEL2 CODE BASE PTR (7) * 14760000 * 2 STAPRM4 PTR(31),/* STATIC DATA BASE PTR (8) * 14770000 * 2 STAPRM5 PTR(31);/* DEL2 CODE BASE PTR (9) * 14780000 * 14790000 * DECLARE 14800000 * /* STAE INPUT P P PARAMETER LIST * 14810000 * 1 STAENPL BASED(R2), /* NAME OF LIST * 14820000 * 2 STAENL1 PTR(31), /* ACCOUNT CODE BASE PTR * 14830000 * 2 STAENL2 PTR(31); /* ACCOUNT RENT BASE PTR * 14840000 * 14850000 * DECLARE 14860000 * /* AREA FOR SERVICE ROUTINE PARAMETER LIST * 14870000 * 1 PLOUT BDY(WORD), /* NAME OF PARM LIST AREA * 14880000 * 2 PLOUTA CHAR(12), /* AREA FOR COMMON POINTERS * 14890000 * 2 PLOUTB CHAR(4), /* AREA FOR INDIVIDUAL DATA * 14900000 * 2 PLOUTC CHAR(8), /* AREA FOR INDIVIDUAL DATA * 14910000 * 3 PLOUTZ BIT(64); /* NAME FOR CLEARING * 14920000 * 14930000 * DECLARE 14940000 * /* SET BASE POINTERS MODEL AREA * 14950000 * 1 BASPTRS, /* NAME OF MODEL PTR AREA * 14960000 * 2 BASUPTP PTR(31),/* PTR TO CURRENT UPT * 14970000 * 2 BASECTP PTR(31),/* PTR TO CURRENT ECT * 14980000 * 2 BASECBP PTR(31),/* PTR TO CURRENT CP ECB * 14990000 * 2 BASEBFP PTR(31),/* PTR TO ACCOUNT COMMAND BUFR * 15000000 * 2 BASERSP PTR(31);/* PTR TO RESPONSE AREA * 15010000 * DECLARE 15020000 * /* PTR TO ENVIRONMENT CONTROL TABLE * 15030000 * ECTPTR PTR(31) BASED(ADDR(BASECTP)); 15040000 * 15050000 ** DECLARE 15060000 ** 1 ECT BASED(ECTPTR), 15070000 ** /* *************************************************************** * 15080000 ** /* THE ENVIRONMENT CONTROL TABLE (ECT) IS BUILT BY THE TMP AND * 15090000 ** /* STORED IN A NON-SHARED SUBPOOL. ITS FIELDS CAN BE MODIFIED * 15100000 ** /* BY A CP OR SERVICE RTN BUT NOT FREED. * 15110000 ** /* *************************************************************** * 15120000 ** 15130000 ** 2 ECTRCDF CHAR(1), /* HIGH ORDER BIT INDICATES CP 15140000 ** ABENDED * 15150000 ** 2 ECTRTCD PTR(24), /* RETURN CODE FROM LAST CP OR 15160000 ** ABEND CODE IF ECTRCDF IS SET * 15170000 ** 2 ECTIOWA PTR(31), /* ADDR I/O SRV RTNS WORK AREA * 15180000 ** 2 ECTMSGF CHAR(1), /* HIGH ORDER BIT SET MEANS 15190000 ** DELETE SECOND LEVEL MSG * 15200000 ** 2 ECTSMSG PTR(24) BDY(BYTE), 15210000 ** /* ADDR OF SECOND LEVEL MSG 15220000 ** CHAIN * 15230000 ** 2 ECTPCMD CHAR(8), /* PRIMARY COMMAND NAME * 15240000 ** 2 ECTSCMD CHAR(8), /* SUBCOMMAND NAME * 15250000 ** 2 ECTSWS CHAR(1), /* 4 BYTES OF SWITCHES * 15260000 ** 3 ECTNOPD BIT(1), /* 0 BIT ON= NO OPERANDS EXIST 15270000 ** IN CMD BUFFER * 15280000 ** 3 * BIT(1), /* RESERVED * 15290000 ** 3 ECTATRM BIT(1), /* CP TERMINATED BY TMP DETACH 15300000 ** W/ STAE EQU * 15310000 ** 3 ECTLOGF BIT(1), /* LOGON/OFF REQUESTED TMP TO 15320000 ** LOGOFF USER BITS * 15330000 ** 3 ECTNMAL BIT(1), /* NO USER MSGS TO BE RECVED AT 15340000 ** LOGON * 15350000 ** 3 ECTNNOT BIT(1), /* NO BRDCST NOTICES TO BE RECVED 15360000 ** LOGON * 15370000 ** 3 * BIT(1), /* RESERVED * 15380000 ** 3 * BIT(1), /* RESERVED * 15390000 ** 2 ECTDDNUM PTR(24), /*COUNTER FOR TEMPORARY DDNAMES * 15400000 ** 2 ECTUSER PTR(31), /*RESERVED FOR INSTALLATION USE * 15410000 ** 2 * PTR(31); /*RESERVED * 15420000 ** 15430000 * 15440000 * 15450000 * 15460000 * DECLARE 15470000 * /* AREA FOR OUTPUT PARAMETER BLOCK * 15480000 * 1 PBOUT CHAR(20) BDY(WORD); 15490000 * 15500000 * DECLARE 15510000 * /* COMMAND BUFFER ACTION AREA * 15520000 * 1 NUCBUFN /* NAME OF BUFFER AREA * 15530000 * BASED(ACBFP) BDY(WORD), 15540000 * 2 NUCBUF CHAR(512) BDY(HWORD),/* NAME OF BUFFER * 15550000 * 3 NUCBFHD CHAR(4) BDY(HWORD), /* HEADER AREA * 15560000 * 4 NUCBFLN PTR(15),/* LENGTH OF BUFFER * 15570000 * 4 NUCBFOF PTR(15),/* OFFSET TO CURRENT SCAN * 15580000 * 3 NUCBFST CHAR(508); /* CHARACTER STRING AREA * 15590000 * 15600000 * DECLARE 15610000 * 1 GMBLN PTR(15), /* GETMAIN BUFFER LENGTH * 15620000 * 2 GMBLNB BIT(16); /* NAME FOR DBL WORD ROUNDING * 15630000 * 15640000 * DECLARE 15650000 * /* PARAMETER LIST FOR PUTLINE * 15660000 * 1 PUTLPL BASED(ADDR(PLOUT)), /* NAME OF PARM LIST * 15670000 * 2 PLPLUPT PTR(31), /* PTR TO UPT * 15680000 * 2 PLPLECT PTR(31), /* PTR TO ECT * 15690000 * 2 PLPLECB PTR(31), /* PTR TO ACCOUNT ECB * 15700000 * 2 PLPLPBK PTR(31); /* PTR TO PUTLINE PARM BLOCK * 15710000 * DECLARE 15720000 * /* PTR TO PUTLINE PARAMETER BLOCK * 15730000 * PTPBPTR PTR(31); 15740000 * 15750000 ** DECLARE 15760000 ** 1 PTPB BASED(PTPBPTR), 15770000 ** /* *************************************************************** * 15780000 ** /* THE PUTLINE PARAMETER BLOCK (PTPB) IS POINTED TO BY THE PARAM. * 15790000 ** /* LIST PASSED TO PUTLINE. IT IS USED TO RETURN PERTINENT INFO. * 15800000 ** /* AS WELL AS CONTROL PUTLINE FUNCTIONS * 15810000 ** /* *************************************************************** * 15820000 ** 15830000 ** 15840000 ** 15850000 ** 15860000 ** 15870000 ** 15880000 ** 15890000 ** 15900000 ** 15910000 ** 15920000 ** 15930000 ** 2 * CHAR(4) BDY(WORD), 15940000 ** /* INTERNAL PUTLINE USAGE * 15950000 ** 2 PTPBOPUT PTR(31), /* ADDRESS OF OUTPUT LINE 15960000 * DESCRIPTOR OR DATA LINE * 15970000 ** 2 PTPBFLN PTR(31); /* PTR TO FORMATTED LINE 15980000 ** RETURNED WHEN OUTPUT= 15990000 ** ADDR,FORMAT) IS SPECIFIED * 16000000 ** 16010000 * DECLARE 16020000 * /* PTR TO PARSE PARAMETER LIST * 16030000 * PPLPTR PTR(31); 16040000 * 16050000 ** DECLARE 16060000 ** 1 PPL BASED(PPLPTR), 16070000 ** /* *************************************************************** * 16080000 ** /* THE PARSE PARAMETER LIST (PPL) IS A LIST OF ADDRESSES PASSED * 16090000 ** /* FROM THE INVOKER TO PARSE VIA REGISTER 1 * 16100000 ** /* *************************************************************** * 16110000 ** 16120000 ** 16130000 ** 16140000 ** 16150000 ** 16160000 ** 16170000 ** 16180000 ** 16190000 ** 16200000 ** 16210000 ** 2 PPLUPT PTR(31), /* PTR TO UPT * 16220000 ** 2 PPLECT PTR(31), /* PTR TO ECT * 16230000 ** 2 PPLECB PTR(31), /* PTR TO CP'S ECB * 16240000 ** 2 PPLPCL PTR(31), /* PTR TO PCL * 16250000 ** 2 PPLANS PTR(31), /* PTR TO ANS PLACE * 16260000 ** 2 PPLCBUF PTR(31), /* PTR TO CMD BUFFER * 16270000 ** 2 PPLUWA PTR(31); /* PTR TO USER WORK AREA (FOR 16280000 ** VALIDITY CK RTNS) * 16290000 ** 16300000 * 16310000 ** DECLARE 16320000 ** 1 IOPL BASED(IOPLPTR), 16330000 ** /* *************************************************************** * 16340000 ** /* THE I/O SERVICE ROUTINE PARAMETER LIST (IOPL) IS A LIST OF * 16350000 ** /* FULLWORD ADDRESSES PASSED BY THE INVOKER OF ANY I/O SERVICE * 16360000 ** /* ROUTINE TO THE APPROPRIATE SERVICE ROUTINE VIA REGISTER ONE. * 16370000 ** /* *************************************************************** * 16380000 ** 16390000 ** 16400000 ** 16410000 ** 16420000 ** 16430000 ** 16440000 ** 16450000 ** 16460000 ** 16470000 ** 16480000 ** 2 IOPLUPT PTR(31), /* PTR TO UPT * 16490000 ** 2 IOPLECT PTR(31), /* PTR TO ECT * 16500000 ** 2 IOPLECB PTR(31), /* PTR TO USER'S ECB * 16510000 ** 2 IOPLIOPB PTR(31); /* PTR TO THE I/O SERVICE RTN PARM BLOCK * 16520000 ** 16530000 * 16540000 * DECLARE 16550000 * /* PARAMETER LIST FOR PARSE * 16560000 * PPLSP CHAR(LENGTH(PPL)); 16570000 * 16580000 * DECLARE 16590000 * /* DEFINE PARAMETER LIST FOR CLEARING * 16600000 * PPLB BIT(LENGTH(PPL)) BASED(ADDR(PPLSP)); 16610000 * 16620000 * DECLARE 16630000 * /* RESERVE LENGTH AND OFFSET OF COMMAND BUFFER * 16640000 * 1 CBHDSAV, /* NAME OF HEADER SAVE AREA * 16650000 * 2 CBHDSV1 CHAR(4) /* COMMAND SCAN RESULTANT * 16660000 * BDY(HWORD), 16670000 * 3 HDSVL1 PTR(15), /* BUFFER LENGTH * 16680000 * 3 HDSVO1 PTR(15); /* CURRENT SAVE * 16690000 * DECLARE 16700000 * /* RESERVE LENGTH AND OFFSET OF COMMAND BUFFER * 16710000 * CBHDSV2 CHAR(4); /* FOR NODELIST SCAN * 16720000 * 16730000 * 16740000 * DECLARE 16750000 * /* AREAS USED IN PARSING COMMAND ENTRIES * 16760000 * 1 PARSARS BIT(320) BDY(WORD), /* PARSE AREAS NAME * 16770000 * /* RESERVE SPACE FOR PDE BLOCKS * 16780000 * 2 PDESPAZ BIT(192) BDY(WORD), /* NAME OF AREA * 16790000 * 3 NODEID CHAR(8) BDY(WORD), /* USERID PDE * 16800000 * 4 NODIDP PTR(31),/* PTR TO NAME * 16810000 * 4 NODIDL FIXED(15),/* LENGTH OF NAME * 16820000 * 4 NODIDF BIT(8), /* FLAGS * 16830000 * 4 NODIDR BIT(8), /* RESERVED * 16840000 * 3 NODEPW CHAR(8) BDY(WORD), /* PASSWORD PDE * 16850000 * 4 NODPWP PTR(31),/* PTR TO NAME * 16860000 * 4 NODPWL FIXED(15),/* LENGTH OF NAME * 16870000 * 4 NODPWF BIT(8), /* FLAGS * 16880000 * 4 NODPWR BIT(8), /* RESERVED * 16890000 * 3 NODEAN CHAR(8) BDY(WORD), /* ACCT NUMBER PDE * 16900000 * 4 NODANP PTR(31),/* PTR TO NAME * 16910000 * 4 NODANL FIXED(15),/* LENGTH OF NAME * 16920000 * 4 NODANF BIT(8), /* FLAGS * 16930000 * 4 NODANR BIT(8), /* RESERVED * 16940000 * /* SAVE AREAS FOR PARSE RESPONSE PTRS * 16950000 * 2 PARSRSP BIT(128) BDY(WORD), /* RESPONSE AREAS* 16960000 * 3 CMDRPTR PTR(31), /* PTR TO COMMAND REPLY * 16970000 * 3 NDRPTRA PTR(31), /* PTR TO NODELIST REPLY * 16980000 * 3 RESPONS PTR(31), /* PTR TO ITEM REPLY * 16990000 * 3 DATRPTR PTR(31); /* PTR TO DATALIST REPLY * 17000000 * 17010000 * 17020000 * DECLARE 17030000 * /* AREAS FOR ENTRY PDE NAME * 17040000 * 1 NODLNMS, /* NAME OF AREAS * 17050000 * 2 NODIDC CHAR(8), /* USERID AREA * 17060000 * 3 NODIDC1 CHAR(1), /* 1ST CHAR OF USERID * 17070000 * 3 NODIDCR CHAR(7), /* REMAINING 7 CHARACTERS * 17080000 * 2 NODPWC CHAR(8), /* PASSWORD AREA * 17090000 * 2 NODANC CHAR(40),/* ACCOUNT NUMBER AREA * 17100000 * 2 NODPNC CHAR(8); /* PROCEDURE NAME AREA * 17110000 * 17120000 * DECLARE 17130000 * /* PTR TO DATA LIST PDE * 17140000 * DATLOC PTR(31); 17150000 * 17160000 * DECLARE 17170000 * /* RESPONSE AREAS FOR PARSE * 17180000 * PARESPA CHAR(4) BDY(WORD), /* FOR NODELIST SCAN * 17190000 * PARESPB CHAR(4) BDY(WORD); /* FOR DATALIST SCAN * 17200000 * 17210000 * 17220000 * DECLARE 17230000 * /* PARSE ELEMENT NAMES * 17240000 * DELCMD GENERATED LABEL, 17250000 * NODELST GENERATED LABEL, 17260000 * DATALST GENERATED LABEL, 17270000 * DATLST GENERATED LABEL, 17280000 * DATITM GENERATED LABEL, 17290000 * NDLSTPA GENERATED LABEL, 17300000 * NODEIDP GENERATED LABEL, 17310000 * NODEPWP GENERATED LABEL, 17320000 * NODEANP GENERATED LABEL, 17330000 * NDLSTIA GENERATED LABEL, 17340000 * NODEIDM GENERATED CHAR(8), 17350000 * NDLSTI2 GENERATED LABEL, 17360000 * NODEPWM GENERATED CHAR(8), 17370000 * NDEPWAM GENERATED CHAR(8), 17380000 * NDLSTI3 GENERATED LABEL, 17390000 * NODEANM GENERATED CHAR(8), 17400000 * NDEANAM GENERATED CHAR(8), 17410000 * NDLSTIAS GENERATED LABEL, 17420000 * NODEIDMS GENERATED CHAR(8), 17430000 * NDLSTI2S GENERATED LABEL, 17440000 * NODEPWMS GENERATED CHAR(8), 17450000 * NDLSTI3S GENERATED LABEL, 17460000 * NODEANMS GENERATED CHAR(8), 17470000 * PRSDPW GENERATED LABEL, 17480000 * DATPW GENERATED LABEL, 17490000 * PRSDAN GENERATED LABEL, 17500000 * DATAN GENERATED LABEL, 17510000 * PRSDPN GENERATED LABEL, 17520000 * DATPN GENERATED LABEL; 17530000 * 17540000 * DECLARE 17550000 * /* PTRS TO FORCE CODE WITH ADDRESSING CAPABILITY TO PCLS * 17560000 * DELCMDP PTR(31) INIT(ADDR(DELCMD)), 17570000 * NLSTIPP PTR(31) INIT(ADDR(NDLSTPA)), 17580000 * NLSTIASP PTR(31) INIT(ADDR(NDLSTIAS)), 17590000 * NLSTIAP PTR(31) INIT(ADDR(NDLSTIA)), 17600000 * NLSTI2SP PTR(31) INIT(ADDR(NDLSTI2S)), 17610000 * NLSTI2P PTR(31) INIT(ADDR(NDLSTI2)), 17620000 * NLSTI3SP PTR(31) INIT(ADDR(NDLSTI3S)), 17630000 * NLSTI3P PTR(31) INIT(ADDR(NDLSTI3)), 17640000 * PRSDPWP PTR(31) INIT(ADDR(PRSDPW)), 17650000 * PRSDANP PTR(31) INIT(ADDR(PRSDAN)), 17660000 * PRSDPNP PTR(31) INIT(ADDR(PRSDPN)); 17670000 * 17680000 * 17690000 * DECLARE 17700000 * /* DATA LIST PDE MASK * 17710000 * 1 CMDDID BASED(DATLOC), /* NAME OF DATA LIST * 17720000 * 2 CMDDNMP PTR(31), /* PTR TO CHARACTER STRING * 17730000 * 2 CMDDLNG PTR(15), /* LENGTH OF CHAR STRING * 17740000 * 2 CMDDFLG CHAR(1), /* FLAGS * 17750000 * 3 CMDDFL1 BIT(1), /* 1 = PARAMETER ENTERED * 17760000 * /* 0 = NO PARM ENTERED * 17770000 * 3 CMDDFRS BIT(7), /* RESERVED FLAGS * 17780000 * 2 CMDDRES BIT(8); /* RESERVED * 17790000 * 17800000 * DECLARE 17810000 * /* DATA LIST IMPORT BUFFER MASK * 17820000 * 1 DBUF BASED(DBUFPTR), /* NAME OF MASK * 17830000 * 2 DBUFLNG PTR(15), /* LENGTH OF BUFFER * 17840000 * 2 DBUFOFF PTR(15), /* TEXT OFFSET * 17850000 * 2 DBUFLHP CHAR(1), /* SPACE FOR LEFT PAREND * 17860000 * 2 DBUFTXT CHAR(32767); /* TEXT AREA * 17870000 * 17880000 * DECLARE 17890000 * /* DATA LIST CHARACTER STRING FROM PARSE * 17900000 * CMDDNMC CHAR(32762) BASED(CMDDNMP); 17910000 * 17920000 * DECLARE 17930000 * /* STANDARD DATALIST IMPORT BUFFER * 17940000 * 1 NUDBUF, /* NAME OF NEW DATALIST BUFFER * 17950000 * 2 NUDBLNG PTR(15), /* LENGTH OF BUFFER * 17960000 * 2 NUDBLP CHAR(1), /* SPACE FOR LEFT PAREND * 17970000 * 2 NUDBTXT CHAR(257); /* TEXT AREA * 17980000 * /* C L A S S I N I T I A L P O I N T E R C H A I N * 17990000 * 18000000 * DECLARE 18010000 * /* INITIAL PASSWORD OFFSET BLOCK * 18020000 * 1 PSWD1OB BDY(WORD) /* NAME OF BLOCK * 18030000 * BASED(DPFLOC1), 18040000 * 2 PSWD1XC CHAR(4), /* END OF CHAIN CHECK * 18050000 * 3 PSWD1FL CHAR(1), /* FLAG AREA * 18060000 * 4 PSWD1F1 BIT(1), /* ..0 -- CONTINUE CHAIN * 18070000 * /* ..1 -- LAST PASSWD * 18080000 * 3 PSWD1XP PTR(24) /* PTR TO NEXT PASSWD OFS * 18090000 * BDY(BYTE), 18100000 * 2 PSWD1SP PTR(31), /* PTR TO FIRST ACCTNMBR * 18110000 * 2 PSWD1DP PTR(31); /* PTR TO PASSWORD DATA * 18120000 * 18130000 * DECLARE 18140000 * /* INITIAL ACCOUNT NUMBER OFFSET BLOCK * 18150000 * 1 ACTN1OB BDY(WORD) /* NAME OF BLOCK * 18160000 * BASED(DAFLOC1), 18170000 * 2 ACTN1XC CHAR(4), /* END OF CHAIN CHECK * 18180000 * 3 ACTN1FL CHAR(1), /* FLAG AREA * 18190000 * 4 ACTN1F1 BIT(1), /* ..0 -- CONTINUE CHAIN * 18200000 * /* ..1 -- LAST ACCTNMBR * 18210000 * /* .....FOR THE CURRENT * 18220000 * /* .....PASSWORD * 18230000 * 3 ACTN1XP PTR(24) /* PTR TO NEXT ACCTNMBR * 18240000 * BDY(BYTE), 18250000 * 2 ACTN1SP PTR(31), /* PTR TO FIRST PROCNAME * 18260000 * 2 ACTN1DP PTR(31); /* PTR TO ACCTNMBR DATA * 18270000 * 18280000 * DECLARE 18290000 * /* INITIAL PROCEDURE NAME OFFSET BLOCK * 18300000 * 1 PRNM1OB BDY(WORD) /* NAME OF BLOCK * 18310000 * BASED(DRFLOC1), 18320000 * 2 PRNM1XC CHAR(4), /* END OF CHAIN CHECK * 18330000 * 3 PRNM1FL CHAR(1), /* FLAG AREA * 18340000 * 4 PRNM1F1 BIT(1), /* ..0 -- CONTINUE CHAIN * 18350000 * /* ..1 -- LAST PROCNAME * 18360000 * /* .....FOR THE CURRENT * 18370000 * /* .....ACCOUNT NUMBER * 18380000 * 3 PRNM1XP PTR(24)/* PTR TO NEXT PROCNAME * 18390000 * BDY(BYTE), 18400000 * 2 PRNM1SP PTR(31), /* RESERVED * 18410000 * 2 PRNM1DP PTR(31); /* PTR TO PROCNAME DATA * 18420000 * 18430000 * DECLARE 18440000 * /* PTR TO INITIAL OFFSET CHAIN POINTER * 18450000 * DCHNP PTR(31); 18460000 * 18470000 * DECLARE 18480000 * /* PTR TO CURRENT DELETE OFFSET BLOCK * 18490000 * DELOP PTR(31), 18500000 * /* PTR TO NEXT DELETE OFFSET BLOCK * 18510000 * TSTOP PTR(31); 18520000 * 18530000 * DECLARE 18540000 * /* PARAMETER BLOCK FOR GETSPACE/FREESPACE ROUTINE * 18550000 * 1 SPAZPB BDY(WORD), /* NAME OF BLOCK * 18560000 * 2 SPZBUFP PTR(31), /* PTR TO MEMBER (BUFFER) * 18570000 * 2 SPZBLKN FIXED(15), /* NMBR OF EXTENSION BLOCKS * 18580000 * 2 SPZBLNG FIXED(15), /* LENGTH OF SPACE INVOLVED * 18590000 * 2 SPZBLOC PTR(31); /* MEMBER BLOCK OFFSET TO: * 18600000 * /* 1, SPACE SUPPLIED * 18610000 * /* (RESPONSE FROM GETSPACE)* 18620000 * /* 2, SPACE TO FREE * 18630000 * /* (REQUEST TO FREESPACE) * 18640000 * 18650000 * DECLARE 18660000 * /* RESERVE PARAMETER TO FREE DATA BLOCK * 18670000 * 1 SPZBLCA BDY(WORD), /* NAME OF AREA M1850 * 18680000 * 2 SPZBLCD PTR(31), /* LOCATION OF DATA M1850 * 18690000 * 2 SPZBLGD PTR(15); /* LENGTH OF DATA BLOCK M1850 * 18700000 * 18710000 * DECLARE 18720000 * /* PTR TO LAST PREVIOUS OB * 18730000 * LASTOP PTR(31); 18740000 * 18750000 * DECLARE 18760000 * /* PTR TO READ/WRITE PARM BLOCK * 18770000 * RWPBP PTR(31); 18780000 * 18790000 * DECLARE 18800000 * /* POINTERS FOR MESSAGE AREA ADDRESSING * 18810000 * MSGNO PTR(15), /* NO OF CURRENT MESSAGE * 18820000 * MOFFNO PTR(31), /* PTR TO MESSAGE OFFSET INDEX * 18830000 * MOFFNC PTR(15) /* CURRENT MESSAGE TEXT OFFSET * 18840000 * BASED(MOFFNO), 18850000 * MSGPTR PTR(31); /* CURRENT MESSAGE TEXT ADR * 18860000 * 18870000 * DECLARE 18880000 * /* MESSAGE BUFFER FORMAT * 18890000 * 1 MSGBUFM BASED(MSGPTR), /* NAME OF MESSAGE BUFFER * 18900000 * 2 MSGBLG PTR(15), /* LENGTH OF MESSAGE * 18910000 * 2 MSGBUF PTR(15), /* TEXT OFFSET * 18920000 * 2 MSGTXT CHAR(1); /* INITIAL MESSAGE CHARACTER * 18930000 * 18940000 * DECLARE 18950000 * /* SINGLE LEVEL MESSAGE POINTER AREA MASK * 18960000 * 1 TMXMDL /* NAME OF MASK * 18970000 * BASED(MSGPTR), 18980000 * 2 TMXMN PTR(31), /* NUMBER OF MESSAGE SEGMENTS * 18990000 * 2 TMXMP1 PTR(31), /* PTR TO 1ST SEGMENT * 19000000 * 2 TMXMP2 PTR(31), /* PTR TO 2ND SEGMENT * 19010000 * 2 TMXMP3 PTR(31), /* PTR TO 3RD SEGMENT * 19020000 * 2 TMXMP4 PTR(31), /* PTR TO 4TH SEGMENT * 19030000 * 2 TMXMP5 PTR(31); /* PTR TO 5TH SEGMENT * 19040000 * 19050000 * DECLARE 19060000 * /* SUBSEQUENT MESSAGE SEGMENT MASKS * 19070000 * TMSMT1 CHAR(148) /* AREA FOR SEGMENT 1 * 19080000 * BASED(TMXMP1), 19090000 * TMSMT2 CHAR(148) /* AREA FOR SEGMENT 2 * 19100000 * BASED(TMXMP2), 19110000 * TMSMT3 CHAR(148) /* AREA FOR SEGMENT 3 * 19120000 * BASED(TMXMP3), 19130000 * TMSMT4 CHAR(148) /* AREA FOR SEGMENT 4 * 19140000 * BASED(TMXMP4), 19150000 * TMSMT5 CHAR(148) /* TEXT OF MSG SEGMENT 5 * 19160000 * BASED(TMXMP5); 19170000 * 19180000 * 19190000 * DECLARE 19200000 * /* AREA FOR FIRST ACTIVE MESSAGE PARAMETER LIST * 19210000 * /* FUNCTION DESCRIPTION FOR * 19220000 * /* SINGLE LEVEL MESSAGE OR / * 19230000 * /* MULTILEVEL MESSAGE * 19240000 * 1 TMSGNS1 BDY(WORD), /* NAME OF AREA * 19250000 * 2 TMSGNNO1 PTR(31),/* NUMBER OF SEGMENTS / * 19260000 * /* PTR TO NEXT LEVEL * 19270000 * 2 TMSGNP10 PTR(31),/* PTR TO 1ST SEGMENT / * 19280000 * /* NUMBER OF SEGMENTS * 19290000 * 2 TMSGNP12 PTR(31),/* PTR TO 2ND SEGMENT / * 19300000 * /* PTR TO 1ST SEGMENT * 19310000 * 2 TMSGNP13 PTR(31),/* PTR TO 3RD SEGMENT / * 19320000 * /* PTR TO 2ND SEGMENT * 19330000 * 2 TMSGNP14 PTR(31),/* PTR TO 4TH SEGMENT / * 19340000 * /* PTR TO 3RD SEGMENT * 19350000 * 2 TMSGNP15 PTR(31),/* PTR TO 5TH SEGMENT / * 19360000 * /* PTR TO 4TH SEGMENT * 19370000 * 2 TMSGNP16 PTR(31);/* PTR TO 6TH SEGMENT / * 19380000 * /* PTR TO 5TH SEGMENT * 19390000 * 19400000 * DECLARE 19410000 * /* AREA FOR SECOND ACTIVE MESSAGE PARAMETER LIST * 19420000 * /* FUNCTION DESCRIPTION FOR * 19430000 * /* SINGLE LEVEL MESSAGE OR / * 19440000 * /* MULTILEVEL MESSAGE * 19450000 * 1 TMSGNS2 BDY(WORD), /* NAME OF AREA * 19460000 * 2 TMSGNNO2 PTR(31),/* NUMBER OF SEGMENTS / * 19470000 * /* PTR TO NEXT LEVEL * 19480000 * 2 TMSGNP21 PTR(31),/* PTR TO 1ST SEGMENT / * 19490000 * /* NUMBER OF SEGMENTS * 19500000 * 2 TMSGNP22 PTR(31),/* PTR TO 2ND SEGMENT / * 19510000 * /* PTR TO 1ST SEGMENT * 19520000 * 2 TMSGNP23 PTR(31),/* PTR TO 3RD SEGMENT / * 19530000 * /* PTR TO 2ND SEGMENT * 19540000 * 2 TMSGNP24 PTR(31),/* PTR TO 4TH SEGMENT / * 19550000 * /* PTR TO 3RD SEGMENT * 19560000 * 2 TMSGNP25 PTR(31),/* PTR TO 5TH SEGMENT / * 19570000 * /* PTR TO 4TH SEGMENT * 19580000 * 2 TMSGNP26 PTR(31);/* PTR TO 6TH SEGMENT / * 19590000 * /* PTR TO 5TH SEGMENT * 19600000 * 19610000 * DECLARE 19620000 * /* AREA FOR FIRST ACTIVE MESSAGE INSERT SEGMENT * 19630000 * 1 TMSGTIX1 BDY(HWORD),/* NAME OF SEGMENT AREA * 19640000 * 2 TMSGTIL1 PTR(15),/* SEGMENT TEXT LENGTH * 19650000 * 2 TMSGTIO1 PTR(15),/* SEGMENT TEXT OFFSET * 19660000 * 2 TMSGTIN1 CHAR(146); /* INSERT TEXT AREA * 19670000 * DECLARE 19680000 * /* AREA FOR SECOND ACTIVE MESSAGE INSERT SEGMENT * 19690000 * 1 TMSGTIX2 BDY(HWORD),/* NAME OF SEGMENT AREA * 19700000 * 2 TMSGTIL2 PTR(15),/* SEGMENT TEXT LENGTH * 19710000 * 2 TMSGTIO2 PTR(15),/* SEGMENT TEXT OFFSET * 19720000 * 2 TMSGTIN2 CHAR(146); /* INSERT TEXT AREA * 19730000 * 19740000 * DECLARE 19750000 * /* AREA FOR ERROR CODE IMAGE * 19760000 * MSGCDE CHAR(4) BASED(ADDR(TMSGTIN1)); /* M1859 * 19770000 * 19780000 * DECLARE 19790000 * /* MULTISEGMENT MESSAGE FORMAT * 19800000 * /* MESSAGE SEGMENT 1 MASK * 19810000 * 1 TMS1MDL /* NAME OF MASK * 19820000 * BASED(TMXMP1), 19830000 * 2 TMS1ML PTR(15), /* LENGTH OF TEXT * 19840000 * 2 TMS1MO PTR(15), /* TEXT OFFSET * 19850000 * 2 TMS1MT CHAR(10); /* TEXT AREA * 19860000 * DECLARE 19870000 * /* MESSAGE SEGMENT 2 MASK * 19880000 * 1 TMS2MDL /* NAME OF MASK * 19890000 * BASED(TMXMP2), 19900000 * 2 TMS2ML PTR(15), /* LENGTH OF TEXT * 19910000 * 2 TMS2MO PTR(15), /* TEXT OFFSET * 19920000 * 2 TMS2MT CHAR(144);/* TEXT AREA * 19930000 * DECLARE 19940000 * /* MESSAGE SEGMENT 3 MASK * 19950000 * 1 TMS3MDL /* NAME OF MASK * 19960000 * BASED(TMXMP3), 19970000 * 2 TMS3ML PTR(15), /* LENGTH OF TEXT * 19980000 * 2 TMS3MO PTR(15), /* TEXT OFFSET * 19990000 * 2 TMS3MT CHAR(144);/* TEXT AREA * 20000000 * DECLARE 20010000 * /* MESSAGE SEGMENT 4 MASK * 20020000 * 1 TMS4MDL /* NAME OF MASK * 20030000 * BASED(TMXMP4), 20040000 * 2 TMS4ML PTR(15), /* LENGTH OF TEXT * 20050000 * 2 TMS4MO PTR(15), /* TEXT OFFSET * 20060000 * 2 TMS4MT CHAR(144);/* TEXT AREA * 20070000 * 20080000 * DECLARE 20090000 * /* MESSAGE SEGMENT 5 MASK * 20100000 * 1 TMS5MDL /* NAME OF MASK * 20110000 * BASED(TMXMP5), 20120000 * 2 TMS5ML PTR(15), /* LENGTH OF EXT * 20130000 * 2 TMS5MO PTR(15), /* TEXT OFFSET * 20140000 * 2 TMS5MT CHAR(144);/* TEXT AREA * 20150000 * 20160000 * DECLARE 20170000 * /* MULTI-LEVEL MESSAGE POINTER AREA MASK * 20180000 * /* FIRST LEVEL MESSAGE POINTER AREA MASK * 20190000 * 1 TMLMDL1 BASED(MSGPTR), /* NAME OF MASK * 20200000 * 2 TMLNX1 PTR(31), /* PTR TO NEXT LEVEL * 20210000 * 2 TMLMN1 PTR(31), /* NUMBER OF MESSAGE SEGMENTS * 20220000 * 2 TMLMP11 PTR(31), /* PTR TO 1ST SEGMENT * 20230000 * 2 TMLMP12 PTR(31), /* PTR TO 2ND SEGMENT * 20240000 * 2 TMLMP13 PTR(31), /* PTR TO 3RD SEGMENT * 20250000 * 2 TMLMP14 PTR(31), /* PTR TO 4TH SEGMENT * 20260000 * 2 TMLMP15 PTR(31); /* PTR TO 5TH SEGMENT * 20270000 * DECLARE 20280000 * /* SECOND LEVEL MESSAGE POINTER AREA MASK * 20290000 * 1 TMLMDL2 BASED(TMLNX1), /* NAME OF MASK * 20300000 * 2 TMLNX2 PTR(31), /* PTR TO NEXT LEVEL * 20310000 * 2 TMLMN2 PTR(31), /* NUMBER OF MESSAGE SEGMENTS * 20320000 * 2 TMLMP21 PTR(31), /* PTR TO 1ST SEGMENT * 20330000 * 2 TMLMP22 PTR(31), /* PTR TO 2ND SEGMENT * 20340000 * 2 TMLMP23 PTR(31), /* PTR TO 3RD SEGMENT * 20350000 * 2 TMLMP24 PTR(31), /* PTR TO 4TH SEGMENT * 20360000 * 2 TMLMP25 PTR(31); /* PTR TO 5TH SEGMENT * 20370000 * DECLARE 20380000 * /* THIRD LEVEL MESSAGE POINTER AREA MASK * 20390000 * 1 TMLMDL3 BASED(TMLNX1), /* NAME OF MASK * 20400000 * 2 TMLNX3 PTR(31), /* PTR TO NEXT LEVEL * 20410000 * 2 TMLMN3 PTR(31), /* NUMBER OF MESSAGE SEGMENTS * 20420000 * 2 TMLMP31 PTR(31), /* PTR TO 1ST SEGMENT * 20430000 * 2 TMLMP32 PTR(31), /* PTR TO 2ND SEGMENT * 20440000 * 2 TMLMP33 PTR(31), /* PTR TO 3RD SEGMENT * 20450000 * 2 TMLMP34 PTR(31), /* PTR TO 4TH SEGMENT * 20460000 * 2 TMLMP35 PTR(31); /* PTR TO 5TH SEGMENT * 20470000 * 20480000 * DECLARE 20490000 * /* MESSAGE LEVEL 1, SEGMENT 1 MASK * 20500000 * 1 TM11MDL BASED(TMLMP11), /* NAME OF MASK * 20510000 * 2 TM11ML PTR(31), /* LENGTH OF SEGMENT * 20520000 * 2 TM11MO PTR(31), /* TEXT OFFSET * 20530000 * 2 TM11MT CHAR(144);/* TEXT AREA * 20540000 * DECLARE 20550000 * /* MESSAGE LEVEL 1, SEGMENT 2 MASK * 20560000 * 1 TM12MDL BASED(TMLMP12), /* NAME OF MASK * 20570000 * 2 TM12ML PTR(31), /* LENGTH OF SEGMENT * 20580000 * 2 TM12MO PTR(31), /* TEXT OFFSET * 20590000 * 2 TM12MT CHAR(144);/* TEXT AREA * 20600000 * DECLARE 20610000 * /* MESSAGE LEVEL 1, SEGMENT 3 MASK * 20620000 * 1 TM13MDL BASED(TMLMP13), /* NAME OF MASK * 20630000 * 2 TM13ML PTR(31), /* LENGTH OF SEGMENT * 20640000 * 2 TM13MO PTR(31), /* TEXT OFFSET * 20650000 * 2 TM13MT CHAR(144);/* TEXT AREA * 20660000 * DECLARE 20670000 * /* MESSAGE LEVEL 1, SEGMENT 4 MASK * 20680000 * 1 TM14MDL BASED(TMLMP14), /* NAME OF MASK * 20690000 * 2 TM14ML PTR(31), /* LENGTH OF SEGMENT * 20700000 * 2 TM14MO PTR(31), /* TEXT OFFSET * 20710000 * 2 TM14MT CHAR(144);/* TEXT AREA * 20720000 * DECLARE 20730000 * /* MESSAGE LEVEL 1, SEGMENT 5 MASK * 20740000 * 1 TM15MDL BASED(TMLMP15), /* NAME OF MASK * 20750000 * 2 TM15ML PTR(31), /* LENGTH OF SEGMENT * 20760000 * 2 TM15MO PTR(31), /* TEXT OFFSET * 20770000 * 2 TM15MT CHAR(144);/* TEXT AREA * 20780000 * 20790000 * DECLARE 20800000 * /* MESSAGE LEVEL 2, SEGMENT 1 MASK * 20810000 * 1 TM21MDL BASED(TMLMP21), /* NAME OF MASK * 20820000 * 2 TM21ML PTR(31), /* LENGTH OF SEGMENT * 20830000 * 2 TM21MO PTR(31), /* TEXT OFFSET * 20840000 * 2 TM21MT CHAR(144);/* TEXT AREA * 20850000 * DECLARE 20860000 * /* MESSAGE LEVEL 2, SEGMENT 2 MASK * 20870000 * 1 TM22MDL BASED(TMLMP22), /* NAME OF MASK * 20880000 * 2 TM22ML PTR(31), /* LENGTH OF SEGMENT * 20890000 * 2 TM22MO PTR(31), /* TEXT OFFSET * 20900000 * 2 TM22MT CHAR(144);/* TEXT AREA * 20910000 * DECLARE 20920000 * /* MESSAGE LEVEL 2, SEGMENT 3 MASK * 20930000 * 1 TM23MDL BASED(TMLMP23), /* NAME OF MASK * 20940000 * 2 TM23ML PTR(31), /* LENGTH OF SEGMENT * 20950000 * 2 TM23MO PTR(31), /* TEXT OFFSET * 20960000 * 2 TM23MT CHAR(144);/* TEXT AREA * 20970000 * DECLARE 20980000 * /* MESSAGE LEVEL 2, SEGMENT 4 MASK * 20990000 * 1 TM24MDL BASED(TMLMP24), /* NAME OF MASK * 21000000 * 2 TM24ML PTR(31), /* LENGTH OF SEGMENT * 21010000 * 2 TM24MO PTR(31), /* TEXT OFFSET * 21020000 * 2 TM24MT CHAR(144);/* TEXT AREA * 21030000 * DECLARE 21040000 * /* MESSAGE LEVEL 2, SEGMENT 5 MASK * 21050000 * 1 TM25MDL BASED(TMLMP25), /* NAME OF MASK * 21060000 * 2 TM25ML PTR(31), /* LENGTH OF SEGMENT * 21070000 * 2 TM25MO PTR(31), /* TEXT OFFSET * 21080000 * 2 TM25MT CHAR(144);/* TEXT AREA * 21090000 * 21100000 * DECLARE 21110000 * /* MESSAGE LEVEL 3, SEGMENT 1 MASK * 21120000 * 1 TM31MDL BASED(TMLMP31), /* NAME OF MASK * 21130000 * 2 TM31ML PTR(31), /* LENGTH OF SEGMENT * 21140000 * 2 TM31MO PTR(31), /* TEXT OFFSET * 21150000 * 2 TM31MT CHAR(144);/* TEXT AREA * 21160000 * DECLARE 21170000 * /* MESSAGE LEVEL 3, SEGMENT 2 MASK * 21180000 * 1 TM32MDL BASED(TMLMP32), /* NAME OF MASK * 21190000 * 2 TM32ML PTR(31), /* LENGTH OF SEGMENT * 21200000 * 2 TM32MO PTR(31), /* TEXT OFFSET * 21210000 * 2 TM32MT CHAR(144);/* TEXT AREA * 21220000 * DECLARE 21230000 * /* MESSAGE LEVEL 3, SEGMENT 3 MASK * 21240000 * 1 TM33MDL BASED(TMLMP33), /* NAME OF MASK * 21250000 * 2 TM33ML PTR(31), /* LENGTH OF SEGMENT * 21260000 * 2 TM33MO PTR(31), /* TEXT OFFSET * 21270000 * 2 TM33MT CHAR(144);/* TEXT AREA * 21280000 * DECLARE 21290000 * /* MESSAGE LEVEL 3, SEGMENT 4 MASK * 21300000 * 1 TM34MDL BASED(TMLMP34), /* NAME OF MASK * 21310000 * 2 TM34ML PTR(31), /* LENGTH OF SEGMENT * 21320000 * 2 TM34MO PTR(31), /* TEXT OFFSET * 21330000 * 2 TM34MT CHAR(144);/* TEXT AREA * 21340000 * DECLARE 21350000 * /* MESSAGE LEVEL 3, SEGMENT 5 MASK * 21360000 * 1 TM35MDL BASED(TMLMP35), /* NAME OF MASK * 21370000 * 2 TM35ML PTR(31), /* LENGTH OF SEGMENT * 21380000 * 2 TM35MO PTR(31), /* TEXT OFFSET * 21390000 * 2 TM35MT CHAR(144);/* TEXT AREA * 21400000 * 21410000 * DECLARE 21420000 * /* ACCOUNT SERVICE ROUTINES PARAMETERS * 21430000 * NOSEXT FIXED(15), /* RESERVE NMBT OF EXT BLOCKS * 21440000 * GSPPB CHAR(12), /* AREA FOR GETSPACE PARM BLK * 21450000 * FSPPB CHAR(12); /* AREA FOR FREESPACE PARM BLK * 21460000 * 21470000 * DECLARE 21480000 * /* PDE NAME STRINGS * 21490000 * NAMEID CHAR(8) BASED(NODIDP), 21500000 * NAMEPW CHAR(8) BASED(NODPWP), 21510000 * NAMEAN CHAR(40) BASED(NODANP); 21520000 * 21530000 * DECLARE 21540000 * /* PSEUD0-BUFFER FOR OBTAINED NODELIST PSTRING * 21550000 * 1 PSBUF CHAR(128) BDY(WORD), /* NAME OF BUFFER * 21560000 * 2 PSBUFHDP BDY(WORD), /* HEADER+PAREND AREA * 21570000 * 3 PSBUFHD, /* NAME OF HEADER AREA * 21580000 * 4 PSBUFL PTR(15), /* BUFFER LSNGTH * 21590000 * 4 PSBUFO PTR(15), /* CURRENT BUFFER OFFSET * 21600000 * 3 PSBUFLP CHAR(1), /* LEFT END PAREND FOR PS * 21610000 * 2 PSBUFTX CHAR(123); /* PSTRING TEXT AREA * 21620000 * 21630000 * DECLARE 21640000 * /* INDIVIDUAL BUFFER FOR NODELIST ITEM * 21650000 * 1 NODIBUF CHAR(56) BDY(HWORD), /* NAME OF BUFFER * 21660000 * 2 NDIBFHD BDY(HWORD), /* NAME OF HEADER * 21670000 * 3 NDIBFL PTR(15),/* BUFFER LENGTH * 21680000 * 3 NDIBFO PTR(15),/* CURRENT BUFFER OFFSET * 21690000 * 2 NDIBFTX CHAR(52);/* ITEM TEXT AREA * 21700000 * 21710000 * DECLARE 21720000 * /* DEFINE BUFFER HEADER FOR PARSE * 21730000 * PARSBHD CHAR(4) BASED(PPLCBUF); 21740000 * 21750000 * 21760000 * DECLARE 21770000 * /* NODELIST PSTRING PARSE PDE * 21780000 * 1 CMDNID BASED(ADDR(NODELST)), /* NAME OF PDE MASK * 21790000 * 2 CMDNNMP PTR(31), /* PTR TO PSTRING * 21800000 * 2 CMDNLNG PTR(15), /* NUMBER OF CHARS * 21810000 * 2 CMDNFLG CHAR(1), /* FLAGS * 21820000 * 3 CMDNFL1 BIT(1),/* 1 = PARAMETER ENTERED * 21830000 * /* 3 = PARM NOT ENTERED * 21840000 * 3 CMDNFRS BIT(7),/* FLAGS 1 - 7 RESERVED * 21850000 * 2 CMDNRES BIT(8); /* RESERVED * 21860000 * 21870000 * DECLARE 21880000 * /* NODELIST TEXT AREA * 21890000 * SUPBUF CHAR(124) BASED(CMDNNMP); 21900000 * 21910000 * DECLARE 21920000 * /* NODELIST USERID PARSE PDE * 21930000 * 1 NDLAN1 BASED(ADDR(NODEIDP)), /* NAME OF PDE MASK * 21940000 * 2 NDLAN1P PTR(31), /* PTR TO USERID * 21950000 * 2 NDL1LNG FIXED(15), /* NUMBER OF CHARACTERS * 21960000 * 2 NDL1FLG BIT(8), /* FLAGS * 21970000 * 3 NDL1FL1 BIT(1), /* 1 = PARAMETER ENTERED * 21980000 * /* 0 = PARM NOT ENTERED * 21990000 * 3 NDL1FRS BIT(7), /* FLAGS 2 - 8 RESERVED * 22000000 * 2 NDL1RES BIT(8); /* RESERVED * 22010000 * 22020000 * DECLARE 22030000 * /* NODELIST PASSWORD PARSE PDE * 22040000 * 1 NDLAN2 BASED(ADDR(NODEPWP)), /* NAME OF PDE MASK * 22050000 * 2 NDLAN2P PTR(31), /* PTR TO PASSWORD * 22060000 * 2 NDL2LNG FIXED(15), /* NUMBER OF CHARACTERS * 22070000 * 2 NDL2FLG BIT(8), /* FLAGS * 22080000 * 3 NDL2FL1 BIT(1), /* 1 = PARAMETER ENTERED * 22090000 * /* 0 = PARM NOT ENTERED * 22100000 * 3 NDL2FRS BIT(7), /* FLAGS 2 - 8 RESERVED * 22110000 * 2 NDL2RES BIT(8); /* RESERVED * 22120000 * 22130000 * DECLARE 22140000 * /* NODELIST ACCOUNT NUMBER PARSE PDE * 22150000 * 1 NDLAN3 BASED(ADDR(NODEANP)), /* NAME OF PDE MASK * 22160000 * 2 NDLAN3P PTR(31), /* PTR TO ACCOUNT NUMBER * 22170000 * 2 NDL3LNG FIXED(15), /* NUMBER OF CHARACTERS * 22180000 * 2 NDL3FLG BIT(8), /* FLAGS * 22190000 * 3 NDL3FL1 BIT(1), /* 1 = PARAMETER ENTERED * 22200000 * /* 0 = PARM NOT ENTERED * 22210000 * 3 NDL3FRS BIT(7), /* FLAGS 2 - 8 RESERVED * 22220000 * 2 NDL3RES BIT(8); /* RESERVED * 22230000 * 22240000 * DECLARE 22250000 * /* NODELIST USERID RESERVED PDE * 22260000 * 1 NDLIDM BASED(ADDR(NODEID)), /* NAME OF PDE MASK * 22270000 * 2 NDLINMP PTR(31), /* PTR TO USERID NAME * 22280000 * 2 NDLILNG FIXED(15), /* NUMBER OF CHARS IN NAME * 22290000 * 2 NDLIFLG BIT(8), /* FLAGS * 22300000 * 3 NDLIFL1 BIT(1), /* 1 = PARAMETER ENTERED * 22310000 * /* 0 = PARM NOT ENTERED * 22320000 * 3 NDLIFRS BIT(6), /* FLAGS 2 - 7 RESERVED * 22330000 * 3 NDLIFL8 BIT(1), /* 1 = USERID DELETED * 22340000 * /* 0 = NOT DELETED * 22350000 * 2 NDLIRES BIT(8); /* RESERVED * 22360000 * 22370000 * DECLARE 22380000 * /* NODELIST PASSWORD RESERVED PDE * 22390000 * 1 NDLPWM BASED(ADDR(NODEPW)), /* NAME OF PDE MASK * 22400000 * 2 NDLPNMP PTR(31), /* PTR TO PASSWORD NAME * 22410000 * 2 NDLPLNG FIXED(15), /* NUMBER OF CHARS IN NAME * 22420000 * 2 NDLPFLG BIT(8), /* FLAGS * 22430000 * 3 NDLPFL1 BIT(1), /* 1 = PARAMETER ENTERED * 22440000 * /* 0 = PARM NOT ENTERED * 22450000 * 3 NDLPFRS BIT(6), /* FLAGS 2 - 7 RESERVED * 22460000 * 3 NDLPFL8 BIT(1), /* PASSWD DELETE STATUS * 22470000 * /* 1 = PASSWD DELETED * 22480000 * /* 0 = NOT DELETED * 22490000 * 2 NDLPRES BIT(8); /* RESERVED * 22500000 * 22510000 * DECLARE 22520000 * /* NODELIST ACCOUNT NUMBER RESERVED PDE * 22530000 * 1 NDLANM BASED(ADDR(NODEAN)), /* NAME OF PDE MASK * 22540000 * 2 NDLANMP PTR(31), /* PTR TO ACCOUNT NUMBER * 22550000 * 2 NDLALNG FIXED(15), /* NUMBER OF CHARS IN NAME * 22560000 * 2 NDLAFLG BIT(8), /* FLAGS * 22570000 * 3 NDLAFL1 BIT(1), /* 1 = PARAMETER ENTERED * 22580000 * /* 0 = PARM NOT ENTERED * 22590000 * 3 NDLAFRS BIT(6), /* FLAGS 2 - 7 RESERVED * 22600000 * 3 NDLAFL8 BIT(1), /* ACCTNMBR DELETE STATUS * 22610000 * /* 1 = ACCTNMBR DELETED * 22620000 * /* 0 = NOT DELETED * 22630000 * 2 NDLARES BIT(8); /* RESERVED * 22640000 * 22650000 * DECLARE 22660000 * /* DATA LIST ANONYMOUS ITEM PARSE PDE * 22670000 * 1 DALINM BASED(ADDR(DATITM)), /* NAME OF PDE MASK * 22680000 * 2 DALINMP PTR(31), /* PTR TO ITEM NAME * 22690000 * 2 DALILNG FIXED(15), /* NUMBER OF CHARS IN MASK * 22700000 * 2 DALIFLG BIT(8), /* FLAGS * 22710000 * 3 DALIFL1 BIT(1), /* 1 = PARAMETER ENTERED * 22720000 * /* 0 = NO PARM ENTERED * 22730000 * 3 DALIFRS BIT(7), /* FLAGS 1 - 7 RESERVED * 22740000 * 2 DALINEX BIT(8); /* RESERVED FOR CHAIN PTR * 22750000 * 22760000 * DECLARE 22770000 * /* NAME OF AREA TO BE CHECKED FOR 'DATA' * 22780000 * TSTBUFR CHAR(4) BASED(DATLOC); 22790000 * 22800000 * DECLARE 22810000 * /* DATA LIST PASSWORD PARSE PDE * 22820000 * 1 DALPWM BASED(ADDR(DATPW)), /* NAME OF PDE MASK * 22830000 * 2 DALPNMP PTR(31), /* PTR TO PASSWORD NAME * 22840000 * 2 DALPLNG FIXED(15), /* NUMBER OF CHARS IN NAME * 22850000 * 2 DALPFLG BIT(8), /* FLAGS * 22860000 * 3 DALPFL1 BIT(1), /* 1 = PARAMETER ENTERED * 22870000 * /* 0 = NO PARM ENTERED * 22880000 * 3 DALPFRS BIT(7), /* FLAGS 1 - 7 RESERVED * 22890000 * 2 DALPNEX BIT(8); /* RESERVED FOR CHAIN PTR * 22900000 * 22910000 * DECLARE 22920000 * /* DATA LIST ACCOUNT NUMBER PARSE PDE * 22930000 * 1 DALANM BASED(ADDR(DATAN)), /* NAME OF PDE MASK * 22940000 * 2 DALANMP PTR(31), /* PTR TO ACCOUNT NUMBER * 22950000 * 2 DALALNG FIXED(15), /* NUMBER OF CHARS IN NAME * 22960000 * 2 DALAFLG BIT(8), /* FLAGS * 22970000 * 3 DALAFL1 BIT(1), /* 1 = PARAMETER ENTERED * 22980000 * /* 0 = NO PARM ENTERED * 22990000 * 3 DALAFRS BIT(7), /* FLAGS 1 - 7 RESERVED * 23000000 * 2 DALANEX BIT(8); /* RESERVED FOR CHAIN PTR * 23010000 * 23020000 * DECLARE 23030000 * /* DATA LIST PROCNAME PARSE PDE * 23040000 * 1 DALRNM BASED(ADDR(DATPN)), /* NAME OF PDE MASK * 23050000 * 2 DALRNMP PTR(31), /* PTR TO PROCNAME NAME * 23060000 * 2 DALRLNG FIXED(15), /* NUMBER OF CHARS IN MASK * 23070000 * 2 DALRFLG BIT(8), /* FLAGS * 23080000 * 3 DALRFL1 BIT(1), /* 1 = PARAMETER ENTERED * 23090000 * /* 0 = NO PARM ENTERED * 23100000 * 3 DALRFRS BIT(7), /* FLAGS 1 - 7 RESERVED * 23110000 * 2 DALRNEX BIT(8); /* RESERVED FOR CHAIN PTR * 23120000 * 23130000 * 23140000 * /* DEFINE NAME CHARACTER STRINGS * 23150000 * DECLARE 23160000 * /* NODELIST USERID CHARACTER STRING * 23170000 * 1 NDLIPC CHAR(8) BASED(NDLINMP), 23180000 * 2 NDLIPC1 CHAR(1); 23190000 * 23200000 * DECLARE 23210000 * /* NODELIST PASSWORD NAME CHARACTER STRING * 23220000 * 1 NDLPPC CHAR(8) BASED(NDLPNMP), 23230000 * 2 NDLPPC1 CHAR(1); 23240000 * 23250000 * DECLARE 23260000 * /* NODELIST ACCOUNT NUMBER CHARACTER STRING * 23270000 * 1 NDLAPC CHAR(40) BASED(NDLANMP), 23280000 * 2 NDLAPC1 CHAR(1); 23290000 * 23300000 * DECLARE 23310000 * /* DATA LIST NAME CHARACTER STRING * 23320000 * 1 NMPTRC CHAR(40) BASED(NAMPTR1), 23330000 * 2 NMPTRC1 CHAR(1); 23340000 * 23350000 * DECLARE 23360000 * /* PROTO-DATA BLOCK USAGE COUNT * 23370000 * UADSNCTR PTR(8) BASED(UADSDPTR); 23380000 * 23390000 * GENERATE DATA; 23400000 * /* DEFINE ROUTINE NAMES * 23410000 * 23420000 * DECLARE 23430000 * /* IDENTIFY EXTERNAL ENTRIES * 23440000 * DELREC ENTRY EXTERNAL, 23450000 * GBBUF ENTRY EXTERNAL, 23460000 * IKJEFA32 ENTRY EXTERNAL, 23470000 * IKJEFA55 ENTRY EXTERNAL, 23480000 * IKJPARSE ENTRY EXTERNAL, 23490000 * IKJPUTL ENTRY EXTERNAL; 23500000 * 23510000 * DECLARE 23520000 * /* IDENTIFY EXTERNAL LABELS * 23530000 * CHKNQ LABEL EXTERNAL, 23540000 * DOENQ2 LABEL EXTERNAL, 23550000 * DOWRT2 LABEL EXTERNAL, 23560000 * USERU LABEL EXTERNAL; 23570000 * 23580000 * DECLARE 23590000 * /* IDENTIFY EXTERNAL ENTRIES FOR INTERNAL PROCEDURES* 23600000 * DELSTO ENTRY STATIC LOCAL EXTERNAL, 23610000 * DOPUTL ENTRY STATIC LOCAL EXTERNAL, 23620000 * FXPUTL ENTRY STATIC LOCAL EXTERNAL, 23630000 * MSGFNDR ENTRY STATIC LOCAL EXTERNAL, 23640000 * SYSERRD ENTRY STATIC LOCAL EXTERNAL; 23650000 * 23660000 * DECLARE 23670000 * /* IDENTIFY EXTERNAL LABELS FOR INTERNAL ROUTINES * 23680000 * DOCLOS LABEL STATIC LOCAL EXTERNAL, 23690000 * DOCLOSR LABEL STATIC LOCAL EXTERNAL, 23700000 * MSGFND LABEL STATIC LOCAL EXTERNAL, 23710000 * MSGNGR LABEL STATIC LOCAL EXTERNAL, 23720000 * MSGNGRM LABEL STATIC LOCAL EXTERNAL, 23730000 * NOSPAZ LABEL STATIC LOCAL EXTERNAL, 23740000 * NONAM LABEL STATIC LOCAL EXTERNAL; 23750000 * 23760000 * DECLARE 23770000 * /* IDENTIFY CALL NAMES FOR INTERNAL PROCEDURES * 23780000 * CLOSDCB ENTRY STATIC LOCAL INTERNAL, 23790000 * COLLCT ENTRY STATIC LOCAL INTERNAL, 23800000 * DOPARS2 ENTRY STATIC LOCAL INTERNAL, 23810000 * OPENDCB ENTRY STATIC LOCAL INTERNAL, 23820000 * PARSREL ENTRY STATIC LOCAL INTERNAL; 23830000 * 23840000 * DECLARE 23850000 * /* IDENTIFY CALL NAMES FOR INTERNAL ROUTINES * 23860000 * DENQ LABEL STATIC LOCAL INTERNAL, 23870000 * DOPARS LABEL STATIC LOCAL EXTERNAL, 23880000 * FRERD LABEL STATIC LOCAL INTERNAL, 23890000 * FXPUTLM LABEL STATIC LOCAL EXTERNAL, 23900000 * NVLDCMD LABEL STATIC LOCAL INTERNAL; 23910000 * 23920000 * /* IDENTIFY LOCAL ENTRIES * 23930000 * GENERATE; 23940000 ENTRY CHKPS 23950000 ENTRY CHKANS 23960000 ENTRY &SECTN1 23970000 DS 0H 23980000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 23990000 **/* * * 24000000 **/* * U S E R I D D A T A L I S T * 24010000 **/* * * 24020000 **/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 24030000 **/* * * 24040000 **/* * I-------------------------------------------I * 24050000 **/* * 4 I UIDLNEX I * 24060000 **/* * I---------------------I---------------------I * 24070000 **/* * 4 I UIDLSWS I UIDLCT I * 24080000 **/* * I---------------------I---------------------I * 24090000 **/* * 8 I UIDLN1 I * 24100000 **/* * I I * 24110000 **/* * I I * 24120000 **/* * I-------------------------------------------I * 24130000 **/* * 16 I UIDLN2 I * 24140000 **/* * I I * 24150000 **/* * I I * 24160000 **/* * I-------------------------------------------I * 24170000 **/* * 24 I USERID I * 24180000 **/* * I I * 24190000 **/* * = = * 24200000 **/* * I I * 24210000 **/* * * 24220000 **/* * * 24230000 **DECLARE 24240000 ** 1 DUIDL BASED(UIDLPTR), 24250000 ** 2 UIDLNEX PTR(31), /* PTR TO NEXT UIDL ENTRY * 24260000 ** 2 UIDLSWS CHAR(2), /* UIDL FLAGS * 24270000 ** 3 * CHAR(1), /* FIRST BYTE OF FLAGS * 24280000 ** 4 UIDADD BIT(1), /* ..1 = RESULT OF ADD CMD * 24290000 ** 4 UIDDEL BIT(1), /* ..1 = RESULT OF DELETE CMD * 24300000 ** 4 UIDCHG BIT(1), /* ..1 = RESULT OF CHANGE CMD * 24310000 ** 4 * BIT(1), /* RESERVED * 24320000 ** 4 * BIT(1), /* RESERVED * 24330000 ** 4 * BIT(1), /* RESERVED * 24340000 ** 4 * BIT(1), /* RESERVED * 24350000 ** 4 * BIT(1), /* RESERVED * 24360000 ** 3 * CHAR(1), /* SECOND BYTE OF FLAGS * 24370000 **/* ..RESERVED * 24380000 ** 2 UIDLCT PTR(16) BDY(BYTE), 24390000 ** /* NUMBER OF USERID ENTRIES * 24400000 **/* NOTE: ADD AND DELETE COUNT IS 1 FOR EACH 8-BYTE USERID * 24410000 **/* FIELD IN THIS LIST. CHANGE COUNT IS 2 FOR EACH * 24420000 **/* 16-BYTE, 2-USERID FIELD * 24430000 ** 2 UIDUSER(*) CHAR(16), /* ARRAY OF USERID NAMES * 24440000 ** 3 UIDLN1 CHAR(8), /* 7 BYTE USERID NAME PLUS A * 24450000 **/* ..RIGHTMOST BLANK * 24460000 **/* ..(NEW USERID FOR CHANGE) * 24470000 ** 3 UIDLN2 CHAR(8); /* 2ND USERID NAME * 24480000 **/* ..(OLD USERID FOR CHANGE) * 24490000 ** 24500000 * 24510000 * 24520000 * 24530000 * /* DEFINE PADDING LENGTH * 24540000 * GENERATE DATA; 24550000 * 24560000 * DECLARE 24570000 * /* PADDING BLOCK * 24580000 * PADBLK CHAR(4) BDY(WORD); 24590000 * 24600000 * 24610000 **/* E IKJEFA30 * 24620000 **/*IKJDEL: P INITIALIZE * 24630000 * 24640000 * /* INITIALIZE * 24650000 * 24660000 * /* SET PTR TO STATIC DATA AREA * 24670000 * GENERATE; 24680000 L R8,CONAD SET COMMON CONSTANT LOCATION 24690000 DS 0H 24700000 * 24710000 * R9 = ADDR(IKJEFA32); /* SET PTR TO EXCISOR ROUTINE * 24720000 L @3,@V1 ADDRESS OF IKJEFA32 0178 24730000 LR @9,@3 0178 24740000 * R7 = R9+4095; /* SET 2ND BASE PTR T0 IKJDEL2 * 24750000 LA @7,4095 0179 24760000 AR @7,@9 0179 24770000 * SAVGR1 = R1; /* SAVE INPUT REGISTER 1 * 24780000 ST @1,SAVGR1 0180 24790000 * DELECF = '0'B; /* CLEAR DELETE CONTROL FLAGS * 24800000 MVI DLCTLR,B'00000000' 0181 24810000 XC DLCTLR+1(3),DLCTLR+1 0181 24820000 * BASPTRS = ACCTPL; /* RESERVE BASIC PARM LIST * 24830000 L @6,SAVGR1 0182 24840000 MVC BASPTRS(20),0(@6) 0182 24850000 * 24860000 * /* CLEAR TEMPORARY WORK AREAS * 24870000 * GENERATE; 24880000 XC PADBLK(PADLNG),PADBLK CLEAR AREA 24890000 DS 0H 24900000 * 24910000 * PLOUT = ACCTPL; /* INITIALIZE COMMUNICATION PL * 24920000 MVC PLOUT(20),0(@6) 0184 24930000 MVI PLOUT+20,C' ' 0184 24940000 MVC PLOUT+21(3),PLOUT+20 0184 24950000 * PLPTR = ADDR(PLOUT); /* SET PTR TO SERVICE RTN PL * 24960000 LA @2,PLOUT 0185 24970000 * PTPBPTR = ADDR(PTPBK); /* SET PTR TO PUTLINE PB * 24980000 LA @F,PTPBK 0186 24990000 ST @F,PTPBPTR 0186 25000000 * DPLPTR = ADDR(DPLBA); /* SET PTR TO DPL * 25010000 LA @F,DPLBA 0187 25020000 ST @F,DPLPTR 0187 25030000 * ARESP = 0; /* CLEAR UDL PTR * 25040000 SR @F,@F 0188 25050000 ST @F,16(0,@6) 0188 25060000 * 25070000 * STAPRM1 = R11; /* SAVE DELETE CODE BASE PTR, * 25080000 ST @B,STAEPL1 0189 25090000 * STAPRM2 = R12; /* RENT BASE PTR, * 25100000 ST @C,STAEPL1+4 0190 25110000 * STAPRM3 = R7; /* DEL2 2ND BASE PTR, * 25120000 ST @7,STAEPL1+8 0191 25130000 * STAPRM4 = R8; /* STATIC DATA PTR, * 25140000 ST @8,STAEPL1+12 0192 25150000 * STAPRM5 = R9; /* AND DEL2 BASE PTR * 25160000 ST @9,STAEPL1+16 0193 25170000 * STAEPL1(1) = STAEPL1(1)&&STAEPL1(1); /* EXTRACT BASE PTR * 25180000 XC STAEPL1(1),STAEPL1 0194 25190000 * 25200000 * /* INITIALIZE PARAMETER BLOCKS FOR ENQUEUE, OPEN, CLOSE, * 25210000 * /* STAE, DEQUEUE AND DATA CONTROL BLOCK * 25220000 * GENERATE; 25230000 MVC DELDCB(MVCLNG),DELDCBM INITIALIZE LISTS 25240000 MVC DIRDCB(DIRDLG),MDIRDCB INITIALIZE DCB FOR ASTERISK 25250000 DS 0H 25260000 ** /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 25270000 ** /* * 25280000 ** /* PARSE COMMAND ENTERED AND * 25290000 ** /* INITIALIZE DELETE POINT LIST * 25300000 ** /* * 25310000 ** /* ESTABLISH ASSIGNED DELETE POINT, SET POINTERS TO THE * 25320000 ** /* FIRST NAME AND THE CURRENT NAME ON EACH LEVEL, EXTRACT * 25330000 ** /* TOTAL NAME COUNT AND INITIALIZE NUMBER OF CURRENT NAME * 25340000 ** /* FOR EACH LEVEL, AND SET ORIGINAL ASTERISK FLAG FOR * 25350000 ** /* EACH OCCURENCE IN COMMAND ENTERED * 25360000 ** /* * 25370000 ** /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 25380000 * 25390000 **/* P SET UP BASE PTRS * 25400000 **/*CLRPDE: P CLEAR PDE SPACE & FLAGS * 25410000 **/* P SAVE BUFFER HEADER * 25420000 **/* P SET UP PARSE PARM LIST * 25430000 **/* S DOPARS: PARSE PSTRING & DATA LIST * 25440000 * 25450000 * CLRPDE: /* CLEAR CONTROL AREAS * 25460000 * PARSARS = '0'B; /* ZERO OUT PARSE AREAS * 25470000 CLRPDE MVI PARSARS,B'00000000' 0196 25480000 XC PARSARS+1(39),PARSARS+1 0196 25490000 * DLCTLR = '0'B; /* CLEAR PROCESS FLAG AREA * 25500000 MVI DLCTLR,B'00000000' 0197 25510000 XC DLCTLR+1(3),DLCTLR+1 0197 25520000 * GSUPFS = '11'B; /* INITIALIZE GEN SUP FLAGS * 25530000 OI DLCTLR+3,B'00001100' 0198 25540000 * /* M2582 * 25550000 * /* RESERVE COMMAND SCAN RESULTANT BUFFER HEADER * 25560000 * CBHDSV1 = NUCBFHD; /* SAVE HEADER * 25570000 L @3,SAVGR1 0199 25580000 L @3,12(0,@3) ACCTPL 0199 25590000 MVC CBHDSAV(4),0(@3) 0199 25600000 * 25610000 * /* INITIALIZE PARSE PARAMETER LIST * 25620000 * PPLPTR = ADDR(PPLSP); /* SET PTR TO PARSE PARM LIST * 25630000 LA @F,PPLSP 0200 25640000 ST @F,PPLPTR 0200 25650000 * PPLSP = PPLSP&&PPLSP; /* CLEAR PARAMETER LIST * 25660000 XC PPLSP(28),PPLSP 0201 25670000 * PPLSP(1:12) = BASPTRS(1:12); /* PTRS TO UPT, ECT, ECB * 25680000 MVC PPLSP(12),BASPTRS 0202 25690000 * PPLUWA = ADDR(STAEPL1); /* SET PTR TO DELETE WORK AREA * 25700000 LA @F,STAEPL1 0203 25710000 L @6,PPLPTR 0203 25720000 ST @F,24(0,@6) 0203 25730000 * PPLPCL = DELCMDP; /* SET PTR TO COMMAND PCL * 25740000 MVC 12(4,@6),DELCMDP 0204 25750000 * PPLANS = ADDR(CMDRPTR); /* SET PTR TO RESPONSE AREA * 25760000 LA @F,PARSARS+24 0205 25770000 ST @F,16(0,@6) 0205 25780000 * PPLCBUF = ACBFP; /* SET PTR TO COMMAND BUFFER * 25790000 L @4,SAVGR1 0206 25800000 MVC 20(4,@6),12(@4) 0206 25810000 * 25820000 * /* CLEAR DELETE POINT LIST AREA AND SET END FLAG * 25830000 * DPLBAB = '0'B; /* CLEAR DELETE POINT LIST * 25840000 MVI DPLBAB,B'00000000' 0207 25850000 XC DPLBAB+1(120),DPLBAB+1 0207 25860000 * DEND = DENDF; /* SET DPL END FLAG * 25870000 L @5,DPLPTR 0208 25880000 MVC 120(1,@5),DENDF 0208 25890000 * 25900000 * /* PARSE FOR P-STRING AND DATA * 25910000 * CALL DOPARS; /* GO TO CALL PARSE * 25920000 BAL @E,DOPARS 0209 25930000 * 25940000 * RESTRICT (PDLPTR); /* RESERVE FOR POINTER SERVICE * 25950000 * 25960000 * GENERATE (USING DELPD,PDLPTR); 25970000 USING DELPD,PDLPTR 25980000 DS 0H 25990000 * PDLPTR = CMDRPTR; /* SET PTR TO PDL * 26000000 L @4,PARSARS+24 0212 26010000 * DATLOC = ADDR(DATITM); /* SET POINTER TO PDE * 26020000 LA @F,DATITM 0213 26030000 ST @F,DATLOC 0213 26040000 * 26050000 **/* D (NO,%PNDL1,YES,) ANY PSTRING? * 26060000 **/* P SET UP PSEUDO-BUFFER * 26070000 **/* P SAVE NODELIST HEADER * 26080000 * 26090000 * /* CHK IF ANY NODELIST ENTERED * 26100000 * IF CMDNFL1 = '0'B /* CHK IF NODELIST PRESENT * 26110000 * THEN /* NO, * 26120000 TM CMDNID+6,B'10000000' 0214 26130000 * GOTO NVLDCMD; /* GO TO INVALID COMMAND EXIT * 26140000 BC 08,NVLDCMD 0215 26150000 * ELSE ; /* NODELIST PRESENT * 26160000 * 26170000 * NODLIN = '1'B; /* SET NODELIST FLAG * 26180000 OI DLCTLR,B'00000001' 0217 26190000 * 26200000 * /* SET UP PSEUDO-BUFFER * 26210000 * PSBUFTX(1:CMDNLNG)=SUPBUF(1:CMDNLNG); /* MOVE SUPPLIED * 26220000 L @3,CMDNID 0218 26230000 LR @E,@3 0218 26240000 LH @5,CMDNID+4 0218 26250000 BCTR @5,0 0218 26260000 LA @A,PSBUF+5 0218 26270000 EX @5,@MVC 0218 26280000 * /* NODELIST INTO PSEUDO-BFR * 26290000 * PSBUFL = CMDNLNG+5; /* SET BUFFER LENGTH * 26300000 LA @F,5 0219 26310000 AH @F,CMDNID+4 0219 26320000 STH @F,PSBUF 0219 26330000 * PSBUFO = 1; /* SET BUFFER OFFSET * 26340000 LA @F,1 0220 26350000 STH @F,PSBUF+2 0220 26360000 * PSBUFLP = '('; /* INSERT LEFT END PAREND * 26370000 MVI PSBUF+4,C'(' 0221 26380000 * PSBUFTX(CMDNLNG+1) = ')'; /* INSERT RIGHT END PAREND * 26390000 LA @5,1 0222 26400000 AH @5,CMDNID+4 0222 26410000 LA @A,PSBUF+4(@5) 0222 26420000 MVI 0(@A),C')' 0222 26430000 * 26440000 * CBHDSV2 = PSBUFHD; /* SAVE NODELIST HEADER * 26450000 MVC CBHDSV2(4),PSBUF 0223 26460000 * PPLCBUF = ADDR(PSBUFHD); /* SET PARSE PTR TO BUFFER * 26470000 LA @F,PSBUF 0224 26480000 L @6,PPLPTR 0224 26490000 ST @F,20(0,@6) 0224 26500000 * 26510000 **/* D (NO,PARSNODL,YES,) ANY DATALIST ENTERED? * 26520000 **/* P FIND LENGTH OF DATA LIST * 26530000 **/* S GBBUF: GET BUFFER IF NEEDED * 26540000 * 26550000 * /* CHK IF ANY DATALIST ENTERED * 26560000 * IF DALIFL1 = '0'B /* CHK IF DATA LIST PRESENT * 26570000 * THEN /* NO, * 26580000 TM DALINM+6,B'10000000' 0225 26590000 * GOTO PRSNODL; /* SKIP DATA LIST PROCESSING * 26600000 BC 08,PRSNODL 0226 26610000 * 26620000 * DATLIN = '1'B; /* SET DATALIST FLAG * 26630000 OI DLCTLR+1,B'10000000' 0227 26640000 * 26650000 * /* CHK IF DATALIST PSEUDO-BUFFER LENGTH IS ADEQUATE, * 26660000 * /* IF NOT, EXECUTE GETMAIN TO ACQUIRE ENOUGH SPACE * 26670000 * TSTOP = 0; /* CLEAR ACCUMULATOR * 26680000 SR @F,@F 0228 26690000 ST @F,TSTOP 0228 26700000 * NAMPTR = ADDR(DATITM); /* SET TO FIRST PDE * 26710000 LA @F,DATITM 0229 26720000 ST @F,NAMPTR 0229 26730000 * STEP: TSTOP = TSTOP + NAMLNG+1; /* ADD NEXT PDE NAME LENGTH * 26740000 STEP LA @F,1 0230 26750000 L @3,NAMPTR 0230 26760000 MVC @TEMP2+2(2),4(@3) 0230 26770000 A @F,@TEMP2 0230 26780000 A @F,TSTOP 0230 26790000 ST @F,TSTOP 0230 26800000 * /* CHK IF ANY NEXT PDE * 26810000 * IF NPNEXC ª= 'FF000000'X /* CHK FOR END FLAG * 26820000 * THEN /* NO, * 26830000 CLC 8(4,@3),@X6 0231 26840000 BC 08,@9FF 0231 26850000 * DO; 26860000 * NAMPTR = NPTRNEX; /* SET TO NEXT PDE * 26870000 MVC NAMPTR(4),8(@3) 0233 26880000 * GOTO STEP; /* ADD NEXT LENGTH * 26890000 BC 15,STEP 0234 26900000 * END; 26910000 * 26920000 * CALL GBBUF; /* GO TO SET BUFFER * 26930000 @9FF L @F,@V2 ADDRESS OF GBBUF 0236 26940000 BALR @E,@F 0236 26950000 * 26960000 * DBUFLNG = TSTOP+5; /* SET BUFFER LENGTH * 26970000 LA @F,5 0237 26980000 A @F,TSTOP 0237 26990000 L @3,DBUFPTR 0237 27000000 STH @F,0(0,@3) 0237 27010000 * DBUFOFF = 0; /* SET TEXT OFFSET * 27020000 SR @F,@F 0238 27030000 STH @F,2(0,@3) 0238 27040000 * DBUFLHP = '('; /* SET LEFT END PAREND * 27050000 MVI 4(@3),C'(' 0239 27060000 * DBUFTXT(TSTOP+1) = ')'; /* SET RIGHT END PAREND * 27070000 LA @5,1 0240 27080000 A @5,TSTOP 0240 27090000 LA @A,4(@5,@3) 0240 27100000 MVI 0(@A),C')' 0240 27110000 * 27120000 **/*PARSNODL: S PARSREL: RELEASE INITIAL COMMAND AREA * 27130000 **/* S DOPARS: PARSE NODE LIST FOR ENTRIES * 27140000 * 27150000 * PRSNODL: /* RELEASE INITIAL COMMAND ENTRY AREA (DUMMY PDL AREA) * 27160000 * R1 = ADDR(CMDRPTR); /* SET PTR TO RELEASE AREA * 27170000 PRSNODL LA @1,PARSARS+24 0241 27180000 * CALL PARSREL; /* GO TO PARSE RELEASE CALL * 27190000 BAL @E,PARSREL 0242 27200000 * 27210000 * PPLPCL = NLSTIPP; /* SET PTR TO NODELIST PCL * 27220000 L @3,PPLPTR 0243 27230000 MVC 12(4,@3),NLSTIPP 0243 27240000 * PPLANS = ADDR(NDRPTRA); /* SET PTR TO RESPONSE AREA * 27250000 LA @F,PARSARS+28 0244 27260000 ST @F,16(0,@3) 0244 27270000 * 27280000 * /* PARSE NODELIST FOR ENTRIES * 27290000 * CALL DOPARS; /* GO TO CALL PARSE * 27300000 BAL @E,DOPARS 0245 27310000 * 27320000 * RESTRICT (PDLPTRA); /* RESERVE FOR POINTER SERVICE * 27330000 * GENERATE (USING NDLPDP,PDLPTRA); 27340000 USING NDLPDP,PDLPTRA 27350000 DS 0H 27360000 * 27370000 * PDLPTRA = NDRPTRA; /* SET PTR TO PDL * 27380000 L @5,PARSARS+28 0248 27390000 * 27400000 **/* D (YES,%PNDL2,NO,) WAS USERID ENTERED? * 27410000 **/*%PNDL1: S NVLDCMD: ISSUE INVALID CMD MESSAGE * 27420000 **/* R GO TO USERU * 27430000 **/*%PNDL2: P SET USERID FLAG * 27440000 * 27450000 * /* CHK IF USERID ENTERED * 27460000 * IF NDL1FL1 = '1'B /* CHK ENTERED FLAG * 27470000 * THEN /* YES, * 27480000 TM NDLAN1+6,B'10000000' 0249 27490000 BC 12,@9FE 0249 27500000 * UIDNTR = '1'B; /* SET CURRENT FLAG * 27510000 OI DLCTLR,B'00001000' 0250 27520000 * ELSE /* USERID NOT ENTERED * 27530000 * GOTO NVLDCMD; /* GO TO INVALID COMMAND EXIT * 27540000 * 27550000 **/* D (YES,,NO,%PARSR1) WAS PASSWORD ENTERED? * 27560000 **/* P SET PASSWORD FLAG * 27570000 * 27580000 * /* CHK IF PASSWORD ENTERED * 27590000 * IF NDL2FL1 = '1'B /* CHK ENTERED FLAG * 27600000 * THEN /* YES, * 27610000 @9FD TM NDLAN2+6,B'10000000' 0252 27620000 BC 12,@9FC 0252 27630000 * PWDNTR = '1'B; /* SET CURRENT FLAG * 27640000 OI DLCTLR,B'00000100' 0253 27650000 * ELSE ; /* PASSWORD NOT ENTERED * 27660000 @9FC EQU * 0254 27670000 * 27680000 **/*%PARSR1: D (NO,UIDCHK,YES,) WAS ACCTNMBR ENTERED? * 27690000 **/* P SET ACCOUNT NUMBER FLAG * 27700000 * 27710000 * /* CHK IF ACCOUNT NUMBER ENTERED * 27720000 * IF NDL3FL1 = '1'B /* CHK ENTERED FLAG * 27730000 * THEN /* YES, * 27740000 @9FB TM NDLAN3+6,B'10000000' 0255 27750000 BC 12,@9FA 0255 27760000 * ACNNTR = '1'B; /* SET CURRENT FLAG * 27770000 OI DLCTLR,B'00000010' 0256 27780000 BC 15,@9F9 0257 27790000 * ELSE ; /* ACCOUNT NUMBER NOT ENTERED * 27800000 @9FA EQU * 0257 27810000 * 27820000 * 27830000 **/*UIDCHK: P SET PCL FOR ASTERISK/NO ASTERISK * 27840000 **/* S DOPARS2: PARSE USERID ENTRY * 27850000 **/* P SAVE USERID CHARACTER STRING * 27860000 **/* S PARSREL: RELEASE USERID AREA * 27870000 * 27880000 * UIDCHK: /* USERID ENTRY SYNTAX CHECK * 27890000 * 27900000 * /* ADJUST PCL FOR DELETE POINT LEVEL * 27910000 * IF PWDNTR = '0'B /* CHK FOR PASSWD ENTRY OR * 27920000 * & DATLIN = '0'B /* DATALIST ENTRY * 27930000 * THEN /* NEITHER, * 27940000 @9F9 EQU * 0258 27950000 UIDCHK TM DLCTLR,B'00000100' 0258 27960000 BC 05,@9F8 0258 27970000 TM DLCTLR+1,B'10000000' 0258 27980000 BC 05,@9F7 0258 27990000 * PPLPCL = NLSTIAP; /* SET FOR NO ASTERISK PCL * 28000000 L @3,PPLPTR 0259 28010000 MVC 12(4,@3),NLSTIAP 0259 28020000 BC 15,@9F6 0260 28030000 * ELSE /* YES, PASSWD/DATALST ENTERED * 28040000 * PPLPCL = NLSTIASP; /* SET FOR ASTERISK PCL * 28050000 @9F7 EQU * 0260 28060000 @9F8 L @3,PPLPTR 0260 28070000 MVC 12(4,@3),NLSTIASP 0260 28080000 * 28090000 * NAMPTR = ADDR(NODEIDP); /* SET PTR TO USERID ENTRY * 28100000 @9F6 LA @F,NODEIDP 0261 28110000 ST @F,NAMPTR 0261 28120000 * 28130000 * /* PARSE USERID ITEM * 28140000 * CALL DOPARS2; /* TO TO CALL PARSE * 28150000 BAL @E,DOPARS2 0262 28160000 * 28170000 * GENERATE (USING NDLPDA,PDLPTR); /* FOR ADDRESSABILITY * 28180000 USING NDLPDA,PDLPTR 28190000 DS 0H 28200000 * PDLPTR = RESPONS; /* SET PTR TO PDL * 28210000 L @4,PARSARS+32 0264 28220000 * NODEID = NODEIDM; /* RESERVE USERID PDE * 28230000 MVC PARSARS(8),NODEIDM 0265 28240000 * NODIDC = NAMEID(1:NODIDL); /* SAVE NAME CHARACTER STRING * 28250000 LH @3,PARSARS+4 0266 28260000 BCTR @3,0 0266 28270000 L @6,PARSARS 0266 28280000 LR @E,@6 0266 28290000 LA @A,NODLNMS 0266 28300000 MVI 0(@A),C' ' 0266 28310000 MVC 1(007,@A),0(@A) 0266 28320000 EX @3,@MVC 0266 28330000 * NODIDP = ADDR(NODIDC); /* SET PTR TO NAME * 28340000 LA @F,NODLNMS 0267 28350000 ST @F,PARSARS 0267 28360000 * 28370000 * /* RELEASE USERID ENTRY AREA * 28380000 * R1 = ADDR(RESPONS); /* SET PTR TO RELEASE AREA * 28390000 LA @1,PARSARS+32 0268 28400000 * CALL PARSREL; /* GO TO PARSE RELEASE CALL * 28410000 BAL @E,PARSREL 0269 28420000 * 28430000 * 28440000 **/*PWDCHK: D (YES,,NO,DATLCHK) WAS PASSWORD ENTERED? * 28450000 **/* P SET PCL FOR ASTERISK/NO ASTERISK * 28460000 **/* S DOPARS2: PARSE PASSWORD ENTRY * 28470000 **/* P SAVE PASSWORD CHARACTER STRING * 28480000 **/* S PARSREL: RELEASE PASSWORD AREA * 28490000 * 28500000 * PWDCHK: /* PASSWORD ENTRY SYNTAX CHECK * 28510000 * 28520000 * /* CHK IF PASSWORD ENTERED * 28530000 * IF PWDNTR = '0'B /* CHK ENTRY FLAG * 28540000 * THEN /* NO, * 28550000 PWDCHK TM DLCTLR,B'00000100' 0270 28560000 * GOTO DATLCHK; /* GO TO CHK FOR DATA LIST * 28570000 BC 08,DATLCHK 0271 28580000 * ELSE ; /* YES, PASSWORD ENTERED * 28590000 * 28600000 * NAMPTR = ADDR(NODEPWP); /* SET PTR TO PASSWORD ENTRY * 28610000 LA @F,NODEPWP 0273 28620000 ST @F,NAMPTR 0273 28630000 * 28640000 * /* ADJUST PCL FOR DELETE POINT LEVEL * 28650000 * IF ACNNTR = '0'B /* CHK FOR ACCTNMBR ENTRY OR * 28660000 * & DATLIN = '0'B /* DATALIST ENTRY * 28670000 * THEN /* NEITHER, * 28680000 TM DLCTLR,B'00000010' 0274 28690000 BC 05,@9F5 0274 28700000 TM DLCTLR+1,B'10000000' 0274 28710000 BC 05,@9F4 0274 28720000 * PPLPCL = NLSTI2P; /* SET FOR NO ASTERISK PCL * 28730000 L @3,PPLPTR 0275 28740000 MVC 12(4,@3),NLSTI2P 0275 28750000 BC 15,@9F3 0276 28760000 * ELSE /* YES, ACCTN/DATALIST ENTERED * 28770000 * PPLPCL = NLSTI2SP; /* SET FOR ASTERISK PCL * 28780000 @9F4 EQU * 0276 28790000 @9F5 L @3,PPLPTR 0276 28800000 MVC 12(4,@3),NLSTI2SP 0276 28810000 * 28820000 * /* PARSE PASSWORD ITEM * 28830000 * CALL DOPARS2; /* GO TO CALL PARSE * 28840000 @9F3 BAL @E,DOPARS2 0277 28850000 * 28860000 * 28870000 * GENERATE (USING NDLPD2,PDLPTR); /* FOR ADDRESSABILITY * 28880000 USING NDLPD2,PDLPTR 28890000 DS 0H 28900000 * PDLPTR = RESPONS; /* SET PTR TO PDL * 28910000 L @4,PARSARS+32 0279 28920000 * NODEPW = NODEPWM; /* RESERVE PASSWORD PDE * 28930000 MVC PARSARS+8(8),NODEPWM 0280 28940000 * NODPWC = NAMEPW(1:NODPWL); /* SAVE NAME CHARACTER STRING * 28950000 LH @3,PARSARS+12 0281 28960000 BCTR @3,0 0281 28970000 L @6,PARSARS+8 PARSARS 0281 28980000 LR @E,@6 0281 28990000 LA @A,NODLNMS+8 0281 29000000 MVI 0(@A),C' ' 0281 29010000 MVC 1(007,@A),0(@A) 0281 29020000 EX @3,@MVC 0281 29030000 * NODPWP = ADDR(NODPWC); /* SET PTR TO NAME * 29040000 LA @F,NODLNMS+8 0282 29050000 ST @F,PARSARS+8 0282 29060000 * 29070000 * /* RELEASE PASSWORD ENTRY AREA * 29080000 * R1 = ADDR(RESPONS); /* SET PTR TO RELEASE AREA * 29090000 LA @1,PARSARS+32 0283 29100000 * CALL PARSREL; /* GO TO PARSE RELEASE CALL * 29110000 BAL @E,PARSREL 0284 29120000 * 29130000 * 29140000 **/*ANCHK: D (NO,DATLCHK,YES,) WAS ACCTNMBR ENTERED? * 29150000 **/* P SET PCL FOR ASTERISK/NO ASTERISK * 29160000 **/* S DOPARS2: PARSE ACCOUNT NUMBER ENTRY * 29170000 **/* P SAVE ACCTNMBER CHARACTER STRING * 29180000 **/* S PARSREL: RELEASE ACCTNMBR AREA * 29190000 * 29200000 * ANCHK: /* ACCOUNT NUMBER ENTRY SYNTAX CHECK * 29210000 * 29220000 * /* CHK IF ACCOUNT NUMBER ENTERED * 29230000 * IF ACNNTR = '0'B /* CHK ENTRY FLAG * 29240000 * THEN /* NO, * 29250000 ANCHK TM DLCTLR,B'00000010' 0285 29260000 * GOTO DATLCHK; /* GO TO CHK FOR DATA LIST * 29270000 BC 08,DATLCHK 0286 29280000 * ELSE ; /* YES, ACCT NMBR ENTERED * 29290000 * 29300000 * /* ADJUST PCL FOR DELETE POINT LEVEL * 29310000 * IF DATLIN = '0'B /* CHK FOR DATALIST ENTRY * 29320000 * THEN /* NO, * 29330000 TM DLCTLR+1,B'10000000' 0288 29340000 BC 05,@9F2 0288 29350000 * PPLPCL = NLSTI3P; /* SET FOR NO ASTERISK PCL * 29360000 L @3,PPLPTR 0289 29370000 MVC 12(4,@3),NLSTI3P 0289 29380000 BC 15,@9F1 0290 29390000 * ELSE /* YES, DATALIST ENTERED * 29400000 * PPLPCL = NLSTI3SP; /* SET FOR ASTERISK PCL * 29410000 @9F2 L @3,PPLPTR 0290 29420000 MVC 12(4,@3),NLSTI3SP 0290 29430000 * 29440000 * NAMPTR = ADDR(NODEANP); /* SET PTR TO ACCTNMBR ENTRY * 29450000 @9F1 LA @F,NODEANP 0291 29460000 ST @F,NAMPTR 0291 29470000 * 29480000 * /* PARSE ACCOUNT NUMBER ITEM * 29490000 * CALL DOPARS2; /* GO TO CALL PARSE * 29500000 BAL @E,DOPARS2 0292 29510000 * 29520000 * GENERATE (USING NDLPD3,PDLPTR); /* FOR ADDRESSABILITY * 29530000 USING NDLPD3,PDLPTR 29540000 DS 0H 29550000 * PDLPTR = RESPONS; /* SET PTR TO PDL * 29560000 L @4,PARSARS+32 0294 29570000 * NODEAN = NODEANM; /* RESERVE ACCOUNT NUMBER PDE * 29580000 MVC PARSARS+16(8),NODEANM 0295 29590000 * NODANC = NAMEAN(1:NODANL); /* SAVE NAME CHARACTER STRING * 29600000 LH @3,PARSARS+20 0296 29610000 BCTR @3,0 0296 29620000 L @6,PARSARS+16 PARSARS 0296 29630000 LR @E,@6 0296 29640000 LA @A,NODLNMS+16 0296 29650000 MVI 0(@A),C' ' 0296 29660000 MVC 1(039,@A),0(@A) 0296 29670000 EX @3,@MVC 0296 29680000 * NODANP = ADDR(NODANC); /* SET PTR TO NAME * 29690000 LA @F,NODLNMS+16 0297 29700000 ST @F,PARSARS+16 0297 29710000 * 29720000 * /* RELEASE ACCOUNT NUMBER ENTRY AREA * 29730000 * R1 = ADDR(RESPONS); /* SET PTR TO RELEASE AREA * 29740000 LA @1,PARSARS+32 0298 29750000 * CALL PARSREL; /* GO TO PARSE RELEASE CALL * 29760000 BAL @E,PARSREL 0299 29770000 * 29780000 * 29790000 **/*DATLCHK: S PARSREL: RELEASE ORIGINAL NODELIST AREA * 29800000 **/* D (NO,LOCDP,YES,) ANY DATA LIST ENTERED? * 29810000 **/* P SAVE DATALIST POINTERS * 29820000 * 29830000 * DATLCHK: /* PROCESS DATALIST IF ANY DATALIST ENTRY * 29840000 * 29850000 * /* RELEASE ORIGINAL NODELIST ENTRY AREA * 29860000 * R1 = ADDR(NDRPTRA); /* SET PTR TO RELEASE AREA * 29870000 DATLCHK LA @1,PARSARS+28 0300 29880000 * /* RELEASE TRIAL PDL AREA * 29890000 * CALL PARSREL; /* GO TO PARSE RELEASE CALL * 29900000 BAL @E,PARSREL 0301 29910000 * 29920000 * /* CHK IF ANY DATA LIST * 29930000 * IF DATLIN = '0'B 29940000 * THEN /* NO, * 29950000 TM DLCTLR+1,B'10000000' 0302 29960000 * GOTO LOCDP; /* SKIP 'DATA' LOCATOR * 29970000 BC 08,LOCDP 0303 29980000 * ELSE ; /* YES, DATA LIST WAS ENTERED * 29990000 * 30000000 * PPLCBUF = DBUFPTR; /* SET PTR TO DATA LIST BUFFER * 30010000 L @3,PPLPTR 0305 30020000 MVC 20(4,@3),DBUFPTR 0305 30030000 * PPLANS = ADDR(DATRPTR); /* GET PTR TO RESPONSE AREA * 30040000 LA @F,PARSARS+36 0306 30050000 ST @F,16(0,@3) 0306 30060000 * 30070000 **/*LOCDP: P INITIALIZE USERID IN DPL * 30080000 **/* D (NO,LOCDP1,YES,) WAS PASSWD IN NODELIST? * 30090000 **/* P INITIALIZE PASSWORD IN DPL * 30100000 * 30110000 * LOCDP: /* INITIALIZE USERID LEVEL * 30120000 * NAMPTR = ADDR(NODEID); /* SET PDE POINTER * 30130000 LOCDP LA @F,PARSARS 0307 30140000 ST @F,NAMPTR 0307 30150000 * DUSRID1 = ADDR(NODEID); /* SET PTR TO FIRST NAME PDE * 30160000 LA @F,PARSARS 0308 30170000 L @3,DPLPTR 0308 30180000 ST @F,8(0,@3) 0308 30190000 * DUSRIDN = ADDR(NODEID); /* SET PTR TO CURRENT NAME PDE * 30200000 LA @F,PARSARS 0309 30210000 ST @F,12(0,@3) 0309 30220000 * DUSRDTN = 1; /* SET TOTAL NAME COUNT * 30230000 LA @F,1 0310 30240000 STH @F,32(0,@3) 0310 30250000 * DUSRDCN = 1; /* SET CURRENT NAME NUMBER * 30260000 STH @F,34(0,@3) 0311 30270000 * 30280000 * /* INITIALIZE ORIGINAL * FLAG FOR USERID * 30290000 * IF NDLIPC1 = '*' /* CHK IF * ENTERED * 30300000 * & NDLILNG = 1 /* AND LENGTH OF 1 * 30310000 * THEN /* YES, * 30320000 L @6,NDLIDM 0312 30330000 CLI 0(@6),C'*' 0312 30340000 BC 07,@9F0 0312 30350000 CH @F,NDLIDM+4 0312 30360000 BC 07,@9EF 0312 30370000 * DUCLSF1 = '1'B; /* SET FLAG FOR ORIGINAL * * 30380000 OI 28(@3),B'10000000' 0313 30390000 * ELSE ; /* NO, NOT ORIGINAL * * 30400000 @9EF EQU * 0314 30410000 @9F0 EQU * 0314 30420000 * 30430000 * 30440000 * /* CHK IF PASSWORD ENTERED IN NODELIST * 30450000 * IF NDLPFL1 = '0'B 30460000 * THEN /* NO, * 30470000 @9EE TM NDLPWM+6,B'10000000' 0315 30480000 * GOTO LOCDP1; /* GO TO CHK FOR DATA LIST * 30490000 BC 08,LOCDP1 0316 30500000 * ELSE ; /* YES, PASSWD IS IN NODELIST * 30510000 * 30520000 * /* INITIALIZE PASSWORD LEVEL * 30530000 * NAMPTR = ADDR(NODEPW); /* SET PDE POINTER * 30540000 LA @F,PARSARS+8 0318 30550000 ST @F,NAMPTR 0318 30560000 * DPASWD1 = ADDR(NODEPW); /* SET PTR TO FIRST NAME PDE * 30570000 LA @F,PARSARS+8 0319 30580000 L @3,DPLPTR 0319 30590000 ST @F,36(0,@3) 0319 30600000 * DPASWDN = ADDR(NODEPW); /* SET PTR TO CURRENT NAME PDE * 30610000 LA @F,PARSARS+8 0320 30620000 ST @F,40(0,@3) 0320 30630000 * DPCLSF1 = '0'B; /* SET NAME (NOT *) FLAG * 30640000 NI 56(@3),B'01111111' 0321 30650000 * /* CHK IF * ENTERED FOR PASSWORD NAME * 30660000 * IF NDLPPC1 = '*' /* CHK IF * ENTERED * 30670000 * & NDLPLNG = 1 /* AND LENGTH OF 1 * 30680000 * THEN /* YES, * 30690000 L @6,NDLPWM 0322 30700000 CLI 0(@6),C'*' 0322 30710000 BC 07,@9ED 0322 30720000 LA @F,1 0322 30730000 CH @F,NDLPWM+4 0322 30740000 BC 07,@9EC 0322 30750000 * DPCLSF1 = '1'B; /* SET * (NOT NAME) FLAG * 30760000 OI 56(@3),B'10000000' 0323 30770000 BC 15,@9EB 0324 30780000 * ELSE /* NO, NOT ASTERISK * 30790000 * DO; 30800000 @9EC EQU * 0324 30810000 * DPSWDTN = 1; /* SET TOTAL PSWD COUNT TO 1 * 30820000 @9ED LA @F,1 0325 30830000 L @3,DPLPTR 0325 30840000 STH @F,60(0,@3) 0325 30850000 * DPSWDCN = 1; /* SET CURRENT PSWD NMBR TO 1 * 30860000 STH @F,62(0,@3) 0326 30870000 * END; 30880000 * 30890000 **/* D (NO,LOCDP3,YES,) WAS ACCTNMBER IN NODELIST? * 30900000 **/* P INITIALIZE ACCOUNT NUMBER IN DPL * 30910000 * 30920000 * /* CHK IF ACCOUNT NUMBER ENTERED IN NODELIST * 30930000 * IF NDLAFL1 = '0'B 30940000 * THEN /* NO, * 30950000 @9EB TM NDLANM+6,B'10000000' 0328 30960000 * GOTO LOCDP3; /* GO TO CHK FOR DATA LIST * 30970000 BC 08,LOCDP3 0329 30980000 * ELSE ; /* YES, ACCT NMBR IN NODELIST * 30990000 * 31000000 * /* INITIALIZE ACCOUNT NUMBER LEVEL * 31010000 * NAMPTR = ADDR(NODEAN); /* SET PDE POINTER * 31020000 LA @F,PARSARS+16 0331 31030000 ST @F,NAMPTR 0331 31040000 * DACCTN1 = ADDR(NODEAN); /* SET PTR TO FIRST NAME PDE * 31050000 LA @F,PARSARS+16 0332 31060000 L @3,DPLPTR 0332 31070000 ST @F,64(0,@3) 0332 31080000 * DACCTNN = ADDR(NODEAN); /* SET PTR TO CURRENT NAME PDE * 31090000 LA @F,PARSARS+16 0333 31100000 ST @F,68(0,@3) 0333 31110000 * DACLSF1 = '0'B; /* SET NAME (NOT *) FLAG * 31120000 NI 84(@3),B'01111111' 0334 31130000 * /* CHK IF * ENTERED FOR ACCOUNT NUMBER * 31140000 * IF NDLAPC1 = '*' /* CHK IF * ENTERED * 31150000 * & NDLALNG = 1 /* AND LENGTH OF 1 * 31160000 * THEN /* YES, * 31170000 L @6,NDLANM 0335 31180000 CLI 0(@6),C'*' 0335 31190000 BC 07,@9EA 0335 31200000 LA @F,1 0335 31210000 CH @F,NDLANM+4 0335 31220000 BC 07,@9E9 0335 31230000 * DACLSF1 = '1'B; /* SET * (NOT ACCTNMBR) FLAG * 31240000 OI 84(@3),B'10000000' 0336 31250000 BC 15,@9E8 0337 31260000 * ELSE /* NO, NOT ASTERISK ALONE * 31270000 * DO; 31280000 @9E9 EQU * 0337 31290000 * DACCTTN = 1; /* SET TOTAL ACCT NMBR CT TO 1 * 31300000 @9EA LA @F,1 0338 31310000 L @3,DPLPTR 0338 31320000 STH @F,88(0,@3) 0338 31330000 * DACCTCN = 1; /* SET CURRENT ACCT NMBR TO 1 * 31340000 STH @F,90(0,@3) 0339 31350000 * END; 31360000 * 31370000 **/* D (NO,LOCDP5,YES,) WAS DATA LIST ENTERED? * 31380000 **/* P SET PARM LIST TO PARSE PROCNAME * 31390000 **/* S COLLCT: SET NUMBER OF PROCNAMES IN DPL * 31400000 **/* P (,LOCDPND) SET ASSIGNED DP TO PROCNAME LEVEL * 31410000 * 31420000 * /* CHK IF ANY DATA LIST ENTERED * 31430000 * IF DATLIN = '0'B 31440000 * THEN /* NO, * 31450000 @9E8 TM DLCTLR+1,B'10000000' 0341 31460000 * GOTO LOCDP5; /* GO TO SET DELETE POINT * 31470000 BC 08,LOCDP5 0342 31480000 * ELSE ; /* YES, PARSE FOR PROCNAME * 31490000 * 31500000 * /* SET UP PARAMETER LIST AND PARSE FOR DATALIST PROCNAME * 31510000 * PPLPCL = PRSDPNP; /* SET PTR TO PROCNAME PCL * 31520000 L @3,PPLPTR 0344 31530000 MVC 12(4,@3),PRSDPNP 0344 31540000 * 31550000 * CALL DOPARS; /* GO TO CALL PARSE * 31560000 BAL @E,DOPARS 0345 31570000 * 31580000 * GENERATE (USING PNMPD,PDLPTR); 31590000 USING PNMPD,PDLPTR 31600000 DS 0H 31610000 * PDLPTR = DATRPTR; /* SET PTR TO PDL * 31620000 L @4,PARSARS+36 0347 31630000 * NAMPTR = ADDR(DATPN); /* SET PTR TO FIRST PDE * 31640000 LA @F,DATPN 0348 31650000 ST @F,NAMPTR 0348 31660000 * 31670000 * DNMIDP = ADDR(DROCNM); /* SET PTR TO DPL LEVEL * 31680000 L @3,DPLPTR 0349 31690000 LA @F,92(0,@3) 0349 31700000 ST @F,DNMIDP 0349 31710000 * 31720000 * CALL COLLCT; /* GO TO COLLECT COUNT * 31730000 BAL @E,COLLCT 0350 31740000 * 31750000 * /* SET ASSIGNED DELETE POINT AT PROCNAME LEVEL * 31760000 * DADP = ADDR(DROCNM); /* SET ASSIGNED DELETE POINT * 31770000 L @3,DPLPTR 0351 31780000 LA @F,92(0,@3) 0351 31790000 ST @F,0(0,@3) 0351 31800000 * GOTO LOCDPND; /* GO TO SET INITIAL DP * 31810000 BC 15,LOCDPND 0352 31820000 * 31830000 * 31840000 **/*LOCDP1: D (NO,LOCDP2,YES,) ANY DATA LIST? * 31850000 **/* S DOPARS: PARSE DATA LIST PASSWORD * 31860000 **/* S COLLCT: (,LOCDP4) SET NUMBER OF PASSWORDS IN DPL * 31870000 * 31880000 * LOCDP1: /* CHK IF ANY DATA LIST * 31890000 * IF DATLIN = '0'B 31900000 * THEN /* NO, * 31910000 LOCDP1 TM DLCTLR+1,B'10000000' 0353 31920000 * GOTO LOCDP2; /* GO TO CHK FOR USERID = * * 31930000 BC 08,LOCDP2 0354 31940000 * ELSE ; /* YES, DATA LIST EXISTS * 31950000 * 31960000 * /* SET UP PARAMETER LIST AND PARSE FOR DATALIST PASSWORD * 31970000 * PPLPCL = PRSDPWP; /* SET PTR TO PASSWORD PCL * 31980000 L @3,PPLPTR 0356 31990000 MVC 12(4,@3),PRSDPWP 0356 32000000 * 32010000 * CALL DOPARS; /* GO TO CALL PARSE * 32020000 BAL @E,DOPARS 0357 32030000 * 32040000 * GENERATE (USING PWDPD,PDLPTR); 32050000 USING PWDPD,PDLPTR 32060000 DS 0H 32070000 * PDLPTR = DATRPTR; /* SET PTR TO PDL * 32080000 L @4,PARSARS+36 0359 32090000 * NAMPTR = ADDR(DATPW); /* SET PTR TO FIRST PDE * 32100000 LA @F,DATPW 0360 32110000 ST @F,NAMPTR 0360 32120000 * 32130000 * DNMIDP = ADDR(DPASWD); /* SET PTR TO DPL LEVEL * 32140000 L @3,DPLPTR 0361 32150000 LA @F,36(0,@3) 0361 32160000 ST @F,DNMIDP 0361 32170000 * 32180000 * CALL COLLCT; /* GO TO COLLECT COUNT * 32190000 BAL @E,COLLCT 0362 32200000 * 32210000 * GOTO LOCDP4; /* GO TO ASSIGN PASSWORD DP * 32220000 BC 15,LOCDP4 0363 32230000 * 32240000 * 32250000 **/*LOCDP2: S DENQ: ENQUEUE OPENUADS * 32260000 **/* S DELSTO: DO STOW-DELETE * 32270000 **/* P (,DOCLOS) GO TO EXIT * 32280000 * 32290000 * LOCDP2: /* ESTABLISH ASSIGNED DELETE POINT IN DPL * 32300000 * DADP = ADDR(DUSERID); /* SET ASSIGNED DELETE POINT * 32310000 LOCDP2 L @3,DPLPTR 0364 32320000 LA @F,8(0,@3) 0364 32330000 ST @F,0(0,@3) 0364 32340000 * LEVLP = DADP; /* SET FOR POSTING LEVEL PTR * 32350000 MVC LEVLP(4),0(@3) 0365 32360000 * 32370000 * CALL DENQ; /* GO TO ENQUEUE AND OPEN * 32380000 BAL @E,DENQ 0366 32390000 * CALL DELSTO; /* GO TO DO STOW-DELETE * 32400000 BAL @E,DELSTO 0367 32410000 * GOTO DOCLOS; /* GO TO END-EXIT * 32420000 BC 15,DOCLOS 0368 32430000 * 32440000 * 32450000 * 32460000 **/*LOCDP3: D (YES,LOCDP3A,NO,) ANY DATA LIST? * 32470000 **/*LOCDP4: P (,LOCDPND) SET ASSIGNED DP TO PASSWORD LEVEL * 32480000 **/*LOCDP3A: S DOPARS: PARSE FOR DATALIST ACCTNMBR * 32490000 **/* S COLLCT: SET NUMBER OF ACCTNMBRS IN DPL * 32500000 * 32510000 * LOCDP3: /* CHK IF ANY DATA LIST WAS ENTERED * 32520000 * IF DATLIN = '0'B /* CHK FOR ANY DATA LIST FLAG * 32530000 * THEN /* NO, * 32540000 LOCDP3 TM DLCTLR+1,B'10000000' 0369 32550000 BC 05,@9E7 0369 32560000 * DO; 32570000 * LOCDP4: /* SET ASSIGNED DELETE POINT AT PASSWORD LEVEL * 32580000 * DADP = ADDR(DPASWD); /* SET ASSIGNED DP * 32590000 LOCDP4 L @3,DPLPTR 0371 32600000 LA @F,36(0,@3) 0371 32610000 ST @F,0(0,@3) 0371 32620000 * GOTO LOCDPND; /* GO TO SET INITIAL DP * 32630000 BC 15,LOCDPND 0372 32640000 * END; 32650000 * ELSE ; /* YES, DATA LIST ENTERED * 32660000 @9E7 EQU * 0374 32670000 * 32680000 * /* SET UP PARAMETER LIST AND PARSE FOR DATALIST ACCT NMBR * 32690000 * PPLPCL = PRSDANP; /* SET PTR TO ACCT NMBR PCL * 32700000 @9E6 L @3,PPLPTR 0375 32710000 MVC 12(4,@3),PRSDANP 0375 32720000 * 32730000 * CALL DOPARS; /* GO TO CALL PARSE * 32740000 BAL @E,DOPARS 0376 32750000 * 32760000 * GENERATE (USING ANMPD,PDLPTR); 32770000 USING ANMPD,PDLPTR 32780000 DS 0H 32790000 * PDLPTR = DATRPTR; /* SET PTR TO PDL * 32800000 L @4,PARSARS+36 0378 32810000 * NAMPTR = ADDR(DATAN); /* SET PTR TO FIRST PDE * 32820000 LA @F,DATAN 0379 32830000 ST @F,NAMPTR 0379 32840000 * 32850000 * DNMIDP = ADDR(DACCTN); /* SET PTR TO DPL LEVEL * 32860000 L @3,DPLPTR 0380 32870000 LA @F,64(0,@3) 0380 32880000 ST @F,DNMIDP 0380 32890000 * 32900000 * CALL COLLCT; /* GO TO COLLECT COUNT * 32910000 BAL @E,COLLCT 0381 32920000 * 32930000 * GENERATE (DROP PDLPTR); 32940000 DROP PDLPTR 32950000 DS 0H 32960000 * 32970000 **/*LOCDP5: P SET ASSIGNED DP TO ACCOUNT NUMBER LEVEL * 32980000 **/*LOCDPND: P INITIALIZE CURRENT DELETE POINT LEVEL * 32990000 **/* S DENQ: EUQUEUE OPENUADS * 33000000 **/* R GO TO EXCISOR ROUTINE, IKJDEL2 * 33010000 * 33020000 * LOCDP5: /* SET ASSIGNED DELETE POINT AT ACCOUNT NUMBER LEVEL * 33030000 * DADP = ADDR(DACCTN); /* SET ASSIGNED DP * 33040000 LOCDP5 L @3,DPLPTR 0383 33050000 LA @F,64(0,@3) 0383 33060000 ST @F,0(0,@3) 0383 33070000 * 33080000 * LOCDPND: /* SET INITIAL DELETE POINT * 33090000 * DCDP = DADP; /* FROM ASSIGNED DP * 33100000 LOCDPND L @3,DPLPTR 0384 33110000 MVC 4(4,@3),0(@3) 0384 33120000 * 33130000 * CALL DENQ; /* GO TO ENQUEUE AND OPEN * 33140000 BAL @E,DENQ 0385 33150000 * GOTO IKJEFA32; /* GO TO CONTINUE PROCESSING * 33160000 L @3,@V1 ADDRESS OF IKJEFA32 0386 33170000 BCR 15,@3 0386 33180000 * 33190000 **/*DENQ: E ENTRY * 33200000 **/*DENQ2: L ENQUEUE ON SYSUADS-OPENUADS * 33210000 **/* D (NO,DENQ2,YES,) ENQUEUE SUCCESSFUL? * 33220000 **/* S OPENDCB: OPEN DCB TO READ-WRITE MEMBER(BPAM) * 33230000 **/* D (NO,%DNQOUT,YES,) WAS USERID ENTRY ASTERISK? * 33240000 **/* S OPENDCB: OPEN DCB TO READ DIRECTORY (BSAM) * 33250000 **/*%DNQOUT: R RETURN * 33260000 * 33270000 * DENQ: /* EP TO EXECUTE ENQUEUE AND OPEN * 33280000 * SAV14DR = R14; /* SAVE PROCEED PTR * 33290000 DENQ ST @E,FLOPTRS+4 0387 33300000 * 33310000 * DENQ2: R1 = ADDR(NQOPN); /* SET PTR TO ENQ PARM BLOCK * 33320000 DENQ2 LA @1,NQOPN 0388 33330000 * 33340000 * /* ENQUEUE SYSUADS-OPEN * 33350000 * GENERATE; 33360000 ENQ ,MF=(E,(1)) 33370000 DS 0H 33380000 * 33390000 * /* CHK FOR SUCCESSFUL ENQUEUE, IF NOT, REPEAT * 33400000 * RCPTR = R15; /* SET RETURN CODE PTR * 33410000 ST @F,RCPTR 0390 33420000 * /* CHK FOR SUCCESSFUL RETURN CODE * 33430000 * IF RCPTR ª= 0 /* IS CODE UNSUCCESSFUL CODE * 33440000 * & RCLC1 ª= 8 /* AND NOT NOW IN FORCE CODE * 33450000 * THEN /* YES, * 33460000 SR @F,@F 0391 33470000 C @F,RCPTR 0391 33480000 BC 08,@9E5 0391 33490000 L @3,RCPTR 0391 33500000 CLI 3(@3),8 0391 33510000 * GOTO DENQ2; /* GO TO TRY AGAIN * 33520000 BC 07,DENQ2 0392 33530000 * 33540000 * /* OPEN UADS DCB FOR READ/WRITE MEMBER * 33550000 * 33560000 * PDLPTR = ADDR(DELDCB); /* SET PTR TO DCB * 33570000 @9E4 EQU * 0393 33580000 @9E5 LA @4,DELDCB 0393 33590000 * R1 = ADDR(DLOPNL); /* SET PTR TO PARM LIST * 33600000 LA @1,DLOPNL 0394 33610000 * 33620000 * CALL OPENDCB; /* GO TO OPEN READ/WRITE DCB * 33630000 BAL @E,OPENDCB 0395 33640000 * 33650000 * /* CHK IF USERID ENTERED AS ASTERISK, IF SO, OPEN DCB * 33660000 * /* FOR DIRECTORY READ * 33670000 * IF DUCLSF1 = '1'B /* CHK FOR ASTERISK FLAG * 33680000 * THEN /* YES, OPEN DCB * 33690000 L @3,DPLPTR 0396 33700000 TM 28(@3),B'10000000' 0396 33710000 BC 12,@9E3 0396 33720000 * DO; 33730000 * PDLPTR = ADDR(DIRDCB); /* SET PTR TO DCB * 33740000 LA @4,DIRWA 0398 33750000 * R1 = ADDR(DDOPNL); /* SET PTR TO PARM LIST * 33760000 LA @1,DDOPNL 0399 33770000 * CALL OPENDCB; /* GO TO OPEN DIRECTORY DCB * 33780000 BAL @E,OPENDCB 0400 33790000 * RELEASE (PDLPTR); /* FREE POINTER * 33800000 * END; 33810000 * ELSE ; /* USERID NOT ASTERISK * 33820000 @9E3 EQU * 0403 33830000 * 33840000 * GOTO DRDFLO; /* GO TO CONTINUE * 33850000 @9E2 L @3,FLOPTRS+4 FLOPTRS 0404 33860000 BCR 15,@3 0404 33870000 * 33880000 **/*NVLDCMD: CHART * 33890000 **/*NVLDCMD: E ENTRY * 33900000 **/* P (,%MSGF1) SET INDEX FOR MESSAGE 19 * 33910000 **/*MSGNGRM: E ENTRY FOR MULTI-LEVEL MESSAGES * 33920000 **/*%MSGF1: S MSGFNDR: LOCATE MESSAGE TEXT * 33930000 **/* S (,%MSGF4) FXPUTLM: SET PUTLINE PARM BLOCK * 33940000 * 33950000 * NVLDCMD: /* INVALID COMMAND ENTRY INDICATOR * 33960000 * MSGNO = 19; /* SET MESSAGE INDEX * 33970000 NVLDCMD LA @F,19 0405 33980000 STH @F,MSGNO 0405 33990000 * 34000000 * MSGNGRM: /* EP FOR MULTI=LEVEL MESSAGES * 34010000 * CALL MSGFNDR; /* GO TO LOCATE MESSAGE TEXT * 34020000 MSGNGRM BAL @E,MSGFNDR 0406 34030000 * CALL FXPUTLM; /* GO TO INITIALIZE PARM BLOCK * 34040000 BAL @E,FXPUTLM 0407 34050000 * GOTO MSGNGRC; /* CONTINUE TO ISSUE MESSAGE * 34060000 BC 15,MSGNGRC 0408 34070000 * 34080000 **/*MSGNGRC: E (,%MSGF4) ENTRY * 34090000 **/*NOSPAZ: E ENTRY * 34100000 **/* P (,%MSGF3) SET INDEX FOR MESSAGE 1 * 34110000 **/*MSGNGR: E ENTRY * 34120000 **/*%MSGF3: S MSGFNDR: LOCATE MESSAGE TEXT * 34130000 **/* S FXPUTL: SET PUTLINE PARM BLOCK * 34140000 * 34150000 * NOSPAZ: /* GETMAIN FAILURE INDICATOR * 34160000 * MSGNO = 1; /* SET MESSAGE INDEX * 34170000 NOSPAZ LA @F,1 0409 34180000 STH @F,MSGNO 0409 34190000 * 34200000 * MSGNGR: /* EP FOR SINGLE LEVEL MESSAGES * 34210000 * /* SET UP MESSAGE ROUTINE AND ERROR FLAG FOR * 34220000 * /* TERMINATION MESSAGE * 34230000 * CALL MSGFNDR; /* GO TO LOCATE MESSAGE TEXT * 34240000 MSGNGR BAL @E,MSGFNDR 0410 34250000 * CALL FXPUTL; /* GO TO INITIALIZE PARM BLOCK * 34260000 BAL @E,FXPUTL 0411 34270000 * 34280000 **/*%MSGF4: S (,%MSGF5) DOPUTL: ISSUE MESSAGE * 34290000 * 34300000 * MSGNGRC: CALL DOPUTL; /* GO TO ISSUE PUTLINE * 34310000 MSGNGRC BAL @E,DOPUTL 0412 34320000 * 34330000 **/*%MSGF5: D (NO,%MSGF6,YES,) WAS USERID ENTRY ASTERISK? * 34340000 **/* P SET TO SKIP DELETE STATUS CHECK * 34350000 **/*%MSGF6: R GO TO USERU * 34360000 * 34370000 * /* CHK IF USERID ENTRY WAS ASTERISK M1859 * 34380000 * IF DUCLSF1 = '0'B /* CHK FOR ASTERISK M1859 * 34390000 * THEN /* NO, M1859 * 34400000 L @3,DPLPTR 0413 34410000 TM 28(@3),B'10000000' 0413 34420000 BC 05,@9E1 0413 34430000 * NODELR = '1'B; /* SET NO DELETE STATUS M1859 * 34440000 OI DLCTLR+2,B'00001000' 0414 34450000 * ELSE; /* YES, CHECK NEXT USER M1859 * 34460000 @9E1 EQU * 0415 34470000 * GOTO USERU; /* GO TO EXIT M1859 * 34480000 @9E0 L @4,@V3 ADDRESS OF USERU 0416 34490000 BCR 15,@4 0416 34500000 * 34510000 **/*NVLDCMD: END * 34520000 **/*IKJEFA30: CHART * 34530000 **/*NONAM: E ENTRY * 34540000 **/* P SET INDEX FOR PROCNAME MESSAGE * 34550000 * 34560000 * NONAM: /* SPECIFIED NAME NOT FOUND * 34570000 * SAV14V = R14; /* RESERVE LINK REGISTER * 34580000 NONAM ST @E,SAV14V 0417 34590000 * 34600000 * /* SET MESSAGE INDEX FOR PROCNAME MESSAGE * 34610000 * MSGNO = 17; /* SET MESSAGE INDEX * 34620000 LA @F,17 0418 34630000 STH @F,MSGNO 0418 34640000 * 34650000 **/* D (NO,%NONM1,YES,) USERID LEVEL NOW? * 34660000 **/* P SET INDEX FOR USERID MESSAGE * 34670000 * 34680000 * /* CHK TO SET FOR USERID MESSAGE * 34690000 * IF DADP = ADDR(DUSERID) /* CHK FOR USERID LEVEL * 34700000 * THEN /* YES, * 34710000 L @3,DPLPTR 0419 34720000 LA @F,8(0,@3) 0419 34730000 C @F,0(0,@3) 0419 34740000 BC 07,@9DF 0419 34750000 * MSGNO = 5; /* SET USERID MESSAGE INDEX * 34760000 LA @F,5 0420 34770000 STH @F,MSGNO 0420 34780000 * ELSE ; /* NO, NOT USERID * 34790000 @9DF EQU * 0421 34800000 * 34810000 **/*%NONM1: D (NO,%NONM2,YES,) PASSWORD LEVEL NOW? * 34820000 **/* P SET INDEX FOR PASSWORD MESSAGE * 34830000 * 34840000 * /* CHK TO SET FOR PASSWORD MESSAGE * 34850000 * IF DADP = ADDR(DPASWD) /* CHK FOR USERID LEVEL * 34860000 * THEN /* YES, * 34870000 @9DE LA @F,36(0,@3) 0422 34880000 C @F,0(0,@3) 0422 34890000 BC 07,@9DD 0422 34900000 * MSGNO = 15; /* SET PASSWORD MESSAGE INDEX * 34910000 LA @F,15 0423 34920000 STH @F,MSGNO 0423 34930000 * ELSE ; /* NO, NOT PASSWORD * 34940000 @9DD EQU * 0424 34950000 * 34960000 **/*%NONM2: D (NO,%NONM3,YES,) ACCTNMBR LEVEL NOW? * 34970000 **/* P SET INDEX FOR ACCOUNT NUMBER MESSAGE * 34980000 * 34990000 * /* CHK TO SET FOR ACCOUNT NUMBER MESSAGE * 35000000 * IF DADP = ADDR(DACCTN) /* CHK FOR ACCT NMBR LEVEL * 35010000 * THEN /* YES, * 35020000 @9DC LA @F,64(0,@3) 0425 35030000 C @F,0(0,@3) 0425 35040000 BC 07,@9DB 0425 35050000 * MSGNO = 16; /* SET ACCT NMBR MESSAGE INDEX * 35060000 LA @F,16 0426 35070000 STH @F,MSGNO 0426 35080000 BC 15,@9DA 0427 35090000 * ELSE ; /* NOT ACCOUNT NUMBER * 35100000 @9DB EQU * 0427 35110000 * 35120000 **/*%NONM3: D (NO,%NONM4,YES,) ANY USEFUL WORK DONE? * 35130000 **/* S (,%NONM5) MSGFND: LOCATE MESSAGE TEXT * 35140000 **/*%NONM4: S MSGFNDR: LOCATE ERROR MESSAGE TEXT * 35150000 **/*%NONM5: S FXPUTL: SET PARM BLOCK FOR PUTLINE * 35160000 **/* S DOPUTL: ISSUE MESSAGE * 35170000 **/* R RETURN * 35180000 * 35190000 * /* CHK IF ANY USEFUL WORK ACCOMPLISHED * 35200000 * IF WRTDON = '1'B /* CHK WORK DONE FLAGS M5522 * 35210000 * THEN /* YES, * 35220000 @9DA TM DLCTLR+3,B'00100000' 0428 35230000 BC 12,@9D9 0428 35240000 * CALL MSGFND; /* THEN LOCATE MESSAGE TEXT * 35250000 BAL @E,MSGFND 0429 35260000 BC 15,@9D8 0430 35270000 * ELSE /* NO USEFUL WORK DONE * 35280000 * CALL MSGFNDR; /* LOCATE MESSAGE TEXT(ERROR) * 35290000 @9D9 BAL @E,MSGFNDR 0430 35300000 * CALL FXPUTL; /* GO TO INITIALIZE PARM BLOCK * 35310000 @9D8 BAL @E,FXPUTL 0431 35320000 * 35330000 * /* SET UP NAME IMAGE * 35340000 * TMSGTIL1 = NAMLNG+4; /* EXTRACT LENGTH * 35350000 LA @F,4 0432 35360000 L @3,NAMPTR 0432 35370000 MVC @TEMP2+2(2),4(@3) 0432 35380000 A @F,@TEMP2 0432 35390000 STH @F,TMSGTIX1 0432 35400000 * TMSGTIO1 = 11; /* SET INSERTION OFFSET * 35410000 LA @F,11 0433 35420000 STH @F,TMSGTIX1+2 0433 35430000 * TMSGTIN1(1:NAMLNG) = NAMPTRC; /* SET NAME IN SEGMENT * 35440000 L @4,NAMPTR 0434 35450000 L @4,0(0,@4) NAMPDE 0434 35460000 LR @E,@4 0434 35470000 MVC @TEMP2+2(2),4(@3) 0434 35480000 L @6,@TEMP2 0434 35490000 BCTR @6,0 0434 35500000 LA @A,TMSGTIX1+4 0434 35510000 EX @6,@MVC 0434 35520000 * 35530000 * /* SET UP SEGMENT LIST * 35540000 * TMSGNS1(1:12) = TMXMDL; /* SET STANDARD SEGMENT PTRS * 35550000 L @6,MSGPTR 0435 35560000 MVC TMSGNS1(12),0(@6) 0435 35570000 * TMSGNP13 = ADDR(TMSGTIX1); /* SET PTR TO NAME SEGMENT * 35580000 LA @F,TMSGTIX1 0436 35590000 ST @F,TMSGNS1+12 0436 35600000 * PTPBOPUT = ADDR(TMSGNS1); /* SET SEGMENT LIST PTR IN PB * 35610000 LA @F,TMSGNS1 0437 35620000 L @4,PTPBPTR 0437 35630000 ST @F,4(0,@4) 0437 35640000 * 35650000 * CALL DOPUTL; /* GO TO ISSUE PUTLINE * 35660000 BAL @E,DOPUTL 0438 35670000 * 35680000 * R14 = SAV14V; /* RESTORE LINK REGISTER * 35690000 L @E,SAV14V 0439 35700000 * GEN(BCR 15,@E); /* RETURN TO CALLER * 35710000 BCR 15,@E 35720000 DS 0H 35730000 * 35740000 **/*MSGNGRX: E ENTRY * 35750000 **/*DOCLOSR: E ENTRY * 35760000 **/* P SET NO DELETED MESSAGE FLAG * 35770000 **/* P (,%DOCLOS1) SET NO STATUS CHECK FLAG * 35780000 * 35790000 * MSGNGRX: /* EP FOR ERROR END FROM IKJEFA32 M1859 * 35800000 * DOCLOSR: /* EP FOR ERROR END M3772 * 35810000 * /* SET BYPASS-CHECK FLAGS M3651 * 35820000 * DELERR = '1'B; /* SET NO SUCCESS MESSAGE FLAG * 35830000 MSGNGRX EQU * 0441 35840000 DOCLOSR OI DLCTLR+1,B'00100000' 0441 35850000 * /* M3772 * 35860000 * NODELR = '1'B; /* SET NO STATUS CHECK FLAG * 35870000 OI DLCTLR+2,B'00001000' 0442 35880000 * /* M3651 * 35890000 **/*DOCLOS: E ENTRY * 35900000 **/*%DOCLOS1: D (NO,%DOCLOS2,YES,) FREE RD BUFFER NOW? * 35910000 **/* S DOWRT2: FREE READ BUFFER * 35920000 **/* S CHKNQ: CHECK/DEQUEUE MEMBER * 35930000 * 35940000 * DOCLOS: /* EP TO DO CLOSE UADS DCB AND DIRECTORY DCB * 35950000 * 35960000 * SAV14DR = ADDR(FRERD); /* SET RETURN ADDRESS M2582 * 35970000 DOCLOS LA @F,FRERD 0443 35980000 ST @F,FLOPTRS+4 0443 35990000 * /* CHK IF NECESSARY TO FREE READ BUFFER M3050 * 36000000 * IF RDDONE = '1'B /* CHK FOR READ BUFFER FLAG * 36010000 * THEN /* YES, * 36020000 TM DLCTLR+2,B'00000010' 0444 36030000 BC 12,@9D7 0444 36040000 * DO; 36050000 * RWPF5 = '0'B; /* SET NO-WRITE FLAG * 36060000 NI RWPB,B'11110111' 0446 36070000 * GOTO DOWRT2; /* GO TO FREE BUFFER * 36080000 L @3,@V4 ADDRESS OF DOWRT2 0447 36090000 BCR 15,@3 0447 36100000 * END; /* M3050 * 36110000 * GOTO CHKNQ; /* GO TO DEQUEUE MEMBER NAME * 36120000 @9D7 L @3,@V5 ADDRESS OF CHKNQ 0449 36130000 BCR 15,@3 0449 36140000 * /* M2582 * 36150000 * FRERD: ; /* TARGET NAME FOR RETURN M2582 * 36160000 * 36170000 **/*%DOCLOS2: S CLOSDCB: CLOSE READ DIRECTORY DCB * 36180000 **/* S CLOSDCB: CLOSE READ MEMBER DCB * 36190000 **/* D (YES,RELDL,NO,) QUIT NOW FLAGS ON? * 36200000 **/* D (NO,DOEND1,YES,) CHK DELETE STATUS NOW? * 36210000 **/* S DELREC: CHK FOR MISSING NAMES * 36220000 * 36230000 * /* CLOSE DIRECTORY DCB * 36240000 * RESTRICT (PDLPTR); 36250000 * PDLPTR = ADDR(DIRDCB); /* SET PTR TO DIRECTORY DCB * 36260000 FRERD LA @4,DIRWA 0452 36270000 * CALL CLOSDCB; /* GO TO ISSUE CLOSE * 36280000 BAL @E,CLOSDCB 0453 36290000 * 36300000 * /* CLOSE UADS DCB * 36310000 * PDLPTR = ADDR(DELDCB); /* SET PTR TO UADS DCB * 36320000 LA @4,DELDCB 0454 36330000 * CALL CLOSDCB; /* GO TO ISSUE CLOSE * 36340000 BAL @E,CLOSDCB 0455 36350000 * RELEASE (PDLPTR); /* FREE POINTER * 36360000 * 36370000 * /* CHK FOR FORCED TERMINATION * 36380000 * IF ECTATRM = '1'B /* CHK ECT QUIT FLAG * 36390000 * ³ ECBCPL = '1'B /* CHK POSTED FLAG * 36400000 * THEN /* YES, * 36410000 L @3,ECTPTR 0457 36420000 TM 28(@3),B'00100000' 0457 36430000 BC 01,@9D6 0457 36440000 L @4,SAVGR1 0457 36450000 L @4,8(0,@4) ACCTPL 0457 36460000 TM 0(@4),B'01000000' 0457 36470000 BC 12,@9D5 0457 36480000 * GOTO RELDL; /* GO TO NEXT CLEAN UP * 36490000 BC 03,RELDL 0458 36500000 * 36510000 * /* CHK TO EXAMINE DELETE STATUS * 36520000 * IF NODELR = '1'B /* CHK NO-DELETE STATUS FLAG * 36530000 * THEN /* YES, * 36540000 @9D5 TM DLCTLR+2,B'00001000' 0459 36550000 * GOTO DOEND1; /* SKIP DELETE STATUS CHECK * 36560000 BC 01,DOEND1 0460 36570000 * ELSE ; /* NO, DO STATUS CHECK * 36580000 * 36590000 * /* SET PRINT NOW FLAG AND PROCESS NAMES NOT FOUND * 36600000 * NODELR = '1'B; /* SET TO SKIP REPEAT PRINT * 36610000 OI DLCTLR+2,B'10001000' 0462 36620000 * PRTNOW = '1'B; /* SET PRINT FLAG * 36630000 * LEVLP = DADP; /* SET TO PRINT DELETE LEVEL * 36640000 L @3,DPLPTR 0464 36650000 MVC LEVLP(4),0(@3) 0464 36660000 * CALL DELREC; /* GO TO PRINT MISSING NAMES * 36670000 L @F,@V6 ADDRESS OF DELREC 0465 36680000 BALR @E,@F 0465 36690000 * 36700000 **/*DOEND1: D (YES,NOEDM,NO,) SKIP DELETED MESSAGE? * 36710000 **/* D (YES,RELDL,NO,) WAS SPECIFIC USERID DELETED? * 36720000 **/* S MSGFND: LOCATE MESSAGE TEXT * 36730000 **/* S FXPUTL: SET PARM BLOCK FOR PUTLINE * 36740000 **/* S (,RELDL) DOPUTL: ISSUE MESSAGE * 36750000 * 36760000 * DOEND1: /* CHK FOR SUCCESSFUL OPERATION * 36770000 * IF DELERR = '1'B /* CHK FOR ERROR FLAG * 36780000 * THEN /* YES, * 36790000 DOEND1 TM DLCTLR+1,B'00100000' 0466 36800000 * GOTO NOEDM; /* SKIP SUCCESS MESSAGE * 36810000 BC 01,NOEDM 0467 36820000 * ELSE /* ERROR FLAG NOT SET * 36830000 * DELERR = '1'B; /* SET TO SKIP REPEAT PRINT * 36840000 OI DLCTLR+1,B'00100000' 0468 36850000 * 36860000 * /* CHK FOR USERID DELETIONS UNDER * MODE * 36870000 * IF DELRSP = '1'B /* CHK IF ANY USERID DELETED * 36880000 * & DUCLSF1 = '0'B /* AND USERID WAS NOT * ENTRY * 36890000 * THEN /* YES, IN COMBINATION * 36900000 TM DLCTLR+1,B'00001000' 0469 36910000 BC 12,@9D4 0469 36920000 L @3,DPLPTR 0469 36930000 TM 28(@3),B'10000000' 0469 36940000 * GOTO RELDL; /* SKIP 'DELETED' MESSAGE * 36950000 BC 10,RELDL 0470 36960000 * ELSE ; /* NO COMBINATION * 36970000 @9D3 EQU * 0471 36980000 * 36990000 * /* ISSUE SUCCESSFUL OPERATION MESSAGE -- DELETED * 37000000 * MSGNO = 8; /* SET MESSAGE INDEX * 37010000 @9D4 LA @F,8 0472 37020000 STH @F,MSGNO 0472 37030000 * CALL MSGFND; /* GO TO LOCATE MESSAGE TEXT * 37040000 BAL @E,MSGFND 0473 37050000 * CALL FXPUTL; /* GO TO INITIALIZE PARM BLOCK * 37060000 BAL @E,FXPUTL 0474 37070000 * CALL DOPUTL; /* GO TO ISSUE PUTLINE * 37080000 BAL @E,DOPUTL 0475 37090000 * GOTO RELDL; /* GO TO EXIT * 37100000 BC 15,RELDL 0476 37110000 * 37120000 **/*NOEDM: L POST ERROR CODE * 37130000 * 37140000 * NOEDM: /* MESSAGE BYPASS TARGET * 37150000 * /* ISSUE TERMINATION POST * 37160000 * GENERATE; 37170000 NOEDM EQU * 0477 37180000 L POSTR,BASECBP SET PTR TO DELETE ECB 37190000 POST (POSTR),15 37200000 DS 0H 37210000 * 37220000 **/*RELDL: D (NO,DODEQ,YES,) ANY DATA LIST? * 37230000 **/* D (NO,%RLDL1,YES,) WAS DATA BUFFER ACQUIRED? * 37240000 **/* L FREE DATA BUFFER * 37250000 **/*%RLDL1: S PARSREL: FREE DATA LIST PDL * 37260000 **/*DODEQ: L DEQUEUE SYSIKJUA-OPENUADS * 37270000 * 37280000 * RELDL: /* CHK TO RELEASE ORIGINAL PDL AREA FOR DATA LIST * 37290000 * IF DATLIN = '0'B /* CHK IF DATA LIST ENTERED * 37300000 * THEN /* NO, * 37310000 RELDL TM DLCTLR+1,B'10000000' 0478 37320000 * GOTO DODEQ; /* GO TO DEQUEUE UADS * 37330000 BC 08,DODEQ 0479 37340000 * ELSE ; /* YES, DATA LIST EXISTS * 37350000 * 37360000 * /* CHK TO FREE DATA LIST BUFFER * 37370000 * IF DATNOW = '1'B /* CHK FOR GOTMAIN FLAG * 37380000 * THEN /* YES, * 37390000 TM DLCTLR+3,B'10000000' 0481 37400000 BC 12,@9D2 0481 37410000 * DO; 37420000 * DATNOW = '0'B; /* CLEAR GOTMAIN FLAG * 37430000 NI DLCTLR+3,B'01111111' 0483 37440000 * R0 = CMDDLNG+SPN1; /* SET LENGTH AND SUBPOOL NO * 37450000 MVC @TEMP4(4),SPN1 0484 37460000 L @F,@TEMP4 0484 37470000 L @3,DATLOC 0484 37480000 AH @F,4(0,@3) 0484 37490000 LR @0,@F 0484 37500000 * R1 = GMAINA; /* SET PTR TO FREEABLE AREA * 37510000 L @1,GMAINA 0485 37520000 * /* EXECUTE FREEMAIN * 37530000 * GENERATE; 37540000 FREEMAIN R,LV=(0),A=(1) 37550000 DS 0H 37560000 * END; 37570000 * 37580000 * DATLIN = '0'B; /* SET DATA LIST FREE FLAG * 37590000 @9D2 NI DLCTLR+1,B'01111111' 0488 37600000 * R1 = ADDR(DATRPTR); /* SET PTR TO RELEASE AREA * 37610000 LA @1,PARSARS+36 0489 37620000 * CALL PARSREL; /* GO TO PARSE RELEASE CALL * 37630000 BAL @E,PARSREL 0490 37640000 * 37650000 * DODEQ: /* DEQUEUE SYSIKJUA-OPEN * 37660000 * R1 = ADDR(DQOPN); /* SET PTR TO DEQ PARM BLOCK * 37670000 DODEQ LA @1,DQOPN 0491 37680000 * GENERATE; 37690000 DEQ ,MF=(E,(1)) 37700000 DS 0H 37710000 * 37720000 * GOTO DELEND; /* GO TO EXIT TO CALLER * 37730000 BC 15,DELEND 0493 37740000 * 37750000 **/*MAINRET: R RETURN TO CALLER * 37760000 * 37770000 * 37780000 * 37790000 * MAINRET: /* MAIN END, RETURN TO CALLER OF DELETE THROUGH DELEND * 37800000 * /* DUMMY PROCEDURE TO ENCLOSE MAIN EXIT INSTRUCTIONS * 37810000 * 37820000 * PROCEDURE 37830000 * OPTIONS( 37840000 * DONTSAVE, /* NO REGISTERS SAVED * 37850000 * NOSAVEAREA); /* NO SAVE AREA GENERATED * 37860000 @EL01 L @D,4(0,@D) 0494 37870000 LR @1,@C 0494 37880000 L @0,@SIZ001 0494 37890000 FREEMAIN R,LV=(0),A=(1) 0494 37900000 LM @E,@C,12(@D) 0494 37910000 BCR 15,@E 0494 37920000 MAINRET EQU * 0494 37930000 * 37940000 * END MAINRET; 37950000 @EL02 BCR 15,@E 0495 37960000 * 37970000 **/*OPENDCB: E ENTRY * 37980000 **/* D (YES,OPDCBR,NO,) IS DCB OPEN NOW? * 37990000 **/* L OPEN DCB * 38000000 **/* D (YES,OPDCBR,NO,) IS DCB OPEN NOW? * 38010000 **/* P SET INDEX FOR MESSAGE * 38020000 **/* R GO TO MSGNGRM * 38030000 **/*OPDCBR: R RETURN TO CALLER * 38040000 * 38050000 * OPENDCB: /* OPEN DATA CONTROL BLOCK ROUTINE EP * 38060000 * 38070000 * PROCEDURE 38080000 * OPTIONS( 38090000 * DONTSAVE, /* NO REGISTERS SAVED * 38100000 * NOSAVEAREA); /* NO SAVE AREA GENERATED * 38110000 * 38120000 * RESTRICT (PDLPTR); /* RESERVE FOR POINTER SERVICE * 38130000 * RESTRICT (PLPTR); /* RESERVE FOR SERVICE RTN PL * 38140000 * RESTRICT (R8); /* RESERVE FOR STATIC DATA PTR * 38150000 * RESTRICT (R9); /* RESERVE FOR PTR TO IKJDEL2 * 38160000 * 38170000 * SAV14DC = R14; /* RESERVE LINK REGISTER * 38180000 OPENDCB ST @E,SAV14DC 0501 38190000 * 38200000 * /* ESTABLISH ADDRESSABILITY FOR DCB * 38210000 * GENERATE (USING IHADCB,PDLPTR); 38220000 USING IHADCB,PDLPTR 38230000 DS 0H 38240000 * 38250000 * /* CHK IF OPEN AND IF SO, RETURN * 38260000 * IF DCBOFLG = '1'B /* CHK FOR OPEN FLAG IN DCB * 38270000 * THEN /* YES, * 38280000 TM DCBFLGS,B'00010000' 0503 38290000 * GOTO OPDCBR; /* GO TO EXIT * 38300000 BC 01,OPDCBR 0504 38310000 * ELSE ; /* NOT OPEN * 38320000 * 38330000 * /* ISSUE OPEN * 38340000 * GENERATE (OPEN ((PDLPTR),),MF=(E,(1))); 38350000 OPEN ((PDLPTR),),MF=(E,(1)) 38360000 DS 0H 38370000 * 38380000 * /* CHK IF OPEN NOW * 38390000 * IF DCBOFLG = '0'B /* CHK FOR OPEN FLAG * 38400000 * THEN /* NO, * 38410000 TM DCBFLGS,B'00010000' 0507 38420000 BC 05,@9D1 0507 38430000 * DO; 38440000 * /* FAILURE IN OPEN PROCESSING * 38450000 * MSGNO = 3; /* SET MESSAGE INDEX * 38460000 LA @F,3 0509 38470000 STH @F,MSGNO 0509 38480000 * GOTO MSGNGRM; /* GO TO SET ERROR MESSAGE * 38490000 BC 15,MSGNGRM 0510 38500000 * END; 38510000 * ELSE ; /* YES, OPEN SUCCESSFUL * 38520000 @9D1 EQU * 0512 38530000 * 38540000 * OPDCBR: /* RETURN TO CALLER * 38550000 * R14 = SAV14DC; /* RESTORE LINK REGISTER * 38560000 @9D0 EQU * 0513 38570000 OPDCBR L @E,SAV14DC 0513 38580000 * RETURN; /* EXIT * 38590000 BC 15,@EL03 0514 38600000 * 38610000 * /* RELEASE DCB ADDRESSABILITY * 38620000 * GENERATE (DROP PDLPTR); 38630000 DROP PDLPTR 38640000 DS 0H 38650000 * RELEASE (PDLPTR); /* FREE POINTER * 38660000 * 38670000 * END OPENDCB; 38680000 @EL03 BCR 15,@E 0517 38690000 ** /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 38700000 ** /* * 38710000 ** /* D E L S T O : EXECUTE STOW-DELETE TO REMOVE A DELETED * 38720000 ** /* USERID MEMBER FROM THE UADS DIRECTORY * 38730000 ** /* * 38740000 ** /* FORM THE FIRST UADS-TYPE USERID NAME BY ADDING A CHARACTER * 38750000 ** /* OF ZERO DIRECTLY AFTER THE BASIC NAME CHARACTER STRING. * 38760000 ** /* EXECUTE A STOW-DELETE ON THAT MODIFIED NAME. IF THE STOW * 38770000 ** /* IS SUCCESSFUL (RETURN CODE OF 0), ADD A VALUE OF 1 TO THE * 38780000 ** /* APPENDED CHARACTER IN THE USERID NAME AND RE-ISSUE THE * 38790000 ** /* STOW-DELETE. REPEAT THIS SUCCESSFUL PROCESS UNTIL 9 MEMBER * 38800000 ** /* BLOCKS (APPENDED CHARACTER 9) HAVE BEEN REMOVED, THEN GO * 38810000 ** /* TO DOBLDU TO EXIT * 38820000 ** /* * 38830000 ** /* IF A RETURN CODE OF 8 IS RETURNED BEFORE NINE MEMBERS HAVE * 38840000 ** /* BEEN REMOVED, CHECK IF APPENDED CHARACTER IS ZERO (FIRST * 38850000 ** /* MEMBER) SIGNIFYING NO SUCH MEMBER NAME EXISTS IN THE UADS. * 38860000 ** /* IF YES, GO TO ISSUE AN ERROR MESSAGE AND RETURN. IF EXTENT * 38870000 ** /* CHARACTER IS NOT ZERO, ALL MEMBER NAMES OF THAT USERID HAVE * 38880000 ** /* BEEN REMOVED FROM THE DIRECTORY. GO TO DOBLDU TO RETURN * 38890000 ** /* * 38900000 ** /* IF RETURN CODE IS OTHER THAN 8, ISSUE THE SYSTEM COMMAND * 38910000 ** /* ERROR MESSAGE WITH STOW ERROR CODE * 38920000 ** /* * 38930000 ** /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 38940000 * 38950000 **/*DELSTO: E ENTRY * 38960000 **/* S DOENQ2: ENQUEUE ON MEMBER NAME * 38970000 **/* P SET STOW NAME FOR INITIAL MEMBER EXTENT * 38980000 **/*DELSTOD: L ISSUE STOW DELETE * 38990000 **/* D (NO,%DELST1,YES,) WAS STOW SUCCESSFUL? * 39000000 **/* D (YES,DOBLDU,NO,) WAS LAST USERID EXTENT? * 39010000 **/* P (,DELSTOD) SET FOR NEXT USERID EXTENT * 39020000 * 39030000 * DELSTO: /* EP TO STOW AND BUILD UDL ROUTINE * 39040000 * 39050000 * PROCEDURE 39060000 * OPTIONS( 39070000 * DONTSAVE, /* NO REGISTERS SAVED * 39080000 * NOSAVEAREA); /* NO SAVE AREA GENERATED * 39090000 * 39100000 * RESTRICT (PLPTR); /* RESERVE FOR SERVICE RTN PL * 39110000 * RESTRICT (R8); /* RESERVE FOR STATIC DATA PTR * 39120000 * RESTRICT (R9); /* RESERVE FOR PTR TO IKJDEL2 * 39130000 * RESTRICT (R7); /* RESERVE FOR PTR TO IKJDEL2 * 39140000 * 39150000 * SAV14DS = R14; /* RESERVE LINK REGISTER * 39160000 DELSTO ST @E,SAV14DS 0523 39170000 * 39180000 * CALL DOENQ2; /* ENQUEUE ON MEMBER NAME * 39190000 L @F,@V7 ADDRESS OF DOENQ2 0524 39200000 BALR @E,@F 0524 39210000 * /* M2582 * 39220000 * 39230000 * STOLST = ' '; /* BLANK OUT USERID FIELD * 39240000 MVI STOLST,C' ' 0525 39250000 MVC STOLST+1(7),STOLST 0525 39260000 * STOLST(1:NDLILNG) = NDLIPC;/* SET UP USERID NAME * 39270000 L @1,NDLIDM 0526 39280000 LR @E,@1 0526 39290000 LH @3,NDLIDM+4 0526 39300000 BCTR @3,0 0526 39310000 LA @A,STOLST 0526 39320000 EX @3,@MVC 0526 39330000 * UDLMOD = STOLST; /* SAVE MODEL FOR UDL * 39340000 MVC UDLMOD(8),STOLST 0527 39350000 * STOLST(NDLILNG+1) = '0'; /* SET FOR INITIAL MEMBER * 39360000 LA @3,1 0528 39370000 AH @3,NDLIDM+4 0528 39380000 LA @A,STOLST-1(@3) 0528 39390000 MVI 0(@A),C'0' 0528 39400000 * 39410000 * /* DELETE CURRENT USERID FROM UADS * 39420000 * DELSTOD: /* EXECUTE STOW-DELETE * 39430000 * ; /* NULL STATEMENT FOR LABEL * 39440000 * GENERATE; 39450000 DELSTOD EQU * 0530 39460000 STOW DELDCB,STOLST,D STOW-DELETE CURRENT USERID 39470000 DS 0H 39480000 * 39490000 * RTNCODE = R15; /* RESERVE RETURN CODE * 39500000 ST @F,RTNCODE 0531 39510000 * 39520000 * /* CHK FOR SUCCESSFUL STOW-DELETE * 39530000 * IF RTNCODE = 0 /* CHK IF STOW SUCCESSFUL * 39540000 * THEN /* YES, * 39550000 SR @F,@F 0532 39560000 C @F,RTNCODE 0532 39570000 BC 07,@9CF 0532 39580000 * /* CHK IF DELETE COMPLETE * 39590000 * IF STOLST(NDLILNG+1)='9' /* CHK FOR LAST EXTENT * 39600000 * THEN /* YES, * 39610000 LA @1,1 0533 39620000 AH @1,NDLIDM+4 0533 39630000 LA @A,STOLST-1(@1) 0533 39640000 CLI 0(@A),C'9' 0533 39650000 * GOTO DOBLDU; /* GO TO EXIT * 39660000 BC 08,DOBLDU 0534 39670000 * ELSE /* NOT YET FOUND COMPLETE * 39680000 * DO; 39690000 * STOLST(NDLILNG+1) = /* STEP EXTENT NUMBER * 39700000 * STOLST(NDLILNG+1)+1; /* BY ONE * 39710000 LA @F,1 0536 39720000 LR @3,@F 0536 39730000 AH @3,NDLIDM+4 0536 39740000 SR @0,@0 0536 39750000 IC @0,STOLST-1(@3) 0536 39760000 AR @F,@0 0536 39770000 LA @6,1 0536 39780000 AH @6,NDLIDM+4 0536 39790000 STC @F,STOLST-1(@6) 0536 39800000 * GOTO DELSTOD; /* GO TO STOW NEXT EXTENT * 39810000 BC 15,DELSTOD 0537 39820000 * END; 39830000 * ELSE ; /* NOT SUCCESSFUL * 39840000 @9CF EQU * 0539 39850000 * 39860000 **/*%DELST1: D (YES,%NOID1,NO,) ID NOT-FOUND CODE NOW? * 39870000 **/* P SET ERROR MESSAGE INDEX * 39880000 **/* R GO TO SYSERRD * 39890000 **/*%NOID1: P SET POST,NOT PRINT FLAG FOR DELREC * 39900000 **/* D (NO,DOBLDU,YES,) UNABLE TO FIND 1ST EXTENT? * 39910000 **/* S DELREC: POST DELETE FAILURE * 39920000 **/* R GO TO DOCLOS * 39930000 * 39940000 * /* CHK FOR FAILURE TO FIND USERID IN DIRECTORY * 39950000 * IF RTNCODE ª= 8 /* CHK FOR FAILURE TO FIND ID * 39960000 * THEN /* NOT ID SEARCH FAILURE, * 39970000 @9CE LA @F,8 0540 39980000 C @F,RTNCODE 0540 39990000 BC 08,@9CD 0540 40000000 * DO; /* CHECK FOR I/O OR INV. M1859 * 40010000 * IF RTNCODE = 16 /* IS THIS AN I/O ERROR M1859 * 40020000 * THEN /* YES M1859 * 40030000 LA @F,16 0542 40040000 C @F,RTNCODE 0542 40050000 BC 07,@9CC 0542 40060000 * DO; 40070000 * MSGNO = 7; /* PUT OUT ERROR MESSAGE M1859 * 40080000 LA @F,7 0544 40090000 STH @F,MSGNO 0544 40100000 * GOTO MSGNGRM; /* GO TO ISSUE MESSAGE M1859 * 40110000 BC 15,MSGNGRM 0545 40120000 * END; 40130000 * ELSE 40140000 * MSGNO = 14; /* SET MESSAGE INDEX * 40150000 @9CC LA @F,14 0547 40160000 STH @F,MSGNO 0547 40170000 * SOFFS = 26; /* SET INSERT OFFSET M2582 * 40180000 @9CB LA @F,26 0548 40190000 STH @F,SOFFS 0548 40200000 * R14 = ADDR(DOCLOSR); /* SET FLOW POINTER M3772 * 40210000 LA @E,DOCLOSR 0549 40220000 * GOTO SYSERRD; /* GO TO ISSUE MESSAGE * 40230000 BC 15,SYSERRD 0550 40240000 * END; 40250000 * ELSE ; /* YES, ID NOT FOUND * 40260000 @9CD EQU * 0552 40270000 * PRTNOW = '0'B; /* SET POST, NOT PRINT FLAG * 40280000 @9CA NI DLCTLR+2,B'01111111' 0553 40290000 * 40300000 * /* CHK FOR FAILURE TO FIND ANY SUCH NAME * 40310000 * IF STOLST(NDLILNG+1)='0' /* CHK IF FIRST EXTENT * 40320000 * THEN /* YES, * 40330000 LA @1,1 0554 40340000 AH @1,NDLIDM+4 0554 40350000 LA @A,STOLST-1(@1) 0554 40360000 CLI 0(@A),C'0' 0554 40370000 BC 07,@9C9 0554 40380000 * DO; 40390000 * NOID: /* UNABLE TO FIND SPECIFIED USERID * 40400000 * LEVLP = DADP; /* SET POST LEVEL TO ASSIGNED * 40410000 NOID L @1,DPLPTR 0556 40420000 MVC LEVLP(4),0(@1) 0556 40430000 * DELNOW = '0'B; /* SET NO DELETE FLAG * 40440000 NI DLCTLR+2,B'10111111' 0557 40450000 * CALL DELREC; /* GO TO POST DELETE FAILURE * 40460000 L @F,@V6 ADDRESS OF DELREC 0558 40470000 BALR @E,@F 0558 40480000 * GOTO DOCLOS; /* GO TO EXIT * 40490000 BC 15,DOCLOS 0559 40500000 * END; 40510000 * ELSE /* CURRENT EXTENT NOT FOUND * 40520000 * GOTO DOBLDU; /* LAST EXTENT WAS DELETED * 40530000 ** /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 40540000 ** /* * 40550000 ** /* DOBLDU: SET THE DELETED FLAG IN THE USERID PDE. EXECUTE * 40560000 ** /* GETMAIN TO GET SPACE FOR THE USER IDENTITY LIST (UDL). IF * 40570000 ** /* GETMAIN FAILS, GO TO ISSUE THE INSUFFICIENT MAIN STORAGE * 40580000 ** /* ERROR MESSAGE. LOCATE THE NEXT SEQUENTIAL POSITION IN UDL * 40590000 ** /* CHAIN AND LINK IN NEW ENTRY. * 40600000 ** /* * 40610000 ** /* BUILD THE ENTRY FROM DELETE INDICATOR FLAG, A COUNT OF THE * 40620000 ** /* DELETED MEMBER NAMES INCLUDED IN THIS ENTRY, AND THE CHAR- * 40630000 ** /* ACTER STRINGS FOR THE NAMES * 40640000 ** /* * 40650000 ** /* RETURN TO CALLER * 40660000 ** /* * 40670000 ** /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 40680000 * 40690000 **/*DOBLDU: P SET USERID DELETED AND STOW DONE FLAGS * 40700000 **/* S DELREC: POST USERID DELETED * 40710000 **/* S GETMAIN: GET SPACE FOR UDL ENTRY * 40720000 **/*UDLPSTP: P ADD UDL ENTRY TO CHAIN * 40730000 **/* R RETURN * 40740000 * 40750000 * DOBLDU: /* SET UP UDL ENTRY FOR ACCOUNT * 40760000 * 40770000 * /* SET USERID DELETED FLAG AND STOW-DONE FLAG * 40780000 * DELNOW = '1'B; /* SET DELETED FLAG * 40790000 @9C8 EQU * 0562 40800000 DOBLDU OI DLCTLR+2,B'01000000' 0562 40810000 * CALL DELREC; /* GO TO POST DELETION * 40820000 L @F,@V6 ADDRESS OF DELREC 0563 40830000 BALR @E,@F 0563 40840000 * STODON = '1'B; /* SET STOW-DONE FLAG M * 40850000 OI DLCTLR+3,B'00000010' 0564 40860000 * 40870000 * /* GET SPACE FOR UDL ENTRY * 40880000 * GENERATE; 40890000 MVC BLDUDL(BGMLNG),BLDUDLM INITIALIZE PARM LIST 40900000 LA GMSPP,GOTMNP SET PTR TO RESPONSE AREA 40910000 LA R1,BLDUDL SET PTR TO PARM LIST 40920000 GETMAIN ,A=(GMSPP),MF=(E,(1)) 40930000 DS 0H 40940000 * 40950000 * RTNCODE = R15; /* RESERVE RETURN CODE * 40960000 ST @F,RTNCODE 0566 40970000 * 40980000 * /* CHK FOR SUCCESSFUL GETMAIN * 40990000 * IF RTNCODE = 4 /* CHK FOR FAILURE CODE * 41000000 * THEN /* YES, * 41010000 LA @F,4 0567 41020000 C @F,RTNCODE 0567 41030000 * GOTO NOSPAZ; /* GO TO ISSUE NO SPACE MSG * 41040000 BC 08,NOSPAZ 0568 41050000 * ELSE ; /* GETMAIN SUCCESSFUL * 41060000 * 41070000 * GOTMSPZ = '0'B; /* CLEAR FIRST 8 BYTES OF NEW * 41080000 L @1,GOTMNP 0570 41090000 MVI 0(@1),B'00000000' 0570 41100000 XC 1(7,@1),1(@1) 0570 41110000 * /* UDL ENTRY * 41120000 * UIDLPTR = ADDR(ARESP); /* INITIALIZE WITH FIRST PTR * 41130000 L @3,SAVGR1 0571 41140000 LA @F,16(0,@3) 0571 41150000 ST @F,UIDLPTR 0571 41160000 * 41170000 * UDLPSTP: /* LOCATE NEXT POSITION IN UDL CHAIN * 41180000 * 41190000 * /* CHK FOR LAST PTR IN CHAIN * 41200000 * IF UIDLNEX ª= 0 /* 0 = LAST PTR * 41210000 * THEN /* NOT LAST PTR * 41220000 UDLPSTP SR @F,@F 0572 41230000 L @1,UIDLPTR 0572 41240000 C @F,0(0,@1) 0572 41250000 BC 08,@9C7 0572 41260000 * DO; 41270000 * UIDLPTR = UIDLNEX; /* STEP PTR * 41280000 MVC UIDLPTR(4),0(@1) 0574 41290000 * GOTO UDLPSTP; /* NOT LAST PTR * 41300000 BC 15,UDLPSTP 0575 41310000 * END; 41320000 * ELSE ; /* IS LAST PTR * 41330000 @9C7 EQU * 0577 41340000 * 41350000 * UIDLNEX = GOTMNP; /* SET NEW SPACE LOC IN PTR * 41360000 @9C6 L @1,UIDLPTR 0578 41370000 MVC 0(4,@1),GOTMNP 0578 41380000 * UIDLPTR = UIDLNEX; /* SET PTR TO NEW ENTRY BLOCK * 41390000 MVC UIDLPTR(4),0(@1) 0579 41400000 * UIDDEL = '1'B; /* SET DELETE RESULT FLAG * 41410000 L @1,UIDLPTR 0580 41420000 OI 4(@1),B'01000000' 0580 41430000 * UIDLCT = 1; /* SET MEMBER COUNT * 41440000 LA @F,1 0581 41450000 STH @F,6(0,@1) 0581 41460000 * UIDLN1(1) = UDLMOD; /* SET MEMBER NAME IN ENTRY * 41470000 MVC 8(8,@1),UDLMOD 0582 41480000 * 41490000 * /* CREATE EXIT FOR STOW * 41500000 * R14 = SAV14DS; /* RESTORE LINK REGISTER * 41510000 L @E,SAV14DS 0583 41520000 * END DELSTO; /* RETURN TO CALLER * 41530000 @EL04 BCR 15,@E 0584 41540000 ** /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 41550000 ** /* * 41560000 ** /* C L O S D C B : SET LOCATION OF CLOSE PARAMETER LIST * 41570000 ** /* (DLCLSL) IN REGISTER 1. IF DCB IS CURRENTLY OPEN (CHECK * 41580000 ** /* OPEN FLAG (DCBOPEN) IN DCB), ISSUE CLOSE AND RETURN TO * 41590000 ** /* CALLER * 41600000 ** /* * 41610000 ** /* AT ENTRY, PDLPTR POINTS TO THE DCB * 41620000 ** /* * 41630000 ** /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 41640000 * 41650000 **/*CLOSDCB: E ENTRY * 41660000 **/* D (NO,%CLSDCBX,YES,) DCB OPEN NOW? * 41670000 **/* S CLOSE: CLOSE DCB * 41680000 **/*%CLSDCBX: R RETURN * 41690000 * 41700000 * CLOSDCB: /* CLOSE UADS AND DIRECTORY DCBS ROUTINE EP * 41710000 * 41720000 * PROCEDURE 41730000 * OPTIONS( 41740000 * DONTSAVE, /* NO REGISTERS SAVED * 41750000 * NOSAVEAREA); /* NO SAVE AREA GENERATED * 41760000 * 41770000 * RESTRICT (PDLPTR); /* RESERVE FOR POINTER SERVICE * 41780000 * RESTRICT (PLPTR); /* RESERVE FOR SERVICE RTN PL * 41790000 * RESTRICT (R8); /* RESERVE FOR STATIC DATA PTR * 41800000 * RESTRICT (R9); /* RESERVE FOR PTR TO IKJDEL2 * 41810000 * RESTRICT (R7); /* RESERVE FOR PTR TO IKJDEL2 * 41820000 * 41830000 * SAV14DC = R14; /* RESERVE LINK REGISTER * 41840000 CLOSDCB ST @E,SAV14DC 0591 41850000 * 41860000 * /* ESTABLISH ADDRESSABILITY FOR DCB * 41870000 * RESTRICT (R1); 41880000 * GENERATE (USING IHADCB,PDLPTR); 41890000 USING IHADCB,PDLPTR 41900000 DS 0H 41910000 * 41920000 * R1 = ADDR(DLCLSL); /* SET PTR TO CLOSE C P PL * 41930000 LA @1,DLCLSL 0594 41940000 * 41950000 * /* CHK IF OPEN NOW AND IF SO, CLOSE * 41960000 * IF DCBOFLG = '1'B /* CHK FOR OPEN FLAG IN DCB * 41970000 * THEN /* YES, CLOSE * 41980000 TM DCBFLGS,B'00010000' 0595 41990000 BC 12,@9C5 0595 42000000 * /* ISSUE CLOSE * 42010000 * GENERATE (CLOSE ((PDLPTR),),MF=(E,(1))); 42020000 CLOSE ((PDLPTR),),MF=(E,(1)) 42030000 DS 0H 42040000 * ELSE ; /* NO, NOT OPEN * 42050000 @9C5 EQU * 0597 42060000 * 42070000 * R14 = SAV14DC; /* RESTORE LINK REGISTER * 42080000 @9C4 L @E,SAV14DC 0598 42090000 * 42100000 * /* RELEASE DCB ADDRESSABILITY * 42110000 * GENERATE(DROP PDLPTR); 42120000 DROP PDLPTR 42130000 DS 0H 42140000 * RELEASE (R1,PDLPTR); /* FREEPOINTER * 42150000 * 42160000 * END CLOSDCB; 42170000 @EL05 BCR 15,@E 0601 42180000 ** /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 42190000 ** /* * 42200000 ** /* M S G F N D R : EP TO LOCATE ERROR MESSAGE ROUTINE. SET * 42210000 ** /* ERROR FLAG (DELERR) * 42220000 ** /* * 42230000 ** /* M S G F N D : EP TO LOCATE NON-ERROR MESSAGE ROUTINE. * 42240000 ** /* FORM A POINTER TO THE MESSAGE OFFSET BY SUBTRACTING 2 FROM * 42250000 ** /* TH SUM OF THE LOCATION OF THE MESSAGE CSECT (ANDXL) AND THE * 42260000 ** /* THE VALUE OF THE MESSAGE INDEX NUMBER (MSGN0) TIMES 2. * 42270000 ** /* ADD THAT LOCATED OFFSET VALUE (MOFFNC) TO THE LOCATION OF * 42280000 ** /* THE MESSAGE CSECT (ANDXL) TO FORM A POINTER TO THE MESSAGE * 42290000 ** /* SEGMENT LIST IN MSGPTR. RETURN TO CALLER * 42300000 ** /* * 42310000 ** /* AT ENTRY, MSGNO CONTAINS THE MESSAGE INDEX NUMBER * 42320000 ** /* * 42330000 ** /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 42340000 * 42350000 **/*MSGFNDR: E ENTRY * 42360000 **/* P (,%MSGFND) SET ERROR FLAG, DELERR * 42370000 **/*MSGFND: E ENTRY * 42380000 **/*%MSGFND: P LOCATE TEXT THROUGH INDEX * 42390000 **/* R RETURN * 42400000 * 42410000 * MSGFNDR: /* LOCATE MESSAGE TEXT ROUTINE EP * 42420000 * 42430000 * PROCEDURE 42440000 * (DUMIR1M) /* RESERVE ENTRY REGISTER 1 * 42450000 * OPTIONS( 42460000 * DONTSAVE, /* NO REGISTERS SAVED * 42470000 * NOSAVEAREA); /* NO SAVE AREA GENERATED * 42480000 * 42490000 * RESTRICT (PLPTR); /* RESERVE FOR SERVICE RTN PL * 42500000 * RESTRICT (R8); /* RESERVE FOR STATIC DATA PTR * 42510000 * RESTRICT (R9); /* RESERVE FOR PTR TO IKJDEL2 * 42520000 * RESTRICT (R7); /* RESERVE FOR PTR TO IKJDEL2 * 42530000 * 42540000 * DELERR = '1'B; /* SET ERROR FLAG * 42550000 MSGFNDR OI DLCTLR+1,B'00100000' 0607 42560000 * 42570000 * MSGFND: /* EP FOR NON-ERROR MESSAGE * 42580000 * 42590000 * SAV14MF = R14; /* RESERVE LINK REGISTER * 42600000 MSGFND ST @E,SAV14MF 0608 42610000 * MOFFNO = (MSGNO*2)+ADDR(ANDXL)-2; /* FORM PTR TO OFFSET * 42620000 LA @E,2 0609 42630000 MH @E,MSGNO 0609 42640000 L @3,@A8 ADDRESS OF ANDXL 0609 42650000 AR @E,@3 0609 42660000 SH @E,@D1 0609 42670000 ST @E,MOFFNO 0609 42680000 * MSGPTR = MOFFNC + ADDR(ANDXL); /* FORM PTR TO TEXT * 42690000 LR @F,@3 0610 42700000 L @6,MOFFNO 0610 42710000 AH @F,0(0,@6) 0610 42720000 ST @F,MSGPTR 0610 42730000 * R14 = SAV14MF; /* RESTORE LINK REGISTER * 42740000 L @E,SAV14MF 0611 42750000 * END MSGFNDR; /* RETURN TO CALLER * 42760000 @EL06 BCR 15,@E 0612 42770000 ** /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 42780000 ** /* * 42790000 ** /* S Y S E R R D : CALL MSGFNDR TO OBTAIN PTR TO MESSAGE SEG- * 42800000 ** /* MENT LIST. UNPACK THE THREE RETURN CODE CHARACTERS OUT * 42810000 ** /* OF THE RETURN CODE SAVE AREA (RTNCODE) INTO THE INSERT * 42820000 ** /* TEXT AREA (TMSGTIN1) AND TRANSLATE THEM INTO EBCDIC CHAR- * 42830000 ** /* ACTERS. BUILD INSERT SEGMENT LISTS IN LOCATIONS (TMSGNS1) * 42840000 ** /* AND (TMSGNS2). * 42850000 ** /* * 42860000 ** /* CALL PUTLINE TO ISSUE MESSAGE * 42870000 ** /* * 42880000 ** /* RETURN VIA FLOW CONTROL POINTER (ERRFLO) * 42890000 ** /* * 42900000 ** /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 42910000 * 42920000 **/*SYSERRD: E ENTRY * 42930000 **/* S MSGFNDR: LOCATE MESSAGE TEXT * 42940000 **/* P CONVERT RETURN CODE TO DECIMAL * 42950000 **/* P UNPACK TO EBCDIC * 42960000 **/* S FXPUTLM: SET PUTLINE PARM BLOCK * 42970000 **/* S DOPUTL: ISSUE MESSAGE * 42980000 **/* R RETURN * 42990000 * 43000000 * SYSERRD: /* SYSTEM ERROR MESSAGE ROUTINE EP * 43010000 * PROCEDURE 43020000 * (DUMIR1E) 43030000 * OPTIONS( 43040000 * DONTSAVE, /* NO REGISTERS SAVED * 43050000 * NOSAVEAREA); /* NO SAVE AREA CREATED * 43060000 * 43070000 * RESTRICT (PLPTR); /* RESERVE FOR POINTER SERVICE * 43080000 * RESTRICT (R8); /* RESERVE FOR STATIC DATA PTR * 43090000 * RESTRICT (R9); /* RESERVE FOR PTR TO IKJDEL2 * 43100000 * RESTRICT (R7); /* RESERVE FOR PTR TO IKJDEL2 * 43110000 * 43120000 * /* EP TO FORM HEXIDECIMAL PRINT IMAGE FOR MESSAGE * 43130000 * SAV14E = R14; /* SAVE RETURN PTR * 43140000 SYSERRD ST @E,FLOPTRS 0618 43150000 * CALL MSGFNDR; /* GO TO LOCATE MESSAGE * 43160000 BAL @E,MSGFNDR 0619 43170000 * 43180000 * /* UNPACK TO EBCDIC CHARACTERS * 43190000 * GENERATE; 43200000 L R3,RTNCODE GET RETURN CODE M1859 43210000 CVD R3,DBLWORD CONVERT TO DECIMAL M1859 43220000 UNPK MSGCDE(2),DBLWORD+6(2) UNPACK BINARY AREA M1859 43230000 OI MSGCDE+1,X'F0' REMOVE SIGN M1859 43240000 DS 0H 43250000 * 43260000 * TMSGNS1(1:12) = TMLMDL1(1:12); /* SET SEGMENT LIST * 43270000 L @3,MSGPTR 0621 43280000 MVC TMSGNS1(12),0(@3) 0621 43290000 * TMSGNNO1 = ADDR(TMSGNS2); /* SET PTR TO SECOND LEVEL * 43300000 LA @F,TMSGNS2 0622 43310000 ST @F,TMSGNS1 0622 43320000 * TMSGNS2(1:20)=TMLMDL2(1:20); /* SET SECOND SEGMENT LIST * 43330000 L @6,MSGPTR 0623 43340000 L @6,0(0,@6) TMLMDL1 0623 43350000 MVC TMSGNS2(20),0(@6) 0623 43360000 * TMSGNP24 = ADDR(TMSGTIX1); /* SET MESSAGE POINTER * 43370000 LA @F,TMSGTIX1 0624 43380000 ST @F,TMSGNS2+16 0624 43390000 * TMSGTIL1 = 6; /* SET LENGTH OF SEGMENT * 43400000 LA @F,6 0625 43410000 STH @F,TMSGTIX1 0625 43420000 * TMSGTIO1 = SOFFS; /* SET INSERT OFFSET * 43430000 MVC TMSGTIX1+2(2),SOFFS 0626 43440000 * 43450000 * CALL FXPUTLM; /* GO TO INITIALIZE PARM BLOCK * 43460000 BAL @E,FXPUTLM 0627 43470000 * PTPBOPUT = ADDR(TMSGNS1); /* SET MESSAGE PTR * 43480000 LA @F,TMSGNS1 0628 43490000 L @3,PTPBPTR 0628 43500000 ST @F,4(0,@3) 0628 43510000 * CALL DOPUTL; /* GO TO ISSUE MESSAGE * 43520000 BAL @E,DOPUTL 0629 43530000 * GOTO ERRFLO; /* GO TO EXIT * 43540000 L @3,FLOPTRS 0630 43550000 BCR 15,@3 0630 43560000 * 43570000 * END SYSERRD; /* RETURN * 43580000 @EL07 BCR 15,@E 0631 43590000 ** /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 43600000 ** /* * 43610000 ** /* D O P A R S 2 : BUILD A SIMULATED BUFFER IN WHICH A SINGLE * 43620000 ** /* ITEM FROM THE NODELIST PSTRING IS PRESENTED TO PARSE. SET * 43630000 ** /* POINTERS TO THE NEW BUFFER (PPLCBUF) AND TO A RESPONSE * 43640000 ** /* AREA (PPLANS) IN THE PARSE PARAMETER LIST. GO TO LOCATION * 43650000 ** /* DOPARSA TO CALL PARSE * 43660000 ** /* * 43670000 ** /* AT ENTRY, PPLPCL POINTS TO AN APPROPRIATE PCL AND PPLPTR * 43680000 ** /* POINTS TO THE PARSE PARAMETER LIST * 43690000 ** /* * 43700000 ** /* D O P A R S : EXECUTE EXIT TO PARSE AND CHECK RETURN CODE * 43710000 ** /* RECEIVED FROM PARSE * 43720000 ** /* * 43730000 ** /* D O P A R S A : LINK TO PARSE AND AT RETURN, SAVE RETURN * 43740000 ** /* CODE FROM REGISTER 15 IN RTNCODE. IF RETURN CODE IS ZERO * 43750000 ** /* GO TO DIRECT RETURN EXIT (PARSND) * 43760000 ** /* * 43770000 ** /* P A R S C H K : IF RETURN CODE IS 16, GO TO ISSUE THE NOT * 43780000 ** /* THE COMMAND SYSTEM ERROR MESSAGE WITH PARSE ERROR CODE * 43790000 ** /* SUBTENDED. AT ENTRY, PPLPTR POINTS TO A COMPLETE PARSE * 43800000 ** /* PARAMETER LIST (PPL) * 43810000 ** /* * 43820000 ** /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 43830000 * 43840000 **/*DOPARS2: E ENTRY * 43850000 **/* P (,DOPARSA) BUILD TEST BUFFER WITH TEST ITEM * 43860000 **/*DOPARS: E ENTRY * 43870000 **/*DOPARSA: P SET PARSE PARM LIST * 43880000 **/* L SYNTAX CHECK ENTRY * 43890000 **/* D (NO,PARSCHK,YES,) WAS PARSE SUCCESSFUL? * 43900000 **/* D (NO,PARSCHK,YES,) WAS PARSE TERMINATED? * 43910000 **/*PARSND: R RETURN * 43920000 **/*PARSCHK: D (NO,%PRSCHK,YES,) NOT ENOUGH SPACE? * 43930000 **/* R GO TO NOSPAZ * 43940000 **/*%PRSCHK: D (NO,%PRSCHK2,YES,) NO-PROMPT OR ATTN? * 43950000 **/* R GO TO DOCLOSR * 43960000 **/*%PRSCHK2: P SET INVALID PARM MESSAGE INDEX * 43970000 **/* S SYSERRD: ISSUE ERROR MESSAGE * 43980000 **/* R EXIT THROUGH DOCLOSR * 43990000 * 44000000 * DOPARS2: /* EP TO SET UP PARSE BUFFER AND CREATE LINK TO PARSE * 44010000 * PROCEDURE 44020000 * (DUMIR1A) 44030000 * OPTIONS( 44040000 * DONTSAVE, /* NO REGISTERS SAVED * 44050000 * NOSAVEAREA); /* NO SAVE AREA GENERATED * 44060000 * 44070000 * RESTRICT (PDLPTR); /* RESERVE FOR POINTER SERVICE * 44080000 * RESTRICT (PDLPTRA); /* RESERVE FOR POINTER SERVICE * 44090000 * RESTRICT (PLPTR); /* RESERVE FOR SERVICE RTN PL * 44100000 * RESTRICT (R8); /* RESERVE FOR STATIC DATA PTR * 44110000 * RESTRICT (R9); /* RESERVE FOR PTR TO IKJDEL2 * 44120000 * RESTRICT (R7); /* RESERVE FOR PTR TO IKJDEL2 * 44130000 * 44140000 * SAV14A = R14; /* RESERVE LINK REGISTER * 44150000 DOPARS2 ST @E,SAV14A 0639 44160000 * 44170000 * /* SET UP TEST BUFFER * 44180000 * NDIBFL = NAMLNG+6; /* SET UP BUFFER LENGTH * 44190000 LA @F,6 0640 44200000 L @3,NAMPTR 0640 44210000 MVC @TEMP2+2(2),4(@3) 0640 44220000 A @F,@TEMP2 0640 44230000 STH @F,NODIBUF 0640 44240000 * NDIBFO = 0; /* SET TEXT OFFSET * 44250000 SR @F,@F 0641 44260000 STH @F,NODIBUF+2 0641 44270000 * NDIBFTX(1) = '('; /* SET LEFT HAND PAREND * 44280000 MVI NODIBUF+4,C'(' 0642 44290000 * NDIBFTX(2:NAMLNG+1)=NAMPTRC; /* INSERT ITEM TEXT * 44300000 L @6,NAMPTR 0643 44310000 L @6,0(0,@6) NAMPDE 0643 44320000 LR @E,@6 0643 44330000 LA @3,1 0643 44340000 L @6,NAMPTR 0643 44350000 MVC @TEMP2+2(2),4(@6) 0643 44360000 A @3,@TEMP2 0643 44370000 SH @3,@D1 0643 44380000 LA @A,NODIBUF+5 0643 44390000 EX @3,@MVC 0643 44400000 * NDIBFTX(NAMLNG+2) = ')'; /* SET RIGHT HAND PAREND * 44410000 LA @3,2 0644 44420000 MVC @TEMP2+2(2),4(@6) 0644 44430000 A @3,@TEMP2 0644 44440000 LA @A,NODIBUF+3(@3) 0644 44450000 MVI 0(@A),C')' 0644 44460000 * PPLCBUF = ADDR(NODIBUF); /* PTR TO ITEM BUFFER * 44470000 LA @F,NODIBUF 0645 44480000 L @3,PPLPTR 0645 44490000 ST @F,20(0,@3) 0645 44500000 * PPLANS = ADDR(RESPONS); /* PTR TO RESPONSE AREA * 44510000 LA @F,PARSARS+32 0646 44520000 ST @F,16(0,@3) 0646 44530000 * 44540000 * GOTO DOPARSA; /* SKIP 2ND ENTRY * 44550000 BC 15,DOPARSA 0647 44560000 * 44570000 * DOPARS: /* EP TO CREATE LINK TO PARSE * 44580000 * SAV14A = R14; /* RESERVE LINK REGISTER * 44590000 DOPARS ST @E,SAV14A 0648 44600000 * DOPARSA: /* TARGET TO SKIP 2ND SAVE OF LINK REGISTER * 44610000 * /* INITIALIZE PARSE PL * 44620000 * GENERATE; 44630000 DOPARSA EQU * 0649 44640000 MVC PRSCPL(LNKLNG),MPRSCPL SET LIST 44650000 DS 0H 44660000 * R1 = ADDR(PPL); /* SET P P PARM LIST PTR * 44670000 L @3,PPLPTR 0650 44680000 LR @1,@3 0650 44690000 * R15 = ADDR(PRSCPL); /* SET C P PARM LIST PTR * 44700000 LA @F,PRSCPL 0651 44710000 * 44720000 * /* CREATE LINKAGE TO PARSE * 44730000 * GENERATE; 44740000 LINK MF=(E,(1)),SF=(E,(15)) GO TO PARSE 44750000 DS 0H 44760000 * 44770000 * /* CHK RETURN CODE FROM PARSE * 44780000 * RTNCODE = R15; /* RESERVE RETURN CODE * 44790000 ST @F,RTNCODE 0653 44800000 * 44810000 * /* CHK FOR SUCCESSFUL COMPLETION * 44820000 * IF RTNCODE = 0 /* CHK FOR ZERO * 44830000 * ³ RTNCODE = 20 /* CHK FOR QUIT REQUEST * 44840000 * THEN /* YES, * 44850000 SR @F,@F 0654 44860000 C @F,RTNCODE 0654 44870000 BC 08,@9C3 0654 44880000 LA @F,20 0654 44890000 C @F,RTNCODE 0654 44900000 BC 07,@9C2 0654 44910000 * GOTO PARSND; /* RETURN TO CALLER * 44920000 BC 08,PARSND 0655 44930000 * ELSE ; /* PARSE NOT SUCCESSFUL * 44940000 @9C2 EQU * 0656 44950000 * 44960000 * 44970000 * PARSCHK: /* PARSE FAILURE INDICATOR ROUTINE * 44980000 * 44990000 * /* CHK FOR TERMINATION RETURN * 45000000 * /* CHK FOR FAILURE TO RECEIVE SUFFICIENT SPACE * 45010000 * IF RTNCODE = 16 /* CHK FOR NO SPACE CODE * 45020000 * THEN /* YES, * 45030000 PARSCHK LA @F,16 0657 45040000 C @F,RTNCODE 0657 45050000 * GOTO NOSPAZ; /* GO TO ISSUE NO SPACE MSG * 45060000 BC 08,NOSPAZ 0658 45070000 * ELSE ; /* NOT LACK OF SPACE * 45080000 * 45090000 * /* CHK FOR INABILITY-TO-PROMPT OR ATTENTION M4480 * 45100000 * IF RTNCODE < 12 /* CHK NO PROMPT/ATTN M4480 * 45110000 * THEN /* YES, M4480 * 45120000 LA @F,12 0660 45130000 C @F,RTNCODE 0660 45140000 * GOTO DOCLOSR; /* GO TO EXIT M3651 * 45150000 BC 02,DOCLOSR 0661 45160000 * 45170000 * /* PARSE FAILURE * 45180000 * MSGNO = 20; /* SET INVALID PARMS INDEX * 45190000 LA @F,20 0662 45200000 STH @F,MSGNO 0662 45210000 * SOFFS = 22; /* SET TEXT OFFSET * 45220000 LA @F,22 0663 45230000 STH @F,SOFFS 0663 45240000 * R14 = ADDR(DOCLOSR); /* SET TERMINATION EXIT * 45250000 LA @E,DOCLOSR 0664 45260000 * GOTO SYSERRD; /* GO TO ISSUE MESSAGE * 45270000 BC 15,SYSERRD 0665 45280000 * 45290000 * PARSND: /* RETURN TO CALLER , * 45300000 * R14 = SAV14A; /* RESTORE LINK REGISTER * 45310000 PARSND L @E,SAV14A 0666 45320000 * END DOPARS2; /* RETURN TO CALLER * 45330000 @EL08 BCR 15,@E 0667 45340000 ** /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 45350000 ** /* * 45360000 ** /* P A R S R E L : EXECUTE A LINK TO IKJRLSA, THE ROUTINE IN * 45370000 ** /* PARSE WHICH RELEASES THE MAIN STORAGE HOLDING A SPECIFIED * 45380000 ** /* PARSE DESCRIPTOR LIST (PDL) * 45390000 ** /* * 45400000 ** /* AT ENTRY, REGISTER 1 POINTS TO THE RESPONSE AREA IN WHICH * 45410000 ** /* PARSE HAD PLACED A POINTER TO THE PDL * 45420000 ** /* * 45430000 ** /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 45440000 * 45450000 **/*PARSREL: E ENTRY * 45460000 **/* L FREE PARSE RESPONSE AREA * 45470000 **/* R RETURN * 45480000 * 45490000 * PARSREL: /* PARSE RELEASE CALL ROUTINE EP * 45500000 * PROCEDURE 45510000 * (DUMIR1P) 45520000 * OPTIONS( 45530000 * DONTSAVE, /* NO REGISTERS SAVED * 45540000 * NOSAVEAREA); /* NO SAVE AREA GENERATED * 45550000 * 45560000 * RESTRICT (PLPTR); /* RESERVE FOR SERVICE RTN PL * 45570000 * RESTRICT (R8); /* RESERVE FOR STATIC DATA PTR * 45580000 * RESTRICT (R9); /* RESERVE FOR PTR TO IKJDEL2 * 45590000 * RESTRICT (R7); /* RESERVE FOR PTR TO IKJDEL2 * 45600000 * 45610000 * /* RESERVE RETURN PTR * 45620000 * SAV14FM = R14; 45630000 PARSREL ST @E,SAV14FM 0673 45640000 * 45650000 * /* RELEASE PDL AREA * 45660000 * GENERATE; 45670000 IKJRLSA (1) GO TO PARSE RELEASE 45680000 DS 0H 45690000 * 45700000 * /* RESTORE RETURN PTR * 45710000 * R14 = SAV14FM; 45720000 L @E,SAV14FM 0675 45730000 * 45740000 * 45750000 * END PARSREL; 45760000 @EL09 BCR 15,@E 0676 45770000 * 45780000 ** /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 45790000 ** /* * 45800000 ** /* C H K P S : VALIDITY CHECK EXIT ROUTINE TO SCAN NODELIST * 45810000