TITLE ' IKJEFE05 - EXEC PARAMETER DEFINITION MODULE' 00010000 * GEN(TITLE 'IKJEFE05 - EXEC PARAMETER DEFINITION MODULE'); 00020000 TITLE 'IKJEFE05 - EXEC PARAMETER DEFINITION MODULE' 00030000 * IKJEFE05: PROC(DUMPARM) OPTIONS 00040000 * (DONTSAVE(1,2,3,4,5,15),REENTRANT,CODEREG(9,11));/*Y01676* 00050000 LCLA &T,&SPN 0002 00060000 .@001 ANOP 0002 00070000 IKJEFE05 CSECT , 0002 00080000 ST @E,12(0,@D) 0002 00090000 ST @0,20(0,@D) 0002 00100000 STM @6,@C,44(@D) 0002 00110000 BALR @9,0 0002 00120000 @PSTART DS 0H 0002 00130000 USING @PSTART+00000,@9 0002 00140000 LA @B,4095(0,@9) 0002 00150000 USING @PSTART+04095,@B 0002 00160000 LR @C,@1 0002 00170000 L @0,@SIZ001 0002 00180000 GETMAIN R,LV=(0) 0002 00190000 XR @C,@1 0002 00200000 XR @1,@C 0002 00210000 XR @C,@1 0002 00220000 USING @DATD+00000,@C 0002 00230000 L @0,20(0,@D) 0002 00240000 XC @TEMPS(@L),@TEMPS 0002 00250000 ST @D,@SAV001+4 0002 00260000 LA @F,@SAV001 0002 00270000 ST @F,8(0,@D) 0002 00280000 LR @D,@F 0002 00290000 * /******************************************************************** 00300000 * /* STATUS: * 00310000 * /* CHANGE LEVEL 000 * 00320000 * /* * 00330000 * /* C427000,427500 YM2699* 00340000 * /* D390000-390500 YM2699* 00350000 * /* A549600,550004-550786,568100 Y02676* 00360000 * /* C566500,615500,663500,758920 Y02676* 00370000 * /* C002500,108000,108500,137500,227000,278000 Y01676* 00380000 * /* C278500,279000,323500,380500-381500,382500 Y01676* 00390000 * /* C454000,454500,456500,457000,457500,662500 Y01676* 00400000 * /* C663000,665000,666000,690405,690643,691000 Y01676* 00410000 * /* C702500,707000,718000-720500,722500-724000 Y01676* 00420000 * /* C728500,750500,756000,757000,757500 Y01676* 00430000 * /* C758500,787500,788000,798500,799000 Y01676* 00440000 * /* C806500,810000,810500,811500,830000,830500 Y01676* 00450000 * /* C753500 Y01676* 00460000 * /* * 00470000 * /* D708000-717500,751000-753000,831000,831500 Y01676* 00480000 * /* * 00490000 * /* A038800,038900,137600,137700,152100-152420 Y01676* 00500000 * /* A199600-199800,227100,228100-228730,233600 Y01676* 00510000 * /* A233700-233900,278600,323600,323700,325100 Y01676* 00520000 * /* A325200-325746,339520-339700,394600,395600 Y01676* 00530000 * /* A395700-395940,457200,457700-457900,662600 Y01676* 00540000 * /* A662700-662960,688600-690404,690524,690762 Y01676* 00550000 * /* A690862-690881,693600-694306,707100,728600 Y01676* 00560000 * /* A753600,758600-758920,798100,799100 Y01676* 00570000 * /* A799200,806600,810100,810200,811600,830100 Y01676* 00580000 * /* A830200,830300,832600 Y01676* 00590000 * /* * 00600000 * /* C715000-715500 A42619* 00610000 * /* 20035 * 00620000 * /* * 00630000 * /* FUNCTION: * 00640000 * /* MODULE IKJEFE05 FIRST SETS UP THE PARAMETER BLOCK WHICH * 00650000 * /* IS TO BE PASSED TO 'DAIR' TO ALLOCATE THE DATA SET. * 00660000 * /* * 00670000 * /* A CHECK IS THEN MADE TO FIND IF THIS IS AN EXPLICIT EXEC. * 00680000 * /* IF IT IS, AND THE DATA SET NAME GIVEN WAS UNQUALIFIED,'CLIST' * 00690000 * /* IS SUFFIXED TO THE DATA SET NAME. IF THE EXEC IS EXPLICIT, * 00700000 * /* 'DAIR' IS LINKED TO IN ORDER TO ALLOCATE THE DATA SET. * 00710000 * /* IF 'DAIR' RETURNS AN ERROR CODE, A MESSAGE IS SENT TO * 00720000 * /* THE TERMINAL, AND E01 IS RETURNED TO FOR TERMINATION. * 00730000 * /* * 00740000 * /* NEXT, THE ORGANIZATION OF THE DATA SET IS EXAMINED TO * 00750000 * /* INSURE THAT IT IS EITHER SEQUENTIAL OR PARTITIONED. IF * 00760000 * /* IT IS NEITHER, AN ERROR MESSAGE IS SENT TO THE TERMINAL, * 00770000 * /* AND E01 IS RETURNED TO FOR TERMINATION. IF IT IS SEQUENTIAL, * 00780000 * /* THE DCB IS ALTERED TO REFLECT THIS. * 00790000 * /* * 00800000 * /* NEXT, THE DATA SET CONTAINING THE PROCEDURE IS OPENED. * 00810000 * /* IF THE OPEN WAS NOT SUCCESSFUL, AN ERROR MESSAGE IS SENT * 00820000 * /* TO THE TERMINAL, AND E01 IS RETURNED TO FOR TERMINATION. * 00830000 * /* IF THE DATA SET ORGANIZATION IS PARTITIONED, A FIND IS * 00840000 * /* ISSUED TO LOCATE THE MEMBER TO BE PROCESSED. IF THE * 00850000 * /* MEMBER CANNOT BE FOUND, A MESSAGE IS SENT TO THE TERMINAL, * 00860000 * /* AND WE RETURN TO E01 FOR TERMINATION. NEXT, TWO BUFFERS * 00870000 * /* ARE OBTAINED, AND A CHECK IS MADE TO INSURE THAT THE RECORD * 00880000 * /* FORMAT IS EITHER FIXED OR VARIABLE. IF IT IS NEITHER, * 00890000 * /* A MESSAGE IS SENT TO THE TERMINAL, AND E01 IS RETURNED TO * 00900000 * /* FOR TERMINATION. IF THE FORMAT OF THE DATA SET IS * 00910000 * /* ACCEPTABLE, MODULE E03 IS CALLED TO PERFORM A READ OF * 00920000 * /* THE FIRST RECORD OF THE DATA SET. THE RECORD IS THEN * 00930000 * /* SCANNED FOR A PROC STATEMENT. IF NONE IS PRESENT, INDICATORS * 00940000 * /* TO THAT EFFECT ARE SET, AND RETURN IS MADE TO E01. * 00950000 * /* * 00960000 * /* IF A PROC STATEMENT IS PRESENT, THE RECORD IS FURTHER SCANNED * 00970000 * /* TO FIND THE SPECIFICATION OF THE NUMBER OF POSITIONALS * 00980000 * /* TO BE DEFINED. THIS SPECIFICATION IS THEN CHECKED TO * 00990000 * /* INSURE THAT IT IS ALL NUMERICS AND IS STORED INTO A WORK * 01000000 * /* AREA AFTER BEING CONVERTED TO A BINARY NUMBER. NEXT, * 01010000 * /* STORAGE IS OBTAINED FOR THE ATAB AND FTAB CONTROL BLOCKS * 01020000 * /* (SEE 'TABLES/WORK-AREAS' FOR DESCRIPTION). THEN THE * 01030000 * /* REMAINDER OF THE PROC STATEMENT(INCLUDING ANY CONTINUATION * 01040000 * /* RECORDS) IS SCANNED, AND ANY SYMBOLIC PARAMETERS ARE * 01050000 * /* PROCESSED. PROCESSING OF SYMBOLIC PARAMETERS INCLUDES * 01060000 * /* SYNTAX CHECKING EACH PARAMETER, ENTERING THE PARAMETER * 01070000 * /* NAME AND INFORMATION ABOUT IT INTO ATAB, AND, IN THE CASE * 01080000 * /* OF KEYWORD WITH VALUE PARAMETERS, ENTERING THE DEFAULT * 01090000 * /* VALUE OF THE PARAMETER INTO FTAB. * 01100000 * /* * 01110000 * /* RETURN IS THEN MADE TO E01. * 01120000 * /* * 01130000 * /* ENTRY POINTS: * 01140000 * /* IKJEFE05 - ONLY ENTRY POINT. * 01150000 * /* * 01160000 * /* INPUT: * 01170000 * /* REGISTER 1 - POINTER TO E01DATDF. E01DATDF IS A * 01180000 * /* STRUCTURE IN IKJEFE01 WHICH CONTAINS VARIABLES * 01190000 * /* USED BY ALL MODULES OF EXEC. REFER TO ITS DEFINITION * 01200000 * /* IN 'TABLES/WORK AREAS' FOR DETAILS. * 01210000 * /* * 01220000 * /* OUTPUT: * 01230000 * /* UPDATED ATAB/FTAB. * 01240000 * /* E01SW9 IS SET TO ONE IF AN ERROR OCCURS. * 01250000 * /* * 01260000 * /* EXTERNAL REFERENCES: * 01270000 * /* IKJDAIR - DAIR SERVICE ROUTINE IS USED TO ALLOCATE THE * 01280000 * /* DATA SET WHICH CONTAINS THE COMMAND PROCEDURE (THIS IS * 01290000 * /* TRUE ONLY IF THE EXEC IS EXPLICIT). * 01300000 * /* * 01310000 * /* IKJEFF18 - DAIRFAIL SERVICE ROUTINE IS USED TO Y01676* 01320000 * /* ANALYZE ANY DAIR FAILURE AND PUT OUT A MESSAGE. Y01676* 01330000 * /* * 01340000 * /* IKJPARSE - THE PARSE SERVICE ROUTINE IS USED TO OBTAIN A * 01350000 * /* SYNTACTICALLY CORRECT DSNAME IF THIS IS AN EXPLICIT EXEC. * 01360000 * /* * 01370000 * /* EXITS,NORMAL: * 01380000 * /* ALWAYS A RETURN TO IKJEFE01. E01SW9 IS 0. * 01390000 * /* * 01400000 * /* EXITS,ERROR: * 01410000 * /* ALWAYS A RETURN TO IKJEFE01. E01SW9 IS SET TO 1. * 01420000 * /* * 01430000 * /* TABLES/WORK AREAS: * 01440000 * /* ATAB (DOUBLE WORD BOUNDARY) * 01450000 * /* |---------------------------------------------------------| 01460000 * /* +0 |ADDRESS OF PREVIOUS BLOCK OF ATAB | 01470000 * /* |---------------------------------------------------------| 01480000 * /* +4 |ADDRESS OF NEXT BLOCK OF ATAB | 01490000 * /* |---------------------------------------------------------| 01500000 * /* +8 |LENGTH OF THIS BLOCK (IN BYTES) | 01510000 * /* |---------------------------------------------------------| 01520000 * /* +12| E | 01530000 * /* | L | 01540000 * /* | E | 01550000 * /* | M | 01560000 * /* | E | 01570000 * /* | N | 01580000 * /* | T | 01590000 * /* | S | 01600000 * /* |---------------------------------------------------------| * 01610000 * /* ATAB ELEMENT (BYTE BOUNDARY) * 01620000 * /* |---------------------------------------------------------| * 01630000 * /* |FOR KEYWORD WITH VALUE AND POSITIONAL PARAMETERS THIS | * 01640000 * /* |IS A PTR TO THE CORRESPONDING FTAB ELEMENT. | * 01650000 * /* |FOR KEYWORD W/O VALUE PARAMETERS A ZERO INDICATES THE | * 01660000 * /* |KEYWORD WAS NOT PRESENT ON THE INVOCATION STATEMENT AND | * 01670000 * /* +0 |ONE INDICATES THAT IT WAS PRESENT. | * 01680000 * /* |---------------------------------------------------------| * 01690000 * /* +4 |FLAG BYTE |LENGTH |SYMBOLIC | * 01700000 * /* |---------------------------------------------------------| * 01710000 * /* |PARAMETER NAME | * 01720000 * /* |---------------------------------------------------------| * 01730000 * /* WHERE: FLAG BYTE IS- * 01740000 * /* BIT 0=1 IF THIS IS KEYWORD WITH VALUE * 01750000 * /* BIT 1=1 IF THIS IS A KEYWORD W/O VALUE * 01760000 * /* BIT 2=1 IF THIS IS THE LAST ELMT IN THIS * 01770000 * /* BLOCK OF ATAB * 01780000 * /* LENGTH BYTE IS- * 01790000 * /* LENGTH IN BYTES OF THE SYMBOLIC PARAMETER * 01800000 * /* NAME WHICH FOLLOWS * 01810000 * /* * 01820000 * /* FTAB (WORD BOUNDARY) * 01830000 * /* |---------------------------------------------------------| 01840000 * /* +0 |ADDRESS OF PREVIOUS BLOCK OF FTAB | 01850000 * /* |---------------------------------------------------------| 01860000 * /* +4 |ADDRESS OF NEXT BLOCK OF FTAB | 01870000 * /* |---------------------------------------------------------| 01880000 * /* +8 |TOTAL LENGTH OF THIS BLOCK |NUMBER OF BYTES IN USE | 01890000 * /* |---------------------------------------------------------| 01900000 * /* +12| E | 01910000 * /* | L | 01920000 * /* | E | 01930000 * /* | M | 01940000 * /* | E | 01950000 * /* | N | 01960000 * /* | T | 01970000 * /* | S| 01980000 * /* |---------------------------------------------------------| * 01990000 * /* FTAB ELEMENT (BYTE BOUNDARY) * 02000000 * /* |---------------------------------------------------------| * 02010000 * /* +0 |LENGTH OF THE SYMBOLIC PARAMETER VALUE WHICH FOLLOWS | * 02020000 * /* |---------------------------------------------------------| * 02030000 * /* +4 |VALUE ASSOCIATED WITH A SYMBOLIC PARAMETER NAME IN ATAB | * 02040000 * /* |---------------------------------------------------------| * 02050000 * /* * 02060000 * /* E01DATDF (DOUBLE WORD BOUNDARY) * 02070000 * /* |---------------------------------------------------------| * 02080000 * /* +0 |DCB FOR DATA SET CONTAINING COMMAND PROCEDURE | * 02090000 * /* |---------------------------------------------------------| * 02100000 * /* +88|POINTER USED FOR INDIRECT ADDRESSING | * 02110000 * /* |---------------------------------------------------------| * 02120000 * /* +92|POINTER USED FOR INDIRECT ADDRESSING | * 02130000 * /* |---------------------------------------------------------| * 02140000 * /* +96|NAME OF PDS MEMBER WHICH CONTAINS THE PROC | * 02150000 * /* |---------------------------------------------------------| * 02160000 * /* +104|DECB FOR THE READ MACRO | * 02170000 * /* |---------------------------------------------------------| * 02180000 * /* +124|POINTER TO INPUT RECORD FROM PROC | * 02190000 * /* |---------------------------------------------------------| * 02200000 * /* +128|NO. OF BYTES ON INPUT RCD WHICH HAVE NOT BEEN PROCESSED | * 02210000 * /* |---------------------------------------------------------| * 02220000 * /* +132|NO. OF POSITIONAL PARAMETERS FOUND ON THE PROC STATEMENT | * 02230000 * /* |---------------------------------------------------------| * 02240000 * /* +136|WORK AREA - ALSO USED TO PASS ADDRESS OF CORE TO BE FREED| * 02250000 * /* | BY MODULE E03 | * 02260000 * /* |---------------------------------------------------------| * 02270000 * /* +140|MINIMUM AMOUNT OF CORE NEEDED FROM A GETMAIN | * 02280000 * /* |---------------------------------------------------------| * 02290000 * /* +144|MAXIMUM AMOUNT OF CORE NEEDED FROM A GETMAIN | * 02300000 * /* |---------------------------------------------------------| * 02310000 * /* +148|ADDRESS OF CORE OBTAINED VIA GETMAIN | * 02320000 * /* |---------------------------------------------------------| * 02330000 * /* +152|AMOUNT OF CORE OBTAINED VIA GETMAIN | * 02340000 * /* |---------------------------------------------------------| * 02350000 * /* +156|ADDRESS OF SUBPOOL 78 CORE WHICH BELONGS TO US | * 02360000 * /* |---------------------------------------------------------| * 02370000 * /* +160|LENGTH OF SUBPOOL 78 CORE WHICH BELONGS TO US | * 02380000 * /* |---------------------------------------------------------| * 02390000 * /* +164|WORK AREA | * 02400000 * /* |---------------------------------------------------------| * 02410000 * /* +168|NO. OF POSITIONAL PARMS SPECIFIED ON THE PROC STMT | * 02420000 * /* |---------------------------------------------------------| * 02430000 * /* +172|POINTER TO CURRENT BLOCK OF ATAB | * 02440000 * /* |---------------------------------------------------------| * 02450000 * /* +176|POINTER TO CURRENT ELEMENT OF ATAB | * 02460000 * /* |---------------------------------------------------------| * 02470000 * /* +180|POINTER TO CURRENT BLOCK OF FTAB | * 02480000 * /* |---------------------------------------------------------| * 02490000 * /* +184|POINTER TO CURRENT ELEMENT OF FTAB | * 02500000 * /* |---------------------------------------------------------| * 02510000 * /* +188|NO. OF BYTES IN VALUE PART OF KEYWORD WITH VALUE | * 02520000 * /* |---------------------------------------------------------| * 02530000 * /* +192|NO. OF KEYWORD W/O VALUE PARMS DEFINED IN PROC STMT | * 02540000 * /* |---------------------------------------------------------| * 02550000 * /* +194|NO. OF KEYWORD WITH VALUE PARMS DEFINED IN PROC STMT | * 02560000 * /* |---------------------------------------------------------| * 02570000 * /* +196|TOTAL BYTES IN ALL KEYWORD W/O VALUE PARMS | * 02580000 * /* |---------------------------------------------------------| * 02590000 * /* +198|TOTAL BYTES IN ALL KEYWORD WITH VALUE PARMS | * 02600000 * /* |---------------------------------------------------------| * 02610000 * /* +200|WORK AREA | * 02620000 * /* |---------------------------------------------------------| * 02630000 * /* +202|SWITCHES | * 02640000 * /* | BIT 0 - SET TO ONE WHEN PROCESSING IMPLICIT EXEC | * 02650000 * /* | BIT 1 - SET TO ONE WHEN E03 IS CALLED TO READ FIRST | * 02660000 * /* | LINE OF PROC | * 02670000 * /* | BIT 2 - SET TO ONE IF PROCEDURE HAS NO PROC STATEMENT | * 02680000 * /* | BIT 3 - SET TO ONE IF NO PROC STMT AND FIRST LINE OF | * 02690000 * /* | PROC IS NOT EMPTY | * 02700000 * /* | BIT 4 - SET TO ONE WHEN AN ABEND HAS OCCURRED | * 02710000 * /* | BIT 5 - SET TO ONE WHEN THE PROMPT OPTION WAS Y01676| * 02720000 * /* | SPECIFIED ON THE INVOCATION STATEMENT Y01676| * 02730000 * /* | BIT 6 - SET TO ONE WHEN E03 IS CALLED TO READ A RCD | * 02740000 * /* | OTHER THAN THE FIRST | * 02750000 * /* | BIT 7 - SET TO ONE IF RECORD FORMAT IS VARIABLE | * 02760000 * /* | BIT 8 - TERMINATION SWITCH (SET TO ONE IF PROC IS | * 02770000 * /* | NON-EXECUTABLE) | * 02780000 * /* | BIT 9 - SET TO ONE IF E03 HAS BEEN CALLED FOR A GETMAIN | * 02790000 * /* | BIT 10 - SET TO ONE WHEN DATA SET IS NULL | * 02800000 * /* | BIT 11 - SET TO ONE WHEN CORE HAS BEEN OBTAINED FROM | * 02810000 * /* | SUBPOOL 78 | * 02820000 * /* | BIT 12 - SET TO ONE WHEN E03 HAS BEEN CALLED TO DO A | * 02830000 * /* | FREEMAIN | * 02840000 * /* | BIT 13 - UNUSED | * 02850000 * /* | BIT 14 - SET TO ONE WHEN THE MINIMUM AMOUNT OF CORE | * 02860000 * /* | NEEDED COULD NOT BE OBTAINED | * 02870000 * /* | BIT 15 - SET TO ONE WHEN THE LIST OPTION WAS SPECIFIED | * 02880000 * /* | ON THE INVOCATION STATEMENT | * 02890000 * /* |---------------------------------------------------------| * 02900000 * /* +204|WORK AREA | * 02910000 * /* |---------------------------------------------------------| * 02920000 * /* +216|POINTER TO CURRENT ATAB ELEMENT - 1 | * 02930000 * /* |---------------------------------------------------------| * 02940000 * /* +220|POINTER TO FTAB ELEMENT - 1 | * 02950000 * /* |---------------------------------------------------------| * 02960000 * /* +224|POINTER TO FIRST INPUT BUFFER | * 02970000 * /* |---------------------------------------------------------| * 02980000 * /* +228|POINTER TO SECOND INPUT BUFFER | * 02990000 * /* |---------------------------------------------------------| * 03000000 * /* +232|POINTER TO CMD PROCESSOR PARAMETER LIST | * 03010000 * /* |---------------------------------------------------------| * 03020000 * /* +236|PARAMETERS TO BE PASSED TO STAE EXIT ROUTINE | * 03030000 * /* |---------------------------------------------------------| * 03040000 * /* +248|POINTER TO PARSE CONTROL LIST | * 03050000 * /* |---------------------------------------------------------| * 03060000 * /* +252|STORAGE FOR SERVICE ROUTINE CONTROL BLOCK | * 03070000 * /* |---------------------------------------------------------| * 03080000 * /* +276|ECB FOR SERVICE ROUTINES | * 03090000 * /* |---------------------------------------------------------| * 03100000 * /* +280|AREA FOR HOLDING RETURN CODES INTERNAL TO EXEC | * 03110000 * /* |---------------------------------------------------------| * 03120000 * /* +284|POINTER TO FIRST BLOCK OF ATAB | * 03130000 * /* |---------------------------------------------------------| * 03140000 * /* +288|END OF CURRENT INPUT BLOCK + 1 | * 03150000 * /* |---------------------------------------------------------| * 03160000 * /* +292|POINTER TO START OF RECORD CURRENTLY BEING PROCESSED | * 03170000 * /* |---------------------------------------------------------| * 03180000 * /* +296|LENGTH OF DYNAMIC PORTION OF MSG TO BE PUT TO TERMINAL | * 03190000 * /* |---------------------------------------------------------| * 03200000 * /* +297|ADDRESS OF DYNAMIC PORTION OF MSG TO BE PUT TO TERMINAL | * 03210000 * /* |---------------------------------------------------------| * 03220000 * /* +300|NUMBER OF FIRST LEVEL MSG TO BE PUT TO TERMINAL | * 03230000 * /* |---------------------------------------------------------| * 03240000 * /* +302|NUMBER OF SECOND LEVEL MSG TO BE PUT TO TERMINAL | * 03250000 * /* |---------------------------------------------------------| * 03260000 * /* +304|POINTER TO THE PARSE DESCRIPTOR LIST | * 03270000 * /* |---------------------------------------------------------| * 03280000 * /* +308|AREA FOR SAVING THE ORIGINAL LENGTH OF THE COMMAND BUFFER| * 03290000 * /* |---------------------------------------------------------| * 03300000 * /* +310|TOTAL BYTES IN ALL POSITIONAL PARAMETERS Y01676| * 03310000 * /* |---------------------------------------------------Y01676| * 03320000 * /* +312|| Y01676* 03330000 * /* * 03340000 * /* * 03350000 * /* ATTRIBUTES: * 03360000 * /* REENTRANT * 03370000 * /* * 03380000 * /* * 03390000 * /* NOTES: * 03400000 * /* CONSTSANTS BEGIN WITH THE LETTERS 'KON' FOLLOWED BY * 03410000 * /* THE VALUE OF THE CONSTANT IF IT IS EITHER A DECIMAL * 03420000 * /* OR EBCDIC CONSTANT. IF IT IS A HEX CONSTANT THE 'KON' * 03430000 * /* IS FOLLOWED BY 'X' THEN THE VALUE OF THE * 03440000 * /* CONSTANT. * 03450000 * /* CHARACTER CODE DEPENDENCIES -- * 03460000 * /* MODULE WAS ASSEMBLED USING EBCIDIC CHARACTER CODE. * 03470000 * /* MODULE MUST BE MODIFIED IF A DIFFERENT CHARACTER SET IS * 03480000 * /* USED. DEPENDENCIES EXIST FOR FOLLOWING CHARACTERISTICS OF * 03490000 * /* EBCIDIC: * 03500000 * /* 1.ZONED DECIMALS HAVE 'F'X IN THE HIGH ORDER HALF BYTE * 03510000 * /* 2.ALPHABETIC CHARACTERS ARE CONTAINED WITHIN THE SETS * 03520000 * /* ('C1'X;'C9'X),('D1'X;'D9'X),('E2'X;'E9'X). * 03530000 * /* 3.NUMERIC CHARACTERS ARE CONTAINED IN THE SET * 03540000 * /* ('F0'X;'F9'X). * 03550000 * /* STATEMENTS WHICH CONTAIN THESE DEPENDENCIES WILL HAVE * 03560000 * /* ASTERISKS IN THEIR COMMENT FIELDS. * 03570000 * /******************************************************************** 03580000 * GEN; 03590000 &SPN SETA 1 03600000 DS 0H 03610000 * DCL DUMPARM FIXED(31); 03620000 * DCL R0 REG(0) PTR(31); /* REGISTER 0 Y01676* 03630000 * /*************************************************************Y01676* 03640000 * /* USED WHEN CALLING THE DAIRFAIL SERVICE ROUTINE Y01676* 03650000 * /* TO ANALIZE A DAIR FAILURE Y01676* 03660000 * /*************************************************************Y01676* 03670000 * DCL R1 REG(1) PTR(31); /* REGISTER 1 USED * 03680000 * /******************************************************************** 03690000 * /* USED TO RECEIVE THE ADDRESS OF THE CPPL FROM TMP * 03700000 * /* AND TO PASS THE ADDRESS OF E01DATDF TO MODULES * 03710000 * /* E02, E03 AND E04. ALSO USED AS A POITER TO THE * 03720000 * /* START OF AN FTAB BLOCK. * 03730000 * /******************************************************************** 03740000 * 03750000 * DCL R2 REG(2) PTR(31); /* REGISTER 2 * 03760000 * /******************************************************************** 03770000 * /* USED AS A WORK REG FOR SYSTEM FUNCTIONS AND AS * 03780000 * /* A POINTER TO CURRENT FTAB ELEMENT * 03790000 * /******************************************************************** 03800000 * 03810000 * DCL R3 REG(3) PTR(31); /* REGISTER 3 * 03820000 * /******************************************************************** 03830000 * /* USED TO CONVEY THE AMOUNT OF CORE TO BE FREED * 03840000 * /* WHEN MODULE E03 IS CALLED FOR THAT FUNCTION * 03850000 * /******************************************************************** 03860000 * 03870000 * DCL R4 REG(4) PTR(31); /* REGISTER 4 * 03880000 * /******************************************************************** 03890000 * /* USED TO CONVEY THE SUBPOOL NUMBER ON GETMAINS * 03900000 * /* AND FREEMAINS WHICH ARE DONE BY MODULE E04 * 03910000 * /* ALSO USED TO POINT TO THE BLOCK OF ATAB * 03920000 * /******************************************************************** 03930000 * 03940000 * DCL R5 REG(5) PTR(31); /* REGISTER 5 * 03950000 * /******************************************************************** 03960000 * /* USED AS A POINTER TO THE CURRENT ELEMENT OF ATAB * 03970000 * /******************************************************************** 03980000 * 03990000 * DCL R6 REG(6) PTR(31); /* REGISTER 6 * 04000000 * /******************************************************************** 04010000 * /* USED AS THE BASE REGISTER FOR E01DATDF DURING * 04020000 * /* EXECUTION OF IKJEFE05 * 04030000 * /******************************************************************** 04040000 * 04050000 * DCL R7 REG(7) PTR(31); /* REGISTER 7 * 04060000 * /******************************************************************** 04070000 * /* THIS IS A BASE REGISTER USED BY BSL * 04080000 * /******************************************************************** 04090000 * 04100000 * DCL R12 REG(12) PTR(31); /* REGISTER 12 * 04110000 * /******************************************************************** 04120000 * /* THIS IS A BASE REGISTER USED BY BSL * 04130000 * /******************************************************************** 04140000 * 04150000 * DCL R15 REG(15) PTR(31); 04160000 * /******************************************************************** 04170000 * /* USED TO CONTAIN THE RETURN CODE UPON RETURN TO * 04180000 * /* THE TMP * 04190000 * /******************************************************************** 04200000 * 04210000 * DCL R14 REG(14) PTR(31); /* REGISTER 14 * 04220000 * 04230000 * DCL KON0 FIXED(15) STATIC INIT(0);/* CONSTANT * 04240000 * /* DECIMAL 0 * 04250000 * DCL KON1 FIXED(15) STATIC INIT(1);/* CONSTANT * 04260000 * /* DECIMAL 1 * 04270000 * DCL KON2 FIXED(15) STATIC INIT(2);/* CONSTANT * 04280000 * /* DECIMAL 2 * 04290000 * DCL KON3 FIXED(15) STATIC INIT(3);/* CONSTANT * 04300000 * /* DECIMAL 3 * 04310000 * DCL KON4 FIXED(15) STATIC INIT(4);/* CONSTANT * 04320000 * /* DECIMAL 4 * 04330000 * DCL KON5 FIXED(15) STATIC INIT(5);/* CONSTANT * 04340000 * /* DECIMAL 5 * 04350000 * DCL KON6 FIXED(15) STATIC INIT(6);/* CONSTANT * 04360000 * /* DECIMAL 6 * 04370000 * DCL KON7 FIXED(15) STATIC INIT(7);/* CONSTANT * 04380000 * /* DECIMAL 7 * 04390000 * DCL KON8 FIXED(15) STATIC INIT(8);/* CONSTANT * 04400000 * /* DECIMAL 8 * 04410000 * DCL KON10 FIXED(15) STATIC INIT(10); 04420000 * /* CONSTANT * 04430000 * /* DECIMAL 10 * 04440000 * DCL KON12 FIXED(15) STATIC INIT(12); 04450000 * /* CONSTANT * 04460000 * /* DECIMAL 12 * 04470000 * DCL KON16 FIXED(15) STATIC INIT(16); 04480000 * /* CONSTANT * 04490000 * /* DECIMAL 16 * 04500000 * DCL KON20 FIXED(15) STATIC INIT(20); 04510000 * /* CONSTANT * 04520000 * /* DECIMAL 20 * 04530000 * DCL KON21 FIXED(15) STATIC INIT(21); 04540000 * /* CONSTANT * 04550000 * /* DECIMAL 21 * 04560000 * DCL KON24 FIXED(15) STATIC INIT(24); 04570000 * /* CONSTANT * 04580000 * /* DECIMAL 24 * 04590000 * DCL KON25 FIXED(15) STATIC INIT(25); 04600000 * /* CONSTANT * 04610000 * /* DECIMAL 25 * 04620000 * DCL KON27 FIXED(15) STATIC INIT(27); /* CONSTANT 04630000 * DECIMAL 04640000 * 27 Y01676* 04650000 * DCL KON31 FIXED(15) STATIC INIT(31); 04660000 * /* CONSTANT * 04670000 * /* DECIMAL 31 * 04680000 * DCL KON37 FIXED(15) STATIC INIT(37); 04690000 * /* CONSTANT * 04700000 * /* DECIMAL 37 * 04710000 * DCL KON252 FIXED(15) STATIC INIT(252); 04720000 * /* CONSTANT * 04730000 * /* DECIMAL 252 * 04740000 * DCL 1 KONSTRUC STATIC, /* HEXADECIMAL CONSTANTS* 04750000 * 2 KONX00 CHAR(1) INIT('00'X), /* CONSTANT * 04760000 * /* HEX '00' * 04770000 * 2 KONX02 CHAR(1) INIT('02'X), /* CONSTANT * 04780000 * /* HEX '02' * 04790000 * 2 KONX0F CHAR(1) INIT('0F'X), /* CONSTANT * 04800000 * /* HEX '0F' * 04810000 * 2 KONX10 CHAR(1) INIT('10'X), /* CONSTANT * 04820000 * /* HEX '10' * 04830000 * 2 KONX20 CHAR(1) INIT('20'X), /* CONSTANT * 04840000 * /* HEX '20' * 04850000 * 2 KONX40 CHAR(1) INIT('40'X), /* CONSTANT * 04860000 * /* HEX '80' * 04870000 * 2 KONX80 CHAR(1) INIT('80'X), /* CONSTANT * 04880000 * /* HEX '80' * 04890000 * 2 KONX8F CHAR(1) INIT('8F'X), /* CONSTANT Y02676* 04900000 * /* HEX '8F' Y02676* 04910000 * 2 KONXC1 CHAR(1) INIT('C1'X), /* CONSTANT * 04920000 * /* HEX 'C1' * 04930000 * 2 KONXC9 CHAR(1) INIT('C9'X), /* CONSTANT * 04940000 * /* HEX 'C9' * 04950000 * 2 KONXD1 CHAR(1) INIT('D1'X), /* CONSTANT * 04960000 * /* HEX 'D1' * 04970000 * 2 KONXD9 CHAR(1) INIT('D9'X), /* CONSTANT * 04980000 * /* HEX 'D9' * 04990000 * 2 KONXE2 CHAR(1) INIT('E2'X), /* CONSTANT * 05000000 * /* HEX 'E2' * 05010000 * 2 KONXE9 CHAR(1) INIT('E9'X), /* CONSTANT * 05020000 * /* HEX 'EF' * 05030000 * 2 KONXEF CHAR(1) INIT('EF'X), /* CONSTANT * 05040000 * /* HEX 'EF' * 05050000 * 2 KONXF0 CHAR(1) INIT('F0'X), /* CONSTANT * 05060000 * /* HEX 'F0' * 05070000 * 2 KONXF9 CHAR(1) INIT('F9'X), /* CONSTANT * 05080000 * /* HEX 'F9' * 05090000 * 2 KONXFA CHAR(1) INIT('FA'X), /* CONSTANT * 05100000 * /* HEX 'FA' * 05110000 * 2 KONXFB CHAR(1) INIT('FB'X), /* CONSTANT * 05120000 * /* HEX 'FB' * 05130000 * 2 KONXFF CHAR(1) INIT('FF'X), /* CONSTANT * 05140000 * /* HEX 'FF' * 05150000 * 2 KSYSPROC CHAR(8) INIT('SYSPROC'), 05160000 * /* CONSTANT * 05170000 * /* 'SYSPROC' * 05180000 * 2 KTEMPNAM CHAR(8) INIT('TEMPNAME'); 05190000 * /* CONSTANT * 05200000 * /* 'TEMPNAME' * 05210000 * DCL 1 TEM01 FIXED(31), /* WORK AREA Y01676* 05220000 * 2 TEMC01 CHAR(4); /* REDEF Y01676* 05230000 * DCL TEM02 FIXED(31) AUTO; /* WORK AREA * 05240000 * DCL TEM03 FIXED(31) AUTO; /* WORK AREA * 05250000 * DCL LPARCTR FIXED(31); /* COUNTER FOR LEFT 05260000 * PARENS Y01676* 05270000 * DCL STARTVAL FIXED(31); /* STARTING POINT FO 05280000 * A KWE VAL Y01676* 05290000 * DCL ENDVAL FIXED(31); /* ENDING POINT FOR 05300000 * A KWE VAL Y01676* 05310000 * DCL CALLERID FIXED(15) INIT(1); /* CALLER NUMBER FOR 05320000 * DAIRFAIL Y01676* 05330000 * DCL MSGWTRAD FIXED(31) INIT(0); /* MSG WTR ADDR 05340000 * DAIRFAIL Y01676* 05350000 * DCL DAIRRET FIXED(31); /* DAIR RET CDE AREA 05360000 * FOR DFAIL Y01676* 05370000 * DCL KQUOTE CHAR(1) INIT('7D'X); /* QUOTE CON Y01676* 05380000 * DCL KBLNK CHAR(1) INIT(' '); /* BLANK CONSTANT * 05390000 * DCL KCOM CHAR(1) INIT(','); /* COMMA CONSTANT * 05400000 * DCL KTAB CHAR(1) INIT('05'X); /* TAB CONSTANT * 05410000 * DCL KPERD CHAR(1) INIT('.'); /* PERIOD CONSTANT * 05420000 * DCL KCONT CHAR(1) INIT('-'); /* CONTINUATION IND* 05430000 * DCL KCONTP CHAR(1) INIT('+'); /* CONT. IND Y02676* 05440000 * DCL KPROC CHAR(4) INIT('PROC'); /* PROC STMT INDIC * 05450000 * DCL KCLIST CHAR(5) INIT('CLIST'); /* CLIST CONSTANT * 05460000 * DCL KLPAR CHAR(1) INIT('('); /* LEFT PARENTHESIS 05470000 * CONSTANT * 05480000 * DCL KRPAR CHAR(1) INIT(')'); /* RIGHT PARENTHESIS 05490000 * CONSTANT * 05500000 * DCL ENDQVAR CHAR(12) INIT('ENDING QUOTE'); /* MESSAGE 05510000 * VARIABLE Y01676* 05520000 * DCL ENDPAR CHAR(17) INIT('RIGHT PARENTHESIS'); /* MESSAGE 05530000 * VARIABLE Y01676* 05540000 * DCL 1 E01DATDF BDY(DWORD) /* MAJOR STRUCTURE OF * 05550000 * BASED(R6), /* USED BY ALL FOUR * 05560000 * /* MODULES * 05570000 * 2 DCBAR CHAR(88) BDY(DWORD), 05580000 * /* LIVE DCB AREA * 05590000 * 2 ADPTR1 PTR(31), /* PTR USED FOR 05600000 * INDIRECT ADDRS * 05610000 * 2 ADPTR2 PTR(31), /* FOR INDIRECT 05620000 * ADDRESSING * 05630000 * 2 MMNAMAR BDY(WORD) CHAR(8), 05640000 * /* MEMBER NAME * 05650000 * 2 RDECB BDY(WORD) CHAR(20), 05660000 * /* STORAGE FOR DECB * 05670000 * 3 * CHAR(6), /* FILLER * 05680000 * 3 DECLNGTH FIXED(15), /* LENGTH OF BLOCK READ * 05690000 * 3 * CHAR(8), /* FILLER * 05700000 * 3 DECIOBPT PTR(31), /* POINTER TO THE IOB * 05710000 * 2 LINPTR1 PTR(31), /* ADDR OF INPUT LINE * 05720000 * 2 EOLCNT FIXED(31), /* BYTES REMAINING 05730000 * IN LINE * 05740000 * 3 EOLCNTCH CHAR(4), /* REDEFINITION OF EOLCNT 05750000 * 2 POSCNT FIXED(31), /* NUMBER OF POSITIONAL 05760000 * PARAMETERS FOUND * 05770000 * 2 TSTLNG FIXED(31), /* WORK AREA - USED FOR */ 05780000 * 3 TSTLNGC CHAR(4), /* ALIGNMENT * 05790000 * 2 GMNMIN FIXED(31), /* MINIMUM AMOUNT OF CORE 05800000 * TO BE GOTTEN * 05810000 * 2 GMNMAX FIXED(31), /* MAXIMUM AMOUNT OF CORE 05820000 * TO BE GOTTEN * 05830000 * 2 ADDGMN PTR(31), /* ADDRESS OF GOTTEN CORE* 05840000 * 2 AMTGMN FIXED(31), /* AMOUNT OF CORE GOTTEN* 05850000 * 2 SP78ADDR PTR(31), /* PTR TO SUBPOOL78 CORE*/ 05860000 * 2 SP78LNGT PTR(31), /* LENGTH OF SUBPOOL78 */ 05870000 * /* CORE */ 05880000 * 2 RDXCNV FIXED(31), /* WORK AREA FOR */ 05890000 * 3 * CHAR(3),/* CONVERTING BASE * 05900000 * 3 DDIG CHAR(1),/* OF NO. PARMS SPEC'D * 05910000 * 2 POSSPC FIXED(31), /* NUMBER OF POSITIONAL 05920000 * PARAMERS SPECIFIED * 05930000 * 2 ATABIND PTR(31), /* PTR TO START OF 05940000 * CURRENT BLOCK OF 05950000 * ATAB * 05960000 * 2 ATABCUR PTR(31), /* PTR TO CURRENT 05970000 * ELEMENT OF ATAB* 05980000 * 2 FTABIND PTR(31), /* PTR TO START OF 05990000 * CURRENT BLOCK OF 06000000 * FTAB * 06010000 * 2 FTABCUR PTR(31), /* PTR TO CURRENT 06020000 * ELEMENT OF ATAB * 06030000 * 2 VALCNT FIXED(31), /* NUMBER OF BYTES IN 06040000 * VALUE OF KEYWORD 06050000 * WITH VALUE * 06060000 * 2 KWOCNT FIXED(15), /* NUMBER OF KWRD W/O * 06070000 * /* VALUE PARMS * 06080000 * 2 KWWCNT FIXED(15), /* NUMBER OF KWRD WITH * 06090000 * /* VALUE PARMS * 06100000 * 2 KWOBYT FIXED(15), /* SIZE OF KWRD W/O * 06110000 * /* VALUE PARMS IN * 06120000 * /* TOTAL BYTES * 06130000 * 2 KWWBYT FIXED(15), /* SIZE OF KWRD W/O * 06140000 * /* VALUE PARMS IN * 06150000 * /* TOTAL BYTES * 06160000 * 2 CNVA FIXED(15), /*WORKAREA FOR UNALIGNED* 06170000 * 3 CNVC CHAR(2), /* ARITHMETIC ITEMS * 06180000 * 2 E01BINSW BDY(HWORD), /* BINARY SWITCHES * 06190000 * 3 E01SW1 BIT(1), /* SWITCH 1 * 06200000 * /* SET TO ONE WHEN 06210000 * PROCESSING 06220000 * IMPLICIT EXEC * 06230000 * 3 E01SW2 BIT(1), /* SWITCH 2 * 06240000 * /* SET TO ONE WHEN 06250000 * IKJEFE03 IS CALL 06260000 * ED TO READ 1ST 06270000 * LINE * 06280000 * 3 E01SW3 BIT(1), /* SWITCH 3 06290000 * /*SET TO ONE IF THE 06300000 * PROCEDURE DOES 06310000 * NOT HAVE A PROC 06320000 * STATEMENT * 06330000 * 3 E01SW4 BIT(1), /* SWITCH 4 * 06340000 * /*SET TO ONE IF 1ST 06350000 * LINE IS NOT EMPTY 06360000 * * 06370000 * 3 E01SW5 BIT(1), /* SWITCH 5 * 06380000 * /*SET TO ONE ON AN 06390000 * ABEND * 06400000 * 3 E01SW6 BIT(1), /* SWITCH 6 * 06410000 * /*SET TO ONE WHEN 06420000 * THE PROMPT OPTION 06430000 * WAS SPECIFIED ON 06440000 * THE INVOCATION 06450000 * STATEMENT Y01676* 06460000 * 3 E01SW7 BIT(1), /* SWITCH 7 * 06470000 * /*SET TO ONE WHEN 06480000 * IKJEFE03 IS CALL- 06490000 * ED TO READ LINE 06500000 * OTHER THAN 1ST* 06510000 * 3 E01SW8 BIT(1), /* SWITCH 8 * 06520000 * /*SET TO ONE IF RCD 06530000 * FMT IS VARIABLE * 06540000 * 3 E01SW9 BIT(1), /* SWITCH 9 * 06550000 * /*SET TO ONE IF PROC 06560000 * CANNOT BE EXECUT- 06570000 * ED * 06580000 * 3 E01SW10 BIT(1), /* SWITCH 10 * 06590000 * /* SET TO ONE WHEN 06600000 * IKFEFE03 HAS BEEN 06610000 * CALLED TO DO A 06620000 * GETMAIN * 06630000 * 3 E01SW11 BIT(1), /* SWITCH 11 * 06640000 * /*SET TO ONE WHEN 06650000 * PROC HAS CONTAINS 06660000 * NO DATA * 06670000 * 3 E01SW12 BIT(1), /* SWITCH 12 * 06680000 * /*SET TO ONE WHEN 06690000 * CORE HAS BEEN 06700000 * OBTAINED FROM SP 06710000 * 78 * 06720000 * 3 E01SW13 BIT(1), /* SWITCH 13 06730000 * SET TO ONE WHEN 06740000 * IKFEFE03 HAS BEEN 06750000 * CALLED TO DO A 06760000 * FREEMAIN * 06770000 * 3 E01SW14 BIT(1), /* SWITCH 14 * 06780000 * /*SET TO ONE WHEN 06790000 * SP78 OVFLOW HAS 06800000 * CAUSED MULTIPLE 06810000 * BLOCKS OF SP78 T 06820000 * BE OBTAINED * 06830000 * 3 E01SW15 BIT(1), /* SET TO ONE WHEN THE 06840000 * /* MINIMUM AMT OF CORE * 06850000 * /* COULD NOT BE GOTTEN* 06860000 * 3 E01SW16 BIT(1), /* SWITCH 16 * 06870000 * 2 REGSAV(3) FIXED(31), /* WORK AREA * 06880000 * 2 LATAB PTR(31), /* PTR TO PREVIOUS ATA 06890000 * ELEMENT * 06900000 * 2 LFTAB PTR(31), /* PTR TO CURRENT FTAB 06910000 * ELEMENT MINUS 1 * 06920000 * 2 BFAPTR FIXED(31), /* POINTER TO INPUT BFR1* 06930000 * 2 BFBPTR PTR(31), /* POINTER TO INPUT BFR2* 06940000 * 2 CPPLPTR PTR(31), /* ADDRESS OF CPPL * 06950000 * 2 STPRM(3) FIXED(31), /* AREA FOR SAVING 06960000 * BASE REGS FOR USE OF 06970000 * STAE EXIT * 06980000 * 2 PPLPTR PTR(31), /* POINTER TO PARM 06990000 * BLOCK FOR PARSE * 07000000 * 2 CBCOR CHAR(24), /* STORAGE FOR SERVICE * 07010000 * /* ROUTINE CONTROL BLCK* 07020000 * 2 SRECB FIXED(31), /* SERV ROUT ECB * 07030000 * 2 RETCDAR FIXED(31), /* AREA FOR RETURN * 07040000 * /* CODE * 07050000 * 2 ABLK1 PTR(31), /* PTR TO FIRST BLOCK * 07060000 * /* OF ATAB */ 07070000 * 2 EOB PTR(31), /* END OF CURRENT INPUT * 07080000 * /* BLOCK + 1 * 07090000 * 2 RCDST PTR(31), /* PTR TO START OF CUR- * 07100000 * /* RENT RECORD * 07110000 * 2 VARSGLNG CHAR(1), /* LENGTH OF VARIABLE * 07120000 * /* PART OF MSG TO BE * 07130000 * /* PUT OUT * 07140000 * 2 VARSGADR PTR(24), /* ADDRESS OF VARIABLE * 07150000 * /* PART OF MSG TO BE * 07160000 * /* PUT OUT * 07170000 * 2 VARSGLN2 CHAR(1), /* LENGTH OF VARIABLE * 07180000 * /* PART OF MSG TO BE * 07190000 * /* PUT OUT * 07200000 * 2 VARSGAD2 PTR(24), /* ADDRESS OF VARIABLE * 07210000 * /* PART OF MSG TO BE * 07220000 * /* PUT OUT * 07230000 * 2 LVL1NO FIXED(15), /* NUMBER OF FIRST LEVEL* 07240000 * /* MESSAGE * 07250000 * 2 LVL2NO FIXED(15), /*NUMBER OF SECOND LEVEL* 07260000 * /* MESSAGE * 07270000 * 2 PDLPTR PTR(31), /* POINTER TO THE PARSE * 07280000 * /* DESCRIPTOR LIST * 07290000 * 2 DRDNPTR BDY(WORD), /* AREA FOR DSNAME * 07300000 * 3 DSNARLNG FIXED(15), /* LENGTH OF DSNAME * 07310000 * 4 DSNARLCH CHAR(2), /* * 07320000 * 3 DSNAMAR CHAR(44), /* DSNAME * 07330000 * 2 CBUFLSAV FIXED(15), /* SAVE AREA FOR CMD BFR* 07340000 * 3 CBUFLSAC CHAR(2), /* LENGTH Y01676* 07350000 * 2 POSBYT FIXED(15); /* SIZE OF POSITIONAL 07360000 * PARAMETERS Y01676* 07370000 * DCL FINEX PTR(24); /*ADDRESS OF END OF DATA* 07380000 * /* EXIT * 07390000 * DCL SYNEX PTR(24); /*ADDRESS OF SYNAD EXIT* 07400000 * 07410000 * 07420000 * /* LOCAL SWITCHES Y01676* 07430000 * /* Y01676* 07440000 * DCL /*Y01676* 07450000 * 1 E05BINSW CHAR(1), /*Y01676* 07460000 * 2 E05SW1 BIT(1), /* INDICATES KEYWORD BEIN 07470000 * PROCESSED HAS Y01676* 07480000 * 3 KWVAL BIT(1), /* A VALUE Y01676* 07490000 * 2 E05SW2 BIT(1), /* INDICATES THE VALUE FO 07500000 * KEYWORD Y01676* 07510000 * 3 QBIT BIT(1), /* IS A QUOTED Y01676* 07520000 * 2 E05SW3 BIT(1), /* FIRST CHAR OF VALUE 07530000 * HAS BEEN Y01676* 07540000 * 3 FIRSTBIT BIT(1), /* FOUND Y01676* 07550000 * 2 E05SW4 BIT(1), /* LAST CHAR OF VALUE 07560000 * HAS BEEN Y01676* 07570000 * 3 LASTBIT BIT(1), /* FOUND Y01676* 07580000 * 2 E05SW5 BIT(1), /* PROC STATEMENT Y02676* 07590000 * 3 CONTFLG BIT(1), /* IS CONTINUED Y02676* 07600000 * 2 * BIT(3); /* RESERVED Y02676* 07610000 * /* * 07620000 * /* BASED VARIABLES * 07630000 * /* * 07640000 * DCL 1 DCBD BDY(DWORD) BASED(ADDR(DCBAR)), 07650000 * /* DSECT -DCBFIELDS* 07660000 * 2 * CHAR(26), /* FILL * 07670000 * 2 DCBDSORG CHAR(2), /* DS ORGANIZATION * 07680000 * 2 * CHAR(5), /* FILL * 07690000 * 2 DCBEODAD PTR(24), /* END DATA EXIT * 07700000 * 2 DCBRECFM CHAR(1), /* RECORD FMT * 07710000 * 3 DCBRCFF BIT(1), /* FIXED LENGTH BIT* 07720000 * 3 DCBRCFV BIT(1), /* VAR LENGTH BIT* 07730000 * 2 DCBEXLST PTR(24), /* OPEN TIME EXIT * 07740000 * 2 DCBDDNAM CHAR(8), /* DDNAME * 07750000 * 2 DCBOFLGS CHAR(1), /* OPEN FLAGS * 07760000 * 2 * CHAR(1), /* FILL * 07770000 * 2 DCBMACR CHAR(2), /* MACRO TYPE * 07780000 * 2 * CHAR(5), /* FILL * 07790000 * 2 DCBSYNAD PTR(24), /* SYNAD ADDRESS * 07800000 * 2 * CHAR(2), /* FILL * 07810000 * 2 DCBBLKSI FIXED(15), /* BLOCKSIZE * 07820000 * 2 * CHAR(18), /* FILL * 07830000 * 2 DCBLRECL FIXED(15), /* RECORD SIZE * 07840000 * 2 * CHAR(4); /* FILL * 07850000 * DCL E05OPEX LABEL LOCAL EXTERNAL;/* LABEL OF OPEN EXIT * 07860000 * DCL INDAD1 LABEL BASED(ADPTR1); /* LABEL USED FOR 07870000 * INDIRECT ADDRS * 07880000 * DCL INDAD2 LABEL BASED(ADPTR2); /* LABEL USED FOR 07890000 * INDIRECT ADDRESS* 07900000 * DCL IKJEFF18 ENTRY BASED(R0); /* DAIRFAIL ENTRY Y01676* 07910000 * DCL E05SPD65 LABEL; /* STMT LABEL Y01676* 07920000 * DCL KWPARERR LABEL; /* STMT LABEL Y01676* 07930000 * DCL E03PRT05 LABEL EXTERNAL; /* ADDRESS OF END OF * 07940000 * /* DATA ROUTINE - * 07950000 * /* LABEL IN E03 * 07960000 * DCL E03SYN05 LABEL EXTERNAL; /* LABEL OF SYNAD EXIT * 07970000 * /* ROUTINE IN E03 * 07980000 * DCL MODDECB BDY(WORD) CHAR(20) BASED(R2);/* MODEL DECB * 07990000 * DCL 1 INPLIN BASED(LINPTR1) /* DSECT OF INPUT * 08000000 * CHAR(256), /* LINE * 08010000 * 2 LINLNG CHAR(2), /* RECORD LENGTH * 08020000 * 2 * CHAR(254); /* FILL * 08030000 * DCL 1 ATAB BDY(WORD) BASED(ATABIND), 08040000 * /* ARGUMENT TABLE * 08050000 * 2 ATABLST PTR(31), /* PTR TO PREV ATAB BLOCK 08060000 * - ZERO IF THIS IS THE 08070000 * FIRST BLOCK * 08080000 * 2 ATABNXT PTR(31), /* PTR TO NEXT ATAB BLOCK 08090000 * - ZERO IF THIS IS LAST 08100000 * * 08110000 * 2 ATABLNG FIXED(31); /* LENGTH OF THIS BLOCK 08120000 * OF ATAB * 08130000 * DCL 1 ATABELMT BDY(WORD) BASED(ATABCUR), /* ELEMENT * 08140000 * /* OF ATAB * 08150000 * 3 FTABPTR CHAR(4), /* PTR TO CORRESPONDING 08160000 * FTAB ELEMENT * 08170000 * 4 FTABPTRB BIT(32), /* REDEFINITION FOR 08180000 * ZEROING POINTER * 08190000 * 3 ATABFLGS CHAR(1), /* FLAGS FOR ATAB 08200000 * BIT 0 = KWORD W. VALU 08210000 * BIT 1 = KWORD WO VALU 08220000 * BIT 2 = LAST ENTRY * 08230000 * 3 ATABELNC CHAR(2), 08240000 * /* LENGTH OF SYMBOLIC 08250000 * PARAMETER * 08260000 * 3 ATABDAT CHAR(256); 08270000 * /* SYMBOLIC PARAMETER * 08280000 * DCL 1 FTAB BDY(WORD) BASED(FTABIND), 08290000 * /* FUNCTION TABLE * 08300000 * 2 FTABLST PTR(31), /* PTR TO PREVIOUS FTAB 08310000 * BLOCK - ZERO IF THIS I 08320000 * FIRST * 08330000 * 2 FTABNXT PTR(31), /* PTR TO NEXT FTAB BLOCK 08340000 * - ZERO IF THIS IS THE 08350000 * LAST * 08360000 * 2 FTABLNG FIXED(15), /* LENGTH OF THIS BLOCK 08370000 * OF FTAB * 08380000 * 2 FTABDLNG FIXED(15); /* NUMBER OF BYTES 08390000 * IN THIS BLOCK 08400000 * WHICH ARE IN USE* 08410000 * DCL 1 FTABELMT BDY(WORD) BASED(FTABCUR), /* ELEMENT * 08420000 * /* OF FTAB * 08430000 * 3 FTABELNG CHAR(4), /* LENGTH OF THIS VALUE * 08440000 * 3 FTABDAT CHAR(256); /* VALUE FOR CORRESPONDIN 08450000 * SYMBOLIC PARAMETER * 08460000 * DCL 1 DSNPDL BDY(WORD) BASED(PDLPTR), /* PARSE DESCRIPTOR 08470000 * OF DSNAME * 08480000 * 2 PTRDSN PTR(31), /* ADDR OF DSNAME * 08490000 * 2 DSNLNG FIXED(15), /* DSNAME LENGTH * 08500000 * 2 DSNFLG CHAR(1), /* PDL FLAGS * 08510000 * 3 DSNNUL BIT(1), /* PRESENT/ABSENT 08520000 * SWITCH * 08530000 * 3 DSNQTE BIT(1), /* CONTAINING QUOTES 08540000 * SWITCH * 08550000 * 3 * BIT(6), /* FILL * 08560000 * 2 * CHAR(1); /* FILL * 08570000 * /* * 08580000 * DCL PDLDNAM CHAR(44) BASED(PTRDSN); 08590000 * /* PARSED DSNAME * 08600000 * /* * 08610000 * DCL DSNMPARS LABEL EXTERNAL NONLOCAL; 08620000 * /* ADDRESSING FOR PCL * 08630000 * /* OF DSNAME * 08640000 * DCL DAPLPTR PTR(31) BASED(ADDR(PPLPTR)); 08650000 * /* POINTER TO PARM BLOCK* 08660000 * /* PASSED TO DAIR * 08670000 * /* * 08680000 * /* * 08690000 * /* PASSED OUT * 08700000 * /* * 08710000 * DCL DAPB0PTR PTR(31); /* PTR USED FOR DAIR * 08720000 * /* PARM BLOCK * 08730000 * /* REFERENCES * 08740000 * DCL ALOCINT BDY(WORD) CHAR(84);/* CORE FOR DAIR PARM 08750000 * BLOCK Y01676* 08760000 * DCL ALOCLR BIT(672) BASED(DAPB0PTR); /* REDEF- 08770000 * INITION OF ALOCINT FOR INITIAL- 08780000 * IZATION TO ZEROES Y01676* 08790000 * DCL 1 ALOCSET BASED(DAPB0PTR), /* REDEFINITION OF * 08800000 * 2 * CHAR(12), /* ALOCINT FOR * 08810000 * 2 B1 CHAR(24), /* INITIALIZATION * 08820000 * 2 * CHAR(16), /* OF NON ZERO * 08830000 * 2 B2 CHAR(16), /* CONSTANTS * 08840000 * 2 * CHAR(3), /* * 08850000 * 2 X1 CHAR(1); /* * 08860000 * /* * 08870000 * DCL ROPE GEND CHAR(256); /* GOTTEN CORE FOR * 08880000 * /*FORM OF OPEN MACRO* 08890000 ** DECLARE 08900000 ** 1 DAPB08 BASED(DAPB0PTR), 08910000 ** /* *************************************************************** * 08920000 ** /* S OPERATION CODE CAUSES ALLOCATION OF A DATA SET. IT CAN ALLOC. * 08930000 ** /* HER A NEW OR OLD SET. * 08940000 ** /* *************************************************************** * 08950000 ** 2 DA08CD CHAR(2), /* DAIR ENTRY CODE * 08960000 ** 2 DA08FLG CHAR(2), /* FUNCTIONS PERFORMED WHEN 08970000 ** RETURN CODE= 0 * 08980000 ** 3 DA08FPE BIT(1), /* FUNCT PERFORMED BUT ERROR 08990000 ** INDICATED BY RETCD * 09000000 ** 3 * BIT(1), /* RESERVED * 09010000 ** 3 * BIT(1), /* RESERVED * 09020000 ** 3 * BIT(1), /* RESERVED * 09030000 ** 3 * BIT(1), /* RESERVED * 09040000 ** 3 * BIT(1), /* RESERVED * 09050000 ** 3 * BIT(1), /* RESERVED * 09060000 ** 3 * BIT(1), /* RESERVED * 09070000 ** 2 DA08DARC FIXED(15), /*DYN ALLOC * 09080000 ** 2 DA08CTRC FIXED(15), /* CATALOG RETURN CODE * 09090000 ** 2 DA08PDSN PTR(31), /* POINTER TO DSNAME TO BE 09100000 ** SEARCHED IN DSE * 09110000 ** 2 DA08DDN CHAR(8), /* DDNAME TO BE SEARCHED IN DSE * 09120000 ** 2 DA08UNIT CHAR(8), /* UNITNAME REQUESTED * 09130000 ** 2 DA08SER CHAR(8), /* VOLUME SERIAL NUMBER-PADDED 09140000 ** W/BLANKS * 09150000 ** 2 DA08BLK CHAR(4), /* DATA SET * 09160000 ** 2 DA08PQTY CHAR(4), /* PRIMARY SPACE QUANTITY * 09170000 ** 2 DA08SQTY CHAR(4), /* SECONDARY SPACE QUANTITY * 09180000 ** 2 DA08DQTY CHAR(4), /* DIRECTORY BLOCK QUANTITY * 09190000 ** 2 DA08MNM CHAR(8), /* MEMBER NAME * 09200000 ** 2 DA08PSWD CHAR(8), /* PASSWORD * 09210000 ** 2 DA08DSP1 CHAR(1), /* DATA SET STATUS FLGS(IF=0 09220000 ** OLD ASSUMED) * 09230000 ** 3 * BIT(1), /* RESERVED * 09240000 ** 3 * BIT(1), /* RESERVED * 09250000 ** 3 * BIT(1), /* RESERVED * 09260000 ** 3 * BIT(1), /* RESERVED * 09270000 ** 3 DA08SHR BIT(1), /* DATA SET IS SHR * 09280000 ** 3 DA08NEW BIT(1), /* DATA SET IS NEW * 09290000 ** 3 DA08MOD BIT(1), /* DATA SET IS MOD * 09300000 ** 3 DA08OLD BIT(1), /* DATA SET IS OLD * 09310000 ** 2 DA08DPS2 CHAR(1), /* DATA SET DISPOSITION(IF=0 09320000 ** KEEP ASSUMED) * 09330000 ** 3 * BIT(1), /* RESERVED * 09340000 ** 3 * BIT(1), /* RESERVED * 09350000 ** 3 * BIT(1), /* RESERVED * 09360000 ** 3 * BIT(1), /* RESERVED * 09370000 ** 3 DA08KEEP BIT(1), /* DS DISP IS KEEP * 09380000 ** 3 DA08DEL BIT(1), /* DS DISP IS DELETE * 09390000 ** 3 DA08CAT BIT(1), /* DS DISP IS CATLG * 09400000 ** 3 DA08UCAT BIT(1), /* DS DISP IS UNCATALOG * 09410000 ** 2 DA08DPS3 CHAR(1), /* DATA SET CONDITIONAL 09420000 ** DISPOSITION * 09430000 ** 3 * BIT(1), /* RESERVED * 09440000 ** 3 * BIT(1), /* RESERVED * 09450000 ** 3 * BIT(1), /* RESERVED * 09460000 ** 3 * BIT(1), /* RESERVED * 09470000 ** 3 DA08KEP BIT(1), /* DS DISP OF KEEP DESIRED * 09480000 ** 3 DA08DELE BIT(1), 09490000 ** 3 DA08CATL BIT(1), 09500000 ** 3 DA08UNCT BIT(1), 09510000 ** 2 DA08CTL CHAR(1), /* FLAGS TO CONTROL ACTIONS 09520000 ** TAKEN BY DAIR * 09530000 ** 3 DA08TRKS BIT(1), /*SPACE UNITS REQUESTED * 09540000 ** 3 DA08ABKL BIT(1), 09550000 ** 3 DA08UID BIT(1), 09560000 ** 3 DA08RLSE BIT(1), 09570000 ** 3 DA08PERM BIT(1), 09580000 ** 3 DA08DMMY BIT(1), 09590000 ** 3 DA08ATRL BIT(1), /*ATTR LIST SUPPLIED C99236* 09600000 ** 3 * BIT(1), /* C99236* 09610000 ** 2 * CHAR(3), /* RESERVED * 09620000 ** 2 DA08DSO CHAR(1), /* DSORG C99236* 09630000 ** 2 DA08ALN CHAR(8); /* ATTR-LIST-NAME C99236* 09640000 ** 09650000 ** DECLARE 09660000 ** 1 DAPB00 BASED(DAPB0PTR), 09670000 ** /* *************************************************************** * 09680000 ** /* S OPERATION CODE CAUSES A SEARCH OF THE DSE TO BE MADE FOR THE * 09690000 ** /* CIFIED DSNAME AND SET THE DA00FLG FIELD ACCORDINGLY. IF DDNAME * 09700000 ** /* REQUESTED INFORMATION IS RETURNED IN DA00FLG INDICATING WHETHER * 09710000 ** /* NOT THE DDNAME IS ALLOCATED TO THE TERMINAL * 09720000 ** /* *************************************************************** * 09730000 ** 2 DA00CD CHAR(2), 09740000 ** 2 DA00FLG CHAR(2), /* FUNCTIONS PERFORMED WHEN 09750000 ** RETURN CODE= 0 * 09760000 ** 3 * BIT(1), /* RESERVED * 09770000 ** 3 * BIT(1), /* RESERVED * 09780000 ** 3 * BIT(1), /* RESERVED * 09790000 ** 3 * BIT(1), /* RESERVED * 09800000 ** 3 DA00PERM BIT(1), /* DSE IS PERM. ALLOCATED M0766* 09810000 ** 3 DA00DYNM BIT(1), /* DD IS A DYNAM M0766* 09820000 ** 3 DA00DSE BIT(1), /* DSNAME FOUND IN DSE * 09830000 ** 3 DA00TERM BIT(1), /* DDNAME ALLOCATED TO A 09840000 ** TERMINAL * 09850000 ** 2 DA00PDSN PTR(31), /* POINTER TO DSNAME TO BE 09860000 ** SEARCHED FOR IN DSE * 09870000 ** 2 DA00DDN CHAR(8), /* DDNAME TO BE SEARCHED FOR IN 09880000 ** DSE * 09890000 ** 2 DA00CTL CHAR(1), /* CONTROL FLAGS FOR SPEC 09900000 ** PROCESSING * 09910000 ** 3 * BIT(1), /* RESERVED * 09920000 ** 3 * BIT(1), /* RESERVED * 09930000 ** 3 DA00UID BIT(1), /* USER ID IS TO BE PREFIXED TO 09940000 ** DSNAME * 09950000 ** 3 * BIT(1), /* RESERVED * 09960000 ** 3 * BIT(1), /* RESERVED * 09970000 ** 3 * BIT(1), /* RESERVED * 09980000 ** 3 * BIT(1), /* RESERVED * 09990000 ** 3 * BIT(1), /* RESERVED * 10000000 ** 2 * CHAR(2), /* RESERVED */ 10010000 ** 2 DA00DSO CHAR(1); /* INDICATES DSORG * 10020000 ** 10030000 ** /* *************************************************************** * 10040000 ** /* THE DYNAMIC ALLOCATION INTERFACE ROUTINE (DAIR) PARAMETER LIST * 10050000 ** /* (DAPL) IS A LIST OF ADDRESSES PASSED FROM THE INVOKER TO DAIR * 10060000 ** /* VIA REGISTER 1 * 10070000 ** /* *************************************************************** * 10080000 ** DECLARE 10090000 ** 1 DAPL BASED(DAPLPTR), 10100000 ** 10110000 ** 10120000 ** 10130000 ** 10140000 ** 10150000 ** 10160000 ** 10170000 ** 10180000 ** 10190000 ** 10200000 ** 2 DAPLUPT PTR(31), /* PTR TO UPT * 10210000 ** 2 DAPLECT PTR(31), /* PTR TO ECT * 10220000 ** 2 DAPLECB PTR(31), /* PTR TO CP'S ECB * 10230000 ** 2 DAPLPSCB PTR(31), /* PTR TO PSCB * 10240000 ** 2 DAPLDAPB PTR(31); /* PTR TO DAIR PARAMETER BLOCK * 10250000 ** /* *************************************************************** * 10260000 ** /* THE COMMAND PROCESSOR PARAMETER LIST (CPPL) IS A LIST OF * 10270000 ** /* ADDRESSES PASSED FROM THE TMP TO THE CP VIA REGISTER 1 * 10280000 ** /* *************************************************************** * 10290000 ** DECLARE 10300000 ** 1 CPPL BASED(CPPLPTR), 10310000 ** 2 CPPLCBUF PTR(31), /* PTR TO COMMAND BUFFER * 10320000 ** 2 CPPLUPT PTR(31), /* PTR TO UPT * 10330000 ** 2 CPPLPSCB PTR(31), /* PTR TO PSCB * 10340000 ** 2 CPPLECT PTR(31); /* PTR TO ECT * 10350000 ** 10360000 * /******************************************************************** 10370000 * /******************************************************************** 10380000 * RESTRICT (R2,R4,R5,R6); 10390000 * R6 = R1; /* INIT. BASE REG * 10400000 LR @6,@1 0092 10410000 * DAPB0PTR = ADDR(ALOCINT); /* INITIALIZE POINTER 10420000 * TO DAIR PARM BLOCK * 10430000 LA @F,ALOCINT 0093 10440000 ST @F,DAPB0PTR 0093 10450000 * FINEX = ADDR(E03PRT05); /* AND EODAD EXIT ADDR* 10460000 L @3,@V1 ADDRESS OF E03PRT05 0094 10470000 ST @3,@TEMP4 0094 10480000 MVC FINEX(3),@TEMP4+1 0094 10490000 * SYNEX = ADDR(E03SYN05); /* AND SYNAD EXIT ADDR* 10500000 L @7,@V2 ADDRESS OF E03SYN05 0095 10510000 ST @7,@TEMP4 0095 10520000 MVC SYNEX(3),@TEMP4+1 0095 10530000 * E05BINSW = KONX00; /* AND LOCAL SW Y01676* 10540000 MVC E05BINSW(1),KONSTRUC 0096 10550000 * POSCNT = KON0; /* INITIALIZE NUMBER OF * 10560000 LH @F,KON0 0097 10570000 ST @F,132(0,@6) 0097 10580000 * /* POSITIONALS FOUND * 10590000 * POSBYT = KON0; /* INIT THE SIZE OF 10600000 * POSIT PARMS Y01676* 10610000 MVC 360(2,@6),KON0 0098 10620000 * STARTVAL = KON0; /* INIT THE WORK Y01676* 10630000 LH @F,KON0 0099 10640000 ST @F,STARTVAL 0099 10650000 * ENDVAL = KON0; /* AREAS USED FOR Y01676* 10660000 ST @F,ENDVAL 0100 10670000 * LPARCTR = KON0; /* PROCESSING KEYWORDS WIT 10680000 * VALUES Y01676* 10690000 ST @F,LPARCTR 0101 10700000 * EOLCNT = KON0; /* INITIALIZE NUMBER OF * 10710000 ST @F,128(0,@6) 0102 10720000 * /* BYTES REMAINING * 10730000 * GEN; 10740000 MVC ROPE,OPEL MOVE LIST FORM OF OPEN 10750000 DS 0H 10760000 * 10770000 * /************************************************************ 10780000 * /*FOLLOWING CODE SETS UP THE INTERFACE FOR DYNAMIC * 10790000 * /*ALLOCATION ROUTINE. THEN INVOKES DAIR TO ALLOCATE * 10800000 * /*THE DATA SET ON EXPLICIT EXECS. * 10810000 * /************************************************************ 10820000 * E05SRC10: ALOCLR = ''B; /* INITIALIZE DAIR 10830000 * INTERFACE * 10840000 E05SRC10 L @3,DAPB0PTR 0104 10850000 XC 0(84,@3),0(@3) 0104 10860000 * VARSGLN2 = KONX00; /* INITIALIZE LENGTH FIEL 10870000 * OF DYNAMIC PORTION OF 10880000 * MESSAGES * 10890000 MVC 300(1,@6),KONSTRUC 0105 10900000 * IF E01SW1 = '1'B /* IF IMPLICIT EXEC * 10910000 * THEN /* THEN * 10920000 TM 202(@6),B'10000000' 0106 10930000 BC 12,@9FF 0106 10940000 * DO; /* DDNAME IS SYSPROC * 10950000 * DA00DDN = KSYSPROC; /* BYPASS CODE FOR * 10960000 MVC 8(8,@3),KONSTRUC+20 0108 10970000 * GOTO E05SRC20; /* ALLOCATION CODE 08 * 10980000 BC 15,E05SRC20 0109 10990000 * END; /* OTHERWISE * 11000000 * CNVA = KON8; /* ALIGN EIGHT * 11010000 @9FF MVC 200(2,@6),KON8 0111 11020000 * DA08CD = CNVC; /* SET OPERATION CODE * 11030000 L @3,DAPB0PTR 0112 11040000 MVC 0(2,@3),200(@6) 0112 11050000 * B1 = KBLNK; /* SET BLANKS * 11060000 MVC 12(1,@3),KBLNK 0113 11070000 MVI 13(@3),C' ' 0113 11080000 MVC 14(22,@3),13(@3) 0113 11090000 * B2 = KBLNK; /* SET BLANKS * 11100000 MVC 52(1,@3),KBLNK 0114 11110000 MVI 53(@3),C' ' 0114 11120000 MVC 54(14,@3),53(@3) 0114 11130000 * DA08SHR = '1'B; /* INDICATE SHARE STATUS* 11140000 OI 68(@3),B'00001000' 0115 11150000 * IF DSNNUL = '1'B /* IF THERE WAS A DSNAME* 11160000 * THEN 11170000 L @7,308(0,@6) 0116 11180000 TM 6(@7),B'10000000' 0116 11190000 BC 12,@9FE 0116 11200000 * DSNAMAR = PDLDNAM(1:DSNLNG); /* MOVE DSNAME * 11210000 LH @8,4(0,@7) 0117 11220000 BCTR @8,0 0117 11230000 L @3,0(0,@7) DSNPDL 0117 11240000 LR @E,@3 0117 11250000 LA @A,314(0,@6) 0117 11260000 MVI 0(@A),C' ' 0117 11270000 MVC 1(043,@A),0(@A) 0117 11280000 EX @8,@MVC 0117 11290000 * DSNARLNG = DSNLNG; /* SET LENGTH * 11300000 @9FE L @3,308(0,@6) 0118 11310000 MVC 312(2,@6),4(@3) 0118 11320000 * IF DSNQTE = '1'B /* BRANCH IF FULLY QUAL-* 11330000 * THEN /* IFIED NAME TO BYPASS * 11340000 L @3,308(0,@6) 0119 11350000 TM 6(@3),B'01000000' 0119 11360000 * GOTO E05SRC15; /* ADDITION OF CLIST * 11370000 BC 01,E05SRC15 0120 11380000 * DA08UID = '1'B; /* INDICATE THAT THE 11390000 * USERID IS TO BE 11400000 * PREFIXED * 11410000 L @7,DAPB0PTR 0121 11420000 OI 71(@7),B'00100000' 0121 11430000 * TEM01 = DSNLNG + KON1; /* SET NEXT CHAR PTR * 11440000 LH @F,KON1 0122 11450000 AH @F,4(0,@3) 0122 11460000 ST @F,TEM01 0122 11470000 * IF TEM01 = KON1 /*IF THERE WAS NO DSNAME* 11480000 * THEN /* DO NOT PUT PERIOD * 11490000 LH @F,KON1 0123 11500000 C @F,TEM01 0123 11510000 * GOTO E05SRC13; /* BEFORE CLIST 11520000 BC 08,E05SRC13 0124 11530000 * IF DSNLNG > KON6 & /* IF THE NAME * 11540000 * DSNAMAR(DSNLNG - KON5) = KPERD &/* CONTAINS CLIST * 11550000 * DSNAMAR(DSNLNG - KON4:DSNLNG) = KCLIST/* ALREADY * 11560000 * THEN /* DO NOT ADD CLIST * 11570000 LH @F,KON6 0125 11580000 CH @F,4(0,@3) 0125 11590000 BC 10,@9FD 0125 11600000 LH @8,KON5 0125 11610000 LCR @8,@8 0125 11620000 AH @8,4(0,@3) 0125 11630000 LA @A,313(@8,@6) 0125 11640000 CLC 0(1,@A),KPERD 0125 11650000 BC 07,@9FC 0125 11660000 LA @E,KCLIST 0125 11670000 LH @7,4(0,@3) 0125 11680000 LH @8,KON4 0125 11690000 LCR @8,@8 0125 11700000 AH @8,4(0,@3) 0125 11710000 SR @7,@8 0125 11720000 LA @A,313(@8,@6) 0125 11730000 EX @7,@CLC 0125 11740000 * GOTO E05SRC15; /* TO IT * 11750000 BC 08,E05SRC15 0126 11760000 * 11770000 **/*E05SRC12: P SUFFIX DSNAME WITH '.CLIST' */ 11780000 * E05SRC12: ; /* SUFFIX PERIOD BEFORE 11790000 * ADDING CLIST * 11800000 @9FB EQU * 0127 11810000 @9FC EQU * 0127 11820000 @9FD EQU * 0127 11830000 * IF DSNLNG > KON37 /* IF DSNAME YM2699* 11840000 * THEN /* ABOVE THE 44 YM2699* 11850000 E05SRC12 LH @F,KON37 0128 11860000 L @3,308(0,@6) 0128 11870000 CH @F,4(0,@3) 0128 11880000 BC 10,@9FA 0128 11890000 * DO; /* CHARACTER MAXIMUM * 11900000 * PDLPTR = PDLPTR + KON16; /* UPDATE PDL POINTER * 11910000 LH @F,KON16 0130 11920000 A @F,308(0,@6) 0130 11930000 ST @F,308(0,@6) 0130 11940000 * ADPTR1 = KON0; /* THEN INDICATE TERM- * 11950000 LH @F,KON0 0131 11960000 ST @F,88(0,@6) 0131 11970000 * LVL1NO = KON25; /* INATION AND 1ST LVL * 11980000 MVC 304(2,@6),KON25 0132 11990000 * LVL2NO = KON0; /* MSG NUMBER AND 2ND * 12000000 MVC 306(2,@6),KON0 0133 12010000 * GOTO E05MML05; /* LVL MSG NUMBER AND GO* 12020000 BC 15,E05MML05 0134 12030000 * END; /* TO PUT OUT MSG * 12040000 * DSNAMAR(TEM01) = KPERD; /* INSERT PERIOD * 12050000 @9FA L @3,TEM01 0136 12060000 LA @A,313(@3,@6) 0136 12070000 MVC 0(1,@A),KPERD 0136 12080000 * TEM01 = TEM01 + KON1; /* UPDATE PTR NXT CHAR * 12090000 LH @F,KON1 0137 12100000 A @F,TEM01 0137 12110000 ST @F,TEM01 0137 12120000 * DSNARLNG = DSNARLNG + KON1; /* INDICATE NEW LENGTH * 12130000 LH @F,KON1 0138 12140000 AH @F,312(0,@6) 0138 12150000 STH @F,312(0,@6) 0138 12160000 * E05SRC13: ; 12170000 * DSNARLNG = DSNARLNG + KON5; /* INDICATE NEW LENGTH * 12180000 E05SRC13 LH @F,KON5 0140 12190000 AH @F,312(0,@6) 0140 12200000 STH @F,312(0,@6) 0140 12210000 * TEM02 = TEM01 + KON4; /* SET LIMIT FOR MOVE * 12220000 LH @F,KON4 0141 12230000 A @F,TEM01 0141 12240000 ST @F,TEM02 0141 12250000 * DSNAMAR(TEM01:TEM02) = KCLIST; /* MOVE CLIST QUALIFIER * 12260000 LA @E,KCLIST 0142 12270000 LR @3,@F 0142 12280000 L @7,TEM01 0142 12290000 SR @3,@7 0142 12300000 LA @A,313(@7,@6) 0142 12310000 EX @3,@MVC 0142 12320000 * TEM01 = TEM02 + KON1; /* UPDATE PTR * 12330000 LH @F,KON1 0143 12340000 A @F,TEM02 0143 12350000 ST @F,TEM01 0143 12360000 * 12370000 * E05SRC15: PDLPTR = PDLPTR + KON8; /* UPDATE TO MEMBER NAME 12380000 * PDE * 12390000 E05SRC15 LH @F,KON8 0144 12400000 A @F,308(0,@6) 0144 12410000 ST @F,308(0,@6) 0144 12420000 * IF DSNNUL = '1'B /* IF THERE IS A MEMBER * 12430000 * THEN /* NAME * 12440000 L @3,308(0,@6) 0145 12450000 TM 6(@3),B'10000000' 0145 12460000 BC 12,@9F9 0145 12470000 * MMNAMAR = PDLDNAM(1:DSNLNG); /* SAVE NAME IN E01DATDF* 12480000 LH @7,4(0,@3) 0146 12490000 BCTR @7,0 0146 12500000 L @8,0(0,@3) DSNPDL 0146 12510000 LR @E,@8 0146 12520000 LA @A,96(0,@6) 0146 12530000 MVI 0(@A),C' ' 0146 12540000 MVC 1(007,@A),0(@A) 0146 12550000 EX @7,@MVC 0146 12560000 BC 15,@9F8 0147 12570000 * ELSE /* IF NO MEMBER NAME * 12580000 * MMNAMAR = KBLNK; /* SET TO BLANKS * 12590000 @9F9 MVC 96(1,@6),KBLNK 0147 12600000 MVI 97(@6),C' ' 0147 12610000 MVC 98(6,@6),97(@6) 0147 12620000 * PDLPTR = PDLPTR + KON8; /* UPDATE TO PASSWD PDE * 12630000 @9F8 LH @F,KON8 0148 12640000 A @F,308(0,@6) 0148 12650000 ST @F,308(0,@6) 0148 12660000 * IF DSNNUL = '1'B /* IF PASSWD PRESENT * 12670000 * THEN /* * 12680000 L @3,308(0,@6) 0149 12690000 TM 6(@3),B'10000000' 0149 12700000 BC 12,@9F7 0149 12710000 * DA08PSWD = PDLDNAM(1:DSNLNG); /* MOVE TO INTERFACE * 12720000 LH @7,4(0,@3) 0150 12730000 BCTR @7,0 0150 12740000 L @8,0(0,@3) DSNPDL 0150 12750000 LR @E,@8 0150 12760000 L @3,DAPB0PTR 0150 12770000 LA @A,60(0,@3) 0150 12780000 MVI 0(@A),C' ' 0150 12790000 MVC 1(007,@A),0(@A) 0150 12800000 EX @7,@MVC 0150 12810000 * DA08PDSN = ADDR(DRDNPTR); /* SET DSNAME POINTER * 12820000 @9F7 LA @F,312(0,@6) 0151 12830000 L @3,DAPB0PTR 0151 12840000 ST @F,8(0,@3) 0151 12850000 * 12860000 * E05SRC20:DAPLDAPB = DAPB0PTR; /* SET PTR TO ALOCATION * 12870000 E05SRC20 L @3,248(0,@6) 0152 12880000 MVC 16(4,@3),DAPB0PTR 0152 12890000 * DAPLPSCB = CPPLPSCB; /* PARAMETERS * 12900000 L @7,232(0,@6) 0153 12910000 MVC 12(4,@3),8(@7) 0153 12920000 * 12930000 * 12940000 * R1 = PPLPTR; /* REG1 POINTS TO PARMS * 12950000 L @1,248(0,@6) 0154 12960000 * GEN(LINK EP=IKJDAIR LINK TO DAIR); 12970000 LINK EP=IKJDAIR LINK TO DAIR 12980000 DS 0H 12990000 * 13000000 * /************************************************************ 13010000 * /*FOLLOWING CODE INSURES THAT THE DATA SET WAS * 13020000 * /*ALLOCATED SUCCESFULLY, ALTERS THE DCB TO REFLECT * 13030000 * /*THE CURRENT SITUATION, ISSUES AN OPEN AND IF * 13040000 * /*NECESSARY ISSUES A FIND. * 13050000 * /*********************************************************** 13060000 * DAIRRET = R15; /* SAVE RET CDE Y01676* 13070000 ST @F,DAIRRET 0156 13080000 * IF DAIRRET ^= KON0 /* IF NON ZERO Y01676* 13090000 * THEN /* DAIR WAS NOT SUCCESS- 13100000 LH @F,KON0 0157 13110000 C @F,DAIRRET 0157 13120000 BC 08,@9F6 0157 13130000 * DO; /* FUL * 13140000 * REGSAV(1) = R1; /* SAVE R1 BEFORE Y01676* 13150000 ST @1,204(0,@6) 0159 13160000 * GEN(LOAD EP=IKJEFF18); /* GOING TO Y01676* 13170000 LOAD EP=IKJEFF18 13180000 DS 0H 13190000 * CALL IKJEFF18 (DAPL,DAIRRET,MSGWTRAD,CALLERID); 13200000 L @3,248(0,@6) 0161 13210000 ST @3,@PL001 0161 13220000 LA @F,DAIRRET 0161 13230000 ST @F,@PL001+4 0161 13240000 LA @F,MSGWTRAD 0161 13250000 ST @F,@PL001+8 0161 13260000 LA @F,CALLERID 0161 13270000 ST @F,@PL001+12 0161 13280000 LR @F,@0 0161 13290000 LA @1,@PL001 0161 13300000 BALR @E,@F 0161 13310000 * /* DAIRFAIL FOR Y01676* 13320000 * GEN(DELETE EP=IKJEFF18); /* ERROR ANALYSIS Y01676* 13330000 DELETE EP=IKJEFF18 13340000 DS 0H 13350000 * R1 = REGSAV(1); /* RESTORE R1 Y01676* 13360000 L @1,204(0,@6) 0163 13370000 * E01SW9 = '1'B; /* INDICAT TER- Y01676* 13380000 OI 203(@6),B'10000000' 0164 13390000 * RETURN; /* MINATION Y01676* 13400000 BC 15,@EL01 0165 13410000 * END; /* AND TERMINATE * 13420000 * IF E01SW1 = '1'B /* IF THIS WAS IMPLICIT*/ 13430000 * THEN /* THEN CHECK IF A PERM- 13440000 * ANENTLY ALLOCATED */ 13450000 @9F6 TM 202(@6),B'10000000' 0167 13460000 BC 12,@9F3 0167 13470000 * IF (DA00FLG & '0A'X) ^= '0A'X /* SYSPROC DD ENTRY WAS*/ 13480000 * THEN /* FOUND AND IF NOT */ 13490000 MVI @CTEMP2,X'0A' 0168 13500000 MVI @CTEMP2+1,X'00' 0168 13510000 L @3,DAPB0PTR 0168 13520000 NC @CTEMP2(2),2(@3) 0168 13530000 MVI @CTEMP4,X'0A' 0168 13540000 MVI @CTEMP4+1,X'00' 0168 13550000 CLC @CTEMP2(002),@CTEMP4 0168 13560000 BC 08,@9F2 0168 13570000 * DO; /* SET INDICATOR FOR */ 13580000 * CNVA = KON4; /* COMMAND NOT FOUND MSG* 13590000 MVC 200(2,@6),KON4 0170 13600000 * GOTO E05SRC40; /* GO TO PUT OUT MSG */ 13610000 BC 15,E05SRC40 0171 13620000 * END; 13630000 * ELSE /* OTHERWISE */ 13640000 * DO; 13650000 * DA08DSO = DA00DSO; /* MOVE VALUES FOR */ 13660000 @9F2 L @3,DAPB0PTR 0174 13670000 MVC 75(1,@3),19(@3) 0174 13680000 * DA08DDN(5:8) = DA00DDN(5:8);/* LATER COMPARES */ 13690000 MVC 16(4,@3),12(@3) 0175 13700000 * DA08DDN(1:4) = DA00DDN(1:4);/* AND THEN */ 13710000 MVC 12(4,@3),8(@3) 0176 13720000 * GOTO E05SRC33; /* GO TO CHECK DATA SET*/ 13730000 BC 15,E05SRC33 0177 13740000 * END; /* ORGANIZATION */ 13750000 * E05SRC30: ; 13760000 @9F1 EQU * 0179 13770000 @9F3 EQU * 0179 13780000 * IF (DA08DSO & KONX40) = KONX40 13790000 * THEN /* IF DATA SET IS SEQNTL* 13800000 E05SRC30 MVC @CTEMP2(1),KONSTRUC+5 0180 13810000 L @3,DAPB0PTR 0180 13820000 NC @CTEMP2(1),75(@3) 0180 13830000 CLC @CTEMP2(1),KONSTRUC+5 0180 13840000 BC 07,@9F0 0180 13850000 * DO; /* ALTER THE DCB * 13860000 * DCBDSORG(1) = KONX40; /* TO REFLECT * 13870000 MVC 26(1,@6),KONSTRUC+5 0182 13880000 * DCBMACR(1) = DCBMACR(1) & KONXFB; /* THIS * 13890000 NC 50(1,@6),KONSTRUC+18 0183 13900000 BC 15,@9EF 0185 13910000 * END; /* * 13920000 * ELSE /* CHECK DSORG * 13930000 * E05SRC33: IF (DA08DSO & KONX02) ^= KONX02 /* IF NOT PARTITIONED * 13940000 * THEN /* IT IS AN ERROR SO * 13950000 @9F0 EQU * 0185 13960000 E05SRC33 MVC @CTEMP2(1),KONSTRUC+1 0185 13970000 L @3,DAPB0PTR 0185 13980000 NC @CTEMP2(1),75(@3) 0185 13990000 CLC @CTEMP2(1),KONSTRUC+1 0185 14000000 BC 08,@9EE 0185 14010000 * DO; /* SET UP PROPER * 14020000 * LVL1NO = KON2; /* INDICATORS FOR THE * 14030000 MVC 304(2,@6),KON2 0187 14040000 * LVL2NO = KON1; /* MESSAGE MODULE * 14050000 MVC 306(2,@6),KON1 0188 14060000 * ADPTR1 = KON0; /* INDICATE TERMINATION* 14070000 LH @F,KON0 0189 14080000 ST @F,88(0,@6) 0189 14090000 * GOTO E05MML05; /* AND EXIT TO PUT OUT * 14100000 BC 15,E05MML05 0190 14110000 * END; /* MESSAGE & TERMINATE * 14120000 * DCBDDNAM = DA08DDN; /* ENTER DDNAME IN DCB * 14130000 @9EE EQU * 0192 14140000 @9EF L @3,DAPB0PTR 0192 14150000 MVC 40(8,@6),12(@3) 0192 14160000 * R2 = ADDR(DCBAR); /* REG 2 POINTS TO DCB * 14170000 LR @2,@6 0193 14180000 * R1 = ADDR(ROPE); /* REG1 POINTS TO LIST 14190000 * FORM OF OPEN * 14200000 LA @1,ROPE 0194 14210000 * GEN (OPEN ((R2)),MF=(E,(1)) OPEN THE DATA SET); 14220000 OPEN ((R2)),MF=(E,(1)) OPEN THE DATA SET 14230000 DS 0H 14240000 * IF (DCBOFLGS & KONX10) ^= KONX10 /* IF THE OPEN WAS NOT * 14250000 * THEN /* SUCCESSFUL * 14260000 MVC @CTEMP2(1),KONSTRUC+3 0196 14270000 NC @CTEMP2(1),48(@6) 0196 14280000 CLC @CTEMP2(1),KONSTRUC+3 0196 14290000 BC 08,@9ED 0196 14300000 * DO; /* SET SECOND LEVEL MSG * 14310000 * LVL2NO = KON1; /* AS OPEN ERROR AND * 14320000 MVC 306(2,@6),KON1 0198 14330000 * CNVA = KON0; /* INDICATE FIRST LEVEL * 14340000 MVC 200(2,@6),KON0 0199 14350000 * GOTO E05SRC40; /* AS DATA SET UNUSABLE * 14360000 BC 15,E05SRC40 0200 14370000 * END; /* GOTO PUT OUT MSG * 14380000 * IF E01SW1 = '0'B /* IF EXPLICIT * 14390000 * THEN /* EXEC * 14400000 @9ED TM 202(@6),B'10000000' 0202 14410000 BC 05,@9EC 0202 14420000 * IF DA08DSO = KONX40 /* AND SEQ DATA SET * 14430000 * THEN /* THEN * 14440000 L @3,DAPB0PTR 0203 14450000 CLC 75(1,@3),KONSTRUC+5 0203 14460000 BC 07,@9EB 0203 14470000 * IF MMNAMAR(1) ^= KBLNK /* IF A MEMBER NAME WAS * 14480000 * THEN /* SPECIFIED FOR THIS * 14490000 CLC 96(1,@6),KBLNK 0204 14500000 BC 08,@9EA 0204 14510000 * DO; /* SEQ. DATA SET SET THE* 14520000 * LVL1NO = KON21; /* SET INDICATORS FOR * 14530000 MVC 304(2,@6),KON21 0206 14540000 * LVL2NO = KON0; /* MESSAGE MODULE * 14550000 MVC 306(2,@6),KON0 0207 14560000 * ADPTR1 = KON0; /* INDICATE TERMINATION * 14570000 LH @F,KON0 0208 14580000 ST @F,88(0,@6) 0208 14590000 * GOTO E05MML10; /* AND GO TO PUT MSG. * 14600000 BC 15,E05MML10 0209 14610000 * END; /* AND TERMINATE * 14620000 * ELSE /* OTHERWISE * 14630000 * DO; 14640000 * CNVA = KON0; /* SET DUMMY FIND R.CODE* 14650000 @9EA MVC 200(2,@6),KON0 0212 14660000 * GOTO E05SRC35; /* BYPASS FIND * 14670000 BC 15,E05SRC35 0213 14680000 * END; /* * 14690000 * IF E01SW1 = '0'B /* IF EXPLICIT EXEC * 14700000 * THEN /* AND * 14710000 @9E9 EQU * 0215 14720000 @9EB EQU * 0215 14730000 @9EC TM 202(@6),B'10000000' 0215 14740000 BC 05,@9E8 0215 14750000 * IF MMNAMAR(1) = KBLNK /* NO MEM NAME GIVEN * 14760000 * THEN /* SET * 14770000 CLC 96(1,@6),KBLNK 0216 14780000 BC 07,@9E7 0216 14790000 * MMNAMAR = KTEMPNAM; /* TO TEMPNAME * 14800000 MVC 96(8,@6),KONSTRUC+28 0217 14810000 * LVL2NO = KON3; /* SET SECOND LEVEL MSG 14820000 * NO. IN CASE THERE IS 14830000 * A FIND ERROR * 14840000 @9E7 EQU * 0218 14850000 @9E8 MVC 306(2,@6),KON3 0218 14860000 * R1 = ADDR(DCBAR); /* REG1 POINTS TO DCB * 14870000 LR @1,@6 0219 14880000 * R2 = ADDR(MMNAMAR); /* REG2 POINTS TO NAME * 14890000 LA @2,96(0,@6) 0220 14900000 * GEN (FIND (1),(2),D OBTAIN CORRECT MEMBER); 14910000 FIND (1),(2),D OBTAIN CORRECT MEMBER 14920000 DS 0H 14930000 * CNVA = R15; /* SAVE RETURN CODE * 14940000 STH @F,200(0,@6) 0222 14950000 * 14960000 * /************************************************************ 14970000 * /*FOLLOWING CODE CHECKS TO INSURE A SUCCESSFUL * 14980000 * /*FIND, FREES THE PDL IF THERE IS ONE,CHECKS TO * 14990000 * /*INSURE A LEGAL RECORD FORMAT, MOVES THE DECB * 15000000 * /*TO DYNAMIC CORE AND CALLS MODULE E03 TO READ * 15010000 * /*THE FIRST RECORD OF THE PROCEDURE * 15020000 * /************************************************************ 15030000 * E05SRC35: ; 15040000 * IF CNVA = KON0 /* IF SUCCESSFUL GO TO * 15050000 * THEN /* PERFORM GETPOOL * 15060000 E05SRC35 LH @F,KON0 0224 15070000 CH @F,200(0,@6) 0224 15080000 * GOTO E05SRC45; /* FOR BUFFERS * 15090000 BC 08,E05SRC45 0225 15100000 * E05SRC40: ; /* IF UNSUCCESSFUL TERM- 15110000 * INATE EXECUTION * 15120000 * IF CNVA ^= KON4 /* IF THIS ERROR WAS NOT* 15130000 * THEN /* THAT MEMBER COULD 15140000 * NOT BE FOUND - SET * 15150000 E05SRC40 LH @F,KON4 0227 15160000 CH @F,200(0,@6) 0227 15170000 BC 08,@9E6 0227 15180000 * LVL1NO = KON3; /* MESSAGES TO INDICATE 15190000 * THIS * 15200000 MVC 304(2,@6),KON3 0228 15210000 BC 15,@9E5 0229 15220000 * ELSE 15230000 * IF E01SW1 = '1'B /* IF IMPLICIT EXEC * 15240000 * THEN /* SET 1ST AND 2ND * 15250000 @9E6 TM 202(@6),B'10000000' 0229 15260000 BC 12,@9E4 0229 15270000 * DO; /* LEVEL MSG. NOS. TO * 15280000 * LVL1NO = KON0; /* INDICATE COMMAND NOT * 15290000 MVC 304(2,@6),KON0 0231 15300000 * LVL2NO = KON0; /* FOUND * 15310000 MVC 306(2,@6),KON0 0232 15320000 BC 15,@9E3 0234 15330000 * END; 15340000 * ELSE /* OTHERWISE * 15350000 * DO; 15360000 * LVL1NO = KON20; /* SET TO ERR OPENING * 15370000 @9E4 MVC 304(2,@6),KON20 0235 15380000 * LVL2NO = KON0; /* SET 2ND LVL MSG * 15390000 MVC 306(2,@6),KON0 0236 15400000 * END; 15410000 * ADPTR1 = KON0; /* INDICATE TERMINATION * 15420000 @9E3 EQU * 0238 15430000 @9E5 LH @F,KON0 0238 15440000 ST @F,88(0,@6) 0238 15450000 * GOTO E05MML10; /* GO TO PUT MSG AND 15460000 * TERMINATE * 15470000 BC 15,E05MML10 0239 15480000 * E05SRC45: R1 = ADDR(DCBAR); /* REG 1 = DCB ADDRESS * 15490000 E05SRC45 LR @1,@6 0240 15500000 * GEN; 15510000 GETBUF (R1),R2 OBTAIN FIRST BUFFER FROM POOL 15520000 ST R2,BFAPTR(R6) SAVE THE ADDRESS 15530000 GETBUF (R1),R2 OBTAIN SECOND BUFFER FROM POOL 15540000 ST R2,BFBPTR(R6) SAVE THE ADDRESS 15550000 DS 0H 15560000 * IF DCBRCFF = '0'B & /* IF INCORRECT RECFM * 15570000 * DCBRCFV = '0'B | /* -THAT IS NOT FIXED * 15580000 * DCBRCFF = '1'B & /* OR VARIABLE- * 15590000 * DCBRCFV = '1'B /* THEN * 15600000 * THEN 15610000 TM 36(@6),B'10000000' 0242 15620000 BC 05,@9E2 0242 15630000 TM 36(@6),B'01000000' 0242 15640000 BC 08,@9E1 0242 15650000 @9E2 TM 36(@6),B'10000000' 0242 15660000 BC 12,@9E0 0242 15670000 TM 36(@6),B'01000000' 0242 15680000 BC 12,@9DF 0242 15690000 * DO; /* SET UP PROPER * 15700000 * LVL1NO = KON5; /* INDICATORS FOR THE * 15710000 @9E1 MVC 304(2,@6),KON5 0244 15720000 * LVL2NO = KON0; /* MESSAGE MODULE * 15730000 MVC 306(2,@6),KON0 0245 15740000 * ADPTR1 = KON0; /* INDICATE TERMINATION* 15750000 LH @F,KON0 0246 15760000 ST @F,88(0,@6) 0246 15770000 * GOTO E05MML05; /* AND EXIT TO PUT OUT * 15780000 BC 15,E05MML05 0247 15790000 * END; /* MESSAGE AND TERM. * 15800000 * IF DCBRCFV = '1'B /* IF RCD FORMAT IS VAR * 15810000 * THEN /* SET THE VARIABLE * 15820000 @9DF EQU * 0249 15830000 @9E0 TM 36(@6),B'01000000' 0249 15840000 BC 12,@9DE 0249 15850000 * E01SW8 = '1'B; /* FORMAT SWITCH ON * 15860000 OI 202(@6),B'00000001' 0250 15870000 * GEN (LA R2,MODDECBD); /* PLACE DECB IN GOTTEN * 15880000 @9DE EQU * 0251 15890000 LA R2,MODDECBD 15900000 DS 0H 15910000 * RDECB = MODDECB; /* CORE * 15920000 MVC 104(20,@6),0(@2) 0252 15930000 * E01SW2 = '1'B; /* SET FIRST READ SWITCH* 15940000 OI 202(@6),B'01000000' 0253 15950000 * R1 = ADDR(E01DATDF); /* SET PARM POINTER * 15960000 LR @1,@6 0254 15970000 * CALL IKJEFE03; /* READ FIRST LINE * 15980000 L @F,@V3 ADDRESS OF IKJEFE03 0255 15990000 BALR @E,@F 0255 16000000 * IF E01SW9 = '1'B /* IF THERE WAS AN ERROR* 16010000 * THEN /* RETURN TO E01 * 16020000 TM 203(@6),B'10000000' 0256 16030000 * RETURN; /* IMMEDIATELY * 16040000 BC 03,@EL01 0257 16050000 * IF LINPTR1 = KON0 /* IF EOD WAS HIT ON 1ST* 16060000 * THEN /* LINE THEN * 16070000 @9DD LH @F,KON0 0258 16080000 C @F,124(0,@6) 0258 16090000 BC 07,@9DC 0258 16100000 * DO; /* INDICATE IT VIA * 16110000 * E01SW11 = '1'B; /* SWITCH 11 * 16120000 OI 203(@6),B'00100000' 0260 16130000 * GOTO E05CNT03; /* AND GO TO CALL E02 * 16140000 BC 15,E05CNT03 0261 16150000 * END; /* FOR PARSING * 16160000 * ADPTR2 = ADDR(E05SPD20); /* RETURN ADDRESS FOR 16170000 * EMPTY LINE * 16180000 @9DC LA @F,E05SPD20 0263 16190000 ST @F,92(0,@6) 0263 16200000 * ADPTR1 = ADDR(E05SPD25); /* RETURN ADDRESS FOR 16210000 * NON-EMPTY LINE * 16220000 LA @F,E05SPD25 0264 16230000 ST @F,88(0,@6) 0264 16240000 * 16250000 * /************************************************************ 16260000 * /*FOLLOWING CODE INITIALIZES PARAMETERS USED IN * 16270000 * /*PROCESSING RECORDS OF THE PROCEDURE * 16280000 * /************************************************************ 16290000 * E05SPD07: IF E01SW8 = '1'B /* IF RCD FORMAT IS * 16300000 * THEN /* VARIABLE * 16310000 E05SPD07 TM 202(@6),B'00000001' 0265 16320000 BC 12,@9DB 0265 16330000 * DO; /* THEN * 16340000 * EOLCNTCH(3:4) = LINLNG; /* ALIGN LENGTH OF RCD * 16350000 L @3,124(0,@6) 0267 16360000 MVC 130(2,@6),0(@3) 0267 16370000 * EOLCNT = EOLCNT - KON12; /* ADJUST BYTE COUNT FOR 16380000 * LRECL INDICATOR 16390000 * AND LINE NUMBER * 16400000 LH @F,KON12 0268 16410000 LCR @F,@F 0268 16420000 A @F,128(0,@6) 0268 16430000 ST @F,128(0,@6) 0268 16440000 * LINPTR1 = LINPTR1 + KON12; /*ALSO ADJUST RCD ADDR * 16450000 LH @F,KON12 0269 16460000 A @F,124(0,@6) 0269 16470000 ST @F,124(0,@6) 0269 16480000 BC 15,@9DA 0271 16490000 * END; 16500000 * ELSE /* IF FIXED FMT ALTER * 16510000 * DO; /* BYTE COUNT FOR Y02676* 16520000 * EOLCNT = DCBLRECL - KON8; /* LINE NUMBERS * 16530000 @9DB LH @F,KON8 0272 16540000 LCR @F,@F 0272 16550000 AH @F,82(0,@6) 0272 16560000 ST @F,128(0,@6) 0272 16570000 * 16580000 * DO TEM01 = EOLCNT TO 1 BY -1; /* STRIP BLANKS Y02676* 16590000 L @F,128(0,@6) 0273 16600000 BC 15,@DO9D8 0273 16610000 * IF INPLIN(TEM01) ^= KBLNK /* AT END OF Y02676* 16620000 * /* RECORD Y02676* 16630000 * THEN /*Y02676* 16640000 @DO9D9 L @3,TEM01 0274 16650000 L @7,124(0,@6) 0274 16660000 LA @A,0(@3,@7) 0274 16670000 BCTR @A,0 0274 16680000 CLC 0(1,@A),KBLNK 0274 16690000 BC 08,@9D5 0274 16700000 * DO; /*Y02676* 16710000 * EOLCNT = TEM01; /* RESET END OF Y02676* 16720000 MVC 128(4,@6),TEM01 0276 16730000 * GOTO E05SPD08; /* LINE INDICATOR TO FIRST 16740000 * NON SEPERATOR Y02676* 16750000 BC 15,E05SPD08 0277 16760000 * END; /*Y02676* 16770000 * END; /*Y02676* 16780000 * 16790000 * EOLCNT = KON1; /* IF A BLANK LINE IT WILL B 16800000 * CAUGHT LATER Y02676* 16810000 @9D5 L @F,TEM01 0279 16820000 BCTR @F,0 0279 16830000 @DO9D8 ST @F,TEM01 0279 16840000 CH @F,@D1 0279 16850000 BC 10,@DO9D9 0279 16860000 LH @F,KON1 0280 16870000 ST @F,128(0,@6) 0280 16880000 * END; /*Y02676* 16890000 * 16900000 * E05SPD08: /* CHECK HERE FOR Y02676* 16910000 * IF INPLIN(EOLCNT) = KCONT | /* PROC STATEMENT Y02676* 16920000 * INPLIN(EOLCNT) = KCONTP /* CONTINUED Y02676* 16930000 * THEN /*Y02676* 16940000 @9DA EQU * 0282 16950000 E05SPD08 L @3,128(0,@6) 0282 16960000 L @7,124(0,@6) 0282 16970000 LA @A,0(@3,@7) 0282 16980000 BCTR @A,0 0282 16990000 CLC 0(1,@A),KCONT 0282 17000000 BC 08,@9D4 0282 17010000 CLC 0(1,@A),KCONTP 0282 17020000 BC 07,@9D3 0282 17030000 * CONTFLG = '1'B; /*Y02676* 17040000 @9D4 OI E05BINSW,B'00001000' 0283 17050000 * 17060000 * /************************************************************ 17070000 * /*FOLLOWING CODE SEARCHES FOR THE NEXT NON-DELIMITER * 17080000 * /*- READING ADDITIONAL RECORDS IF A CONTINUATION * 17090000 * /*IS INDICATED - IF A NON-DELIMITER IS FOUND EXIT * 17100000 * /*IS MADE TO INDAD1. IF THERE ARE ONLY DELIMITERS * 17110000 * /*ON THE LINE EXIT IS MADE TO INDAD2 * 17120000 * /************************************************************ 17130000 * E05SPD10: DO TEM01 = KON1 TO EOLCNT; /* SEARCH LINE FOR * 17140000 @9D3 EQU * 0284 17150000 E05SPD10 LH @F,KON1 0284 17160000 ST @F,TEM01 0284 17170000 @DO9D2 L @F,128(0,@6) 0284 17180000 C @F,TEM01 0284 17190000 BC 04,@DO9CF 0284 17200000 BC 15,@DO9D0 0284 17210000 @DO9D1 LA @F,1 0284 17220000 A @F,TEM01 0284 17230000 ST @F,TEM01 0284 17240000 BC 15,@DO9D2 0284 17250000 * IF INPLIN(1) = KBLNK | /* NON-DELIMITER * 17260000 * INPLIN(1) = KTAB | /* IF ITS A * 17270000 * INPLIN(1) = KCOM /* DELIMITER BYPASS * 17280000 * THEN /* AND * 17290000 @DO9D0 L @3,124(0,@6) 0285 17300000 CLC 0(1,@3),KBLNK 0285 17310000 BC 08,@9CE 0285 17320000 CLC 0(1,@3),KTAB 0285 17330000 BC 08,@9CD 0285 17340000 CLC 0(1,@3),KCOM 0285 17350000 BC 07,@9CC 0285 17360000 * LINPTR1 = LINPTR1 + KON1; /* DO NEXT CHAR * 17370000 @9CD EQU * 0286 17380000 @9CE LH @F,KON1 0286 17390000 A @F,124(0,@6) 0286 17400000 ST @F,124(0,@6) 0286 17410000 * ELSE /* EXIT IF NON-DELIM * 17420000 * GOTO E05SPD15; /* TO CHECK FOR A * 17430000 * END; /* CONTINUATION MARK * 17440000 BC 15,@DO9D1 0288 17450000 * GOTO INDAD2; /* IF EMPTY LINE EXIT * 17460000 @DO9CF L @3,92(0,@6) 0289 17470000 BCR 15,@3 0289 17480000 * 17490000 * E05SPD15: IF TEM01 = EOLCNT & /* IF ONLY CONTINUATION * 17500000 * CONTFLG = '1'B /* INDICATOR IS Y02676* 17510000 * THEN /* PRESENT THEN * 17520000 E05SPD15 L @F,128(0,@6) 0290 17530000 C @F,TEM01 0290 17540000 BC 07,@9CA 0290 17550000 TM E05BINSW,B'00001000' 0290 17560000 BC 12,@9C9 0290 17570000 * DO; /* SET THE READ * 17580000 * E01SW7 = '1'B; /* INDICATOR * 17590000 OI 202(@6),B'00000010' 0292 17600000 * CONTFLG = '0'B; /* RESET CONT IND Y02676* 17610000 NI E05BINSW,B'11110111' 0293 17620000 * REGSAV(2) = R1; /* SAVE REG1 * 17630000 ST @1,208(0,@6) 0294 17640000 * R1 = ADDR(E01DATDF); /* SET PARM POINTER * 17650000 LR @1,@6 0295 17660000 * CALL IKJEFE03; /* AND CALL IKJEFE03 * 17670000 L @F,@V3 ADDRESS OF IKJEFE03 0296 17680000 BALR @E,@F 0296 17690000 * E01SW7 = '0'B; /* RESET INDICATOR * 17700000 NI 202(@6),B'11111101' 0297 17710000 * R1 = REGSAV(2); /* RESTORE REG2 * 17720000 L @1,208(0,@6) 0298 17730000 * IF E01SW9 = '1'B /* IF THERE WAS AN ERROR* 17740000 * THEN /* RETURN TO E01 * 17750000 TM 203(@6),B'10000000' 0299 17760000 * RETURN; /* IMMEDIATELY * 17770000 BC 03,@EL01 0300 17780000 * IF LINPTR1 = KON0 /* IF EOD WAS HIT ON * 17790000 * THEN /* FIRST LOGICAL LINE * 17800000 @9C8 LH @F,KON0 0301 17810000 C @F,124(0,@6) 0301 17820000 BC 07,@9C7 0301 17830000 * DO; /* INDICATE IT VIA * 17840000 * E01SW11 = '1'B; /* SWITCH 11 * 17850000 OI 203(@6),B'00100000' 0303 17860000 * GOTO E05CNT03; /* GOTO RETURN * 17870000 BC 15,E05CNT03 0304 17880000 * END; /* TO PARSE INVOCATION * 17890000 * GOTO E05SPD07; /* IF NOT EOD * 17900000 * END; /* THEN PROCESS THE LINE* 17910000 * EOLCNT = EOLCNT + KON1 - TEM01; /* IF NOT CONTINUATION 17920000 * RESET BYTES REMAINING* 17930000 @9C9 EQU * 0308 17940000 @9CA L @F,TEM01 0308 17950000 LCR @F,@F 0308 17960000 AH @F,KON1 0308 17970000 A @F,128(0,@6) 0308 17980000 ST @F,128(0,@6) 0308 17990000 * GOTO INDAD1; /* RETURN TO CALLER * 18000000 L @3,88(0,@6) 0309 18010000 BCR 15,@3 0309 18020000 * 18030000 * /************************************************************ 18040000 * /*THIS IS THE RETURN POINT IF THE FIRST LOGICAL * 18050000 * /*RECORD OF THE PROCEDURE CONTAINED ONLY DELIMITERS * 18060000 * /************************************************************ 18070000 * E05SPD20: E01SW3 = '1'B; /* SET NOPROC SWITCH * 18080000 E05SPD20 OI 202(@6),B'00100000' 0310 18090000 * GOTO E05CNT03; /* GO TO RETURN * 18100000 BC 15,E05CNT03 0311 18110000 * 18120000 * /************************************************************ 18130000 * /*FOLLOWING CODE EXAMINES THE FIRST RECORD OF THE * 18140000 * /*PROCEDURE TO DETERMINE IF THERE IS A 'PROC' * 18150000 * /*STATEMENT. * 18160000 * /************************************************************ 18170000 * E05SPD25: IF EOLCNT < KON4 | /* IF THE FIRST WORD * 18180000 * INPLIN(1:4) ^= KPROC | /* IS NOT EQUAL TO * 18190000 * EOLCNT > KON4 & /* PROC THEN * 18200000 * INPLIN(5) ^= KBLNK & /* TURN ON * 18210000 * INPLIN(5) ^= KTAB & /* SWITCHES * 18220000 * INPLIN(5) ^= KCOM /* THREE * 18230000 * THEN /* (NO PROC STMT) * 18240000 E05SPD25 LH @F,KON4 0312 18250000 C @F,128(0,@6) 0312 18260000 BC 02,@9C6 0312 18270000 L @3,124(0,@6) 0312 18280000 CLC 0(4,@3),KPROC 0312 18290000 BC 07,@9C5 0312 18300000 C @F,128(0,@6) 0312 18310000 BC 10,@9C4 0312 18320000 CLC 4(1,@3),KBLNK 0312 18330000 BC 08,@9C3 0312 18340000 CLC 4(1,@3),KTAB 0312 18350000 BC 08,@9C2 0312 18360000 CLC 4(1,@3),KCOM 0312 18370000 BC 08,@9C1 0312 18380000 * DO; /* AND * 18390000 @9C5 EQU * 0313 18400000 * E01SW3 = '1'B; /* FOUR * 18410000 @9C6 OI 202(@6),B'00110000' 0314 18420000 * E01SW4 = '1'B; /* (1ST LINE NOT EMPTY) * 18430000 * GOTO E05CNT03; /* AND GO TO RETURN * 18440000 BC 15,E05CNT03 0316 18450000 * END; /* TO PARSE INVOCATION * 18460000 * LINPTR1 = LINPTR1 + KON4; /* INDEX POINTER PAST * 18470000 @9C1 EQU * 0318 18480000 @9C2 EQU * 0318 18490000 @9C3 EQU * 0318 18500000 @9C4 LH @F,KON4 0318 18510000 A @F,124(0,@6) 0318 18520000 ST @F,124(0,@6) 0318 18530000 * EOLCNT = EOLCNT - KON4; /* 'PROC' * 18540000 LH @F,KON4 0319 18550000 LCR @F,@F 0319 18560000 A @F,128(0,@6) 0319 18570000 ST @F,128(0,@6) 0319 18580000 * ADPTR1 = ADDR(E05SPD35); /* RET ADDR IF NON-EMPTY 18590000 * LINE FOUND * 18600000 LA @F,E05SPD35 0320 18610000 ST @F,88(0,@6) 0320 18620000 * ADPTR2 = ADDR(E05SPD30); /* RET ADDR IF EMPTY 18630000 * LINE FOUND * 18640000 LA @F,E05SPD30 0321 18650000 ST @F,92(0,@6) 0321 18660000 * GOTO E05SPD10; /* GO FIND NEXT PARM * 18670000 BC 15,E05SPD10 0322 18680000 * 18690000 * /************************************************************ 18700000 * /*RETURN POINT IF ENTIRE RECORD AFTER 'PROC' STMT * 18710000 * /*CONTAINS ONLY DELIMITERS. * 18720000 * /************************************************************ 18730000 * E05SPD30: ; /* SINCE NO. OF POS- * 18740000 * LVL1NO = KON6; /* ITIONALS IS MISSING * 18750000 E05SPD30 MVC 304(2,@6),KON6 0324 18760000 * LVL2NO = KON1; /* GOTO PUT OUT MESSAGE * 18770000 MVC 306(2,@6),KON1 0325 18780000 * ADPTR1 = KON0; /* INDICATE TERMINATION * 18790000 LH @F,KON0 0326 18800000 ST @F,88(0,@6) 0326 18810000 * GOTO E05MML05; 18820000 BC 15,E05MML05 0327 18830000 * 18840000 * /************************************************************ 18850000 * /*FOLLOWING CHECKS TO BE SURE THE NO. OF POSITIONALS * 18860000 * /*SPECIFICATION IS NUMERIC THEN CONVERTS IT TO BINARY * 18870000 * /************************************************************ 18880000 * E05SPD35: DO TEM01 = KON1 TO EOLCNT; /* PROCESS NO. POSITS * 18890000 E05SPD35 LH @F,KON1 0328 18900000 ST @F,TEM01 0328 18910000 @DO9C0 L @F,128(0,@6) 0328 18920000 C @F,TEM01 0328 18930000 BC 04,@DO9BD 0328 18940000 BC 15,@DO9BE 0328 18950000 @DO9BF LA @F,1 0328 18960000 A @F,TEM01 0328 18970000 ST @F,TEM01 0328 18980000 BC 15,@DO9C0 0328 18990000 * DDIG = INPLIN(TEM01); /* MOVE DIGIT TO WK AREA* 19000000 @DO9BE L @3,TEM01 0329 19010000 L @7,124(0,@6) 0329 19020000 LA @E,0(@3,@7) 0329 19030000 BCTR @E,0 0329 19040000 MVC 167(1,@6),0(@E) 0329 19050000 * IF DDIG ^< KONXF0 & DDIG ^> KONXF9/********************** 19060000 * /*IF IT IS * 19070000 * THEN /* NUMERIC THEN * 19080000 CLC 167(1,@6),KONSTRUC+15 0330 19090000 BC 04,@9BC 0330 19100000 CLC 167(1,@6),KONSTRUC+16 0330 19110000 BC 02,@9BB 0330 19120000 * DO; /* CONVERT * 19130000 * DDIG = DDIG & KONX0F; /* IT INTO BINARY * 19140000 NC 167(1,@6),KONSTRUC+2 0332 19150000 * POSSPC = POSSPC * KON10 + RDXCNV; 19160000 LH @F,KON10 0333 19170000 M @E,168(0,@6) 0333 19180000 A @F,164(0,@6) 0333 19190000 ST @F,168(0,@6) 0333 19200000 BC 15,@9BA 0335 19210000 * /* AND UPDATE CUMULATIVE* 19220000 * END; /* BINARY VALUE * 19230000 * ELSE /* IF NOT NUMERIC THEN * 19240000 * IF DDIG = KBLNK | /* IF IT IS A DELIMITER * 19250000 * DDIG = KCOM | /* THE END OF THE NUMBER* 19260000 * DDIG = KTAB | /* HAS BEEN REACHED * 19270000 * CONTFLG = '1'B & TEM01 = EOLCNT /*Y02676* 19280000 * THEN 19290000 @9BB EQU * 0335 19300000 @9BC CLC 167(1,@6),KBLNK 0335 19310000 BC 08,@9B9 0335 19320000 CLC 167(1,@6),KCOM 0335 19330000 BC 08,@9B8 0335 19340000 CLC 167(1,@6),KTAB 0335 19350000 BC 08,@9B7 0335 19360000 TM E05BINSW,B'00001000' 0335 19370000 BC 12,@9B6 0335 19380000 L @F,128(0,@6) 0335 19390000 C @F,TEM01 0335 19400000 BC 07,@9B5 0335 19410000 * GOTO E05SPD40; /* SO EXIT * 19420000 BC 08,E05SPD40 0336 19430000 * ELSE /* IF NOT NUMERIC OR DE- 19440000 * LIMITER IT IS ERROR * 19450000 * DO; /* SET UP PROPER * 19460000 @9B5 EQU * 0337 19470000 * LVL1NO = KON6; /* INDICATORS FOR THE * 19480000 @9B6 MVC 304(2,@6),KON6 0338 19490000 * LVL2NO = KON1; /* MESSAGE MODULE * 19500000 MVC 306(2,@6),KON1 0339 19510000 * VARSGADR = ADDR(INPLIN); 19520000 L @3,124(0,@6) 0340 19530000 ST @3,@TEMP4 0340 19540000 MVC 297(3,@6),@TEMP4+1 0340 19550000 * /* STORE ADDR OF DYNAMIC 19560000 * PORTION * 19570000 * CNVA = TEM01 + KON4;/* COMPUTE LENGTH OF * 19580000 LH @F,KON4 0341 19590000 A @F,TEM01 0341 19600000 STH @F,200(0,@6) 0341 19610000 * VARSGLNG = CNVC(2);/* DYNAMIC PORTION * 19620000 MVC 296(1,@6),201(@6) 0342 19630000 * ADPTR1 = 0; /* INDICATE TERMINATION* 19640000 SR @F,@F 0343 19650000 ST @F,88(0,@6) 0343 19660000 * GOTO E05MML10; 19670000 BC 15,E05MML10 0344 19680000 * END; /* MESSAGE AND TERM. * 19690000 * END; 19700000 * E05SPD40: EOLCNT = EOLCNT - TEM01 + KON1; /* UPDATE BYTES LEFT * 19710000 @DO9BD EQU * 0346 19720000 E05SPD40 LH @F,KON1 0347 19730000 S @F,TEM01 0347 19740000 A @F,128(0,@6) 0347 19750000 ST @F,128(0,@6) 0347 19760000 * LINPTR1 = LINPTR1 + TEM01 - KON1; /* UPDATE LINE PTR PAST 19770000 * THE NUMERIC * 19780000 LH @F,KON1 0348 19790000 LCR @F,@F 0348 19800000 A @F,TEM01 0348 19810000 A @F,124(0,@6) 0348 19820000 ST @F,124(0,@6) 0348 19830000 * ADPTR2 = ADDR(E05CNT03); /* SET RETURN ADDRESS FRO 19840000 * SCAN ROUTINE FOR EMPTY 19850000 * LINE * 19860000 LA @F,E05CNT03 0349 19870000 ST @F,92(0,@6) 0349 19880000 * ADPTR1 = ADDR(E05SPD43); /*SET RETURN ADDRESS 19890000 * FROM SCAN ROUTINE FOR 19900000 * NONEMPTY LINE * 19910000 LA @F,E05SPD43 0350 19920000 ST @F,88(0,@6) 0350 19930000 * GOTO E05SPD10; /* GO TO SCAN ROUTINE * 19940000 BC 15,E05SPD10 0351 19950000 * 19960000 * /************************************************************ 19970000 * /*FOLLOWING CODE OBTAINS CORE STORAGE FOR ATAB * 19980000 * /*AND FTAB CONTROL BLOCKS AND SETS UP THE NECESSARY * 19990000 * /*PARAMETERS AND POINTERS ASSOCIATED WITH EACH. * 20000000 * /************************************************************ 20010000 * E05SPD43: E01SW10 = '1'B; /* SET GETMAIN SWITCH* 20020000 E05SPD43 OI 203(@6),B'01000000' 0352 20030000 * R4 = KON1; /* SET SUBPOOL INDICATOR* 20040000 LH @4,KON1 0353 20050000 * REGSAV(2) = R1; /* SAVE REG1 * 20060000 ST @1,208(0,@6) 0354 20070000 * R1 = ADDR(E01DATDF); /* SET REG1 POINTING TO 20080000 * PARMS * 20090000 LR @1,@6 0355 20100000 * CALL IKJEFE03; /* PERFORM GETMAIN * 20110000 L @F,@V3 ADDRESS OF IKJEFE03 0356 20120000 BALR @E,@F 0356 20130000 * R1 = REGSAV(2); /* RESTORE REG1 * 20140000 L @1,208(0,@6) 0357 20150000 * E01SW10 = '0'B; /*RESET GETMAIN SWITCH* 20160000 NI 203(@6),B'10111111' 0358 20170000 * IF E01SW15 = '1'B /* IF WE COULD NOT GET * 20180000 * THEN /* MINIMUM CORE - * 20190000 TM 203(@6),B'00000010' 0359 20200000 * RETURN; /* RETURN TO E01 TO END* 20210000 BC 03,@EL01 0360 20220000 * 20230000 * R4 = ADDGMN; /* SET THE PTR TO ATAB * 20240000 @9B4 L @4,148(0,@6) 0361 20250000 * ABLK1 = R4; /* SAVE ADDR OF BLOCK * 20260000 ST @4,284(0,@6) 0362 20270000 * R5 = R4 + KON12; /* SET PTR TO CURRENT 20280000 * ATAB ELEMENT * 20290000 LH @5,KON12 0363 20300000 AR @5,@4 0363 20310000 * R4->ATABLNG = AMTGMN / KON2; /* SET ATAB BLOCK LENGTH 20320000 * TO GOTTEN CORE DIVIDED 20330000 * BY TWO * 20340000 L @E,152(0,@6) 0364 20350000 SRDA @E,32 0364 20360000 LH @0,KON2 0364 20370000 DR @E,@0 0364 20380000 ST @F,8(0,@4) 0364 20390000 * R4->ATABLST = KON0; /* SET PREVIOUS BLOCK 20400000 * POINTER * 20410000 LH @F,KON0 0365 20420000 ST @F,0(0,@4) 0365 20430000 * R4->ATABNXT = KON0; /* SET NEXT BLOCK PTR * 20440000 ST @F,4(0,@4) 0366 20450000 * R1 = R4 + R4-> ATABLNG; /* SET PTR TO FTAB * 20460000 L @F,8(0,@4) 0367 20470000 AR @F,@4 0367 20480000 LR @1,@F 0367 20490000 * R2 = R1 + KON12; /* SET PTR TO CURRENT * 20500000 LH @2,KON12 0368 20510000 AR @2,@1 0368 20520000 * /* FTAB ELEMENT * 20530000 * R1->FTABLNG = R4->ATABLNG; /* SET FTAB BLOCK LENGTH* 20540000 MVC 8(2,@1),10(@4) 0369 20550000 * R1->FTABLST = KON0; /* SET PREVIOUS BLOCK * 20560000 LH @F,KON0 0370 20570000 ST @F,0(0,@1) 0370 20580000 * /* POINTER * 20590000 * R1->FTABNXT = KON0; /* SET NEXT BLOCK PTR * 20600000 ST @F,4(0,@1) 0371 20610000 * R1->FTABDLNG = KON12; /* INITIALIZE BYTES USED* 20620000 MVC 10(2,@1),KON12 0372 20630000 * POSCNT = KON0; /* NUMBER OF POSITIONALS* 20640000 LH @F,KON0 0373 20650000 ST @F,132(0,@6) 0373 20660000 * /* FOUND IS ZERO * 20670000 * ATABIND = R4; /* STORE ATAB ADDRESS * 20680000 ST @4,172(0,@6) 0374 20690000 * FTABIND = R1; /* STORE FTAB ADDRESS * 20700000 ST @1,180(0,@6) 0375 20710000 * 20720000 * /************************************************************ 20730000 * /*FOLLOWING CODE SCANS THE SYMBOLIC PARAMETERS * 20740000 * /*DEFINED IN THE 'PROC' STATEMENT TO INSURE THAT * 20750000 * /*EACH IS COMPOSED OF ALPHANUMERIC CHARACTERS * 20760000 * /*THE FIRST OF WHICH IS ALPHABETIC. * 20770000 * /************************************************************ 20780000 * E05SPD48: ; /* SET SUBSCRIPT VALUE * 20790000 * DO TEM01 = KON1 TO EOLCNT; /*SCAN THE SYMBOLIC 20800000 * PARAMETER * 20810000 E05SPD48 LH @F,KON1 0377 20820000 ST @F,TEM01 0377 20830000 @DO9B3 L @F,128(0,@6) 0377 20840000 C @F,TEM01 0377 20850000 BC 04,@DO9B0 0377 20860000 BC 15,@DO9B1 0377 20870000 @DO9B2 LA @F,1 0377 20880000 A @F,TEM01 0377 20890000 ST @F,TEM01 0377 20900000 BC 15,@DO9B3 0377 20910000 * IF INPLIN(TEM01) = KBLNK | /* IS THIS * 20920000 * INPLIN(TEM01) = KCOM | /* A DELIMITER * 20930000 * INPLIN(TEM01) = KTAB /* YES AND PRO- Y01676* 20940000 * THEN /* CESSING VALUE Y01676* 20950000 @DO9B1 L @3,TEM01 0378 20960000 L @7,124(0,@6) 0378 20970000 LA @A,0(@3,@7) 0378 20980000 BCTR @A,0 0378 20990000 CLC 0(1,@A),KBLNK 0378 21000000 BC 08,@9AF 0378 21010000 CLC 0(1,@A),KCOM 0378 21020000 BC 08,@9AE 0378 21030000 CLC 0(1,@A),KTAB 0378 21040000 BC 07,@9AD 0378 21050000 * IF KWVAL = '1'B /* GO CHECK VALUE Y01676* 21060000 * THEN /* IF NOT VALUE Y01676* 21070000 @9AE EQU * 0379 21080000 @9AF TM E05BINSW,B'10000000' 0379 21090000 * GO TO VALSCAN2; /* THEN EXIT SCAN Y01676* 21100000 BC 01,VALSCAN2 0380 21110000 * ELSE /* CAUSE THIS IS Y01676* 21120000 * GO TO E05SPD66; /* END OF PARM Y01676* 21130000 BC 15,E05SPD66 0381 21140000 * /* END OF LINE Y01676* 21150000 * IF TEM01 = EOLCNT & /* WITH A CONTINUATION * 21160000 * CONTFLG = '1'B /* IF IT IS THE Y02676* 21170000 * THEN /* PARAMETER IS ENDED* 21180000 @9AD L @F,128(0,@6) 0382 21190000 C @F,TEM01 0382 21200000 BC 07,@9AC 0382 21210000 TM E05BINSW,B'00001000' 0382 21220000 * GOTO VALCHECK; /* SO EXIT SCAN Y01676* 21230000 BC 03,VALCHECK 0383 21240000 * IF KWVAL = '1'B /* IF THIS IS Y01676* 21250000 * THEN /* VALUE PART OF KWRD* 21260000 @9AB EQU * 0384 21270000 @9AC TM E05BINSW,B'10000000' 0384 21280000 * GOTO VALSCAN1; /* BYPASS ALPHANUM CHECK* 21290000 BC 01,VALSCAN1 0385 21300000 * ADPTR1 = ADDR(E05SPD65); /* RETURN ADDRESS FOR 21310000 * ALPHA CHAR FOUND * 21320000 LA @F,E05SPD65 0386 21330000 ST @F,88(0,@6) 0386 21340000 * ADPTR2 = ADDR(E05SPD60); /* RETURN ADDRESS FOR 21350000 * NON-ALPHA FOUND * 21360000 LA @F,E05SPD60 0387 21370000 ST @F,92(0,@6) 0387 21380000 * 21390000 * /* IF THE CHARACTER IS NOT ALPHABETIC THEN RETURN VIA EXIT 2* 21400000 * IF INPLIN (TEM01) < KONXC1 | /************************ 21410000 * INPLIN(TEM01) > KONXC9 & /************************ 21420000 * INPLIN(TEM01) < KONXD1 | /************************ 21430000 * INPLIN(TEM01) > KONXD9 & /************************ 21440000 * INPLIN(TEM01) < KONXE2 | /************************ 21450000 * INPLIN(TEM01) > KONXE9 /************************ 21460000 * THEN /************************ 21470000 L @3,TEM01 0388 21480000 L @7,124(0,@6) 0388 21490000 LA @A,0(@3,@7) 0388 21500000 BCTR @A,0 0388 21510000 CLC 0(1,@A),KONSTRUC+8 0388 21520000 BC 04,@9AA 0388 21530000 CLC 0(1,@A),KONSTRUC+9 0388 21540000 BC 12,@9A9 0388 21550000 CLC 0(1,@A),KONSTRUC+10 0388 21560000 BC 04,@9A8 0388 21570000 @9A9 L @3,TEM01 0388 21580000 L @7,124(0,@6) 0388 21590000 LA @A,0(@3,@7) 0388 21600000 BCTR @A,0 0388 21610000 CLC 0(1,@A),KONSTRUC+11 0388 21620000 BC 12,@9A7 0388 21630000 CLC 0(1,@A),KONSTRUC+12 0388 21640000 BC 04,@9A6 0388 21650000 @9A7 L @3,TEM01 0388 21660000 L @7,124(0,@6) 0388 21670000 LA @A,0(@3,@7) 0388 21680000 BCTR @A,0 0388 21690000 CLC 0(1,@A),KONSTRUC+13 0388 21700000 BC 12,@9A5 0388 21710000 * GOTO INDAD2; /************************ 21720000 @9A6 EQU * 0389 21730000 @9A8 EQU * 0389 21740000 @9AA L @3,92(0,@6) 0389 21750000 BCR 15,@3 0389 21760000 * GOTO INDAD1; /* ELSE RETURN VIA EXIT1* 21770000 @9A5 L @3,88(0,@6) 0390 21780000 BCR 15,@3 0390 21790000 * 21800000 * E05SPD60: IF INPLIN(TEM01) < KONXFA & /* IF THE CHAR IS * 21810000 * INPLIN(TEM01) > KONXEF & /* NUMERIC AND * 21820000 * TEM01 ^= KON1 /* AND NOT THE FIRST * 21830000 * THEN /* CONTINUE * 21840000 E05SPD60 L @3,TEM01 0391 21850000 L @7,124(0,@6) 0391 21860000 LA @A,0(@3,@7) 0391 21870000 BCTR @A,0 0391 21880000 CLC 0(1,@A),KONSTRUC+17 0391 21890000 BC 10,@9A4 0391 21900000 CLC 0(1,@A),KONSTRUC+14 0391 21910000 BC 12,@9A3 0391 21920000 LH @F,KON1 0391 21930000 C @F,TEM01 0391 21940000 * GOTO E05SPD65; /* THE SCAN * 21950000 BC 07,E05SPD65 0392 21960000 * IF INPLIN(TEM01) = KLPAR & /*IF CHARACTER IS * 21970000 * TEM01 > KON1 /* LEFT PAREN - IT IS OK* 21980000 * THEN /* SO BRANCH AROUND * 21990000 @9A2 EQU * 0393 22000000 @9A3 EQU * 0393 22010000 @9A4 L @3,TEM01 0393 22020000 L @7,124(0,@6) 0393 22030000 LA @A,0(@3,@7) 0393 22040000 BCTR @A,0 0393 22050000 CLC 0(1,@A),KLPAR 0393 22060000 BC 07,@9A1 0393 22070000 LH @F,KON1 0393 22080000 C @F,TEM01 0393 22090000 * GOTO E05SPD63; /* ERROR CODE * 22100000 BC 05,E05SPD63 0394 22110000 * /* OTHERWISE 22120000 * IT IS AN 22130000 * ERROR * 22140000 * /* SO * 22150000 * ADPTR1 = ADDR(E05SPD65); /* INDICATE RETURN POINT* 22160000 @9A0 EQU * 0395 22170000 @9A1 LA @F,E05SPD65 0395 22180000 ST @F,88(0,@6) 0395 22190000 * E05SPD62: ; /* SET UP PROPER * 22200000 * LVL1NO = KON7; /* INDICATORS FOR THE */ 22210000 E05SPD62 MVC 304(2,@6),KON7 0397 22220000 * LVL2NO = KON1; /* MESSAGE MODULE * 22230000 MVC 306(2,@6),KON1 0398 22240000 * VARSGADR = ADDR(INPLIN); /* SET POINTER TO PARM * 22250000 L @3,124(0,@6) 0399 22260000 ST @3,@TEMP4 0399 22270000 MVC 297(3,@6),@TEMP4+1 0399 22280000 * CNVA = TEM01 + KON4; /* IN ERROR AND SET * 22290000 LH @F,KON4 0400 22300000 A @F,TEM01 0400 22310000 STH @F,200(0,@6) 0400 22320000 * VARSGLNG = CNVC(2); /* ITS LENGTH * 22330000 MVC 296(1,@6),201(@6) 0401 22340000 * GOTO E05MML10; /* AND EXIT TO PUT OUT 22350000 * MESSAGE AND TERM. * 22360000 BC 15,E05MML10 0402 22370000 * VALSCAN1: IF QBIT = '0'B /* IF WE ARE NOT Y01676* 22380000 * THEN /* PROCESSING A Y01676* 22390000 VALSCAN1 TM E05BINSW,B'01000000' 0403 22400000 BC 05,@99F 0403 22410000 * IF INPLIN(TEM01) = KLPAR /* QUOTED STRING Y01676* 22420000 * THEN /* CHECK FOR LEFT Y01676* 22430000 L @3,TEM01 0404 22440000 L @7,124(0,@6) 0404 22450000 LA @A,0(@3,@7) 0404 22460000 BCTR @A,0 0404 22470000 CLC 0(1,@A),KLPAR 0404 22480000 BC 07,@99E 0404 22490000 * LPARCTR = KON1 + LPARCTR; /* AND RIGHT Y01676* 22500000 L @F,LPARCTR 0405 22510000 AH @F,KON1 0405 22520000 ST @F,LPARCTR 0405 22530000 BC 15,@99D 0406 22540000 * ELSE /* PARENS AND Y01676* 22550000 * IF INPLIN(TEM01) = KRPAR /* DECREMENT THE Y01676* 22560000 * THEN /* PAREN COUNT Y01676* 22570000 @99E L @3,TEM01 0406 22580000 L @7,124(0,@6) 0406 22590000 LA @A,0(@3,@7) 0406 22600000 BCTR @A,0 0406 22610000 CLC 0(1,@A),KRPAR 0406 22620000 BC 07,@99C 0406 22630000 * DO; /* IF THE LAST Y01676* 22640000 * LPARCTR = LPARCTR - KON1; /* CHAR Y01676* 22650000 L @F,LPARCTR 0408 22660000 SH @F,KON1 0408 22670000 ST @F,LPARCTR 0408 22680000 * IF LASTBIT = '1'B /* HAS BEEN Y01676* 22690000 * THEN /* FOUND - THIS Y01676* 22700000 TM E05BINSW,B'00010000' 0409 22710000 BC 12,@99B 0409 22720000 * LPARCTR = KON0; /* IS VALUE END 22730000 * WHEN ZERO RET Y01676* 22740000 LH @F,KON0 0410 22750000 ST @F,LPARCTR 0410 22760000 * IF LPARCTR = 0 /* FOR ATAB AND Y01676* 22770000 * THEN /* FTAB UPDATE Y01676* 22780000 @99B SR @F,@F 0411 22790000 C @F,LPARCTR 0411 22800000 BC 07,@99A 0411 22810000 * DO; /* SAVE POSITION Y01676* 22820000 * TEM03 = TEM01; /* OF LAST Y01676* 22830000 MVC TEM03(4),TEM01 0413 22840000 * IF FIRSTBIT = '1'B & /*Y01676* 22850000 * LASTBIT = '0'B /* IF THE 22860000 * FIRST CHAR HAS BEEN 22870000 * FOUND AND THE LAST HAS 22880000 * NOT THEN SAVE Y01676* 22890000 * THEN /* ITS POSITION Y01676* 22900000 TM E05BINSW,B'00100000' 0414 22910000 BC 12,@999 0414 22920000 TM E05BINSW,B'00010000' 0414 22930000 BC 05,@998 0414 22940000 * ENDVAL = TEM01-KON1; /*Y01676* 22950000 L @F,TEM01 0415 22960000 SH @F,KON1 0415 22970000 ST @F,ENDVAL 0415 22980000 * GO TO E05SPD66; /* PAREN Y01676* 22990000 BC 15,E05SPD66 0416 23000000 * END; /* BEFORE RETURN Y01676* 23010000 * END; 23020000 @99A EQU * 0418 23030000 * IF INPLIN(TEM01) = KQUOTE /* IS THIS A Y01676* 23040000 * THEN /* QUOTE Y01676* 23050000 @99C EQU * 0419 23060000 @99D EQU * 0419 23070000 @99F L @3,TEM01 0419 23080000 L @7,124(0,@6) 0419 23090000 LA @A,0(@3,@7) 0419 23100000 BCTR @A,0 0419 23110000 CLC 0(1,@A),KQUOTE 0419 23120000 BC 07,@997 0419 23130000 * DO; /* YES-THEN CHECK Y01676* 23140000 * IF QBIT = '1'B /* IF WE ARE PRO- Y01676* 23150000 * THEN /* CESSING A QTE Y01676* 23160000 TM E05BINSW,B'01000000' 0421 23170000 BC 12,@996 0421 23180000 * DO; /* CHECK TO SEE Y01676* 23190000 * IF TEM01 < EOLCNT & 23200000 * INPLIN(TEM01 + KON1) = KQUOTE 23210000 * THEN /* IF NEXT CHAR Y01676* 23220000 L @F,128(0,@6) 0423 23230000 C @F,TEM01 0423 23240000 BC 12,@995 0423 23250000 LH @8,KON1 0423 23260000 A @8,TEM01 0423 23270000 LA @A,0(@8,@7) 0423 23280000 BCTR @A,0 0423 23290000 CLC 0(1,@A),KQUOTE 0423 23300000 BC 07,@994 0423 23310000 * DO; /* IS A QUOTE? Y01676* 23320000 * INPLIN(TEM01 + KON1:EOLCNT - KON1) = 23330000 * INPLIN(TEM01 + KON2:EOLCNT); 23340000 LH @3,KON2 0425 23350000 A @3,TEM01 0425 23360000 LA @E,0(@3,@7) 0425 23370000 BCTR @E,0 0425 23380000 LH @8,KON1 0425 23390000 LCR @8,@8 0425 23400000 A @8,128(0,@6) 0425 23410000 LH @3,KON1 0425 23420000 A @3,TEM01 0425 23430000 SR @8,@3 0425 23440000 LA @A,0(@3,@7) 0425 23450000 BCTR @A,0 0425 23460000 EX @8,@MVC 0425 23470000 * /* REMOVE A QUOTE Y01676* 23480000 * EOLCNT = EOLCNT - KON1; /* AND Y01676* 23490000 LH @F,KON1 0426 23500000 LCR @F,@F 0426 23510000 A @F,128(0,@6) 0426 23520000 ST @F,128(0,@6) 0426 23530000 BC 15,@993 0428 23540000 * END; /* ADJUST LENGTH Y01676* 23550000 * ELSE /* OTHERWISE THIS Y01676* 23560000 * DO; /* IS THE ENDING Y01676* 23570000 @994 EQU * 0428 23580000 * LASTBIT = '1'B; /* QUOTE - SET Y01676* 23590000 @995 OI E05BINSW,B'00010000' 0429 23600000 * QBIT = '0'B; /* INDICATORS Y01676* 23610000 NI E05BINSW,B'10111111' 0430 23620000 * ENDVAL = TEM01 - KON1; /* SAVE Y01676* 23630000 L @F,TEM01 0431 23640000 SH @F,KON1 0431 23650000 ST @F,ENDVAL 0431 23660000 * END; /* POSITION Y01676* 23670000 * END; /* GO RESUME SCAN Y01676* 23680000 BC 15,@992 0434 23690000 * ELSE /* IF WE ARE NOT Y01676* 23700000 * IF FIRSTBIT = '0'B /* PROCESSING A Y01676* 23710000 * THEN /* QUOTED STRING Y01676* 23720000 @996 TM E05BINSW,B'00100000' 0434 23730000 BC 05,@991 0434 23740000 * DO; /* AND THE FIRST Y01676* 23750000 * QBIT = '1'B; /* CHAR HAS NOT Y01676* 23760000 OI E05BINSW,B'01100000' 0436 23770000 * FIRSTBIT = '1'B; /* NOT BEEN FOUND Y01676* 23780000 * STARTVAL = TEM01 + KON1; /* THIS IS Y01676* 23790000 LH @F,KON1 0438 23800000 A @F,TEM01 0438 23810000 ST @F,STARTVAL 0438 23820000 BC 15,@990 0440 23830000 * END; /* VALUE START Y01676* 23840000 * ELSE /* FIRST CHAR HAS Y01676* 23850000 * IF LASTBIT = '1'B /* BEEN FOUND -IF Y01676* 23860000 * THEN /* LAST CHAR BEEN Y01676* 23870000 @991 TM E05BINSW,B'00010000' 0440 23880000 * GO TO KWPARERR; /* FOUND - THEN IT IS A 23890000 * SYNTAX ERROR Y01676* 23900000 BC 01,KWPARERR 0441 23910000 * GO TO E05SPD65; /* RESUME SCAN RETURN 23920000 * POINT Y01676* 23930000 BC 15,E05SPD65 0442 23940000 * END; /*Y01676* 23950000 * IF FIRSTBIT = '0'B /* IF FIRST CHAR Y01676* 23960000 * THEN /* HAS NOT BEEN Y01676* 23970000 @997 TM E05BINSW,B'00100000' 0444 23980000 BC 05,@98F 0444 23990000 * DO; /* FOUND THEN Y01676* 24000000 * FIRSTBIT = '1'B; /* THIS IS IT Y01676* 24010000 OI E05BINSW,B'00100000' 0446 24020000 * STARTVAL = TEM01; /* SAVE START AND Y01676* 24030000 MVC STARTVAL(4),TEM01 0447 24040000 BC 15,@98E 0449 24050000 * END; /* RESUME SCAN Y01676* 24060000 * ELSE /* OTHERWISE Y01676* 24070000 * IF LASTBIT = '1'B /* IF LAST CHAR Y01676* 24080000 * THEN /* ALREADY BEEN Y01676* 24090000 @98F TM E05BINSW,B'00010000' 0449 24100000 BC 12,@98D 0449 24110000 * DO; /* FOUND - THEN Y01676* 24120000 * KWPARERR: /* THERE IS A Y01676* 24130000 * LVL1NO = KON8; /* SYNTAX ERROR Y01676* 24140000 KWPARERR MVC 304(2,@6),KON8 0451 24150000 * LVL2NO = KON1; /* NOTIFY USER Y01676* 24160000 MVC 306(2,@6),KON1 0452 24170000 * ADPTR1 = ADDR(E05SPD87);/* THEN RETURN Y01676* 24180000 LA @F,E05SPD87 0453 24190000 ST @F,88(0,@6) 0453 24200000 * E05BINSW = KONX00; /* TO SCAN REMAINDER 24210000 * OF THE PROC Y01676* 24220000 MVC E05BINSW(1),KONSTRUC 0454 24230000 * R5->ATABELNC = R5->ATABELNC && R5->ATABELNC; 24240000 XC 5(2,@5),5(@5) 0455 24250000 * LPARCTR = KON0; /* ZERO OUT LEN Y01676* 24260000 LH @F,KON0 0456 24270000 ST @F,LPARCTR 0456 24280000 * STARTVAL = KON0; /* FLD AND RESET Y01676* 24290000 ST @F,STARTVAL 0457 24300000 * ENDVAL = KON0; /* POSITION 24310000 * INDICATORS Y01676* 24320000 ST @F,ENDVAL 0458 24330000 * VARSGADR = ADDR(INPLIN); /* SET ADDR OF Y01676* 24340000 L @3,124(0,@6) 0459 24350000 ST @3,@TEMP4 0459 24360000 MVC 297(3,@6),@TEMP4+1 0459 24370000 * CNVA = TEM01 + KON4; /* OF DYNAMIC 24380000 * PORTION Y01676* 24390000 LH @F,KON4 0460 24400000 A @F,TEM01 0460 24410000 STH @F,200(0,@6) 0460 24420000 * VARSGLNG = CNVC(2); /* AND THE LENGTH Y01676* 24430000 MVC 296(1,@6),201(@6) 0461 24440000 * GO TO E05MML10; /* GO ISSUE MSG Y01676* 24450000 BC 15,E05MML10 0462 24460000 * END; /*Y01676* 24470000 * GO TO E05SPD65; /* RESUME SCAN Y01676* 24480000 * 24490000 * VALSCAN2: IF QBIT = '0'B /* IF WE ARE NOT Y01676* 24500000 * THEN /* IN A QUOTED Y01676* 24510000 VALSCAN2 TM E05BINSW,B'01000000' 0465 24520000 BC 05,@98C 0465 24530000 * IF FIRSTBIT = '1'B /* STRING AND THE Y01676* 24540000 * THEN /* FIRST CHAR HAS Y01676* 24550000 TM E05BINSW,B'00100000' 0466 24560000 BC 12,@98B 0466 24570000 * IF LASTBIT = '0'B /* BEEN FOUND AND THE LAS 24580000 * CHAR HAS NOT Y01676* 24590000 * THEN /* THEN THIS IS Y01676* 24600000 TM E05BINSW,B'00010000' 0467 24610000 BC 05,@98A 0467 24620000 * DO; /* THE DELIM FOL- Y01676* 24630000 * LASTBIT = '1'B; /* LOWING THE LAST 24640000 * CHARACTER Y01676* 24650000 OI E05BINSW,B'00010000' 0469 24660000 * ENDVAL = TEM01 - KON1; /* SAVE ITS Y01676* 24670000 L @F,TEM01 0470 24680000 SH @F,KON1 0470 24690000 ST @F,ENDVAL 0470 24700000 * END; /* POSITION AND Y01676* 24710000 * /* GO AND Y01676* 24720000 * GO TO E05SPD65; /* RESUME SCAN Y01676* 24730000 BC 15,E05SPD65 0472 24740000 * 24750000 * E05SPD63: KWVAL = '1'B; /* IF IT IS LEFT PAREN 24760000 * SET SWITCH INDICATING 24770000 * VALUE PART OF 24780000 * KEYWORD Y01676* 24790000 E05SPD63 OI E05BINSW,B'10000000' 0473 24800000 * LPARCTR = KON1; /* INITIALIZE THE LEFT 24810000 * PAREN COUNTER Y01676* 24820000 LH @F,KON1 0474 24830000 ST @F,LPARCTR 0474 24840000 * TEM02 = TEM01; /* SAVE START POINT OF 24850000 * VALUE (LPAR) Y01676* 24860000 MVC TEM02(4),TEM01 0475 24870000 BC 15,@DO9B2 0477 24880000 * 24890000 * E05SPD65: ; 24900000 * END; /* CONTINUE SCAN * 24910000 * 24920000 * VALCHECK: IF KWVAL = '1'B /* IF WE WERE Y01676* 24930000 * THEN /* PROCESSING THE Y01676* 24940000 @DO9B0 EQU * 0477 24950000 VALCHECK TM E05BINSW,B'10000000' 0478 24960000 BC 12,@989 0478 24970000 * DO; /* VALUE OF A KEYWORD 24980000 * WHEN WE FELL OUT 24990000 * THEN INIT Y01676* 25000000 * LVL1NO = KON27; /* INDICATORS FOR Y01676* 25010000 MVC 304(2,@6),KON27 0480 25020000 * LVL2NO = KON0; /* MESSAGE MOD Y01676* 25030000 MVC 306(2,@6),KON0 0481 25040000 * VARSGAD2 = ADDR(INPLIN); /* SET ADDR OF Y01676* 25050000 L @3,124(0,@6) 0482 25060000 ST @3,@TEMP4 0482 25070000 MVC 301(3,@6),@TEMP4+1 0482 25080000 * CNVA = TEM01 + KON3; /* ADJUST LENGTH Y01676* 25090000 LH @F,KON3 0483 25100000 A @F,TEM01 0483 25110000 STH @F,200(0,@6) 0483 25120000 * VARSGLN2 = CNVC(2); /* DYNAMIC PORTION AND 25130000 * LENGTH Y01676* 25140000 MVC 300(1,@6),201(@6) 0484 25150000 * IF QBIT = '1'B /* IF WE WERE IN Y01676* 25160000 * THEN /* A QUOTED STRING THEN 25170000 * WE MUST ASSUME Y01676* 25180000 TM E05BINSW,B'01000000' 0485 25190000 BC 12,@988 0485 25200000 * DO; /* AN ENDING QTE Y01676* 25210000 * VARSGADR = ADDR(ENDQVAR); /* SET ENDING Y01676* 25220000 LA @F,ENDQVAR 0487 25230000 ST @F,@TEMP4 0487 25240000 MVC 297(3,@6),@TEMP4+1 0487 25250000 * CNVA = LENGTH(ENDQVAR); /* QUOTE MSG VAR Y01676* 25260000 LA @F,12 0488 25270000 STH @F,200(0,@6) 0488 25280000 BC 15,@987 0490 25290000 * END; /*Y01676* 25300000 * ELSE /* IF NOT IN Y01676* 25310000 * DO; /* A QUOTED STR Y01676* 25320000 * VARSGADR = ADDR(ENDPAR);/* SET MSG VAR Y01676* 25330000 @988 LA @F,ENDPAR 0491 25340000 ST @F,@TEMP4 0491 25350000 MVC 297(3,@6),@TEMP4+1 0491 25360000 * CNVA = LENGTH(ENDPAR); /* FOR RIGHT PAR Y01676* 25370000 LA @F,17 0492 25380000 STH @F,200(0,@6) 0492 25390000 * END; /* THEN Y01676* 25400000 * IF FIRSTBIT = '1'B /* CHECK IF WE Y01676* 25410000 * THEN /* FOUND THE FIRST 25420000 * CHARACTER Y01676* 25430000 @987 TM E05BINSW,B'00100000' 0494 25440000 BC 12,@986 0494 25450000 * DO; /* YES THEN WAS Y01676* 25460000 * IF LASTBIT = '0'B /* THE LAST CHAR Y01676* 25470000 * THEN /* FOUND? IF NOT Y01676* 25480000 TM E05BINSW,B'00010000' 0496 25490000 BC 05,@985 0496 25500000 * ENDVAL = TEM01 - KON1; /* THIS IS END Y01676* 25510000 L @F,TEM01 0497 25520000 SH @F,KON1 0497 25530000 ST @F,ENDVAL 0497 25540000 * END; /* OF VALUE Y01676* 25550000 @985 EQU * 0498 25560000 * CNVA = KON4 + CNVA; /* ADJUST LENGTH Y01676* 25570000 @986 LH @F,200(0,@6) 0499 25580000 AH @F,KON4 0499 25590000 STH @F,200(0,@6) 0499 25600000 * VARSGLNG = CNVC(2); /* OF VARIABLE Y01676* 25610000 MVC 296(1,@6),201(@6) 0500 25620000 * TEM03 = TEM01 - KON1; /* SAVE LOGICAL Y01676* 25630000 L @F,TEM01 0501 25640000 SH @F,KON1 0501 25650000 ST @F,TEM03 0501 25660000 * ADPTR1 = ADDR(E05SPD66); /* SET RETURN POINT AND 25670000 * GO ISSUE Y01676* 25680000 LA @F,E05SPD66 0502 25690000 ST @F,88(0,@6) 0502 25700000 * GO TO E05MML15; /* MESSAGE Y01676* 25710000 BC 15,E05MML15 0503 25720000 * END; /* END OF VALUE Y01676* 25730000 * 25740000 * /***********************************************************/ 25750000 * /*FOLLOWING CODE INSURES THAT VALUE PORTION OF */ 25760000 * /*KEYWORD WITH VALUE IS TERMINATED BY A RIGHT */ 25770000 * /*PARENTHESIS. THE VALUE IS THEN PLACED IN FTAB. */ 25780000 * /***********************************************************/ 25790000 * E05SPD66: TEM01 = TEM01 - KON1; /* SET TEM01 POINTING TO 25800000 * LAST CHAR OF PARM * 25810000 @989 EQU * 0505 25820000 E05SPD66 L @F,TEM01 0505 25830000 SH @F,KON1 0505 25840000 ST @F,TEM01 0505 25850000 * IF KWVAL ^= '1'B /* IF THIS IS NOT Y01676* 25860000 * THEN /* KEYWORD 25870000 * WITH VALUE BYPASS * 25880000 TM E05BINSW,B'10000000' 0506 25890000 * GOTO E05SPD75; /* FTAB INSERTION * 25900000 BC 12,E05SPD75 0507 25910000 * IF POSCNT ^= POSSPC /* IF PAREN WAS FOUND IN* 25920000 * THEN /* A POSITIONAL IT IS 25930000 * AN ERROR * 25940000 L @F,168(0,@6) 0508 25950000 C @F,132(0,@6) 0508 25960000 BC 08,@984 0508 25970000 * DO; /* SET UP PROPER * 25980000 * ADPTR1 = ADDR(E05SPD75); /* RETURN ADDRESS * 25990000 LA @F,E05SPD75 0510 26000000 ST @F,88(0,@6) 0510 26010000 * KWVAL = '0'B; /* RESET KWRD WITH 26020000 * VALUE SW Y01676* 26030000 NI E05BINSW,B'01111111' 0511 26040000 * GOTO E05SPD62; /* AND EXIT TO PUT OUT * 26050000 BC 15,E05SPD62 0512 26060000 * END; /* MESSAGE * 26070000 * VALCNT = ENDVAL - STARTVAL + KON1; /* SET VALCNT = LENGTH OF 26080000 * VALUE PORTION Y01676* 26090000 @984 LH @F,KON1 0514 26100000 S @F,STARTVAL 0514 26110000 A @F,ENDVAL 0514 26120000 ST @F,188(0,@6) 0514 26130000 * TEM01 = TEM02 - KON1; /* SET TEM01 = LENGTH OF 26140000 * KEYWDE PORTION Y01676* 26150000 L @F,TEM02 0515 26160000 SH @F,KON1 0515 26170000 ST @F,TEM01 0515 26180000 * TSTLNG = VALCNT + KON4; /* SET TSTLNG = AMT OF FT 26190000 * THAT IS NEEDED Y01676* 26200000 LH @F,KON4 0516 26210000 A @F,188(0,@6) 0516 26220000 ST @F,136(0,@6) 0516 26230000 * IF TEM01 ^> KON31 /* IF LENGTH OF PARM * 26240000 * THEN /* IS ACCEPTABLE * 26250000 LH @F,KON31 0517 26260000 C @F,TEM01 0517 26270000 * GOTO E05SPD68; /* BYPASS ERROR ROUTINE* 26280000 BC 10,E05SPD68 0518 26290000 * TEM01 = TEM03; /* RESET TEM01 TO LENGTH 26300000 * OF KWRD & VAL Y01676* 26310000 MVC TEM01(4),TEM03 0519 26320000 * KWVAL = '0'B; /* RESET KWRD W. VALUE 26330000 * SWITCH Y01676* 26340000 NI E05BINSW,B'01111111' 0520 26350000 * E05SPD67: ; 26360000 * ADPTR1 = ADDR(E05SPD87); /* SET RETURN ADDRESS * 26370000 E05SPD67 LA @F,E05SPD87 0522 26380000 ST @F,88(0,@6) 0522 26390000 * R5->ATABELNC = R5->ATABELNC && R5->ATABELNC; 26400000 XC 5(2,@5),5(@5) 0523 26410000 * /* ZERO OUT LENGTH FIELD* 26420000 * LVL1NO = KON16; /* SET NO. OF 1ST LEVEL* 26430000 MVC 304(2,@6),KON16 0524 26440000 * LVL2NO = KON1; /* SET NO. OF 2ND LEVEL * 26450000 MVC 306(2,@6),KON1 0525 26460000 * GOTO E05MML05; /* GOTO LINK TO MSG MOD * 26470000 BC 15,E05MML05 0526 26480000 * E05SPD68: ; 26490000 * IF (R1->FTABLNG - R2 + R1) ^< TSTLNG /* IF REMAINING 26500000 * FTAB IS * 26510000 * THEN /* LARGE ENOUGH TO HOLD * 26520000 E05SPD68 LR @F,@1 0528 26530000 SR @F,@2 0528 26540000 AH @F,8(0,@1) 0528 26550000 C @F,136(0,@6) 0528 26560000 * GOTO E05SPD72; /* VALUE - BYPASS GETMN * 26570000 BC 10,E05SPD72 0529 26580000 * R1->FTABDLNG = R2 - R1; /* SET NUMBER OF BYTES 26590000 * IN USE * 26600000 LR @F,@2 0530 26610000 SR @F,@1 0530 26620000 STH @F,10(0,@1) 0530 26630000 * GMNMIN = TSTLNG + KON12; /* SET MIN NEEDED * 26640000 LH @F,KON12 0531 26650000 A @F,136(0,@6) 0531 26660000 ST @F,140(0,@6) 0531 26670000 * 26680000 * E01SW10 = '1'B; /* SET GETMAIN SWITCH * 26690000 OI 203(@6),B'01000000' 0532 26700000 * REGSAV(2) = R1; /* SAVE REG1 * 26710000 ST @1,208(0,@6) 0533 26720000 * R1 = ADDR(E01DATDF); /* SET REG1 POINTING TO 26730000 * PARMS * 26740000 LR @1,@6 0534 26750000 * REGSAV(1) = R4; /* SAVE REG4 * 26760000 ST @4,204(0,@6) 0535 26770000 * R4 = KON1; /* SET SUBPOOL INDICATOR* 26780000 LH @4,KON1 0536 26790000 * CALL IKJEFE03; /* PERFORM GETMAIN * 26800000 L @F,@V3 ADDRESS OF IKJEFE03 0537 26810000 BALR @E,@F 0537 26820000 * R4 = REGSAV(1); /* RESTORE REG4 * 26830000 L @4,204(0,@6) 0538 26840000 * R1 = REGSAV(2); /* RESTORE REG1 * 26850000 L @1,208(0,@6) 0539 26860000 * E01SW10 = '0'B; /* RESET GETMAIN SWITCH * 26870000 NI 203(@6),B'10111111' 0540 26880000 * IF E01SW15 = '1'B /* IF WE COULD NOT GET * 26890000 * THEN /* MINIMUM CORE - THEN * 26900000 TM 203(@6),B'00000010' 0541 26910000 * RETURN; /* RETURN TO E01 TO END* 26920000 BC 03,@EL01 0542 26930000 * 26940000 * R1->FTABNXT = ADDGMN; /* SET FTAB FORWARD PTR * 26950000 @983 MVC 4(4,@1),148(@6) 0543 26960000 * R2 = R1; /* SAVE PRESENT BLOCK 26970000 * POINTER * 26980000 LR @2,@1 0544 26990000 * R1 = ADDGMN; /* UPDATE PTR TO NEW 27000000 * BLOCK * 27010000 L @1,148(0,@6) 0545 27020000 * R1->FTABLST = R2; /* SET BCKWRD PTR * 27030000 ST @2,0(0,@1) 0546 27040000 * R1->FTABNXT = KON0; /* SET FRWD PTR * 27050000 LH @F,KON0 0547 27060000 ST @F,4(0,@1) 0547 27070000 * R1->FTABLNG = AMTGMN; /* SET LENGTH OF THIS 27080000 * FTAB BLOCK * 27090000 MVC 8(2,@1),154(@6) 0548 27100000 * R2 = R1 + KON12; /* SET PTR TO CURRENT 27110000 * FTAB ELEMENT * 27120000 LH @2,KON12 0549 27130000 AR @2,@1 0549 27140000 * 27150000 * E05SPD72: /* CHECK Y01676* 27160000 * IF STARTVAL = KON0 | /* IF THE Y01676* 27170000 * VALCNT = KON0 /* VALUE Y01676* 27180000 * THEN 27190000 E05SPD72 LH @F,KON0 0550 27200000 C @F,STARTVAL 0550 27210000 BC 08,@982 0550 27220000 C @F,188(0,@6) 0550 27230000 BC 07,@981 0550 27240000 * DO; /* IS THE NULL STRING * 27250000 * TSTLNG = KON0; /* SET LENGTH * 27260000 @982 LH @F,KON0 0552 27270000 ST @F,136(0,@6) 0552 27280000 * R2->FTABELNG = TSTLNGC; /* TO ZERO * 27290000 MVC 0(4,@2),136(@6) 0553 27300000 * GOTO E05SPD74; /* BYPASS MOVE Y01676* 27310000 BC 15,E05SPD74 0554 27320000 * END; 27330000 * R2->FTABDAT(1:VALCNT) = INPLIN(STARTVAL:ENDVAL); /* ELSE 27340000 * MOVE TO FTAB Y01676* 27350000 @981 L @3,STARTVAL 0556 27360000 L @7,124(0,@6) 0556 27370000 LA @E,0(@3,@7) 0556 27380000 BCTR @E,0 0556 27390000 L @8,188(0,@6) 0556 27400000 BCTR @8,0 0556 27410000 LA @A,4(0,@2) 0556 27420000 EX @8,@MVC 0556 27430000 * TSTLNG = VALCNT; /* EXISTING LEN * 27440000 MVC 136(4,@6),188(@6) 0557 27450000 * R2->FTABELNG = TSTLNGC; /*SAVE LENGTH OF ELEMENT* 27460000 MVC 0(4,@2),136(@6) 0558 27470000 * E05SPD74: STARTVAL = KON0; /* RESET VALUE Y01676* 27480000 E05SPD74 LH @F,KON0 0559 27490000 ST @F,STARTVAL 0559 27500000 * ENDVAL = KON0; /* POSITIONS Y01676* 27510000 ST @F,ENDVAL 0560 27520000 * E05BINSW = E05BINSW & KONX8F; /* AND BIT SWITCHES USED 27530000 * FOR VALUE PROCESSING 27540000 * THEN Y02676* 27550000 NC E05BINSW(1),KONSTRUC+7 0561 27560000 * 27570000 * /************************************************************ 27580000 * /*FOLLOWING PLACES THE SYMBOLIC PARAMETER INTO * 27590000 * /*THE ATAB CONTROL BLOCK. * 27600000 * /************************************************************ 27610000 * 27620000 * E05SPD75: TSTLNG = TEM01 + KON8; /* DETERMINE AMOUNT OF 27630000 * CORE NEEDED FROM ATAB* 27640000 E05SPD75 LH @F,KON8 0562 27650000 A @F,TEM01 0562 27660000 ST @F,136(0,@6) 0562 27670000 * IF (R4->ATABLNG - R5 + R4) ^< TSTLNG/* IF REMAINING ATAB IS * 27680000 * THEN /* LARGE ENOUGH - BYPASS* 27690000 LR @F,@4 0563 27700000 SR @F,@5 0563 27710000 A @F,8(0,@4) 0563 27720000 C @F,136(0,@6) 0563 27730000 * GOTO E05SPD82; /* THE GETMAIN * 27740000 BC 10,E05SPD82 0564 27750000 * LATAB -> ATABFLGS = LATAB -> ATABFLGS | KONX20; 27760000 L @3,216(0,@6) 0565 27770000 OC 4(1,@3),KONSTRUC+4 0565 27780000 * /* SET LAST ELMT FLAG * 27790000 * GMNMIN = TSTLNG + KON12; /* SET MINIMUM NEEDED * 27800000 LH @F,KON12 0566 27810000 A @F,136(0,@6) 0566 27820000 ST @F,140(0,@6) 0566 27830000 * E01SW10 = '1'B; /* SET GETMAIN SWITCH * 27840000 OI 203(@6),B'01000000' 0567 27850000 * REGSAV(2) = R1; /* SAVE REG1 * 27860000 ST @1,208(0,@6) 0568 27870000 * R1 = ADDR(E01DATDF); /* SET REG1 POINTING TO 27880000 * PARMS * 27890000 LR @1,@6 0569 27900000 * REGSAV(1) = R4; /* SAVE REG4 * 27910000 ST @4,204(0,@6) 0570 27920000 * R4 = KON1; /* SET SUBPOOL INDICATOR* 27930000 LH @4,KON1 0571 27940000 * CALL IKJEFE03; /* PERFORM GETMAIN * 27950000 L @F,@V3 ADDRESS OF IKJEFE03 0572 27960000 BALR @E,@F 0572 27970000 * R4 = REGSAV(1); /* RESTORE REG4 * 27980000 L @4,204(0,@6) 0573 27990000 * R1 = REGSAV(2); /* RESTORE REG1 * 28000000 L @1,208(0,@6) 0574 28010000 * E01SW10 = '0'B; /* RESET GETMAIN SWITCH * 28020000 NI 203(@6),B'10111111' 0575 28030000 * IF E01SW15 = '1'B /* IF WE COULD NOT GET * 28040000 * THEN /* MINIMUM CORE - THEN * 28050000 TM 203(@6),B'00000010' 0576 28060000 * RETURN; /* RETURN TO E01 * 28070000 BC 03,@EL01 0577 28080000 * R4->ATABNXT = ADDGMN; /* SET ATAB FORWARD PTR * 28090000 @980 MVC 4(4,@4),148(@6) 0578 28100000 * R5 = R4; /* SAVE PRESENT BLOCK 28110000 * PTR * 28120000 LR @5,@4 0579 28130000 * R4 = ADDGMN; /* UPDATE PTR TO NEW 28140000 * BLOCK * 28150000 L @4,148(0,@6) 0580 28160000 * R4->ATABLST = R5; /* SET BCKWRD PTR * 28170000 ST @5,0(0,@4) 0581 28180000 * R4->ATABNXT = KON0; /* SET FRWD PTR * 28190000 LH @F,KON0 0582 28200000 ST @F,4(0,@4) 0582 28210000 * R4->ATABLNG = AMTGMN; /* SET LENGTH OF THIS 28220000 * ATAB BLOCK * 28230000 MVC 8(4,@4),152(@6) 0583 28240000 * R5 = R4 + KON12; /* SET PTR TO CURRENT 28250000 * ATAB ELEMENT * 28260000 LH @5,KON12 0584 28270000 AR @5,@4 0584 28280000 * 28290000 * /************************************************************ 28300000 * /*FOLLOWING CODE SETS THE CORRECT FLAGS FOR THE * 28310000 * /*SYMBOLIC PARAMETER JUST ENTERED INTO ATAB AND * 28320000 * /*IF IT WAS A KEYWORD WITH VALUE THE DEFAULT VALUE * 28330000 * /*IS ENTERED INTO FTAB. THEN WE RECYCLE TO SCAN * 28340000 * /*FOR THE NEXT PARAMETER * 28350000 * /************************************************************ 28360000 * E05SPD82: IF KWVAL = '1'B /* IF THIS IS A Y01676* 28370000 * THEN /* KEYWORD Y01676* 28380000 E05SPD82 TM E05BINSW,B'10000000' 0585 28390000 BC 12,@97F 0585 28400000 * DO; /* WITH VALUE SET PROPER* 28410000 * R5->ATABFLGS = KONX80; /* FLAGS AND POINTER * 28420000 MVC 4(1,@5),KONSTRUC+6 0587 28430000 * TSTLNG = R2; /*(ALIGN PTR) * 28440000 ST @2,136(0,@6) 0588 28450000 * R5->FTABPTR = TSTLNGC; /* TO PROPER FTAB ENTRY * 28460000 MVC 0(4,@5),136(@6) 0589 28470000 * KWWCNT = KWWCNT + KON1; /* UPDATE NO. COUNT * 28480000 LH @F,KON1 0590 28490000 AH @F,194(0,@6) 0590 28500000 STH @F,194(0,@6) 0590 28510000 * KWWBYT = KWWBYT + TEM01; /* UPDATE BYTE COUNT * 28520000 L @F,TEM01 0591 28530000 AH @F,198(0,@6) 0591 28540000 STH @F,198(0,@6) 0591 28550000 * GOTO E05SPD85; /* AND BYPASS OTHER * 28560000 BC 15,E05SPD85 0592 28570000 * END; /* TESTS * 28580000 * R5-> FTABPTRB = ''B; /*INDICATE NO FTAB ENTRY* 28590000 @97F XC 0(4,@5),0(@5) 0594 28600000 * IF POSSPC = POSCNT /* IF THIS IS KWRD W.O. * 28610000 * THEN /* VALUE * 28620000 L @F,132(0,@6) 0595 28630000 C @F,168(0,@6) 0595 28640000 BC 07,@97E 0595 28650000 * DO; /* THEN * 28660000 * KWOCNT = KWOCNT + KON1; /* UPDATE NO. COUNT * 28670000 LH @F,KON1 0597 28680000 AH @F,192(0,@6) 0597 28690000 STH @F,192(0,@6) 0597 28700000 * KWOBYT = KWOBYT + TEM01; /* UPDATE BYTE COUNT * 28710000 L @F,TEM01 0598 28720000 AH @F,196(0,@6) 0598 28730000 STH @F,196(0,@6) 0598 28740000 * R5->ATABFLGS = KONX40; /* VALUE FLAGS = HEX 40 * 28750000 MVC 4(1,@5),KONSTRUC+5 0599 28760000 * IF TEM01 > KON31 /* IF LENGTH EXCEEDS * 28770000 * THEN /* MAX ALLOWED THEN GO * 28780000 LH @F,KON31 0600 28790000 C @F,TEM01 0600 28800000 * GOTO E05SPD67; /* TO PUT OUT MESSAGE * 28810000 BC 04,E05SPD67 0601 28820000 BC 15,@97D 0603 28830000 * END; 28840000 * ELSE /* OTHERWISE * 28850000 * DO; /* THIS IS Y01676* 28860000 * R5->ATABFLGS = KONX00; /* A POSITIONAL 28870000 * FLAGS = HEX 00 Y01676* 28880000 @97E MVC 4(1,@5),KONSTRUC 0604 28890000 * POSBYT = TEM01 + POSBYT; /* UPDATE BYTE Y01676* 28900000 LH @F,360(0,@6) 0605 28910000 A @F,TEM01 0605 28920000 STH @F,360(0,@6) 0605 28930000 * END; /* COUNT Y01676* 28940000 * IF TEM01 > KON252 /* IF LENGTH EXCEEDS * 28950000 * THEN /* MAX ALLOWED THEN GO * 28960000 @97D LH @F,KON252 0607 28970000 C @F,TEM01 0607 28980000 * GOTO E05SPD67; /* TO PUT OUT MESSAGE * 28990000 BC 04,E05SPD67 0608 29000000 * 29010000 * E05SPD85: R5->ATABDAT(1:TEM01) = INPLIN(1:TEM01); 29020000 E05SPD85 L @3,124(0,@6) 0609 29030000 LR @E,@3 0609 29040000 L @7,TEM01 0609 29050000 BCTR @7,0 0609 29060000 LA @A,7(0,@5) 0609 29070000 EX @7,@MVC 0609 29080000 * /* MOVE PARM TO ATAB * 29090000 * CNVA = TEM01; /* TSTLNG EQUALS LENGTH 29100000 * OF ELEMENT * 29110000 MVC 200(2,@6),TEM01+2 0610 29120000 * R5->ATABELNC = CNVC; /* SET LENGTH OF ELEMENT* 29130000 MVC 5(2,@5),200(@6) 0611 29140000 * IF KWVAL = '1'B /* IF THIS WAS A 29150000 * KEYWORD Y01676* 29160000 * THEN /* WITH VALUE * 29170000 TM E05BINSW,B'10000000' 0612 29180000 BC 12,@97C 0612 29190000 * DO; /* THEN * 29200000 * LFTAB = R2; /* SET PREV ELMT PTR 29210000 * ALIGN * 29220000 ST @2,220(0,@6) 0614 29230000 * CNVC = R2->FTABELNG(3:4); /* LENGTH AND UPDATE * 29240000 MVC 200(2,@6),2(@2) 0615 29250000 * R2 = R2 + CNVA + KON4; /* FTAB ELEMENT PTR AND * 29260000 LH @F,KON4 0616 29270000 AH @F,200(0,@6) 0616 29280000 AR @2,@F 0616 29290000 * KWVAL = '0'B; /* RESET KWRD WITH 29300000 * VALUE SW Y01676* 29310000 NI E05BINSW,B'01111111' 0617 29320000 * TEM03 = KON1 + TEM03; /* UPDATE PAST LEFT 29330000 * PAREN Y01676* 29340000 L @F,TEM03 0618 29350000 AH @F,KON1 0618 29360000 ST @F,TEM03 0618 29370000 * LINPTR1 = LINPTR1 + TEM03 - TEM02; /* THEN Y01676* 29380000 L @F,TEM02 0619 29390000 LCR @F,@F 0619 29400000 A @F,TEM03 0619 29410000 A @F,124(0,@6) 0619 29420000 ST @F,124(0,@6) 0619 29430000 * /*UPDATE INPUT POINTER * 29440000 * EOLCNT = EOLCNT - TEM03 + TEM02; /* UPDATE BYTE 29450000 * COUNT Y01676* 29460000 L @F,TEM02 0620 29470000 S @F,TEM03 0620 29480000 A @F,128(0,@6) 0620 29490000 ST @F,128(0,@6) 0620 29500000 * END; /* SWITCH * 29510000 * 29520000 * E05SPD87:IF POSSPC ^= POSCNT /* IF THIS WAS * 29530000 * THEN /* A POSITIONAL * 29540000 @97C EQU * 0622 29550000 E05SPD87 L @F,132(0,@6) 0622 29560000 C @F,168(0,@6) 0622 29570000 BC 08,@97B 0622 29580000 * POSCNT = POSCNT + KON1; /* UPDATE COUNT * 29590000 LH @F,KON1 0623 29600000 A @F,132(0,@6) 0623 29610000 ST @F,132(0,@6) 0623 29620000 * LINPTR1 = LINPTR1 + TEM01; /* UPDATE INPUT POINTER * 29630000 @97B L @F,TEM01 0624 29640000 A @F,124(0,@6) 0624 29650000 ST @F,124(0,@6) 0624 29660000 * EOLCNT = EOLCNT - TEM01; /* UPDATE BYTE COUNT * 29670000 L @F,TEM01 0625 29680000 LCR @F,@F 0625 29690000 A @F,128(0,@6) 0625 29700000 ST @F,128(0,@6) 0625 29710000 * ADPTR2 = ADDR(E05CNT03); /* SET RETURN ADDRESS 29720000 * FOR EMPTY LINE * 29730000 LA @F,E05CNT03 0626 29740000 ST @F,92(0,@6) 0626 29750000 * ADPTR1 = ADDR(E05SPD90); /* AND FOR NON-EMPTY 29760000 * LINE * 29770000 LA @F,E05SPD90 0627 29780000 ST @F,88(0,@6) 0627 29790000 * GOTO E05SPD10; /* PERFORM SCAN * 29800000 BC 15,E05SPD10 0628 29810000 * E05SPD90: CNVC = R5->ATABELNC; /* RETURN POINT 29820000 * FOR MORE PARMS FOUND * 29830000 E05SPD90 MVC 200(2,@6),5(@5) 0629 29840000 * LATAB = R5; /* SET PREV ELMT PTR 29850000 ST @5,216(0,@6) 0630 29860000 * R5 = R5 + CNVA + KON7; /* UPDATE POINTER 29870000 LH @F,KON7 0631 29880000 AH @F,200(0,@6) 0631 29890000 AR @5,@F 0631 29900000 * GOTO E05SPD48; /* PROCESS THIS PARM 29910000 BC 15,E05SPD48 0632 29920000 * 29930000 * E05CNT03: ; 29940000 * RESTRICT (R3); 29950000 * R3 = R1; /* SET R3 POINTING TO 29960000 * FTAB * 29970000 E05CNT03 LR @3,@1 0635 29980000 * RETURN; /* RETURN TO E01 * 29990000 BC 15,@EL01 0636 30000000 * RELEASE (R3); 30010000 * 30020000 * 30030000 * E05MML05: VARSGLNG = KONX00; /* INDICATE NO VAR. PART* 30040000 E05MML05 MVC 296(1,@6),KONSTRUC 0638 30050000 * E05MML10: /*Y01676* 30060000 * /* SET TERMINATE Y01676* 30070000 * E01SW9 = '1'B; /* SWITCH ON Y01676* 30080000 E05MML10 OI 203(@6),B'10000000' 0639 30090000 * E05MML15: REGSAV(1) = R1; /* SAVE REG 1 Y01676* 30100000 E05MML15 ST @1,204(0,@6) 0640 30110000 * R1 = ADDR(E01DATDF); /* REG1 = ADDR OF PARMS * 30120000 LR @1,@6 0641 30130000 * GEN (LINK EP=IKJEFE04 LINK TO MSG MODULE); 30140000 LINK EP=IKJEFE04 LINK TO MSG MODULE 30150000 DS 0H 30160000 * R1 = REGSAV(1); /* RESTORE REG1 * 30170000 L @1,204(0,@6) 0643 30180000 * VARSGLN2 = KONX00; /* RESET MSG VAR Y10676* 30190000 MVC 300(1,@6),KONSTRUC 0644 30200000 * IF RETCDAR = KON16 | ADPTR1 = KON0 /* IF MSG WAS NOT OUTPUT* 30210000 * THEN /* THEN * 30220000 LH @F,KON16 0645 30230000 C @F,280(0,@6) 0645 30240000 BC 08,@97A 0645 30250000 LH @F,KON0 0645 30260000 C @F,88(0,@6) 0645 30270000 BC 07,@979 0645 30280000 * DO; /* SET TERMINATION * 30290000 * E01SW9 = '1'B; /* SWITCH AND * 30300000 @97A OI 203(@6),B'10000000' 0647 30310000 * RETURN; /* RETURN TO E01 * 30320000 BC 15,@EL01 0648 30330000 * END; 30340000 * GOTO INDAD1; /* ELSE RETURN TO CALLER* 30350000 @979 L @3,88(0,@6) 0650 30360000 BCR 15,@3 0650 30370000 * 30380000 * 30390000 * /************************************************************ 30400000 * /*FOLLOWING CODE IS THE OPEN EXIT ROUTINE ENTERED * 30410000 * /*WHILE THE DATA SET IS BEING OPENED. IT OBTAINS * 30420000 * /*THE BUFFER POOL AND FILLS IN THE EODAD ADDRESS. * 30430000 * /************************************************************ 30440000 * E05OPEX: GEN; 30450000 E05OPEX EQU * 0651 30460000 LH R2,DCBD+62(R6) LOAD MAX BLOCKSIZE 30470000 LA R2,3(R2) ADD THREE AND DELETE 30480000 SRA R2,2 LOW ORDER BITS TO OBTAIN 30490000 SLA R2,2 CORRECT FULLWORD MULTIPLE 30500000 LA R3,2 SET NUMBER OF BUFFERS TO TWO 30510000 LA R4,0(1) SET DCB ADDR WITH HIGH BYTE ZERO 30520000 LR R5,R14 SAVE REG 14 30530000 GETPOOL (4),(3),(2) OBTAIN BUFFER POOL 30540000 MVC DCBEODAD(3,R6),FINEX MOVE IN EODAD ADDRESS 30550000 MVC DCBSYNAD(3,R6),SYNEX MOVE IN SYNAD ADDRESS 30560000 LR R14,R5 RESTORE REGISTER 14 30570000 BR R14 RETURN TO CONTROL PROG 30580000 DS 0H 30590000 * GEN; 30600000 READ MODDECBD,SF,MF=L LIST FORM OF READ MACRO 30610000 SOPE EQU * 30620000 OPEL OPEN (MODDECBD),MF=L LIST FORM OF OPEN MACRO 30630000 EOPE EQU * 30640000 DS 0H 30650000 * GENERATE DATA; 30660000 * END 30670000 * /* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. 30680000 * /*%INCLUDE SYSLIB (IKJDAP08) 30690000 * /*%INCLUDE SYSLIB (IKJDAP00) 30700000 * /*%INCLUDE SYSLIB (IKJDAPL ) 30710000 * /*%INCLUDE SYSLIB (IKJCPPL ) 30720000 * ; 30730000 @EL01 L @D,4(0,@D) 0654 30740000 LR @1,@C 0654 30750000 L @0,@SIZ001 0654 30760000 FREEMAIN R,LV=(0),A=(1) 0654 30770000 L @E,12(0,@D) 0654 30780000 L @0,20(0,@D) 0654 30790000 LM @6,@C,44(@D) 0654 30800000 BCR 15,@E 0654 30810000 @DATA1 EQU * 30820000 @0 EQU 00 EQUATES FOR REGISTERS 0-15 30830000 @1 EQU 01 30840000 @2 EQU 02 30850000 @3 EQU 03 30860000 @4 EQU 04 30870000 @5 EQU 05 30880000 @6 EQU 06 30890000 @7 EQU 07 30900000 @8 EQU 08 30910000 @9 EQU 09 30920000 @A EQU 10 30930000 @B EQU 11 30940000 @C EQU 12 30950000 @D EQU 13 30960000 @E EQU 14 30970000 @F EQU 15 30980000 @D1 DC H'1' 30990000 @CLC CLC 0(1,@A),0(@E) 31000000 @MVC MVC 0(1,@A),0(@E) 31010000 @V1 DC V(E03PRT05) 31020000 @V2 DC V(E03SYN05) 31030000 @V3 DC V(IKJEFE03) 31040000 DS 0F 31050000 @SIZ001 DC AL1(&SPN) 31060000 DC AL3(@DATEND-@DATD) 31070000 DS 0F 31080000 DS 0D 31090000 @DATA EQU * 31100000 DUMPARM EQU 00000000 FULLWORD INTEGER 31110000 R0 EQU 00000000 FULLWORD POINTER REGISTER 31120000 R1 EQU 00000001 FULLWORD POINTER REGISTER 31130000 R2 EQU 00000002 FULLWORD POINTER REGISTER 31140000 R3 EQU 00000003 FULLWORD POINTER REGISTER 31150000 R4 EQU 00000004 FULLWORD POINTER REGISTER 31160000 R5 EQU 00000005 FULLWORD POINTER REGISTER 31170000 R6 EQU 00000006 FULLWORD POINTER REGISTER 31180000 R7 EQU 00000007 FULLWORD POINTER REGISTER 31190000 R12 EQU 00000012 FULLWORD POINTER REGISTER 31200000 R15 EQU 00000015 FULLWORD POINTER REGISTER 31210000 R14 EQU 00000014 FULLWORD POINTER REGISTER 31220000 KON0 EQU * HALFWORD INTEGER 31230000 DC FL2'0' 31240000 KON1 EQU * HALFWORD INTEGER 31250000 DC FL2'1' 31260000 KON2 EQU * HALFWORD INTEGER 31270000 DC FL2'2' 31280000 KON3 EQU * HALFWORD INTEGER 31290000 DC FL2'3' 31300000 KON4 EQU * HALFWORD INTEGER 31310000 DC FL2'4' 31320000 KON5 EQU * HALFWORD INTEGER 31330000 DC FL2'5' 31340000 KON6 EQU * HALFWORD INTEGER 31350000 DC FL2'6' 31360000 KON7 EQU * HALFWORD INTEGER 31370000 DC FL2'7' 31380000 KON8 EQU * HALFWORD INTEGER 31390000 DC FL2'8' 31400000 KON10 EQU * HALFWORD INTEGER 31410000 DC FL2'10' 31420000 KON12 EQU * HALFWORD INTEGER 31430000 DC FL2'12' 31440000 KON16 EQU * HALFWORD INTEGER 31450000 DC FL2'16' 31460000 KON20 EQU * HALFWORD INTEGER 31470000 DC FL2'20' 31480000 KON21 EQU * HALFWORD INTEGER 31490000 DC FL2'21' 31500000 KON24 EQU * HALFWORD INTEGER 31510000 DC FL2'24' 31520000 KON25 EQU * HALFWORD INTEGER 31530000 DC FL2'25' 31540000 KON27 EQU * HALFWORD INTEGER 31550000 DC FL2'27' 31560000 KON31 EQU * HALFWORD INTEGER 31570000 DC FL2'31' 31580000 KON37 EQU * HALFWORD INTEGER 31590000 DC FL2'37' 31600000 KON252 EQU * HALFWORD INTEGER 31610000 DC FL2'252' 31620000 KONSTRUC EQU @DATA+00000040 36 BYTE(S) ON WORD 31630000 KONX00 EQU * 1 BYTE(S) 31640000 DC X'00' 31650000 KONX02 EQU * 1 BYTE(S) 31660000 DC X'02' 31670000 KONX0F EQU * 1 BYTE(S) 31680000 DC X'0F' 31690000 KONX10 EQU * 1 BYTE(S) 31700000 DC X'10' 31710000 KONX20 EQU * 1 BYTE(S) 31720000 DC X'20' 31730000 KONX40 EQU * 1 BYTE(S) 31740000 DC X'40' 31750000 KONX80 EQU * 1 BYTE(S) 31760000 DC X'80' 31770000 KONX8F EQU * 1 BYTE(S) 31780000 DC X'8F' 31790000 KONXC1 EQU * 1 BYTE(S) 31800000 DC X'C1' 31810000 KONXC9 EQU * 1 BYTE(S) 31820000 DC X'C9' 31830000 KONXD1 EQU * 1 BYTE(S) 31840000 DC X'D1' 31850000 KONXD9 EQU * 1 BYTE(S) 31860000 DC X'D9' 31870000 KONXE2 EQU * 1 BYTE(S) 31880000 DC X'E2' 31890000 KONXE9 EQU * 1 BYTE(S) 31900000 DC X'E9' 31910000 KONXEF EQU * 1 BYTE(S) 31920000 DC X'EF' 31930000 KONXF0 EQU * 1 BYTE(S) 31940000 DC X'F0' 31950000 KONXF9 EQU * 1 BYTE(S) 31960000 DC X'F9' 31970000 KONXFA EQU * 1 BYTE(S) 31980000 DC X'FA' 31990000 KONXFB EQU * 1 BYTE(S) 32000000 DC X'FB' 32010000 KONXFF EQU * 1 BYTE(S) 32020000 DC X'FF' 32030000 KSYSPROC EQU * 8 BYTE(S) 32040000 DC C'SYSPROC' 32050000 DC 00001C' ' 32060000 KTEMPNAM EQU * 8 BYTE(S) 32070000 DC C'TEMPNAME' 32080000 CALLERID EQU * HALFWORD INTEGER 32090000 DC FL2'1' 32100000 ORG @DATA+00000080 32110000 MSGWTRAD EQU * FULLWORD INTEGER 32120000 DC FL4'0' 32130000 KQUOTE EQU * 1 BYTE(S) 32140000 DC X'7D' 32150000 KBLNK EQU * 1 BYTE(S) 32160000 DC C' ' 32170000 KCOM EQU * 1 BYTE(S) 32180000 DC C',' 32190000 KTAB EQU * 1 BYTE(S) 32200000 DC X'05' 32210000 KPERD EQU * 1 BYTE(S) 32220000 DC C'.' 32230000 KCONT EQU * 1 BYTE(S) 32240000 DC C'-' 32250000 KCONTP EQU * 1 BYTE(S) 32260000 DC C'+' 32270000 KPROC EQU * 4 BYTE(S) 32280000 DC C'PROC' 32290000 KCLIST EQU * 5 BYTE(S) 32300000 DC C'CLIST' 32310000 KLPAR EQU * 1 BYTE(S) 32320000 DC C'(' 32330000 KRPAR EQU * 1 BYTE(S) 32340000 DC C')' 32350000 ENDQVAR EQU * 12 BYTE(S) 32360000 DC C'ENDING QUOTE' 32370000 ENDPAR EQU * 17 BYTE(S) 32380000 DC C'RIGHT PARENTHESIS' 32390000 E01DATDF EQU 00000000 362 BYTE(S) ON DWORD 32400000 DCBAR EQU E01DATDF+00000000 88 BYTE(S) ON DWORD 32410000 ADPTR1 EQU E01DATDF+00000088 FULLWORD POINTER 32420000 ADPTR2 EQU E01DATDF+00000092 FULLWORD POINTER 32430000 MMNAMAR EQU E01DATDF+00000096 8 BYTE(S) ON WORD 32440000 RDECB EQU E01DATDF+00000104 20 BYTE(S) ON WORD 32450000 A00000 EQU E01DATDF+00000104 6 BYTE(S) 32460000 DECLNGTH EQU E01DATDF+00000110 HALFWORD INTEGER 32470000 A00001 EQU E01DATDF+00000112 8 BYTE(S) 32480000 DECIOBPT EQU E01DATDF+00000120 FULLWORD POINTER 32490000 LINPTR1 EQU E01DATDF+00000124 FULLWORD POINTER 32500000 EOLCNT EQU E01DATDF+00000128 FULLWORD INTEGER 32510000 EOLCNTCH EQU E01DATDF+00000128 4 BYTE(S) 32520000 POSCNT EQU E01DATDF+00000132 FULLWORD INTEGER 32530000 TSTLNG EQU E01DATDF+00000136 FULLWORD INTEGER 32540000 TSTLNGC EQU E01DATDF+00000136 4 BYTE(S) 32550000 GMNMIN EQU E01DATDF+00000140 FULLWORD INTEGER 32560000 GMNMAX EQU E01DATDF+00000144 FULLWORD INTEGER 32570000 ADDGMN EQU E01DATDF+00000148 FULLWORD POINTER 32580000 AMTGMN EQU E01DATDF+00000152 FULLWORD INTEGER 32590000 SP78ADDR EQU E01DATDF+00000156 FULLWORD POINTER 32600000 SP78LNGT EQU E01DATDF+00000160 FULLWORD POINTER 32610000 RDXCNV EQU E01DATDF+00000164 FULLWORD INTEGER 32620000 A00002 EQU E01DATDF+00000164 3 BYTE(S) 32630000 DDIG EQU E01DATDF+00000167 1 BYTE(S) 32640000 POSSPC EQU E01DATDF+00000168 FULLWORD INTEGER 32650000 ATABIND EQU E01DATDF+00000172 FULLWORD POINTER 32660000 ATABCUR EQU E01DATDF+00000176 FULLWORD POINTER 32670000 FTABIND EQU E01DATDF+00000180 FULLWORD POINTER 32680000 FTABCUR EQU E01DATDF+00000184 FULLWORD POINTER 32690000 VALCNT EQU E01DATDF+00000188 FULLWORD INTEGER 32700000 KWOCNT EQU E01DATDF+00000192 HALFWORD INTEGER 32710000 KWWCNT EQU E01DATDF+00000194 HALFWORD INTEGER 32720000 KWOBYT EQU E01DATDF+00000196 HALFWORD INTEGER 32730000 KWWBYT EQU E01DATDF+00000198 HALFWORD INTEGER 32740000 CNVA EQU E01DATDF+00000200 HALFWORD INTEGER 32750000 CNVC EQU E01DATDF+00000200 2 BYTE(S) 32760000 E01BINSW EQU E01DATDF+00000202 2 BYTE(S) ON HWORD 32770000 E01SW1 EQU E01DATDF+00000202 1 BIT(S) 32780000 E01SW2 EQU E01DATDF+00000202 1 BIT(S) 32790000 E01SW3 EQU E01DATDF+00000202 1 BIT(S) 32800000 E01SW4 EQU E01DATDF+00000202 1 BIT(S) 32810000 E01SW5 EQU E01DATDF+00000202 1 BIT(S) 32820000 E01SW6 EQU E01DATDF+00000202 1 BIT(S) 32830000 E01SW7 EQU E01DATDF+00000202 1 BIT(S) 32840000 E01SW8 EQU E01DATDF+00000202 1 BIT(S) 32850000 E01SW9 EQU E01DATDF+00000203 1 BIT(S) 32860000 E01SW10 EQU E01DATDF+00000203 1 BIT(S) 32870000 E01SW11 EQU E01DATDF+00000203 1 BIT(S) 32880000 E01SW12 EQU E01DATDF+00000203 1 BIT(S) 32890000 E01SW13 EQU E01DATDF+00000203 1 BIT(S) 32900000 E01SW14 EQU E01DATDF+00000203 1 BIT(S) 32910000 E01SW15 EQU E01DATDF+00000203 1 BIT(S) 32920000 E01SW16 EQU E01DATDF+00000203 1 BIT(S) 32930000 REGSAV EQU E01DATDF+00000204 3*FULLWORD INTEGER 32940000 LATAB EQU E01DATDF+00000216 FULLWORD POINTER 32950000 LFTAB EQU E01DATDF+00000220 FULLWORD POINTER 32960000 BFAPTR EQU E01DATDF+00000224 FULLWORD INTEGER 32970000 BFBPTR EQU E01DATDF+00000228 FULLWORD POINTER 32980000 CPPLPTR EQU E01DATDF+00000232 FULLWORD POINTER 32990000 STPRM EQU E01DATDF+00000236 3*FULLWORD INTEGER 33000000 PPLPTR EQU E01DATDF+00000248 FULLWORD POINTER 33010000 CBCOR EQU E01DATDF+00000252 24 BYTE(S) 33020000 SRECB EQU E01DATDF+00000276 FULLWORD INTEGER 33030000 RETCDAR EQU E01DATDF+00000280 FULLWORD INTEGER 33040000 ABLK1 EQU E01DATDF+00000284 FULLWORD POINTER 33050000 EOB EQU E01DATDF+00000288 FULLWORD POINTER 33060000 RCDST EQU E01DATDF+00000292 FULLWORD POINTER 33070000 VARSGLNG EQU E01DATDF+00000296 1 BYTE(S) 33080000 VARSGADR EQU E01DATDF+00000297 3 BYTE POINTER ON WORD+1 33090000 VARSGLN2 EQU E01DATDF+00000300 1 BYTE(S) 33100000 VARSGAD2 EQU E01DATDF+00000301 3 BYTE POINTER ON WORD+1 33110000 LVL1NO EQU E01DATDF+00000304 HALFWORD INTEGER 33120000 LVL2NO EQU E01DATDF+00000306 HALFWORD INTEGER 33130000 PDLPTR EQU E01DATDF+00000308 FULLWORD POINTER 33140000 DRDNPTR EQU E01DATDF+00000312 46 BYTE(S) ON WORD 33150000 DSNARLNG EQU E01DATDF+00000312 HALFWORD INTEGER 33160000 DSNARLCH EQU E01DATDF+00000312 2 BYTE(S) 33170000 DSNAMAR EQU E01DATDF+00000314 44 BYTE(S) 33180000 CBUFLSAV EQU E01DATDF+00000358 HALFWORD INTEGER 33190000 CBUFLSAC EQU E01DATDF+00000358 2 BYTE(S) 33200000 POSBYT EQU E01DATDF+00000360 HALFWORD INTEGER 33210000 DCBD EQU 00000000 88 BYTE(S) ON DWORD 33220000 A00004 EQU DCBD+00000000 26 BYTE(S) 33230000 DCBDSORG EQU DCBD+00000026 2 BYTE(S) 33240000 A00005 EQU DCBD+00000028 5 BYTE(S) 33250000 DCBEODAD EQU DCBD+00000033 3 BYTE POINTER ON WORD+1 33260000 DCBRECFM EQU DCBD+00000036 1 BYTE(S) 33270000 DCBRCFF EQU DCBD+00000036 1 BIT(S) 33280000 DCBRCFV EQU DCBD+00000036 1 BIT(S) 33290000 DCBEXLST EQU DCBD+00000037 3 BYTE POINTER ON WORD+1 33300000 DCBDDNAM EQU DCBD+00000040 8 BYTE(S) 33310000 DCBOFLGS EQU DCBD+00000048 1 BYTE(S) 33320000 A00006 EQU DCBD+00000049 1 BYTE(S) 33330000 DCBMACR EQU DCBD+00000050 2 BYTE(S) 33340000 A00007 EQU DCBD+00000052 5 BYTE(S) 33350000 DCBSYNAD EQU DCBD+00000057 3 BYTE POINTER ON WORD+1 33360000 A00008 EQU DCBD+00000060 2 BYTE(S) 33370000 DCBBLKSI EQU DCBD+00000062 HALFWORD INTEGER 33380000 A00009 EQU DCBD+00000064 18 BYTE(S) 33390000 DCBLRECL EQU DCBD+00000082 HALFWORD INTEGER 33400000 A00010 EQU DCBD+00000084 4 BYTE(S) 33410000 ENTRY E05OPEX 33420000 MODDECB EQU 00000000 20 BYTE(S) ON WORD 33430000 INPLIN EQU 00000000 256 BYTE(S) 33440000 LINLNG EQU INPLIN+00000000 2 BYTE(S) 33450000 A00011 EQU INPLIN+00000002 254 BYTE(S) 33460000 ATAB EQU 00000000 12 BYTE(S) ON WORD 33470000 ATABLST EQU ATAB+00000000 FULLWORD POINTER 33480000 ATABNXT EQU ATAB+00000004 FULLWORD POINTER 33490000 ATABLNG EQU ATAB+00000008 FULLWORD INTEGER 33500000 ATABELMT EQU 00000000 263 BYTE(S) ON WORD 33510000 FTABPTR EQU ATABELMT+00000000 4 BYTE(S) 33520000 FTABPTRB EQU ATABELMT+00000000 32 BIT(S) 33530000 ATABFLGS EQU ATABELMT+00000004 1 BYTE(S) 33540000 ATABELNC EQU ATABELMT+00000005 2 BYTE(S) 33550000 ATABDAT EQU ATABELMT+00000007 256 BYTE(S) 33560000 FTAB EQU 00000000 12 BYTE(S) ON WORD 33570000 FTABLST EQU FTAB+00000000 FULLWORD POINTER 33580000 FTABNXT EQU FTAB+00000004 FULLWORD POINTER 33590000 FTABLNG EQU FTAB+00000008 HALFWORD INTEGER 33600000 FTABDLNG EQU FTAB+00000010 HALFWORD INTEGER 33610000 FTABELMT EQU 00000000 260 BYTE(S) ON WORD 33620000 FTABELNG EQU FTABELMT+00000000 4 BYTE(S) 33630000 FTABDAT EQU FTABELMT+00000004 256 BYTE(S) 33640000 DSNPDL EQU 00000000 8 BYTE(S) ON WORD 33650000 PTRDSN EQU DSNPDL+00000000 FULLWORD POINTER 33660000 DSNLNG EQU DSNPDL+00000004 HALFWORD INTEGER 33670000 DSNFLG EQU DSNPDL+00000006 1 BYTE(S) 33680000 DSNNUL EQU DSNPDL+00000006 1 BIT(S) 33690000 DSNQTE EQU DSNPDL+00000006 1 BIT(S) 33700000 A00012 EQU DSNPDL+00000006 6 BIT(S) 33710000 A00013 EQU DSNPDL+00000007 1 BYTE(S) 33720000 PDLDNAM EQU 00000000 44 BYTE(S) 33730000 DAPLPTR EQU 00000248 FULLWORD POINTER 33740000 ALOCLR EQU 00000000 672 BIT(S) ON BYTE 33750000 ALOCSET EQU 00000000 72 BYTE(S) ON WORD 33760000 A00014 EQU ALOCSET+00000000 12 BYTE(S) 33770000 B1 EQU ALOCSET+00000012 24 BYTE(S) 33780000 A00015 EQU ALOCSET+00000036 16 BYTE(S) 33790000 B2 EQU ALOCSET+00000052 16 BYTE(S) 33800000 A00016 EQU ALOCSET+00000068 3 BYTE(S) 33810000 X1 EQU ALOCSET+00000071 1 BYTE(S) 33820000 DAPB08 EQU 00000000 84 BYTE(S) ON WORD 33830000 DA08CD EQU DAPB08+00000000 2 BYTE(S) 33840000 DA08FLG EQU DAPB08+00000002 2 BYTE(S) 33850000 DA08FPE EQU DAPB08+00000002 1 BIT(S) 33860000 A00017 EQU DAPB08+00000002 1 BIT(S) 33870000 A00018 EQU DAPB08+00000002 1 BIT(S) 33880000 A00019 EQU DAPB08+00000002 1 BIT(S) 33890000 A00020 EQU DAPB08+00000002 1 BIT(S) 33900000 A00021 EQU DAPB08+00000002 1 BIT(S) 33910000 A00022 EQU DAPB08+00000002 1 BIT(S) 33920000 A00023 EQU DAPB08+00000002 1 BIT(S) 33930000 DA08DARC EQU DAPB08+00000004 HALFWORD INTEGER 33940000 DA08CTRC EQU DAPB08+00000006 HALFWORD INTEGER 33950000 DA08PDSN EQU DAPB08+00000008 FULLWORD POINTER 33960000 DA08DDN EQU DAPB08+00000012 8 BYTE(S) 33970000 DA08UNIT EQU DAPB08+00000020 8 BYTE(S) 33980000 DA08SER EQU DAPB08+00000028 8 BYTE(S) 33990000 DA08BLK EQU DAPB08+00000036 4 BYTE(S) 34000000 DA08PQTY EQU DAPB08+00000040 4 BYTE(S) 34010000 DA08SQTY EQU DAPB08+00000044 4 BYTE(S) 34020000 DA08DQTY EQU DAPB08+00000048 4 BYTE(S) 34030000 DA08MNM EQU DAPB08+00000052 8 BYTE(S) 34040000 DA08PSWD EQU DAPB08+00000060 8 BYTE(S) 34050000 DA08DSP1 EQU DAPB08+00000068 1 BYTE(S) 34060000 A00024 EQU DAPB08+00000068 1 BIT(S) 34070000 A00025 EQU DAPB08+00000068 1 BIT(S) 34080000 A00026 EQU DAPB08+00000068 1 BIT(S) 34090000 A00027 EQU DAPB08+00000068 1 BIT(S) 34100000 DA08SHR EQU DAPB08+00000068 1 BIT(S) 34110000 DA08NEW EQU DAPB08+00000068 1 BIT(S) 34120000 DA08MOD EQU DAPB08+00000068 1 BIT(S) 34130000 DA08OLD EQU DAPB08+00000068 1 BIT(S) 34140000 DA08DPS2 EQU DAPB08+00000069 1 BYTE(S) 34150000 A00028 EQU DAPB08+00000069 1 BIT(S) 34160000 A00029 EQU DAPB08+00000069 1 BIT(S) 34170000 A00030 EQU DAPB08+00000069 1 BIT(S) 34180000 A00031 EQU DAPB08+00000069 1 BIT(S) 34190000 DA08KEEP EQU DAPB08+00000069 1 BIT(S) 34200000 DA08DEL EQU DAPB08+00000069 1 BIT(S) 34210000 DA08CAT EQU DAPB08+00000069 1 BIT(S) 34220000 DA08UCAT EQU DAPB08+00000069 1 BIT(S) 34230000 DA08DPS3 EQU DAPB08+00000070 1 BYTE(S) 34240000 A00032 EQU DAPB08+00000070 1 BIT(S) 34250000 A00033 EQU DAPB08+00000070 1 BIT(S) 34260000 A00034 EQU DAPB08+00000070 1 BIT(S) 34270000 A00035 EQU DAPB08+00000070 1 BIT(S) 34280000 DA08KEP EQU DAPB08+00000070 1 BIT(S) 34290000 DA08DELE EQU DAPB08+00000070 1 BIT(S) 34300000 DA08CATL EQU DAPB08+00000070 1 BIT(S) 34310000 DA08UNCT EQU DAPB08+00000070 1 BIT(S) 34320000 DA08CTL EQU DAPB08+00000071 1 BYTE(S) 34330000 DA08TRKS EQU DAPB08+00000071 1 BIT(S) 34340000 DA08ABKL EQU DAPB08+00000071 1 BIT(S) 34350000 DA08UID EQU DAPB08+00000071 1 BIT(S) 34360000 DA08RLSE EQU DAPB08+00000071 1 BIT(S) 34370000 DA08PERM EQU DAPB08+00000071 1 BIT(S) 34380000 DA08DMMY EQU DAPB08+00000071 1 BIT(S) 34390000 DA08ATRL EQU DAPB08+00000071 1 BIT(S) 34400000 A00036 EQU DAPB08+00000071 1 BIT(S) 34410000 A00037 EQU DAPB08+00000072 3 BYTE(S) 34420000 DA08DSO EQU DAPB08+00000075 1 BYTE(S) 34430000 DA08ALN EQU DAPB08+00000076 8 BYTE(S) 34440000 DAPB00 EQU 00000000 20 BYTE(S) ON WORD 34450000 DA00CD EQU DAPB00+00000000 2 BYTE(S) 34460000 DA00FLG EQU DAPB00+00000002 2 BYTE(S) 34470000 A00038 EQU DAPB00+00000002 1 BIT(S) 34480000 A00039 EQU DAPB00+00000002 1 BIT(S) 34490000 A00040 EQU DAPB00+00000002 1 BIT(S) 34500000 A00041 EQU DAPB00+00000002 1 BIT(S) 34510000 DA00PERM EQU DAPB00+00000002 1 BIT(S) 34520000 DA00DYNM EQU DAPB00+00000002 1 BIT(S) 34530000 DA00DSE EQU DAPB00+00000002 1 BIT(S) 34540000 DA00TERM EQU DAPB00+00000002 1 BIT(S) 34550000 DA00PDSN EQU DAPB00+00000004 FULLWORD POINTER 34560000 DA00DDN EQU DAPB00+00000008 8 BYTE(S) 34570000 DA00CTL EQU DAPB00+00000016 1 BYTE(S) 34580000 A00042 EQU DAPB00+00000016 1 BIT(S) 34590000 A00043 EQU DAPB00+00000016 1 BIT(S) 34600000 DA00UID EQU DAPB00+00000016 1 BIT(S) 34610000 A00044 EQU DAPB00+00000016 1 BIT(S) 34620000 A00045 EQU DAPB00+00000016 1 BIT(S) 34630000 A00046 EQU DAPB00+00000016 1 BIT(S) 34640000 A00047 EQU DAPB00+00000016 1 BIT(S) 34650000 A00048 EQU DAPB00+00000016 1 BIT(S) 34660000 A00049 EQU DAPB00+00000017 2 BYTE(S) 34670000 DA00DSO EQU DAPB00+00000019 1 BYTE(S) 34680000 DAPL EQU 00000000 20 BYTE(S) ON WORD 34690000 DAPLUPT EQU DAPL+00000000 FULLWORD POINTER 34700000 DAPLECT EQU DAPL+00000004 FULLWORD POINTER 34710000 DAPLECB EQU DAPL+00000008 FULLWORD POINTER 34720000 DAPLPSCB EQU DAPL+00000012 FULLWORD POINTER 34730000 DAPLDAPB EQU DAPL+00000016 FULLWORD POINTER 34740000 CPPL EQU 00000000 16 BYTE(S) ON WORD 34750000 CPPLCBUF EQU CPPL+00000000 FULLWORD POINTER 34760000 CPPLUPT EQU CPPL+00000004 FULLWORD POINTER 34770000 CPPLPSCB EQU CPPL+00000008 FULLWORD POINTER 34780000 CPPLECT EQU CPPL+00000012 FULLWORD POINTER 34790000 ORG @DATA 34800000 DS 00000131C 34810000 @L EQU 1 34820000 @DATD DSECT 34830000 @SAV001 EQU @DATD+00000000 72 BYTE(S) ON WORD 34840000 TEM01 EQU @DATD+00000072 FULLWORD INTEGER 34850000 TEMC01 EQU TEM01+00000000 4 BYTE(S) 34860000 TEM02 EQU @DATD+00000076 FULLWORD INTEGER 34870000 TEM03 EQU @DATD+00000080 FULLWORD INTEGER 34880000 LPARCTR EQU @DATD+00000084 FULLWORD INTEGER 34890000 STARTVAL EQU @DATD+00000088 FULLWORD INTEGER 34900000 ENDVAL EQU @DATD+00000092 FULLWORD INTEGER 34910000 DAIRRET EQU @DATD+00000096 FULLWORD INTEGER 34920000 FINEX EQU @DATD+00000101 3 BYTE POINTER ON WORD+1 34930000 SYNEX EQU @DATD+00000105 3 BYTE POINTER ON WORD+1 34940000 E05BINSW EQU @DATD+00000108 1 BYTE(S) 34950000 E05SW1 EQU E05BINSW+00000000 1 BIT(S) 34960000 KWVAL EQU E05BINSW+00000000 1 BIT(S) 34970000 E05SW2 EQU E05BINSW+00000000 1 BIT(S) 34980000 QBIT EQU E05BINSW+00000000 1 BIT(S) 34990000 E05SW3 EQU E05BINSW+00000000 1 BIT(S) 35000000 FIRSTBIT EQU E05BINSW+00000000 1 BIT(S) 35010000 E05SW4 EQU E05BINSW+00000000 1 BIT(S) 35020000 LASTBIT EQU E05BINSW+00000000 1 BIT(S) 35030000 E05SW5 EQU E05BINSW+00000000 1 BIT(S) 35040000 CONTFLG EQU E05BINSW+00000000 1 BIT(S) 35050000 A00003 EQU E05BINSW+00000000 3 BIT(S) 35060000 DAPB0PTR EQU @DATD+00000112 FULLWORD POINTER 35070000 ALOCINT EQU @DATD+00000116 84 BYTE(S) ON WORD 35080000 DS 00000232C 35090000 @TEMPS DS 0F 35100000 @TEMP4 DC F'0' 35110000 @CTEMP2 DS CL002 35120000 @CTEMP4 DS CL002 35130000 @PL001 DS 04F 35140000 CNOP 0,4 35150000 ROPE DS CL(EOPE-SOPE) AREA FOR OPEN MACRO 35160000 @DATD DSECT 35170000 @DATEND EQU * 35180000 IKJEFE05 CSECT , 35190000 @9CC EQU E05SPD15 35200000 @9CB EQU @DO9D1 35210000 @9C7 EQU E05SPD07 35220000 @9B9 EQU E05SPD40 35230000 @9B8 EQU E05SPD40 35240000 @9B7 EQU E05SPD40 35250000 @9BA EQU @DO9BF 35260000 @999 EQU E05SPD66 35270000 @998 EQU E05SPD66 35280000 E05SPD65 EQU @DO9B2 35290000 @992 EQU E05SPD65 35300000 @990 EQU E05SPD65 35310000 @98E EQU E05SPD65 35320000 @98D EQU E05SPD65 35330000 @98C EQU E05SPD65 35340000 @98B EQU E05SPD65 35350000 @98A EQU E05SPD65 35360000 @993 EQU @992 35370000 END 35380000