*********************************************************************** 00040002 * 00050002 * MODULE NAME= IEFVFA 00060002 * 00070002 * DESCRIPTIVE NAME= SCAN ROUTINE 00080002 * 00090002 * COPYRIGHT= N/A 00100002 * 00110002 * STATUS= VS2 REL037 PTF @ZA31145 00120003 * 00130002 * FUNCTION= 1. SCANS JCL CARD IMAGE FOR SYNTAX ERRORS. 00140002 * 2. CONVERTS JCL STATEMENT TO INTERNAL TEXT. 00150002 * OPERATION= 1. AT ENTRY, MODULE CHECKS IF THE STATEMENT IS 00160002 * CONTINUED ON ANOTHER CARD. IF IT IS, THE CONTINU- 00170002 * ATION EXPECTED SWITCH IS SET ON, AND THE SCAN 00180002 * STARTS WITH THE STATEMENT NAME. IF THE CARD IMAGE 00190002 * IS ITSELF A CONTINUATION, THE SCAN IS CONTINUED 00200002 * AT THE OPERAND FIELD. 00210002 * 2. THE MODULE SCANS ACROSS GROUPINGS OF ALPHANUMERIC 00220002 * AND NATIONAL CHARACTERS TERMINATING IN A DELIMITER. 00230002 * CONTROL IS PASSED TO THE ROUTINE FOR THE 00240002 * PARTICULAR DELIMITER ENCOUNTERED. 00250002 * 3. GROUPINGS TERMINATING IN THE '=' DELIMITER ARE 00260002 * CHECKED AGAINST A DICTIONARY OF VALID KEYWORDS. 00270002 * WHEN A VALID KEYWORD HAS BEEN IDENTIFIED, THE 00280002 * CHARACTERS FOLLOWING ARE CHECKED FOR CORRECT 00290002 * SYNTAX. INVALID KEYWORDS, AND VALID KEYWORDS WHOSE 00300002 * OPERANDS ARE NOT SYNTACTICALLY CORRECT, CAUSE THE 00310002 * JOB TO BE FAILED AND ERROR MESSAGES TO BE ISSUED. 00320002 * 4. WHEN AN AMPERSAND IS ENCOUNTERED, THE MODULE 00330002 * ASSUMES A SYMBOLIC PARAMETER FOLLOWS, AND BRANCHES 00340002 * TO THE SYMBOLIC PARAMETER ROUTINE (IEFVFB) TO 00350002 * PROCESS IT. 00360002 * 5. FOR A JOB STATEMENT, A CHECK IS MADE FOR THE SPECI- 00370002 * FICATION OF KEYWORDS FOR WHICH DEFAULTS MAY BE 00380002 * SUPPLIED VIA THE NEL (E.G., MSGLEVEL, MSGCLASS, 00390002 * ETC.). FOR THOSE OMITTED, PREBUILT TEXT, INTO WHICH 00400002 * THE DEFAULT VALUES ARE PLUGGED, IS APPENDED TO THE 00410002 * TEXT STRING FOR THE STATEMENT. 00420002 * 6. FOR A JOB STATEMENT, AFTER TEXT FOR THE STATEMENT 00430002 * HAS BEEN COMPLETED, THE TEXT IS SEARCHED FOR THE 00440002 * MSGLEVEL KEY. FLAGS INDICATING THE MSGLEVEL 00450002 * SPECIFIED ARE SET FOR USE BY THE PRESCAN ROUTINE. 00460002 * 7. FOR AN EXEC STATEMENT A CHECK IS MADE FOR THE 00470002 * SPECIFICATION OF A PROCEDURE NAME. IF ONE HAS BEEN 00480002 * SPECIFIED, THE MODULE PERFORMS A 'FIND' ON THE 00490002 * PROCEDURE IN THE PROCEDURE LIBRARY, AND SETS 00500002 * APPROPRIATE SWITCHES TO CAUSE READS FROM THE 00510002 * PROCEDURE LIBRARY. 00520002 * 8. CORRECT PARAMETERS ARE CONVERTED TO INTERNAL TEXT. 00530002 * THIS CONTINUES UNTIL THE ENTIRE STATEMENT HAS BEEN 00540002 * SCANNED, OR AN ERROR HAS BEEN ENCOUNTERED. AN ERROR 00550002 * CAUSES TERMINATION OF THE SCAN AND GENERATION 00560002 * OF INTERNAL TEXT. 00570002 * 9. FOR A DD STATEMENT (AFTER THE INTERNAL @G29AN2E 00571003 * TEXT HAS BEEN CREATED) A CHECK IS MADE FOR @G29AN2E 00572003 * THE SPECIFICATION OF THE SUBSYS KEYWORD. IF@G29AN2E 00573003 * IT HAS BEEN SPECIFIED THE SUBSYS NAME IS @G29AN2E 00574003 * CHECKED FOR VALID CHARACTERS. IF THE @G29AN2E 00575003 * CHARACTERS ARE VALID THE SUBSYSTEM INTER- @G29AN2E 00576003 * FACE REQUEST ROUTINE REQUESTS THE SUBSYSTEM@G29AN2E 00577003 * TO CHECK THE INTERNAL TEXT OF THE SUBSYS @G29AN2E 00578003 * PARAMETER. @G29AN2E 00579003 * 00580002 * NOTES 00590002 * CHARACTER CODE DEPENDENCIES= EBCDIC 00600002 * DEPENDENCIES= NONE 00610002 * RESTRICTIONS= NONE 00620002 * REGISTER CONVENTIONS= 00630002 * R2- ERROR MESSAGE CODE WHEN ERROR FOUND 00640002 * R9- CARD IMAGE SCAN POINTER 00650002 * RA- BASE REGISTER 2 00660002 * RB- BASE REGISTER 1 00670002 * RC- CONVERTER WORK AREA POINTER 00680002 * RD- SAVE AREA POINTER 00690002 * PATCH-LABEL= PATCH 00700002 * 00710002 * MODULE TYPE= BAL 00720002 * PROCESSOR= ASSEMBLER 00730002 * ATTRIBUTES= NCAL,LET,LIST,XREF,REFR,RENT 00740002 * 00750002 * ENTRY POINT= IEFVFA 00760002 * PURPOSE= SCAN STATEMENT 00770002 * LINKAGE= BRANCH ON REGISTER 00780002 * INPUT DATA= JCL STATEMENT 00790002 * CONVERTER WORK AREA 00800002 * R9- ADDRESS OF JCL STATEMENT 00810002 * RA- ADDRESS OF STATEMENT PARAMETER LIST 00820002 * RC- ADDRESS OF CWA 00830002 * REGISTERS SAVED= RA 00840002 * REGISTER CONTENTS DURING PROCESSING= SEE REGISTER CONVERNTIONS 00850002 * REGISTERS RESTORED= NONE 00860002 * 00870002 * EXIT - NORMAL= BRANCH TO IEFVHF 00880002 * CONDITIONS= BLANK DELIMITER FOUND 00890002 * OUTPUT DATA= UPDATED FIELDS IN CWA 00900002 * INTERNAL TEXT FOR STATEMENT 00910002 * RETURN CODES= NONE 00920002 * 00930002 * EXIT - ERROR= BRANCH TO IEFVHF 00940002 * CONDITIONS= ERROR FOUND 00950002 * OUTPUT DATA= UPDATED FIELDS IN CWA (JOB FAILED BIT ON) 00960002 * INTERNAL TEXT FOR CORRECT PARAMETERS 00970002 * ERROR MESSAGE WRITTEN TO MESSAGE DATA SET 00980002 * RETURN CODES= NONE 00990002 * 01000002 * EXTERNAL REFERENCES= 01010002 * ROUTINES= IEFVGM VIA BRANCH - WRITE ERROR MSG TO MSG DATA SET 01020002 * IEFVHR VIA BRANCH - WRITE I/O ERROR MSG TO CONSOLE 01030002 * IEFVHQ VIA BRANCH - WRITE SYMBOLIC PARAMETER TABLE 01040002 * TO SWA 01050002 * IEFVFB VIA BRANCH - PROCESS SYMBOLIC PARAMETERS 01060002 * IEFACT VIA BRANCH - POST SCAN EXIT TO USER ROUTINE 01070002 * IEFNB900 VIA BRANCH - SEARCH INTERNAL TEXT FOR SPECFIC 01080002 * KEYWORD KEYS 01090002 * DATA AREAS= CONVERTER WORK AREA 01100002 * JCL DATA SET INPUT BUFFER 01110002 * PROCEDURE LIBRARY INPUT BUFFER 01120002 * INTERNAL TEXT BUFFER 01130002 * CONTROL BLOCKS= QMPA,SSOB,SSIB @G29AN2E 01140003 * TABLES= NONE 01144003 * MACROS= IEFZB900,IEFQMNGR,IEFVKEYS,IEFVMCWA,IEFJMR,CVT, 01148003 * IEFSSREQ,IEFJESCT @G29AN2E 01152003 * ENQUEUE RESOURCES= NONE 01156003 * CHANGE LEVEL=Y30LPSB,Y30OPSB,Y30LPTD,Y30OPTD,Z30JPSF, 01160003 * Z40MPTH,OZ03299,OZ05366,ZA04797,ZA06243 01164003 * Z40RPTH,Z40RPSM,ZA10120,ZA11328,G29AN2E @G29AN2E 01168003 * G32HPPJ,ZA12458,ZA13371,ZA13424,ZA13667 @G32HPPJ 01172003 * ZA13844,ZA14268,ZA15003,ZA16422,ZA20640 @ZA20640 01176003 * ZA24749,ZA26148,ZA27753,ZA31145 @ZA31145 01180003 * 01184003 * MESSAGES= 01200002 * IEF601I INVALID STATEMENT IN PROCEDURE 01210002 * IEF609I INVALID OVERRIDE KEYWORD 01220002 * IEF612I PROCEDURE NOT FOUND 01230002 * IEF613I PROCEDURE WITHIN A PROCEDURE 01240002 * IEF614I I/O ERROR SEARCHING FOR PROCEDURE 01250002 * IEF616I SUBLIST WITHIN SUBLIST INCORRECT 01260002 * IEF618I OPERAND FIELD NOT TERMINATED IN COMMA OR BLANK 01270002 * IEF620I CONTINUATION INVALID ON DD * 01280002 * IEF622I UNBALANCED PARENTHESES 01290002 * IEF623I SOURCE TEXT CONTAINS UNDEFINED CHARACTERS 01300002 * IEF624I INCORRECT USE OF PERIOD 01310002 * IEF625I INCORRECT USE OF LEFT PAREN 01320002 * IEF626I INCORRECT USE OF PLUS 01330002 * IEF627I INCORRECT USE OF AMPERSAND 01340002 * IEF628I INCORRECT USE OF ASTERISK 01350002 * IEF629I INCORRECT USE OF APOSTROPHE 01360002 * IEF630I UNIDENTIFIED KEYWORD 01370002 * IEF632I FORMAT ERROR 01380002 * IEF639I INVALID CLASS DESIGNATION 01385002 * IEF640I EXCESSIVE NUMBER OF POSITIONAL PARAMETERS 01390002 * IEF641I IMPROPER SUBPARAMETER LIST @G29AN2E 01392003 * IEF646I REQUIRED POSITIONAL PARAMETER MISSING @ZA13367 01395003 * IEF647I NON-ALPHABETIC FIRST CHARACTER 01400002 * IEF650I INCORRECT USE OF SLASH 01410002 * IEF651I INCORRECT USE OF MINUS 01420002 * IEF652I MUTUALLY EXCLUSIVE KEYWORDS 01430002 * IEF677I WARNING MESSAGE(S) FOR JOB JJJ ISSUED @G29AN2E 01430803 * IEF744I SUBSYSTEM NOT SPECIFIED @G29AN2E 01431603 * IEF745I SUBSYSTEM SSSS DOES NOT EXIST @G29AN2E 01432403 * IEF746I SUBSYSTEM SSSS IS NOT OPERATIONAL @G29AN2E 01433203 * IEF747I SUBSYSTEM SSSS DOES NOT SUPPORT JCL @G29AN2E 01434003 * PARAMETERS @G29AN2E 01434803 * IEF748I SUBSYSTEM NAME INVALID @G29AN2E 01435603 * IEF749I JCL STATEMENT BUFFER CAPACITY EXCEEDED @G29AN2E 01436403 * IEF750I SYSTEM ERROR IN PROCESSING SUBSYS @G29AN2E 01437203 * DD PARAMETER @G29AN2E 01438003 * 01438803 * 01440002 *********************************************************************** 01450002 EJECT 01460002 MACRO 02420000 JCLD 02440000 ************************************************** 02461018 * 02462018 * ANY MAJOR DD KEYWORD THAT IS ADDED TO THIS MACRO SHOULD OCIP39A 02463018 * ALSO BE ADDED TO IEEVSTAR, WHICH CONTAINS A TABLE OF OCIP39A 02464018 * DD MAJOR KEYWORDS. THE REASON FOR THIS IS THE FOLLOWING: OCIP39A 02465018 * WHEN USING SYMBOLIC PARAMETERS ON THE START COMMAND, OCIP39A 02466018 * MAJOR DD KEYWORDS PARAMETERS CANNOT BE USED TO OCIP39A 02467018 * DEFINE SYMBOLIC PARAMETERS OCIP39A 02468018 * 02469018 ************************************************** 02470018 * EACH GROUP OF KEYWORDS IS TERMINATED WITH 'ETEND' IN 20002 02472020 * THE LAST PARAMETER OF THE LAST DENT MACRO IN THE GROUP 20002 02474020 ******************************************************************20002 02476020 J5L DENT (COND),(CONDJK) 02480000 DENT (ADDRSPC),(ADRSPJK) Y01029 02490001 DENT (PRTY),(PRTYJK) 02500000 DENT (PERFORM),(PRFMJK) Y02655 02510002 DENT (TYPRUN),(TYPRUNJK) 02520000 DENT (CLASS),(CLASSJK) AAAA 02524015 DENT (ROLL),(ROLLJK) AAAA 02528015 DENT (RESTART),(RESTARJK) AACA 02532017 DENT (RD),(RDJK) AACA 02536017 DENT (REGION),(REGINJK) 02540000 DENT (MSGCLASS),(MSGCLAJK) 02560000 DENT (TIME),(TIMEJK) 02570018 DENT (NOTIFY),(NOTIFYJK) 20001 02575020 DENT (USER),(USERK) @Z40RPTH 02576003 DENT (PASSWORD),(PASWORDK) @Z40RPSM 02577003 DENT (GROUP),(GROUPK) @Z40RPSM 02578003 DENT (MSGLEVEL),(MSGLEVJK),,(ETEND) 02580000 E4L DENT (PGM),(PGMEK,PROCEK) 02600000 DENT (PROC),(PROCEK,PGMEK) 02620000 DENT (ACCT),(ACCTEEK,ACCTPEK) 02640000 DENT (COND),(CONDEEK,CONDPEK) 02660000 DENT (RD),(RDEEK,RDPEK) AACA 02666017 DENT (RD,.),(RDPEK,RDEEK) AACA 02672017 DENT (PARM),(PARMEEK,PARMPEK) 02680001 DENT (PERFORM),(PRFMEEK,PRFMPEK) Y02655 02684002 DENT (PERFORM,.),(PRFMPEK,PRFMEEK) Y02655 02688002 DENT (DYNAMNBR),(DYNMEEK,DYNMPEK) Y02670 02692002 DENT (DYNAMNBR,.),(DYNMPEK,DYNMEEK) Y02670 02696002 DENT (TIME),(TIMEEEK,TIMEPEK) 02700000 DENT (ACCT,.),(ACCTPEK,ACCTEEK) 02720000 DENT (COND,.),(CONDPEK,CONDEEK) 02740000 DENT (PARM,.),(PARMPEK,PARMEEK) 02760000 DENT (TIME,.),(TIMEPEK,TIMEEEK) 02780000 DENT (DPRTY,.),(SDPPEK,SDPEEK) I241 02782018 DENT (DPRTY),(SDPEEK,SDPPEK) I241 02784018 DENT (ROLL),(ROLLEEK,ROLLPEK) AAAA 02786015 DENT (ROLL,.),(ROLLPEK,ROLLEEK) AAAA 02792015 DENT (ADDRSPC,.),(ADRSPPEK,ADRSPEEK) Y01029 02794001 DENT (ADDRSPC),(ADRSPEEK,ADRSPPEK) Y01029 02796001 DENT (REGION),(REGINEEK,REGINPEK) 02800000 DENT (REGION,.),(REGINPEK,REGINEEK),,(ETEND) 02820000 D4L DENT (AFF),(AFFK,SEPK,DDNAMEK,SYSOUTK,COPIESK,BURSTK, Z40MPTHX02840003 MODIFYK,FLASHK,CHARSK) Z40MPTH 02844003 DENT (SEP),(SEPK,AFFK,DDNAMEK,SYSOUTK,COPIESK,BURSTK, Z40MPTHX02848003 MODIFYK,FLASHK,CHARSK) Z40MPTH 02852003 DENT (DCB),(DCBK,AMPK) AABA 02856003 DENT (DLM),(DLMK,DDNAMEK,PROTECTK,QNAMEK) @ZA24749 02860003 DENT (HOLD),(HOLDK,DDNAMEK,QNAMEK) @ZA24749 02864003 DENT (DSN),(DSNAMEK,DDNAMEK,QNAMEK,IPLTXIDK,COPIESK, @Z40MPTHX02868003 BURSTK,MODIFYK,FLASHK,CHARSK) @Z40MPTH 02872003 DENT (VOL),(VOLUMEK,DDNAMEK,SYSOUTK,COPIESK,BURSTK, @Z40MPTHX02876003 MODIFYK,FLASHK,CHARSK,QNAMEK),(SERMK,REFMK) @ZA24749 02880003 DENT (MSVGP),(MSVGPK,SERMK,BURSTK,MODIFYK,CHARSK, Y30LPTDX02884003 FLASHK,DSIDK,SYSOUTK,COPIESK,QNAMEK,DDNAMEK) Y30LPTD 02888003 DENT (DSID),(DSIDK,BURSTK,FLASHK,MODIFYK,CHARSK, Y30OPTDX02892003 DDNAMEK,MSVGPK,QNAMEK) @ZA24749 02896003 DENT (BURST),(BURSTK,DSNAMEK,LABELK,VOLUMEK,MSVGPK, @Z40MPTHX02900003 DSIDK,QNAMEK,DISPK,AFFK,SEPK,SPLITK,SUBALLOK, @Z40MPTHX02904003 AMPK,DDNAMEK,PROTECTK) @G32HPPJ 02908003 DENT (MODIFY),(MODIFYK,DSNAMEK,LABELK,VOLUMEK,MSVGPK, Z40MPTHX02912003 DSIDK,QNAMEK,DISPK,AFFK,SEPK,SPLITK,SUBALLOK, @Z40MPTHX02916003 AMPK,DDNAMEK,PROTECTK) @G32HPPJ 02920003 DENT (FLASH),(FLASHK,DSNAMEK,LABELK,VOLUMEK,MSVGPK, Z40MPTHX02924003 DSIDK,QNAMEK,DISPK,AFFK,SEPK,SPLITK,SUBALLOK, @Z40MPTHX02928003 AMPK,DDNAMEK,PROTECTK) @G32HPPJ 02932003 DENT (CHARS),(CHARSK,DSNAMEK,LABELK,VOLUMEK,MSVGPK, @Z40MPTHX02936003 DSIDK,QNAMEK,DISPK,AFFK,SEPK,SPLITK,SUBALLOK, @Z40MPTHX02940003 AMPK,DDNAMEK,PROTECTK) @G32HPPJ 02944003 DENT (UNIT),(UNITK,DDNAMEK,QNAMEK),(AFFMK,SEPMK) @ZA24749 02948003 DENT (DISP),(DISPK,SYSOUTK,DDNAMEK,BURSTK,MODIFYK, @Z40MPTHX02952003 FLASHK,CHARSK,COPIESK,QNAMEK) @ZA24749 02956003 DENT (SPACE),(SPACEK,SPLITK,SUBALLOK,DDNAMEK,AMPK,QNAMEK) 02972003 * @ZA24749 02981003 DENT (AMP),(AMPK,DYNAK,UCSK,FCBK, AM/O KEYWORD KEY YA03225X03006002 TERMK,DCBK,SYSOUTK,QNAMEK,SPACEK,SPLITK, YA03225X03007002 SUBALLOK,BFALNMK,BFTEKMK,BLKSIZMK,BUFLMK, YA03225X03008002 BUFNOMK,BUFRQMK,CODEMK,CPRIMK,CYLOFLMK,HIARCHMK, YA03225X03009002 DENMK,DIAGNSK,DSORGMK,EROPTMK,INTVLMK,KEYLENMK, YA03225X03010002 LIMCTMK,LRECLMK,MODEMK,NCPMK,NTMMK,OPTCDMK),,, @ZA11328X03011003 (PRTSPMK,RECFMMK,RKPMK,SOWAMK,STACKMK,TRTCHMK, @ZA11328X03013003 GNCPMK,GDSORGMK,BUFOFFMK,BUFINMK,BUFOUTMK, YA03225X03015003 BUFMAXMK,BUFSIZMK,PCIMK,RESERVMK,THRESHMK, YA03225X03017003 IPLTXIDK,BURSTK,MODIFYK,FLASHK,CHARSK,COPIESK) @Z40MPTH 03019003 DENT (LABEL),(LABELK,DDNAMEK,SYSOUTK,BURSTK,MODIFYK, @Z40MPTHX03021003 FLASHK,CHARSK,COPIESK,QNAMEK),(EXPDTMK,RETPDMK) @ZA24749 03023003 DENT (SPLIT),(SPLITK,SPACEK,SUBALLOK,DDNAMEK,AMPK, @Z40MPTHX03025003 SYSOUTK,BURSTK,MODIFYK,FLASHK,CHARSK,COPIESK,QNAMEK) 03027003 * @ZA24749 03029003 DENT (COPIES),(COPIESK,DSNAMEK,LABELK,VOLUMEK,MSVGPK, Z40MPTHX03031003 QNAMEK,DISPK,AFFK,SEPK,SPLITK,SUBALLOK, @Z40MPTHX03033003 AMPK,DDNAMEK) @Z40MPTH 03035003 DENT (DEST),(DESTK,DDNAMEK,QNAMEK) @ZA24749 03037003 DENT (FREE),(FREEK,DDNAMEK,QNAMEK) @ZA24749 03039003 DENT (DSNAME),(DSNAMEK,DDNAMEK,QNAMEK,IPLTXIDK, @Z40MPTHX03041003 COPIESK,BURSTK,MODIFYK,FLASHK,CHARSK) @Z40MPTH 03043003 DENT (SUBSYS),(SUBSYSK,SYSOUTK,DDNAMEK,QNAMEK) @ZA24749 03045003 DENT (DUMM),(DUMMK,DYNAK,DDNAMEK,QNAMEK) @ZA24749 03056003 DENT (DYNA),(DYNAK,DUMMK,DSNAMEK,DDNAMEK,VOLUMEK,UNITK, M3131*03067020 DISPK,SPACEK,DCBK,LABELK,SPLITK,AFFK,SEPK,SYSOUTK, M3131*03070020 UCSK,SUBALLOK,TERMK,QNAMEK,OUTLIMK,FCBK,DLMK, YM02710*03073002 AMPK,COPIESK,DESTK,HOLDK,FREEK,MSVGPK,DSIDK, @Y30OPSB*03076003 CHKPTK,BURSTK,MODIFYK,FLASHK,CHARSK,PROTECTK) @G32HPPJ 03078003 DENT (TERM),(TERMK,AMPK,DDNAMEK,PROTECTK,QNAMEK) @ZA24749 03080003 DENT (PROTECT),(PROTECTK,MODIFYK,QNAMEK,UCSK,FCBK,DDNAMEK, *03082003 SYSOUTK,TERMK,DYNAK,DLMK,CHARSK,FLASHK,BURSTK) @G32HPPJ 03084003 DENT (SYSOUT),(SYSOUTK,DISPK,DDNAMEK,AFFK,SEPK,VOLUMEK, C03086003 LABELK,SPLITK,SUBALLOK,MSVGPK,SUBSYSK, @G29AN2EC03088003 QNAMEK,AMPK,CHKPTK,PROTECTK) @G32HPPJ 03090003 DENT (VOLUME),(VOLUMEK,DDNAMEK,SYSOUTK,COPIESK, @Z40MPTHX03092003 BURSTK,MODIFYK,FLASHK,CHARSK,QNAMEK),(SERMK,REFMK) 03094003 * @ZA24749 03105003 DENT (CHKPT),(CHKPTK,SYSOUTK,DDNAMEK,QNAMEK) @ZA24749 03110003 * DDNAME IS MUTUALLY EXCLUSIVE WITH THE SAME DD KEYWORDS AS YM02710 03122002 * THOSE WITH WHICH DD */DATA ARE MUTUALLY EXCLUSIVE. MUTUAL YM02710 03124002 * EXCLUSIVITY FOR DDNAME IS DETERMINED BY MEANS OF A BIT TABLE YM02710 03126002 * (DASTAB) RATHER THAN BY CHECKING DICTIONARY ENTRIES. YM02710 03128002 DENT (DDNAME),(DDNAMEK,UNITK,LABELK,VOLUMEK,AFFK,SEPK,DISPK,S103130016 PACEK,SPLITK,DSNAMEK,SYSOUTK,SUBALLOK,UCSK, O0101X03140019 QNAMEK,FCBK,FUNCMK,FREEK,SUBSYSK,PROTECTK) @G32HPPJ 03150003 DENT (FCB),(FCBK,DDNAMEK,RKPMK,CYLOFLMK,INTVLMK,AMPK, Y01113X03152003 FRIDMK,PROTECTK,QNAMEK) @ZA24749 03154003 DENT (UCS),(UCSK,RKPMK,CYLOFLMK,INTVLMK,DDNAMEK, 20002X03156003 RESERVMK,AMPK,PROTECTK,QNAMEK) @ZA24749 03158003 DENT (QNAME),(QNAMEK,DDNAMEK,DSNAMEK,SYSOUTK,AMPK, @Z40MPTHX03160003 IPLTXIDK,MSVGPK,BURSTK,MODIFYK,FLASHK,CHARSK, @Z40MPTHX03162003 COPIESK,PROTECTK,CHKPTK,DESTK,DISPK,DLMK, @ZA24749C03164003 DSIDK,DUMMK,FCBK,FREEK,HOLDK,LABELK,OUTLIMK, @ZA24749C03166003 SPACEK,TERMK,UCSK,UNITK,VOLUMEK,SUBSYSK, @ZA24749C03168003 SPLITK,SUBALLOK) @ZA24749 03170003 DENT (OUTLIM),(OUTLIMK,DDNAMEK,QNAMEK,CPRIMK, @ZA31145X03172003 THRESHMK) @ZA31145 03172603 DENT (SUBALLOC),(SUBALLOK,SPACEK,SPLITK,DDNAMEK, @Z40MPTHX03174003 SYSOUTK,AMPK,BURSTK,MODIFYK,FLASHK,CHARSK, @Z40MPTHX03176003 COPIESK,QNAMEK),,(ETEND) @ZA24749 03178003 D4LD DENT (DEN),(DENMK,DDNAMEK) AABA 03190016 DENT (FRID),(FRIDMK,FCBK,DDNAMEK) YM02710 03195002 DENT (NCP),(NCPMK,DDNAMEK,BUFMAXMK) 20002 03200020 DENT (NTM),(NTMMK,DDNAMEK,PCIMK) 20002 03210020 DENT (RKP),(RKPMK,UCSK,DDNAMEK,RESERVMK,FCBK) 20202 03220020 DENT (GDSORG),(GDSORGMK,DDNAMEK) AABA 03230016 DENT (GNCP),(GNCPMK,BFTEKMK,BFALNMK,HIARCHMK,DDNAMEK) A30036 03240019 DENT (BUFL),(BUFLMK,DDNAMEK) AABA 03250016 DENT (CODE),(CODEMK,KEYLENMK,MODEMK,PRTSPMK,STACKMK,DDNAMEK, C03256018 TRTCHMK) 19373 03262018 DENT (CPRI),(CPRIMK,DDNAMEK,THRESHMK,OUTLIMK) @ZA31145 03266003 DENT (MODE),(MODEMK,CODEMK,KEYLENMK,PRTSPMK,DDNAMEK,TRTCHMK) 03276018 * 19373* 03282018 DENT (SOWA),(SOWAMK,DDNAMEK) AABA 03290016 DENT (BFALN),(BFALNMK,GNCPMK,DDNAMEK) A30036 03300019 DENT (BFTEK),(BFTEKMK,GNCPMK,DDNAMEK) A30036 03310019 DENT (BUFNO),(BUFNOMK,BUFRQMK,BUFINMK,BUFOUTMK) 20002 03317020 DENT (BUFOFF),(BUFOFFMK,DDNAMEK) 19200 03325019 DENT (BUFRQ),(BUFRQMK,BUFNOMK,DDNAMEK,BUFINMK,BUFOUTMK) 20002 03332020 DENT (DIAGNS),(DIAGNSK) 21042 03332101 DENT (DSORG),(DSORGMK,DDNAMEK) AABA 03340016 DENT (EROPT),(EROPTMK,DDNAMEK) AABA 03350016 DENT (INTVL),(INTVLMK,UCSK,DDNAMEK,FCBK) 20202 03360020 DENT (LIMCT),(LIMCTMK,DDNAMEK) AABA 03370016 DENT (LRECL),(LRECLMK,DDNAMEK) AABA 03380016 DENT (OPTCD),(OPTCDMK,DDNAMEK) AABA 03390016 DENT (PRTSP),(PRTSPMK,CODEMK,KEYLENMK,MODEMK,STACKMK,DDNAMEK,C03396018 TRTCHMK) 19373 03402018 DENT (RECFM),(RECFMMK,DDNAMEK) AABA 03410016 DENT (STACK),(STACKMK,CODEMK,KEYLENMK,PRTSPMK,DDNAMEK, C03416018 TRTCHMK) 19373 03422018 DENT (TRTCH),(TRTCHMK,DDNAMEK,KEYLENMK,MODEMK,CODEMK,STACKMK,C03428018 PRTSPMK) 19373 03434018 DENT (CYLOFL),(CYLOFLMK,UCSK,DDNAMEK,RESERVMK,FCBK) 20202 03444020 DENT (KEYLEN),(KEYLENMK,CODEMK,MODEMK,PRTSPMK,STACKMK, C03470018 DDNAMEK,TRTCHMK) 19373 03500018 DENT (BUFIN),(BUFINMK,BUFNOMK,BUFRQMK,DDNAMEK) 20002 03510020 DENT (BUFOUT),(BUFOUTMK,BUFNOMK,BUFRQMK,DDNAMEK) 20002 03520020 DENT (BUFMAX),(BUFMAXMK,NCPMK,DDNAMEK) 20002 03530020 DENT (BUFSIZE),(BUFSIZMK,BLKSIZMK,DDNAMEK) 20002 03540020 DENT (PCI),(PCIMK,NTMMK,DDNAMEK) 20002 03550020 DENT (RESERVE),(RESERVMK,RKPMK,UCSK,CYLOFLMK,DDNAMEK) 20002 03560020 DENT (THRESH),(THRESHMK,CPRIMK,DDNAMEK,OUTLIMK) @ZA31145 03570003 DENT (IPLTXID),(IPLTXIDK,DDNAMEK,DSNAMEK,QNAMEK) Y01948 03580001 DENT (HIARCHY),(HIARCHMK,GNCPMK,DDNAMEK) A30036 03600019 DENT (FUNC),(FUNCMK,DDNAMEK) 21088 03650001 DENT (BLKSIZE),(BLKSIZMK,BUFSIZMK),,(ETEND) 20002 03670020 D4LUS DENT (SEP),(SEPMK,AFFMK) 03740000 D4LUA DENT (AFF),(AFFMK,SEPMK),,(ETEND) 03760000 D4LV DENT (REF),(REFMK,SERMK) 03780000 DENT (SER),(SERMK,REFMK,MSVGPK),,(ETEND) @Y30LPSB 03800003 D6LL DENT (EXPDT),(EXPDTMK,RETPDMK) 03820000 DENT (RETPD),(RETPDMK,EXPDTMK),,(ETEND) 03840000 MEND 03860000 EJECT 03880000 MACRO 03900000 &L DENT &A,&B,&C,&D,&E 5TH PARM CONTIN. FOR 2ND PARM @ZA11328 03920003 LCLA &Y,&Z 03940000 LCLC &X 03960000 A&SYSNDX DS 0C 03980000 &L DC AL1(B&SYSNDX-A&SYSNDX) 04000000 &X SETC '=' 04020000 AIF (N'&A LE 1).L1 04040000 &X SETC '&A(2)' 04060000 .L1 ANOP 04080000 DC C'&A(1)&X' 04100000 .L2 ANOP 04120000 &Y SETA &Y+1 04140000 DC AL1(&B(&Y)) 04160000 AIF (&Y LT N'&B).L2 04180000 AIF (N'&E LT 1).L2B IF NO 5TH PARM., PROCESS 3RD @ZA11328 04182003 &Y SETA 0 @ZA11328 04184003 .L2A ANOP @ZA11328 04186003 &Y SETA &Y+1 INCREMENT LOOP CONTROL @ZA11328 04188003 DC AL1(&E(&Y)) @ZA11328 04190003 AIF (&Y LT N'&E).L2A LOOP IF ALL 5TH NOT DONE @ZA11328 04192003 .L2B ANOP @ZA11328 04194003 &Y SETA 128 04200000 .L3 AIF (&Z GE N'&C).L4 04220000 &Z SETA &Z+1 04240000 DC AL1(&Y+&C(&Z)) 04260000 AGO .L3 04280000 .L4 ANOP 04300000 B&SYSNDX DS 0C 04320000 AIF ('&D' EQ '').L5 04340000 DC AL1(ETEND) 04360000 .L5 ANOP 04380000 MEND 04400000 EJECT 04420000 MACRO 04440000 &L JTRT &A,&B,&C,&D 04460000 LCLA &X 04480000 BK EQU 4 BLANK CHARACTER. 04500000 PR EQU 8 PERIOD CHARACTER. 04520000 TT EQU 12 ILLEGAL CHARACTER. 04540000 LP EQU 16 LEFT PAREN CHARACTER. 04560000 PL EQU 20 PLUS CHARACTER. 04580000 AM EQU 24 AMPERSAND CHARACTER. 04600000 AS EQU 28 ASTERICK CHARACTER. 04620000 RP EQU 32 RIGHT PAREN CHARACTER. 04640000 MI EQU 48 MINUS CHARACTER 04660000 SL EQU 52 SLASH CHARACTER 04680000 CO EQU 36 COMMA CHARACTER. 04700000 AP EQU 40 APOST CHARACTER. 04720000 EQ EQU 44 EQUAL CHARACTER. 04740000 AL EQU 0 ALPHA CHARACTER. 04760000 NC EQU 0 NUMERIC CHARACTER. 04780000 &L DC AL1(&A) ILLEGAL. 04800000 DC 255AL1(&A) ILLEGAL. 04820000 ORG &L+C' ' BLANK. 04840000 DC AL1(&B(1)) 04860000 ORG &L+C'.' PERIOD. 04880000 DC AL1(&B(2)) 04900000 ORG &L+C'(' 04920000 DC AL1(&B(3)) 04940000 ORG &L+C'+' PLUS. 04960000 DC AL1(&B(4)) 04980000 ORG &L+C'&&' AMPERSAND. 05000000 DC AL1(&B(5)) 05020000 ORG &L+C'*' ASTERICK. 05040000 DC AL1(&B(6)) 05060000 ORG &L+C')' RIGHT PAREN. 05080000 DC AL1(&B(7)) 05100000 ORG &L+C'-' MINUS. 05120000 DC AL1(&B(8)) 05140000 ORG &L+C'/' SLASH. 05160000 DC AL1(&B(9)) 05180000 ORG &L+C',' COMMA. 05200000 DC AL1(&B(10)) 05220000 ORG &L+C'''' APOST. 05240000 DC AL1(&B(11)) 05260000 ORG &L+C'=' EQUAL. 05280000 DC AL1(&B(12)) 05300000 ORG &L+C'$' ALPHA. 05320000 DC AL1(&C) 05340000 ORG &L+C'#' 05360000 DC AL1(&C) 05380000 ORG &L+C'@' 05400000 DC AL1(&C) 05420000 &X SETA 0 05440000 ORG &L+C'A' ALPHA. 05460000 .L2 ANOP 05480000 &X SETA &X+1 05500000 DC AL1(&C) 05520000 AIF (&X LT 9).L2 05540000 &X SETA 0 05560000 ORG &L+C'J' ALPHA. 05580000 .L3 ANOP 05600000 &X SETA &X+1 05620000 DC AL1(&C) 05640000 AIF (&X LT 9).L3 05660000 &X SETA 0 05680000 ORG &L+C'S' ALPHA. 05700000 .L4 ANOP 05720000 &X SETA &X+1 05740000 DC AL1(&C) 05760000 AIF (&X LT 8).L4 05780000 &X SETA 0 05800000 ORG &L+C'0' NUMERIC. 05820000 .L5 ANOP 05840000 &X SETA &X+1 05860000 DC AL1(&D) 05880000 AIF (&X LT 10).L5 05900000 MEND 05920000 EJECT 05940000 MACRO 05960000 &L SCSW &A,&B,&C 05980000 GBLB &Z 06000000 LCLA &X 06020000 LCLC &Y 06040000 AIF (&Z).T1 06060000 O EQU 1 ONES. 06080000 M EQU 4 MIXED. 06100000 Z EQU 8 ZEROS. 06120000 &Z SETB 1 06140000 .T1 ANOP 06160000 &X SETA K'&B-1 06180000 &Y SETC '&B'(1,&X) 06200000 AIF ('&A' EQ 'C').L1 06220000 AIF ('&A' EQ 'S').L2 06240000 &L TM &B,&Y 06260000 BC &A,&C 06280000 MEXIT 06300000 .L1 ANOP 06320000 &L NI &B,255-&Y 06340000 MEXIT 06360000 .L2 ANOP 06380000 &L OI &B,&Y 06400000 MEND 06420000 EJECT 06440000 IEFQMNGR 06460000 EJECT 19874 06466019 IEFVKEYS 19874 06472019 EJECT 06480000 WORKAREA DSECT Y02668 06520802 USING WORKAREA,R7 Y02668 06521202 WKTTR DS CL4 POINTER TO NEXT RECORD Y02668 06521602 WKQMPAPT DS CL4 ADDRESS OF QMPA Y02668 06522002 WKRECORD DS CL168 COMPRESSED RECORD Y02668 06522402 WKPTR1 DS CL4 POINTER TO ITSELF Y02668 06522802 WKCT DS CL1 NUMBER OF ENTRIES MADE IN Y02668 06523202 WKPTR2 DS CL3 HOLDER FOR TTR ASSIGNED FRY02668 06523602 * THE QUEUE MANAGER Y02668 06524002 WKPROCN1 DS CL8 PROCEDURE NAME Y02668 06524402 WKTTR1 DS CL3 TTR OF FIRST RECORD Y02668 06524802 WKPROCN2 DS CL8 PROCEDURE NAME Y02668 06525202 WKTTR2 DS CL3 TTR OF FIRST RECORD Y02668 06525602 WKPROCN3 DS CL8 PROCEDURE NAME Y02668 06526002 WKTTR3 DS CL3 TTR OF FIRST RECORD Y02668 06526402 WKPROCN4 DS CL8 PROCEDURE NAME Y02668 06526802 WKTTR4 DS CL3 TTR OF FIRST RECORD Y02668 06527202 WKPROCN5 DS CL8 PROCEDURE NAME Y02668 06527602 WKTTR5 DS CL3 TTR OF FIRST RECORD Y02668 06528002 WKPROCN6 DS CL8 PROCEDURE NAME Y02668 06528402 WKTTR6 DS CL3 TTR OF FIRST RECORD Y02668 06528802 WKPROCN7 DS CL8 PROCEDURE NAME Y02668 06529202 WKTTR7 DS CL3 TTR OF FIRST RECORD Y02668 06529602 WKPROCN8 DS CL8 PROCEDURE NAME Y02668 06530002 WKTTR8 DS CL3 TTR OF FIRST RECORD Y02668 06530402 WKPROCN9 DS CL8 PROCEDURE NAME Y02668 06530802 WKTTR9 DS CL3 TTR OF FIRST RECORD Y02668 06531202 WKPROCNA DS CL8 PROCEDURE NAME Y02668 06531602 WKTTRA DS CL3 TTR OF FIRST RECORD Y02668 06532002 WKPROCNB DS CL8 PROCEDURE NAME Y02668 06532402 WKTTRB DS CL3 TTR OF FIRST RECORD Y02668 06532802 WKPROCNC DS CL8 PROCEDURE NAME Y02668 06533202 WKTTRC DS CL3 TTR OF FIRST RECORD Y02668 06533602 WKPROCND DS CL8 PROCEDURE NAME Y02668 06534002 WKTTRD DS CL3 TTR OF FIRST RECORD Y02668 06534402 WKPROCNE DS CL8 PROCEDURE NAME Y02668 06534802 WKTTRE DS CL3 TTR OF FIRST RECORD Y02668 06535202 WKPROCNF DS CL8 PROCEDURE NAME Y02668 06535602 WKTTRF DS CL3 TTR OF FIRST RECORD Y02668 06536002 EJECT 06536102 NEL DSECT 06537102 IEFNEL SUBCOM=C 06538102 EJECT 06540000 IEFCOMWA Y02668 06560002 IEFCVRWA 06570002 EJECT 06580000 IEFVMSWA 06600000 CVT DSECT 06603001 CVT 06606001 EJECT 06609001 IEFJMR 06612001 EJECT 06612502 IEFTXTFT 06613002 EJECT 06620000 IEFJSSOB (CI) @G29AN2E 06625003 EJECT @G29AN2E 06630003 IEFJSSIB @G29AN2E 06635003 EJECT @G29AN2E 06640003 IEFJESCT @G29AN2E 06645003 EJECT @G29AN2E 06650003 IHASUBIT @G29AN2E 06655003 EJECT @G29AN2E 06660003 IEFVFA CSECT 06670020 *C209181 @ZA01934 06670203 *A209182,210410-210720 @ZA01934 06670403 *C258484 @ZA01931 06670703 * ADDED CODE NEAR LABEL PRR0 @ZA10120 06670803 * ADDED MACRO CODE FOR PROPER ASSEMBLY @ZA11328 06670903 * ADDED CODE AFTER LABELS AOFECHCK AOFDERR3 @ZA13367 06671303 * ADDED STMTS NEAR LABEL FA9 AND BKR3 @ZA12458 06671403 * CHANGED MVC TO OC WHEN DDNAME= KEY FOUND AFTER LABEL EQRF @ZA13371 06671503 * CHANGED BNE TO BL NEAR LABEL AOFACC5 @ZA13424 06671603 * MOVE OI INSTRUCTION FROM COMMA ROUTINE TO EQUAL ROUTINE @ZA14268 06671803 * CHANGE COMMENT IN MIR ROUTINE @ZA14268 06672003 * ADDED CODE AFTER LABEL FAFF1 @ZA13844 06672103 * ADDED CODE AFTER LABEL E3 @ZA15003 06672203 * SU32 RACF PROTECT SUPPORT @G32HPPJ 06672303 * DELETED 3 INSTRUCTIONS AFTER LABEL T102 @ZA16422 06672403 * CHANGED CODE IN PERIOD ROUTINE @ZA20640 06672503 * CHANGED DENT MACRO FOR QNAME @ZA24749 06672603 * CHANGED AND ADDED CODE AFTER LABEL E3 @ZA25564 06672703 * ADDED CODE BEFORE AND AFTER LABEL FA32 @ZA26148 06672903 * MERGE SU4,10,16 CODE TO RELEASE 037 PTF @ZA27753 06673203 * CHANGED DENT MACRO FOR OUTLIM,CPRI AND THRESH @ZA31145 06673303 * ADDED PARAMETERS TO THE DENT MACRO INVOCATIONS FOR OUTLIM, @ZA31145 06673403 * THRESH, AND CPRI TO MAKE THEM MUTUALLY EXCLUSIVE WITH EACH @ZA31145 06673503 * OTHER @ZA31145 06673603 * ERROR MESSAGE CODES - Y02668 06673703 ERMSG601 EQU X'01' IEF601I-INVALID STMT IN PROC. Y02668 06673803 ERMSG612 EQU X'0C' IEF612I - PROCEDURE NOT FOUND.Y02668 06673903 ERMSG613 EQU X'0D' IEF613I - PROC WITHIN A PROC. Y02668 06674003 ERMSG614 EQU X'0E' IEF614I - I/O ERR SEARCHING Y02668*06674903 FOR PROC. Y02668 06675002 ERMSG632 EQU X'20' IEF632I - FORMAT ERR - 'PGM'. Y02668 06676002 ERMSG639 EQU X'27' IEF639I-INVALID CLASS DESIG. YM01546 06676502 ERMSG609 EQU X'09' IEF609I - INVALID O'RIDE KEYWDY02668 06677002 ERMSG640 EQU X'28' IEF640I - EXCESS # POS PARAM YM03459 06677302 ERMSG641 EQU X'29' IEF641I - IMPROPER SUBP LST @G29AN2E 06677403 ERMSG642 EQU X'2A' IEF642I - EXCESSIVE PARM LTH YM03459 06677602 ERMSG646 EQU X'2E' IEF646I - REQ'D POSIT PARM MISSING 06677703 * @ZA13367 06677803 ERMSG647 EQU X'2F' IEF647I - NON-ALPHA 1ST CHAR. Y02668 06678002 ERMSG744 EQU X'4C' IEF744I - SUBSYS. NOT SPEC. @G29AN2E 06678103 ERMSG748 EQU X'4D' IEF748I - SUBSYS. NAME INV. @G29AN2E 06678203 ERMSG749 EQU X'4E' IEF749I - BUFFER CAPACITY EX@G29AN2E 06678303 ERMSG750 EQU X'4F' IEF750I - SYSTEM ERROR @G29AN2E 06678403 ERWTO417 EQU X'02' PROCLIB DEVICE I/O ERROR Y02668 06678502 INSTPROC EQU X'80' PROCESSING INSTREAM PROC BIT. Y02668 06679002 AOMSLONE EQU C'1' MSGLEVEL CODE 1. Y02668 06680002 AOMSLTWO EQU C'2' MSGLEVEL CODE 2. Y02668 06690002 DISPLID EQU 7 DISPLACEMENT OF BLOCK ID IN Y02621 06692002 * SWA QMPA REMOTE LIST. Y02621 06694002 SYMBUFID EQU X'25' ID OF SYMBUF BLOCKS IN SWA Y02621 06696002 TXTBUFID EQU X'25' ID OF TEXTBUF BLOCKS IN SWA Y02621 06698002 ENDLISTK EQU X'00' Y02668 06700002 D12 EQU 12 I272 06726101 LAST EQU X'80' TO TURN HI-ORDER BIT ON I272 06727401 SWAWTOFF EQU X'7F' TO TURN OFF AOSWAWRT @ZA05366 06727503 VFA4 EQU 4 COUNT OF FOUR Y02621 06727803 NOKEY EQU X'00' NO SECONDARY MSG @G29AN2E 06728103 OFFNUM EQU 1 OFFSET TO NUM BYTE @G29AN2E 06728403 OFFLEN EQU 2 OFFSET TO LENGTH BYTE @G29AN2E 06728703 OFFSSNM EQU 3 OFFSET TO SSNAME @G29AN2E 06729003 TWLVZERO EQU X'C0' 12/0 MULTIPUNCH @G29AN2E 06729303 M745OO EQU 0 OFFSET TO MSG IEF745I @G29AN2E 06729603 M745OL EQU 2 OFFSET TO LEN FOR IEF745I @G29AN2E 06729903 M746OO EQU 4 OFFSET TO MSG IEF746I @G29AN2E 06730203 M746OL EQU 6 OFFSET TO LEN FOR IEF746I @G29AN2E 06730503 M747OO EQU 8 OFFSET TO MSG IEF747I @G29AN2E 06730803 M747OL EQU 10 OFFSET TO LEN FOR IEF747I @G29AN2E 06731103 L3 EQU 3 LENGTH 3 @G29AN2E 06731403 AOLEN EQU 8 OFFSET TO LENGTH AREA @G29AN2E 06731703 AOTXT EQU 10 OFFSET TO TEXT AREA @G29AN2E 06732003 AOTXT1 EQU 11 OFFSET TO TEXT AREA +1 @G29AN2E 06732303 SSNAMEL EQU 4 MAX LENGTH OF SSNAME @G29AN2E 06732603 AOSSNM EQU 28 OFFSET TO SSNAME AREA @G29AN2E 06732903 EXTRN VGM90TXT @G29AN2E 06733203 EXTRN VGM90MOT @G29AN2E 06733503 SPACE 1 Y0266 06733803 BALR RB,0 BASE FOR SCAN CODE. Y02668 06735802 USING *,RB,RA ESTABLISH ADDRESSABILITY. Y02668 06737802 VFA01 DS 0H AADA 06740018 *****************************************************************Y02668 06742002 * MODULE TRACE CODE - FOR TESTING. Y02668 06744002 L RF,TRACEV LOAD TRACE RTNE ADDR. Y02668 06746002 BALR RE,RF ENTER MOD ID IN TRACE RECORD. Y02668 06748002 TRACEV DC V(TRACE) TRACE RTNE ADDR. Y02668 06750002 DC C'VFA ' MOD ID USED BY TRACE. Y02668 06752002 * TRACE RETURNS HERE. Y02668 06754002 *****************************************************************Y02668 06756002 B FA1 TRANSFER. 06760000 VFA02 DC A(VFA01+4096) SECOND BASE AADA 06770018 MODID BRANCH=NO Y02668 06820002 * DC C'SU32' FUNCTION ID @G32HPPJ 06830003 * DC C'01' LEVEL # (PROTECT) @G32HPPJ 06833003 * DC C'02' REMOVE UNNEEDED INSTRUCTIONS IN @ZA16422 06836003 * PAREN ROUTINE @ZA16422 06839003 * DC C'03' EQUAL FOLLOWED BY PERIOD SHOULD BE @ZA20640 06842003 * AN ERROR @ZA20640 06845003 * DC C'04' QNAME MUTUAL EXCLUSIVITY FIX @ZA24749 06848003 * DC C'05' DO NOT CLEAR SYMBUF IF ERROR ON EXEC 06851003 * STATEMENT WITHIN A PROC. @ZA25564 06854003 * (REMOVES PART OF ZA15003) @ZA25564 06857003 * DC C'06' JCL ERROR IF NON-ALPHA CHAR IN NAME 06860003 * WITH EMBEDDED PERIOD @ZA26148 06861003 * DC C'07' MERGE SU4,10,16 CODE TO 037 PTF @ZA27753 06862003 DC C'08' OUTLIM,THRESH & CPRI MUTUAL EXCLUSIVE FIX@ZA31145 06862503 * 06866003 EJECT 06869003 * ********************************************************** 06880000 * * * 06900000 * * ENTERED FROM INTERP CONTROL RTNS. INITIALIZES * 06920000 * * POINTERS, CHECKS COL 72 FOR NONBLANK CHARACTER. * 06940000 * * * 06960000 * ********************************************************** 06980000 FA1 DS 0H START OF SCAN. 07000000 L R8,CTRLWAP LOCAL WORK AREA POINTER 07020000 ST RA,DELPTR RA IS PTR TO 'RSTMT' OR AADA 07020318 * 'PSTMT' IN IWA. AADA 07020618 * SAVE RA IN LOCAL WORK AREA AADA 07020918 * TO FREE IT FOR USE AS BASE. AADA 07021218 L RA,VFA02 LOAD BASE. AADA 07021518 MVI DLMFBYTE,INITVAL INITIALIZE THE DELIMITER FUNC- 7821 07022017 * TION BYTE. X'7F' IS NOT EQUAL 7821 07024017 * TO ANY OF THE FUNCTION BYTE 7821 07026017 * VALUES IN THE TRT TABLE USED BY 7821 07028017 * THE FB1 ROUTINE. NOTE THAT THE 7821 07030017 * HIGH ORDER BIT OR EQUAL SIGN 7821 07032017 * DELIMITER(EQDELSW) IS TURNED 7821 07034017 * OFF ALSO. 7821 07036017 ST R9,CBEGP SAVE POINTER TO START OF CARD AREA. 07120000 LR R7,R9 SAVE POINTER. 07140000 LA R7,SVO(R7) COMPUTE CARD COLUMN 72. 07160000 MVC FAWA1(1),0(R7) SAVE PUNCH IN COL 72 07180000 SCSW C,COLSTY ZERO COLUMN 72 SW. 07200000 SCSW O,CXPNZ,FA3 TRANSFER CONTIN NOT RCVD 07220000 CLI 0(R7),C' ' IS COLUMN 72 BLANK. 07240000 BC EQUAL,FA3 YES TRANSFER. 07260000 SCSW S,COLSTY NO SET COLUMN 72 SW ON. 07280000 MVI 0(R7),C' ' BLANK COL 72 07300000 FA3 DS 0H ENTRY. 07320000 * ********************************************************** 07340000 * * * 07360000 * * TRANSFER TO PREPARE FOR CONTINUE OF SCAN IF CON- * 07380000 * * TINUATION OF PRECEDING CARD IS EXPECTED. OTHER- * 07400000 * * WISE ZERO LOCAL SWITCHES. TRANSFER TO SCAN IF * 07420000 * * CARD IS FROM PROC AND IS TO BE OVERRIDDEN, IF NOT * 07440000 * * FROM PROC ETC, CLEAR DUPLICATE TABLE (DUPTB), AND * 07460000 * * PROCESS THIS CARD. * 07480000 * * * 07500000 * ********************************************************** 07520000 ST R7,CENDP SAVE END POINTER FOR LENGTH. 07540000 L R7,AFB7 ADDRESS OF TRANSLATE TABLE 07544000 ST R7,FATRP SAVE FOR SYMBOLIC PARAM RTN 07548000 LA R7,E1 ADDRESS OF SCAN ERROR RTN 07552000 ST R7,FERRP SAVE FOR SYMBOLIC PARAMETER RTN 07556000 MVI INTBUF,0 ZERO LENGTH OF INTERMEDIATE BUFFER 07560000 SR R7,R7 07564000 ST R7,INTBUF-ITBMSGL CLEAR TTR FIELD OF BUFFER 07568000 * USED BY INTBUF (INTBUF EQUATE) 07572000 L RF,DELPTR GET PTR SAVED ON ENTRY TO AADA 07582018 * THIS ROUTINE. AADA 07588018 IC R7,LISTPTR(RF) GET OFFSET TO OPERANDS AADA 07594018 BCTR R7,R0 DECREMENT OFF SET BY ONE. 07600000 AR R7,R9 COMPUTE STRING POINTER. 07620000 ST R7,CSTRP SAVE STRING POINTER. 07640000 MVC MSGKEY(1),FAWA2 GET MOST RECENT KEY FOR AACA 07646017 * SECONDARY MESSAGE AACA 07652017 SCSW O,CXPZ,FA9 TRANSFER CONT EXP SW ON. 07660000 SCSW C,CLEARSWW ZERO SWITCHES. 07680000 NI SWY2,255-KEYNXTSW CLEAR SW FOR NO MORE POSITIONAL M0297 07681020 TM DDOVZ,DDOV IS IT OVERRIDDEN PROCEDURE M0297 07682020 BO FA3001 YES, NO NEED FOR NEW PREFIX. Y02668 07683002 * NOT CONTINUTATION AND NOT OVERRIDE - START OF NEW TEXT STRING. Y02668 07685302 BAL RE,AOPX CREATE TEXT STRING PREFIX. Y02668 07685602 FA3001 DS 0H M0297 07686020 NI ENDKYSWP,255-ENDKYSW TURN OFF SWITCH M0482 07692020 CLI VERB(RF),4 IS VERB DD AADA 07700018 BNE FA3B NO THEN TRANSFER 20033 07710020 * 07721000 * IF THE OPERAND FIELD BEGINS WITH A SYMBOLIC PARAMETER 07722000 * GO TO IEFVFB TO BUILD TEXT IN INTBUF. (IF FIRST SYMBOLIC 07723000 * IS DUMMY IT WILL BE CHANGED TO A KEYWORD, DUMM=). 07724000 * 07725000 SPACE 07725217 OC SYMTTR(VFA4),SYMTTR DOES SYMBUF HAVE A TTR? Y02621 07725402 BZ FA3002 NO - THEREFOR.NO SYMBOLICS Y02621 07725602 SPACE 07725817 CLI 1(R7),C'&&' IS FIRST CHAR = AMPERSAND 07726000 BNE FA3002 NO - TRANSFER, NO SYMBOLIC 07727000 NI AMPSWZ,255-AMPSW TURN OFF SYMBOLIC BIT A27310 07727519 LA R1,1(R7) YES- GET PTR TO AMPERSAND 07728000 XC SYMBUF(VFA4),SYMBUF INDICATE NO TTR IN SYMBUF Y02621 07728502 ST R1,CBSYP POINTER FOR SYMBOLIC PARAM RTN 07729000 L RF,FIEFVFB GET SYMBOLIC PARAM RTN 07730000 BALR RE,RF GO TO SYMBOLIC PARAM RTN 07731000 L R7,CSTRP RESTORE REGISTER 07732000 FA3002 DS 0H 07733000 L R1,TEXTBUFP ADDR OF TEXT STRING. Y02668 07735002 USING TEXT,R1 PREFIX ADDRESSABILITY. Y02668 07737002 CLC FAI(5),1(R7) IS OPERAND DUMMY 07740000 BC NOT-EQUAL,FA3A NO - CONTINUE 07760000 OI STRDINDC,DTXDUMMY INDICATE DUMMY DD FOR IEFVDA. Y02668 07774002 MVI 5(R7),C'=' YES - MAKE DUMMY A KEYWORD 07780000 FA3A DS 0H 07800000 CLC FAJ(5),1(R7) IS OPERAND DYNAM 20033 07803020 BC NOT-EQUAL,FA3B NO CONTINUE 20033 07806020 SCSW Z,DDOVZ,FA3A01 TRANSFER NOT O'RIDDEN PROC @ZA04797 07806603 SCSW S,FLUSHSWW FLUSH DYNAM IF PROC O'RIDE @ZA04797 07807003 B FA3B BYPASS DYNAM @ZA04797 07807803 FA3A01 DS 0H @ZA04797 07808203 OI STRDINDC,DTXDYNAM SET DYNAM BIT. Y02668 07809002 DROP R1 Y02668 07810002 MVI 5(R7),C'=' YES MAKE IT A KEYWORD 20033 07812020 FA3B DS 0H 20033 07815020 SCSW Z,DDOVZ,FA31 TRANSFER NOT OVERRIDDEN PROC 07820000 SCSW Z,PROCERRZ,FA91 TRANSFER NO ERROR THIS STATEMENT 07840000 SCSW S,CMTZ YES- SET COMMENT SW 07860000 SCSW S,FERRORA - SET DD ERROR 07880000 B FAC 07900000 FA31 DS 0H ENTRY NO OVERRIDE 07920000 OI LPBYSWZ,LPBYSW INITIALIZE TO ON AACA 07926017 * ( LEFT PAREN CHECK NOT AACA 07932017 * MADE FOR VERB KEYS ) AACA 07938017 SCSW C,CLEARVZ ZERO SWITCHES 07944018 SCSW C,PROCSWZ CLEAR EXEC PROC INDICATOR 07950000 CLI INTBUF,0 IS TEXT IN INTBUF 07952000 BNE FA3102 YES - TRANSFER 07954000 XC SYMBUF(VFA4),SYMBUF INDICATE NO TTR IN SYMBUF Y02621 07956002 * BY ZEROING TTR FIELD IN SYMBOLIC BUFFER Y02621 07957002 FA3102 DS 0H 07958000 XC DUPTAB(L'KEYTAB+L'DUPTAB),DUPTAB INITIALIZE YM02705 07976002 * THE DUPTAB AND KEYTAB TABLES. YM02705 07986002 SR R7,R7 CLEAR REGISTER. 08000000 STH R7,CURLE ZERO CURRENT LEVEL. 08020000 STH R7,LASLE ZERO LAST LEVEL. 08040000 L R6,TBEGP GET TEXT BEGIN POINTER. 08060000 ST R6,TKEYP SET TEXT KEY POINTER. 08120000 ST R6,TLENP INITIALIZE WITH KEY ADDR. KEY Y02668*08126002 RTNE (K1) MAKES IT COME OUT OKY02668 08132002 LA R6,1(R6) BUMP BY ONE TO INIT. 08140000 ST R6,TNUMP SET TEXT NUMBER POINTER. 08160000 LA R6,1(R6) BUMP BY ONE TO INIT. 08180000 STC R7,0(R6) ZERO TLENP BYTE. 08200000 LA R6,2(R9) BUMP CHAR BEG POINTER. 08240000 L RF,DELPTR GET PTR SAVED ON ENTRY AADA 08250018 IC R7,NAMEL(RF) AADA 08260018 LA R5,0(R7,R6) COMPUTE CHARACTER END SYMBOL POINTER. 08280000 ST R5,CESYP SAVE POINTER. 08300000 * ********************************************************** 08320000 * * * 08340000 * * EXAMINE LABEL AND SET POINTER (CBSYP) AS FOLLOWS: * 08360000 * * * 08380000 * * CARD IMAGE=// - CBSYP POINTS TO COL. 3 * 08400000 * * =//A - CHAR 'A' * 08420000 * * =//A.B - CHAR 'B' * 08440000 * * * 08460000 * ********************************************************** 08480000 CLI 0(R6),C'A' IS 1ST CHAR ALPHA-NUMERIC @ZA26148 08486003 BC LOW,FA32B NO,CHECK OTHER VALID CHARS @ZA26148 08490003 FA32 DS 0H FOR LOOP. 08500000 CLI 0(R6),C'.' IS CHARACTER PERIOD. 08520000 BNE FA32A NO,CONTINUE 22553 08524018 SCSW C,VERBSWY CLEAR VERB SWITCHES 22553 08528018 TM VERB(RF),4 IS VERB 'DD' A27940 08530019 BNO FA33 NO, INCLUDE PERIOD IN LABEL A27940 08532019 B FA34 YES,PROCESS LABEL AFTER '.' A27940 08534019 FA32A CLI 0(R6),C' ' IS CHARACTER BLANK. 22553 08556018 BC EQUAL,FA33 YES TRANSFER. 08580000 LA R6,1(R6) NO BUMP POINTER. 08600000 B FA32 TRANSFER BACK. 08620000 FA32B CLI 0(R6),C' ' NAME FIELD BLANK? @ZA26148 08626003 BE FA32 YES,CONTINUE @ZA26148 08627003 CLI 0(R6),C'$' NATIONAL CHARACTER? @ZA26148 08628003 BE FA32 YES,OK @ZA26148 08629003 CLI 0(R6),C'#' NATIONAL CHARACTER? @ZA26148 08630003 BE FA32 YES,OK @ZA26148 08631003 CLI 0(R6),C'@' NATIONAL CHARACTER? @ZA26148 08632003 BE FA32 YES,OK @ZA26148 08633003 LA R2,ERMSG647 NON-ALPHA 1ST CHAR OF NAME @ZA26148 08634003 B E1 BRANCH TO ERROR ROUTINE @ZA26148 08635003 FA33 DS 0H ENTER. 08640000 LA R6,1(R9) RESTORE POINTER BEFORE LABEL. 08660000 * ********************************************************** 08680000 * * * 08700000 * * IDENTIFY VERB AND SET APPROPRIATE SWITCH. * 08720000 * * * 08740000 * ********************************************************** 08760000 FA34 DS 0H ENTER. 08780000 LA R6,1(R6) BUMP POINTER TO 1ST CHARACTER LABEL. 08800000 ST R6,CBSYP SAVE CHARACTER BEGIN SYM POINTER. 08820000 SCSW C,VERBSWY CLEAR VERB SWITCHES. 08840000 CLI VERB(RF),X'08' IS THIS PROC VERB AADA 08856018 BE FA402 YES- GO PROCESS AS EXEC AADA 08864018 CLI VERB(RF),2 NO - COMPARE TO CODE FOR EXEC 08872018 BC HIGH,FA5 TRANSFER DD CARD. 08880000 BC EQUAL,FA4 TRANSFER EXEC CARD. 08900000 SCSW S,JOBSWY SET JOB CARD SWITCH. 08920000 MVI IWAJMSGL,AOMSGLV1 INITIALIZE TO MSGLEVEL=1 TO YM06865*08925002 PRINT COMMENT CARDS BETWEEN YM06865*08930002 JOB CARD CONTINUATIONS. YM06865 08935002 LA R7,JOBK GET JOB KEY. 08940000 B FA6 TRANSFER. 08960000 FA402 DS 0H 08966000 SCSW S,VERBCSWZ INDICATE A PROC VERB 08972000 FA4 DS 0H ENTRY FOR EXEC CARD. 08980000 SCSW S,EXECSWY SET EXEC CARD SWITCH. 09000000 NI AOSW2,255-AOPROCNM CLEAR POSITIONAL PROCNM SW. Y02668 09000102 L R7,TEXTBUFP TEXT STRING ADDRESS. YM00379 09000202 USING TEXT,R7 TEXT PREFIX ADDRESSABILITY. YM00379 09000402 TM SWH,CPSYSFLG CHECKPT/RESTART EXEC? YM00379 09000602 BZ FA406 BRANCH NO. YM00379 09000802 OI STREINDC,ETXCPFLG SET C/R FLAG IN PREFIX. Y02668 09001002 NI SWH,255-CPSYSFLG CLEAR C/R EXEC FLAG. YM00371 09001102 FA406 DS 0H Y02668 09001402 TM SWE,PROC EXEC READ FROM PROC? Y02668 09002002 BZ FA404 BRANCH NO. Y02668 09004002 OI STREINDC,ETXPROC SET PROC BIT IN PREFIX. Y02668 09010002 DROP R7 Y02668 09012002 FA404 DS 0H Y02668 09014002 TM SWE,PREF IS THIS PROC END OF FILE ? YA02705 09015002 BZ FA408 NO - DO NOT RESET PROC SW YA02705 09016002 NI SWE,255-PROC-GPI-PREF-PRCV-CONCAT-POVRD-POVRX-SEQUENCE 09017002 * EXEC ENCOUNTERED NOT FROM PROC CLEAR PROC SWITCH YA02705 09018002 XC SYMTTR(VFA4),SYMTTR CLEAR BUFFER FOR NEXT PROC YM02713 09018502 NI AOSW2,SWAWTOFF CLEAR INDICATOR FOR IEFVHA @ZA05366 09018703 FA408 DS 0H YM02705 09019002 LA R7,EXECK GET EXEC KEY. 09020000 B FA6 TRANSFER. 09040000 FA5 DS 0H ENTRY FOR DD CARD. 09060000 SCSW S,DDSWY SET DD CARD SWITCH. 09080000 LA R7,DDK GET DD KEY. 09100000 * ********************************************************** 09120000 * * * 09140000 * * PUT VERB KEY INTO TEXT BUFFER, TRANSLATE LABEL * 09160000 * * FOR VALIDITY, AND PUT LABEL IN TEXT BUFFER. * 09180000 * * * 09200000 * ********************************************************** 09220000 FA6 DS 0H ENTRY. 09240000 BAL R9,K1 PUT KEY IN TEXT. 09260000 SCSW Z,VERBCSWZ,FA60 TRANSFER NOT PROC VERB 09265000 MVI MSGKEY,PSECMSG PROC SECONDARY MSG CODE 19874 09270019 FA60 DS 0H 09275000 L R1,CBSYP GET BEGIN SYMBOL POINTER FOR LABEL. 09280000 SR R2,R2 CLEAR REGISTER. 09300000 L R3,AFB7 GET ADDRESS OF TRANSLATE TABLE. 09320000 L R5,CESYP GET END SYMBOL POINTER FOR LABEL. 09340000 SR R5,R1 COMPUTE LENGTH OF LABEL. 09360000 EX R5,FB6 EXECUTE TRANSLATE. 09380000 BC 13,FA61 IS LAST FUNCTION BYTE NONZERO. 09400000 LA R1,4 YES LOAD REGISTER WITH FOUR. 09420000 CLR R1,R2 IS DELIMITER A BLANK. 09440000 BC EQUAL,FA62 YES TRANSFER. 09460000 FA61 DS 0H ENTRY FOR ERROR. 09480000 LA R2,ERMES4 GET ERROR NUMBER. 09500000 B E1 GO TO ERROR ROUTINE. 09520000 FA62 DS 0H ENTER. 09540000 SCSW S,LDLX SET SWITCH FOR SUBLIST. 09560000 BAL R7,T1 PUT LABEL IN TEXT. 09580000 * ********************************************************** 09600000 * * * 09620000 * * TRANSFER TO BEGIN SCAN IF JOB OR EXEC CARD * 09640000 * * * 09660000 * ********************************************************** 09680000 SCSW Z,DDSWY,FA91 TRANSFER FOR JOB OR EXEC CARD. 09700000 L R7,TKEYP LOAD POINTER TO DD KEY IN TEXT.Y02113 09701002 LA R7,2(R7) ADD 2 TO POINT TO NAME LENGTH. Y02113 09702002 CLI 0(R7),STPCTLEN IS LENGTH OF NAME 7? Y02113 09703002 BNE FA63 NO,CANNOT BE STEPCAT DD CARD. Y02113 09704002 LA R7,1(R7) ADD 1 TO POINT TO NAME ITSELF. Y02113 09705002 CLC 0(7,R7),STEPCATN IS THE NAME STEPCAT? Y02113 09706002 BNE FA63 NO,CONTINUE NORMAL DD PROCESS. Y02113 09707002 LA R7,WAEXCPFX YES,ADDRESS OF EXEC CARD PREFIX Y02113 09708002 USING TEXT,R7 09709002 OI STREINDC,ETXSTPCT INDICATE STEP HAS STEPCAT DD. Y02668 09710002 DROP R7 09712002 FA63 DS 0H Y02113 09713002 L R7,CSTRP GET CHARACTER STRING POINTER. 09720000 CLI 1(R7),C'*' IS THIS DD* AABA 09730016 BE FA7 YES- GO PROCESS DD* AABA 09740016 CLC 1(4,R7),FAG NO - CHECK FOR DD DATA AABA 09750016 BNE FA91 TRANSFER NOT * OR DATA AABA 09760016 LA R7,3(R7) ADJUST R7 FOR THE COMPARE BELOW AABA 09780016 FA7 DS 0H AABA 09790016 CLI 2(R7),C' ' DELIMITER A BLANK? Y02668 09796002 BE FA701 BRANCH YES. Y02668 09800002 CLI 2(R7),C',' DELIMITER A COMMA? Y02668 09804002 BNE FA91 BR TO TRANSLATE. ERROR, BUT Y02668*09808002 WILL BE CAUGHT FURTHER ON. Y02668 09812002 * DD */DATA STATEMENT. Y02668 09816002 FA701 DS 0H Y02668 09820002 TM SWE,GPI PROC INPUT SWITCH ON? Y02668 09824002 BZ FA702 BRANCH NO TO CONTINUE SCAN. Y02668 09828002 * DD */DATA FOUND IN PROCEDURE - ERROR. Y02668 09832002 LA R2,ERMSG601 LOAD MESSAGE CODE. Y02668 09836002 B E1 BRANCH TO ERROR ROUTINE. Y02668 09840002 FA702 DS 0H Y02668 09844002 L R1,TEXTBUFP TEXT STRING ADDRESS. Y02668 09848002 USING TEXT,R1 PREFIX ADDRESSABILITY. Y02668 09852002 OI STRDINDC,DTXSYSIN SET SYSIN BIT. Y02668 09856002 DROP R1 Y02668 09860002 MVC DUPTAB(EDASTAB-DASTAB),DASTAB SET BITS IN DUPTAB AABA 09880016 * FOR ALL KEYWORDS AABA 09890016 * MUTUALLY EXCLUSIVE AABA 09900016 * WITH DD* OR DATA. AABA 09910016 B FA91 AABA 09920016 * AABA 09930016 EJECT 09935002 DASTAB DS 0H AABA 09940016 * DASTAB IS A TABLE OF BITS USED TO REPLACE THE DD AABA 09950016 * KEYWORD ENTIRES IN THE DUPLICATE TABLE. EACH BIT AABA 09960016 * CORRESPONDS TO HEX VALUE FOR A KEYWORD AS ASSIGNED AABA 09970016 * IN THE IEFVKEYS MACRO. THOSE BITS CORRESPONDING TO AABA 09980016 * KEYWORDS PERMITTED ON DD* STATEMENTS ARE SET TO ZERO. AABA 09990016 * THOSE MUTUALLY EXCLUSIVE WITH DD* ARE SET TO ONE. AABA 10000016 * AABA 10010016 SPACE 10020016 * KEYS KEYWORDS ALLOWED ON DD* AABA 10030016 * ----- -------- ------- -- --- AABA 10040016 SPACE 10050016 * 00-07 ************************** AABA 10060016 DC BL1'11111111' AABA 10070016 SPACE 10080016 * 08-0F ************************** AABA 10090016 DC BL1'11111111' 19874 10100019 SPACE 10110016 * 10-17 ************************** AABA 10120016 DC BL1'11111111' AABA 10130016 SPACE 10140016 * 18-1F ************************** AABA 10150016 DC BL1'11111111' AABA 10160016 SPACE 10170016 * 20-27 ************************** AABA 10180016 DC BL1'10111111' DSID @Y30OPSB 10190003 SPACE 10200016 * 28-2F ************************** AABA 10210016 DC BL1'11101111' DLM YM02719 10220002 SPACE 10230016 * 30-37 10240016 DC BL1'11111111' AABA 10250016 SPACE 10260016 * 38-3F 10270016 DC BL1'11111111' AABA 10280016 * 40-47 ************ 19874 10280719 DC BL1'01101111' DCB,VOL @Y30OPSB 10281403 * 48-4F ************ 19874 10282119 DC BL1'11111110' SER @Y30OPSB 10282803 * 50-57 ************ 19874 10283519 DC BL1'11111010' BLKSIZE,BUFNO 19874 10284219 * 58-5F ************ 19874 10284919 DC BL1'11111111' 19874 10285619 * 60-67 ************ 19874 10286319 DC BL1'11101111' LRECL @Y30OPSB 10287003 * 68-6F ************ 19874 10287719 DC BL1'11111111' 19874 10288419 SPACE 10290016 EDASTAB DS 0H END OF TABLE AABA 10300016 EJECT YM02719 10310002 DASTAB1 DS 0H YM02719 10316002 * DASTAB1 TABLE IS A BIT MASK REPRESENTING THE YM02719 10322002 * MUTUALLY EXCLUSIVE BIT SETTINGS IN DUPTAB FOR YM02719 10328002 * THE DDNAME KEYWORD. YM02719 10334002 * YM02719 10340002 * KEYS KEYWORDS ALLOWED ON DDNAME YM02719 10346002 * YM02719 10352002 * 00-07 YM02719 10358002 DC BL1'11111111' YM02719 10364002 * 08-0F YM02719 10370002 DC BL1'11111111' YM02719 10376002 * 10-17 YM02719 10382002 DC BL1'11111111' YM02719 10388002 * 18-1F YM02719 10394002 DC BL1'11111111' YM02719 10400002 * 20-27 YM02719 10406002 DC BL1'11111111' YM02719 10412002 * 28-2F YM02719 10418002 DC BL1'11011111' DIAGNS YM02719 10424002 * 30-37 YM02719 10430002 DC BL1'11111111' YM02719 10436002 * 38-3F YM02719 10442002 DC BL1'11111111' YM02719 10448002 * 40-47 YM02719 10454002 DC BL1'01111111' DCB YM02719 10460002 * 48-4F YM02719 10466002 DC BL1'11111111' YM02719 10472002 * 50-57 YM02719 10478002 DC BL1'11111010' BLKSIZE,BUFNO YM02719 10484002 * 58-5F YM02719 10490002 DC BL1'11111111' YM02719 10496002 * 60-67 YM02719 10502002 DC BL1'11111111' YM02719 10508002 * 68-6F YM02719 10514002 DC BL1'11111111' YM02719 10520002 SPACE 1 YM02719 10526002 EDASTAB1 DS 0H END OF TABLE YM02719 10532002 EJECT YM02719 10538002 * ********************************************************** 10560000 * * * 10580000 * * ENTRY IF CARD IS AN EXPECTED CONTINUATION. * 10600000 * * * 10620000 * ********************************************************** 10640000 FA9 DS 0H ENTRY. 10645003 SCSW C,CXPOPZ TURN OFF CONT EXP OPERAND @ZA12458 10650003 SCSW C,CXPZ TURN OFF CONT EXP SWITCH. 10680000 SCSW S,ENDSZ TURN ON END SCAN SWITCH. 10700000 SCSW O,CMTZ,FAC TRANSFER COMMENT SWITCH ON. 10720000 SCSW O,CXPNZ,E1 CONTIN EXPECTED - NOT RCVD 10740000 SCSW Z,CXPCZ,FA91 TRANSFER NOT CONT EXP & CANC AACA 10748016 LA R7,ENDK GET END KEY AACA 10756016 BAL R9,K1 PUT END KEY IN TEXT AACA 10764016 B FAB AACA 10772016 * ********************************************************** 10780000 * * * 10800000 * * ENTRY TO PREPARE FOR SCAN. * 10820000 * * * 10840000 * ********************************************************** 10860000 FA91 DS 0H ENTRY. 10880000 SCSW C,ENDSZ TURN OFF END SCAN SWITCH. 10900000 TM JOBSWY,JOBSW IS THIS A JOB CARD? A49636 10950001 BZ FB1 NO. GO TO ELEMENT SCAN. A49636 10960001 * YES. TEST FOR OPERANDS. A49636 10970001 L R1,CSTRP GET CHAR. STRING PTR. A49636 10980001 LA R1,DEC1(R1) ADJUST PLUS ONE. A49636 10990001 L R5,CENDP GET COL. 72 LOCATION. A49636 10992001 LA R5,DEC0(R5) CLEAR HI ORDER BYTE. A49636 10994001 CR R5,R1 IS CSTRP NOW AT COL. 72? A49636 10996001 BE BKR2 YES. NO OPERANDS EXIST. A49636 10998001 * GO SET END KEY. A49636 10998401 B FB1 NO. GO TO ELEMENT SCAN. A49636 11000001 EJECT 11020000 * ********************************************************* 11040000 * * * 11060000 * * SCAN EXIT ROUTINE * 11080000 * * * 11100000 * ********************************************************* 11120000 FAA DS 0H RETURN FOR ELEMENT SCAN ROUTINES. 11140000 SCSW Z,ENDSZ,FAC TRANSFER END SCAN SW OFF. 11160000 FAB DS 0H ENTRY FOR CONT EXP & CANCELLED. 11180000 SR R7,R7 CLEAR REGISTER. 11200000 AH R7,CURLE IS CURRENT LEVEL ZERO. 11220000 BC ZERO,FAC TRANSFER CURRENT LEVEL ZERO. 11240000 LA R2,ERMES7 GET ERROR MESSAGE NUMBER. 11260000 L R5,TBEGP GET VERB KEY FOR THIS STMT. Y02668 11280002 MVC MSGKEY(1),0(R5) FOR ENTRY IN SECONDARY MSG. Y02668 11290002 B E1 TRANSFER ERROR 11300000 FAC DS 0H ENTRY. 11320000 SCSW Z,COLSTY,FAD TRANSFER COL 72 BLANK. 11340000 SCSW S,CXPZ TURN ON CONT EXP SW. 11360000 SCSW Z,ENDSZ,FAE TRANSFER END SCAN SW OFF. 11380000 SCSW S,CMTZ TURN ON COMMENT SWITCH. 11400000 B FAE TRANSFER. 11420000 FAD DS 0H ENTRY. 11440000 SCSW C,CMTZ TURN OFF COMMENT SWITCH. 11460000 FAD1 DS 0H ENTRY FROM ERROR RTN FOR CXPN 11480000 L RF,QPARM+QMPCL-QMNAM REMOTE LIST ADDRESS AADA 11481018 OC SYMBUF(VFA4),SYMBUF IS THERE A SYMBUF TO WRITE? Y02621 11483002 BZ FAFF IF ZERO FIELD NO - TRANSFER Y02621 11484002 MVC 4(4,RF),SYMBUF YES- GET SYMBUF TTR AADA 11485018 MVI DISPLID(RF),SYMBUFID BLOCK ID INTO REMOTE LIST Y02621 11485502 LA R9,SYMBUF AND PTR TO SYMBUF 11486000 ST R9,0(RF) TO REMOTE LIST AADA 11487018 MVI QPARM+QMPOP-QMNAM,QMWRTE WRITE ONLY 11488000 L RF,FIEFVHQ Q-MNGR ADDRESS AADA 11488518 BALR RE,RF GO TO Q MANAGER TO WRITE SYMBUF 11489000 FAFF DS 0H 11490000 SCSW Z,POVRDZ,FAF TRANSFER NO DD OVER RIDE. 11500000 SCSW S,DDOVZ TURN ON DD OVER RIDE FOR SCAN. 11520000 * CLEAR THE COMMENT SW THAT WAS 11526016 SCSW C,CMTZ SET BY BKR RTN 11532016 FAE DS 0H ENTRY TO GET ANOTHER CARD 11540000 L R7,CBEGP 11566000 LA R7,SVO(R7) COMPUTE COL 72. 11572000 MVC 0(1,R7),FAWA1 RESTORE PUNCH IN COL 72 11580000 MVC FAWA2(1),MSGKEY SAVE MOST RECENT KEY AACA 11586017 * FOR SECONDARY MSG AACA 11592017 B AOEXIT BR TO GET REMAINDER OF STMT. Y02668 11600002 FAF DS 0H ENTRY TO GO PROCESS TEXT. 11640000 SCSW C,DDOVZ TURN OFF SCAN DD OVER RIDE SW. 11660000 SCSW Z,FERRORA,FASUB ERROR SWITCH ZERO TRANSFER @G29AN2E 11680003 SCSW C,FERRORA CLEAR ERROR SWITCH 11680203 B FAE TRANSFER DO NOT PASS INTERNAL TEXT 11680403 EJECT 11680603 ***************************************************************@G29AN2E 11680803 * *@G29AN2E 11681003 * SUBSYS KEYWORD EXIT *@G29AN2E 11681203 * *@G29AN2E 11681403 ***************************************************************@G29AN2E 11681603 * *@G29AN2E 11681803 * A CHECK IS MADE FOR THE SUBSYS KEY. IF IT DOES NOT *@G29AN2E 11682003 * EXIST THE POST SCAN EXIT IS TAKEN IMMEDIATELY. OTHER- *@G29AN2E 11682203 * WISE AN SSOB IS BUILT SO THAT SUBSYS PROCESSING CAN BE *@G29AN2E 11682403 * DONE BY THE SUBSYSTEM. THE SSNAME IS CHECKED FOR VALID *@G29AN2E 11682603 * CHARACTERS, THE SSOB AND SSIB ARE INITIALIZED, AND THE *@G29AN2E 11682803 * SUBSYSTEM INTERFACE REQUEST ROUTINE IS CALLED TO CALL *@G29AN2E 11683003 * THE APPROPRIATE SUBSYSTEM. ON RETURN, THE RETURN CODES *@G29AN2E 11683203 * ARE CHECKED AND ERROR MESSAGES ARE ISSUED AS NECESSARY. *@G29AN2E 11683403 * IF NO ERRORS HAVE BEEN FOUND THE POST SCAN EXIT IS *@G29AN2E 11683603 * TAKEN. *@G29AN2E 11683803 * *@G29AN2E 11684003 * *@G29AN2E 11684203 * REGISTERS ARE USED AS FOLLOWS: *@G29AN2E 11684403 * R1=WORK REG *@G29AN2E 11684603 * R5=PTR TO SSOB *@G29AN2E 11684803 * R6=PTR TO SUBSYS KEY IN INTERNAL TEXT *@G29AN2E 11685003 * R7=WORK REG *@G29AN2E 11685203 * R8=WORK REG *@G29AN2E 11685403 * *@G29AN2E 11685603 FASUB DS 0H @G29AN2E 11685803 * ****************************************************@G29AN2E 11686003 * * *@G29AN2E 11686203 * * CHECK IF SUBSYS PROCESSING IS REQUIRED. IF IT *@G29AN2E 11686403 * * IS PROCEED WITH BUILDING THE SSOB, OTHERWISE *@G29AN2E 11686603 * * GO TO POST SCAN EXIT. *@G29AN2E 11686803 * * *@G29AN2E 11687003 * ****************************************************@G29AN2E 11687203 L R1,TEXTBUFP ESTABLISH ADDRESSABILITY @G29AN2E 11687403 USING TEXT,R1 TO INTERNAL TEXT @G29AN2E 11687603 TM STRINDCS,DDSTR IS THIS A DD CARD? @G29AN2E 11687803 BNO FAFF1 NO,GO TO POST SCAN EXIT @G29AN2E 11688003 TM STRDINDC,DTXSUBSK WAS SUBSYS SPECIFIED @G29AN2E 11688203 BNO FAFF1 NO, GO TO POST SCAN EXIT @G29AN2E 11688403 DROP R1 @G29AN2E 11688603 BAL RE,AOTXTLTH GO UPDATE TEXT LENGTH @G29AN2E 11688803 CLC AOSTRLTH,TXTBFLEN HAS BUFFER OVERFLOWED? @G29AN2E 11689003 BNH FASUB0 NO, PROCEED WITH SSOB @G29AN2E 11689203 LA R2,ERMSG749 BUFFER CAPACITY EXCEEDED @G29AN2E 11689403 MVI MSGKEY,NOKEY INDICATE NO SECONDARY MSG @G29AN2E 11689603 B E1 ISSUE ERROR MESSAGE @G29AN2E 11689803 FASUB0 DS 0H @G29AN2E 11690003 L R5,AOSSOB GET ADDR OF SSOB @G29AN2E 11690203 USING SSOB,R5 ESTABLISH ADDR. FOR SSOB @G29AN2E 11690403 XC SSOB(SSOBLN19),SSOB CLEAR ENTIRE SSOB @G29AN2E 11690603 MVC SSOBID,SSOBCHAR SET SSOB IDENTIFIER @G29AN2E 11690803 MVI SSOBLEN+1,SSOBHSIZ INIT LEN OF SSOB HEADER @G29AN2E 11691003 MVI SSOBFUNC+1,SSOBCONV INIT SSOB FUNCTION ID @G29AN2E 11691203 LA R7,SSCIBGN GET ADDR OF CONV SUBSYS EXT. @G29AN2E 11691403 ST R7,SSOBINDV INIT FUNCTION AREA PTR @G29AN2E 11691603 MVI SSCILEN+1,SSCISIZE INIT LENGTH FIELD @G29AN2E 11691803 MVI SSCISSNM,C' ' BEGIN BLANK OUT OF NAME @G29AN2E 11692003 MVC SSCISSNM+1(L3),SSCISSNM PROPAGATE BLANK @G29AN2E 11692203 MVC SSOBSSIB,AOSSIB INIT PTR TO SSIB @G29AN2E 11692403 MVC SSCIINTP,TEXTBUFP SET INTERNAL TEXT PTR @G29AN2E 11692603 * IN SSCI @G29AN2E 11692803 * ****************************************************@G29AN2E 11693003 * * *@G29AN2E 11693203 * * CHECK THAT AT LEAST ONE PARAMETER HAS BEEN *@G29AN2E 11693403 * * SPECIFIED. CHECK FOR VALID NUMBER OF CHARS IN *@G29AN2E 11693603 * * THE SUBSYS NAME. *@G29AN2E 11693803 * * *@G29AN2E 11694003 * ****************************************************@G29AN2E 11694203 L R6,AOSUBSYS POINT TO SUBSYS KEY @G29AN2E 11694403 XR R7,R7 CLEAR WORK REG @G29AN2E 11694603 IC R7,OFFNUM(R6) GET NUMBER OF PARMS @G29AN2E 11694803 CH R7,ONE NO. OF PARMS GREATER/= TO 1 @G29AN2E 11695003 BL FASERR1 NO- 0 PARMS SPECIFIED @G29AN2E 11695203 BCTR R7,0 FIND NO. OF SSPARMS @G29AN2E 11695403 STH R7,SSCINPRM SAVE NO. OF SSPARMS IN SSCI @G29AN2E 11695603 IC R7,OFFLEN(R6) GET LENGTH OF SSNAME @G29AN2E 11695803 CH R7,MAXSSNML IS LENGTH OF SSNAME NO MORE @G29AN2E 11696003 * THAN 4 CHARS? @G29AN2E 11696203 BH FASERR2 NO, TOO MANY CHARS. @G29AN2E 11696403 CH R7,ONE IS THERE AT LEAST ONE CHAR @G29AN2E 11696603 BL FASERR1 NO, SSNAME NOT SPECIFIED @G29AN2E 11696803 LA RE,OFFSSNM(R6) GET ADDR OF SSNAME @G29AN2E 11697003 AR R7,RE R7 NOW POINTS TO 1 BYTE @G29AN2E 11697203 * BEYOND SSNAME @G29AN2E 11697403 ST R7,SSCISUBS SAVE ADDR OF FIRST @G29AN2E 11697603 * LEN-SSPARM PAIR @G29AN2E 11697803 SPACE 2 11698003 * ******************************************************@G29AN2E 11698203 * * *@G29AN2E 11698403 * * CHECK FOR VALID CHARACTERS IN SSNAME *@G29AN2E 11698603 * * (TEST IS BASED ON THE FACT THAT ONLY ALPHA/NUMERIC *@G29AN2E 11698803 * * CHARS AND CERTAIN SPECIAL CHARS ARE ALLOWED THROUGH*@G29AN2E 11699003 * * THE SCAN ROUTINE) *@G29AN2E 11699203 * * *@G29AN2E 11699403 * ******************************************************@G29AN2E 11699603 SPACE 1 11699803 FASUB1 DS 0H @G29AN2E 11700003 BCTR R7,0 GET ADDR OF LAST BYTE @G29AN2E 11700203 * OF SSNAME @G29AN2E 11700403 CLI 0(R7),C'*' ASTERISK? @G29AN2E 11700603 BE FASERR2 YES,ERROR @G29AN2E 11700803 CLI 0(R7),C'/' SLASH? @G29AN2E 11701003 BE FASERR2 YES,ERROR @G29AN2E 11701203 CLI 0(R7),C'+' PLUS? @G29AN2E 11701403 BE FASERR2 YES,ERROR @G29AN2E 11701603 CLI 0(R7),C'-' MINUS? @G29AN2E 11701803 BE FASERR2 YES,ERROR @G29AN2E 11702003 CLI 0(R7),C' ' BLANK? @G29AN2E 11702203 BE FASERR2 YES,ERROR @G29AN2E 11702403 CLI 0(R7),TWLVZERO 12/0 MULTIPUNCH? @G29AN2E 11702603 BE FASERR2 YES,ERROR @G29AN2E 11702803 CLI 0(R7),C',' COMMA? @G29AN2E 11703003 BE FASERR2 YES,ERROR @G29AN2E 11703203 CLI 0(R7),C'.' PERIOD? @G29AN2E 11703403 BE FASERR2 YES,ERROR @G29AN2E 11703603 CLI 0(R7),C'(' LEFT PAREN? @G29AN2E 11703803 BE FASERR2 YES,ERROR @G29AN2E 11704003 CLI 0(R7),C')' RIGHT PAREN? @G29AN2E 11704203 BE FASERR2 YES,ERROR @G29AN2E 11704403 CLI 0(R7),C'&&' AMPERSAND? @G29AN2E 11704603 BE FASERR2 YES,ERROR @G29AN2E 11704803 CLI 0(R7),C'=' EQUAL SIGN? @G29AN2E 11705003 BE FASERR2 YES,ERROR @G29AN2E 11705203 CR R7,RE IS THIS THE FIRST CHAR @G29AN2E 11705403 * IN SSNAME? @G29AN2E 11705603 BE FASUB2 YES, TEST FOR NUMERIC @G29AN2E 11705803 B FASUB1 CHECK PRECEDING CHAR @G29AN2E 11706003 SPACE 1 11706203 FASUB2 DS 0H @G29AN2E 11706403 MVC SSNMWA(1),0(RE) MOVE FIRST CHAR TO WORKSPACE @G29AN2E 11706603 NI SSNMWA,X'F0' ZERO LOW ORDER BITS @G29AN2E 11706803 XI SSNMWA,C'0' TEST FOR DIFFERENCE IN ZONE @G29AN2E 11707003 BZ FASERR2 ERROR, NUMERICS INVALID @G29AN2E 11707203 XR RE,RE ZERO WORK REG @G29AN2E 11707403 IC RE,OFFLEN(R6) GET LENGTH @G29AN2E 11707603 BCTR RE,0 DECREMENT FOR EXECUTE @G29AN2E 11707803 EX RE,FASNMVE1 MOVE NAME FROM INTERNAL @G29AN2E 11708003 * TEXT INTO SSOB @G29AN2E 11708203 L R7,AOSSIB ESTABLISH ADDR @G29AN2E 11708403 USING SSIB,R7 FOR SSIB @G29AN2E 11708603 XC SSIB(SSIBSIZE),SSIB CLEAR ENTIRE SSIB @G29AN2E 11708803 MVC SSIBID,SSIBCHAR SET SSIB IDENTIFIER @G29AN2E 11709003 MVI SSIBLEN+1,SSIBSIZE INIT SSIB LENGTH @G29AN2E 11709203 MVC SSIBSSNM,SSCISSNM GET NAME FORM SSOB @G29AN2E 11709403 DROP R7 @G29AN2E 11709603 L R1,WAMSGBUF GET ADDR OF MSG BUFFER @G29AN2E 11709803 LA R1,AOLEN(R1) ALLOW FOR EIGHT BYTE OFFSET @G29AN2E 11710003 ST R1,SSCIMPTR SAVE ADDR IN SSOB @G29AN2E 11710203 MVC SSCIMLEN,MLEN STORE MAX. MSG LENGTH @G29AN2E 11710403 OI AOSSOB,X'80' SET HIGH ORDER BIT FOR @G29AN2E 11710603 * JESSSREQ @G29AN2E 11710803 LA R1,AOSSOB POINT TO ADDR OF SSOB @G29AN2E 11711003 IEFSSREQ @G29AN2E 11711203 NI AOSSOB,X'FF'-X'80' TURN OFF HIGH ORDER BIT @G29AN2E 11711403 * ****************************************************@G29AN2E 11711603 * * CHECK RETURN CODE FROM SUBSYSTEM INTERFACE *@G29AN2E 11711803 * * REQUEST ROUTINE. IF SUCCESSFUL COMPLETION *@G29AN2E 11712003 * * CODE IS RETURNED, THEN TEST RETURN CODE FROM *@G29AN2E 11712203 * * THE SUBSYSTEM. OTHERWISE, ISSUE ERROR MESSAGE *@G29AN2E 11712403 * * AND FAIL JOB. *@G29AN2E 11712603 * * *@G29AN2E 11712803 * ****************************************************@G29AN2E 11713003 SPACE 1 11713203 B *+4(RF) @G29AN2E 11713403 B FASUB3 SUCCESSFUL RETURN CODE @G29AN2E 11713603 B FASERR3 SUBSYS KEY NOT SUPPORTED @G29AN2E 11713803 B FASERR5 SUBSYSTEM NOT OPERATIONAL @G29AN2E 11714003 B FASERR4 SUBSYSTEM DOES NOT EXIST @G29AN2E 11714203 B FASERR6 SYSTEM ERROR/FUNC NOT COMP. @G29AN2E 11714403 B FASERR6 SYSTEM ERROR/LOGICAL @G29AN2E 11714603 * ****************************************************@G29AN2E 11714803 * * *@G29AN2E 11715003 * * CHECK RETURN CODE FROM SUBSYSTEM PASSED IN THE *@G29AN2E 11715203 * * SSOB. IF EQUAL TO ZERO, GO TO POST SCAN EXIT. *@G29AN2E 11715403 * * IF > 0 GO TO VGM TO ISSUE MSG RETURNED BY SUB- *@G29AN2E 11715603 * * SYSTEM. IF RETURN CODE =4 OR 8 ALSO ISSUE *@G29AN2E 11715803 * * WARNING MESSAGE. THE JOB IS FAILED IF THE *@G29AN2E 11716003 * * SUBSYSTEM HAS FOUND A SYNTAX ERROR, SYSTEM *@G29AN2E 11716203 * * ERROR, OR UNKNOWN PROBLEM. *@G29AN2E 11716403 * * *@G29AN2E 11716603 * ****************************************************@G29AN2E 11716803 SPACE 1 11717003 FASUB3 DS 0H @G29AN2E 11717203 NC SSOBRETN,SSOBRETN SET CONDITION CODE @G29AN2E 11717403 BZ FAFF1 SUCCESSFUL SYNTAX CHECK @G29AN2E 11717603 LA R2,SSCICMOD GET TEXT MOD. RETURN CODE @G29AN2E 11717803 C R2,SSOBRETN CHECK FOR TEXT MODIFIED @G29AN2E 11718003 BE FASWARN GO SET UP FOR WARNING @G29AN2E 11718203 LA R2,SSCISYNC GET SYNTAX ERROR-CONT. CODE @G29AN2E 11718403 C R2,SSOBRETN CHECK FOR SYNTAX ERROR-CONT. @G29AN2E 11718603 BE FASWARN GO SET UP FOR WARNING @G29AN2E 11718803 OI AOSW4,AOMSGTXT INDICATE TEXT IS PASSED @G29AN2E 11719003 XR R2,R2 CLEAR REGISTER @G29AN2E 11719203 L RF,IEFVGMV LOAD VCON @G29AN2E 11719403 BALR RE,RF GO TO ISSUE MSG FROM SUBSYS @G29AN2E 11719603 NI AOSW4,X'FF'-AOMSGTXT RESET FLAG @G29AN2E 11719803 LA R2,SSCISYNT GET SYNTAX ERROR- TERMINATE @G29AN2E 11720003 C R2,SSOBRETN CHECK FOR SYNTAX ERR-TERM @G29AN2E 11720203 BE E102 TERMINATE JOB @G29AN2E 11720403 B FASERR6 SYSTEM ERROR @G29AN2E 11720603 FASERR1 DS 0H @G29AN2E 11720803 LA R2,ERMSG744 SUBSYSTEM NOT SPECIFIED @G29AN2E 11721003 B FASUB4 @G29AN2E 11721203 FASERR2 DS 0H @G29AN2E 11721403 LA R2,ERMSG748 SUBSYSTEM NAME INVALID @G29AN2E 11721603 B FASUB4 @G29AN2E 11721803 FASERR6 DS 0H @G29AN2E 11722003 LA R2,ERMSG750 SYSTEM ERROR IN PROCESSING @G29AN2E 11722203 * SUBSYS DD PARAMETER @G29AN2E 11722403 FASUB4 DS 0H @G29AN2E 11722603 MVI MSGKEY,NOKEY INDICATE NO SECONDARY MSG @G29AN2E 11722803 B E1 ISSUE ERROR MESSAGE @G29AN2E 11723003 FASERR3 DS 0H @G29AN2E 11723203 L R2,AVGM90OT GET ADDR OF VGM90 MSG OFFSET @G29AN2E 11723403 * TABLE @G29AN2E 11723603 LH R7,M745OO(R2) GET OFFSET TO MSG TEXT @G29AN2E 11723803 LH RE,M745OL(R2) GET LENGTH OF MSG @G29AN2E 11724003 B FASSM1 @G29AN2E 11724203 FASERR4 DS 0H @G29AN2E 11724403 L R2,AVGM90OT GET ADDR OF VGM90 MSG OFFSET @G29AN2E 11724603 * TABLE @G29AN2E 11724803 LH R7,M746OO(R2) GET OFFSET TO MSG TEXT @G29AN2E 11725003 LH RE,M746OL(R2) GET LENGTH OF MSG @G29AN2E 11725203 B FASSM1 @G29AN2E 11725403 FASERR5 DS 0H @G29AN2E 11725603 L R2,AVGM90OT GET ADDR OF VGM90 MSG OFFSET @G29AN2E 11725803 * TABLE @G29AN2E 11726003 LH R7,M747OO(R2) GET OFFSET TO MSG TEXT @G29AN2E 11726203 LH RE,M747OL(R2) GET LENGTH OF MSG @G29AN2E 11726403 * ****************************************************@G29AN2E 11726603 * * *@G29AN2E 11726803 * * INITIALIZE MESSAGE BUFFER FOR MESSAGES *@G29AN2E 11727003 * * IEF745I-IEF747I. MOVE THE SSNAME FROM THE *@G29AN2E 11727203 * * SSIB POINTED TO BY THE SSOB TO THE MESSAGE *@G29AN2E 11727403 * * BUFFER *@G29AN2E 11727603 * * *@G29AN2E 11727803 * ****************************************************@G29AN2E 11728003 SPACE 1 11728203 FASSM1 DS 0H @G29AN2E 11728403 L R1,WAMSGBUF GET ADDR OF MSG BUFFER @G29AN2E 11728603 MVI AOTXT(R1),C' ' MOVE BLANK TO POSITION OF @G29AN2E 11728803 * TEXT AREA @G29AN2E 11729003 MVC AOTXT1(149,R1),AOTXT(R1) BLANK REST OF TEXT AREA@G29AN2E 11729203 MVC AOLEN(2,R1),MLEN INDICATE MAX LENGTH @G29AN2E 11729403 L R2,AVGM90TX GET ADDR OF VGM90 TEXT TABLE @G29AN2E 11729603 AR R2,R7 ADD OFFSET OF MSG TO GET @G29AN2E 11729803 * ADDR OF MSG @G29AN2E 11730003 BCTR RE,0 DECREMENT FOR EXECUTE @G29AN2E 11730203 EX RE,FASNMVE2 MOVE MSG TO BUFFER @G29AN2E 11730403 L R7,AOSSOB GET ADDR OF SSOB @G29AN2E 11730603 USING SSOB,R7 ESTABLISH ADDRESSABILITY @G29AN2E 11730803 L R2,SSOBSSIB GET ADDR OF SSIB @G29AN2E 11731003 DROP R7 @G29AN2E 11731203 USING SSIB,R2 ESTABLISH ADDR TO SSIB @G29AN2E 11731403 MVC AOSSNM(SSNAMEL,R1),SSIBSSNM MOVE SSNAME FROM @G29AN2E 11731603 * SSIB TO CORRECT POISTION IN @G29AN2E 11731803 * MESSAGE @G29AN2E 11732003 OI AOSW4,AOMSGTXT INDICATE TEXT IS PASSED @G29AN2E 11732203 XR R2,R2 CLEAR REG 2 @G29AN2E 11732403 L RF,IEFVGMV LOAD VCON @G29AN2E 11732603 BALR RE,RF GO ISSUE MESSAGE @G29AN2E 11732803 NI AOSW4,X'FF'-AOMSGTXT @G29AN2E 11733003 B E102 GO SET JOB FAIL @G29AN2E 11733203 * ****************************************************@G29AN2E 11733403 * * *@G29AN2E 11733603 * * SET UP TO ISSUE WARNING MESSAGE. GO TO *@G29AN2E 11733803 * * VGM THEN TO POST SCAN EXIT. *@G29AN2E 11734003 * * *@G29AN2E 11734203 * ****************************************************@G29AN2E 11734403 FASWARN DS 0H @G29AN2E 11734603 LH R2,ONE PLACE DUMMY WARNING NO IN REG@G29AN2E 11734803 OI AOSW4,AOWRNREQ WARNING ONLY @G29AN2E 11735003 OI AOSW4,AOMSGTXT TEXT IS BEING PASSED @G29AN2E 11735203 L RF,IEFVGMV LOAD VCON @G29AN2E 11735403 BALR RE,RF GO ISSUE WARNING @G29AN2E 11735603 NI AOSW4,X'FF'-AOMSGTXT TURN OFF TEXT INDICATOR @G29AN2E 11735803 B FAFF1 TAKE POST SCAN EXIT @G29AN2E 11736003 SPACE 2 11736203 ***** SUBSYS PROCESSING STORAGE @G29AN2E 11736403 FASNMVE1 MVC SSCISSNM(0),OFFSSNM(R6) MOVE NAME FROM INTERNAL @G29AN2E 11736603 * TEXT INTO SSOB @G29AN2E 11736803 FASNMVE2 MVC AOTXT(0,R1),0(R2) MOVE MSG INTO VGM BUFFER @G29AN2E 11737003 ONE DC H'1' ONE @G29AN2E 11737203 MAXSSNML DC H'4' MAXIMUM SSNAME LENGTH @G29AN2E 11737403 MLEN DC H'110' MAX MSG LENGTH @G29AN2E 11737603 SSOBCHAR DC C'SSOB' SSOB IDENTIFIER @G29AN2E 11737803 SSIBCHAR DC C'SSIB' SSIB IDENTIFIER @G29AN2E 11738003 AVGM90OT DC A(VGM90MOT) ADDR OF MESSAGE OFFSET TABLE @G29AN2E 11738203 AVGM90TX DC A(VGM90TXT) ADDR OF MESSAGE OFFSET TABLE @G29AN2E 11738403 TXTBFLEN DC H'8192' INTERNAL TEXT BUFFER LENGTH @G29AN2E 11738603 DROP R5 @G29AN2E 11738803 EJECT 11739003 FAFF1 DS 0H ENTER 11740000 *****************************************************************Y02668 11847002 * * *Y02668 11848002 * * POST SCAN EXIT - TAKEN BY JOB ENTRY SUBSYSTEM *Y02668 11849002 * * *Y02668 11850002 *****************************************************************Y02668 11851002 SPACE 2 Y02668 11852002 BAL RE,AOTXTLTH GO TO UPDATE TEXT LENGTH Y02668 11852402 * CHECK IF PGM=KEY IN EXEC TEXT STRING @ZA13844 11857003 TM SWZ,EXECSW IS THIS AN EXEC STMT? @ZA13844 11858003 BZ FACC1 BRANCH IF NOT @ZA13844 11858803 MVI AOSCHKYS,PGMEK PGM=KEY IN SEARCH LIST @ZA13844 11859603 MVI AOSCHKYS+1,ENDLISTK FLAG END OF SEARCH LIST @ZA13844 11860403 BAL RE,AOKSRCHR FIND PGM=KEY IN TEXT @ZA13844 11861203 * R9 HAS ADDR OF PGM=KEY IF FOUND, ZERO IF NOT FOUND @ZA13844 11862003 LTR R9,R9 PGM= KEY FOUND @ZA13844 11862803 BNZ FACC1 YES, BRANCH @ZA13844 11863603 * EXEC TEST IS FOR PROCNAME, PROC= , OR ERROR CONDITION @ZA13844 11864403 L RF,TEXTBUFP TEXT STRING ADDRESS @ZA13844 11865203 USING TEXT,RF PREFIX ADDRESSABILITY @ZA13844 11866003 OI STREINDC,ETXPRCV INDICATE STMT INVOKES PROC @ZA13844 11866803 DROP RF @ZA13844 11869503 * JES2 REQUIRES TEXT PREFIX INTERFACE @ZA13844 11870003 FACC1 DS 0H @ZA13844 11871003 L RF,CWATXTEX GET PTR TO POST SCAN RTN Y02668 11872003 * ENTRY IN NEL EXIT LIST Y02668 11873003 LTR RF,RF WAS AN ENTRY FOUND IN VH1 Y02668 11874003 BZ FACC3 NO, BYPASS EXIT Y02668 11875003 LA R1,TEXTBUFP GET PARM LIST PTR YM00373 11876003 * CONTAINING A 1 WORD TEXT PTR YM00373 11877002 TM 0(RF),X'40' Q. ADDR. DEFINITION AAAA 11897015 BO FACC2 BR - YES AAAA 11900015 LA R3,CWAPSENM GET PTR TO EXIT NAME YM00373 11903002 L RF,CWALINK GET LINK LIST FORM PTR YM00373 11908002 LINK EPLOC=(3),MF=(E,(1)),SF=(E,(15)) TAKE NAME EXIT YM00373 11913002 B FACC3 AAAA 11918015 FACC2 DS 0H AAAA 11921015 L RF,4(RF) TAKE ADDR. EXIT AAAA 11924015 BALR RE,RF AAAA 11927015 EJECT Y02668 11928002 FACC3 DS 0H AAAA 11930015 SCSW Z,JOBSWY,AOMS01 BRANCH IF NOT JOB CARD Y02668 11934002 MVI AOSCHKYS,MSGLEVJK PUT MSGLEVEL KEY IN SEARCH Y02668 11942002 * PARMLIST Y02668 11946002 MVI AOSCHKYS+1,ENDLISTK INDICATE END OF LIST Y02668 11950002 BAL RE,AOKSRCHR FIND PTR TO MSGLEVEL KEY Y02668 11958002 LTR R9,R9 WAS MSGLEVEL FOUND? Y02668 11962002 BZ AOMS01 NO, BR. TO NORM PROCESSING Y02668 11966002 LA R9,2(R9) BUMP PTR TO PARM VALUE Y02668 11970002 AOMS02 DS 0H Y02668 11974002 CLI 1(R9),AOMSLONE IS MSGLEVEL=1? Y02668 11978002 BL AOMS04 MSGLEVEL IS 0 Y02668 11982002 BH AOMS03 MSGLEVEL IS 2 Y02668 11986002 MVI IWAJMSGL,AOMSGLV1 SET BIT FOR MSGLEVEL=1. Y02668 11990002 B AOMS01 BRANCH TO NORM PROCESSING Y02668 11994002 AOMS03 DS 0H Y02668 11998002 CLI 1(R9),AOMSLTWO MSGLEVEL>2 ? Y02668 12002002 BH AOMS01 YES, LEAVE IN DEFAULT Y02668 12006002 MVI IWAJMSGL,AOMSGLV2 SET BIT FOR MSGLEVEL=2. Y02668 12010002 B AOMS01 BRANCH TO NORM PROCESSING Y02668 12014002 AOMS04 DS 0H Y02668 12018002 MVI IWAJMSGL,AOMSGLV0 SET BIT FOR MSGLEVEL=0. Y02668 12022002 AOMS01 DS 0H Y02668 12026002 * CHECK IF RESTART= SPECIFIED. Y02668 12026302 MVI AOSCHKYS,RESTARJK RESTART KEY IN SEARCH LIST. Y02668 12026602 MVI AOSCHKYS+1,ENDLISTK END OF LIST INDICATOR. Y02668 12026902 BAL RE,AOKSRCHR FIND RESTART KEY IN TEXT. Y02668 12027502 * AOKSRCHR RETURNS ADDR IN R9 IF KEY FOUND, ZERO IF NOT FOUND. Y02668 12027802 LTR R9,R9 RESTART KEY FOUND? Y02668 12028102 BZ AOFACC5 BRANCH NO. Y02668 12028402 * RESTART= HAS BEEN SPECIFIED. Y02668 12028702 * FORMAT IS - RESTART=(STEPNAME,CHECKID). Y02668 12029002 OI SWH,CPFLGXX SET RESTART FLAG YM01573 12029302 L RE,TEXTBUFP GET PTR TO PREFIX YM01573 12029402 USING TEXT,RE ADDRESS JOB PREFIX YM01573 12029502 OI STRJINDC,JTXCPSTF FLUSH JOB 'TIL RESTART STEP YM01573 12029602 * IS FOUND YM01573 12029702 DROP RE 12029802 CLI 2(R9),0 STEPNAME SPECIFIED? YM01573 12029902 BE AORST09 NO, --ERROR, NEED STEPNAME YM01573 12030002 * STEPNAME HAS BEEN SUPPLIED YM01573 12030102 CLI 3(R9),C'*' RESTART FOR FIRST STEP? Y02668 12030802 BNE AORST01 BR NO - ACTUAL NAME SPECIFIED.Y02668 12031102 CLI 2(R9),1 IS '*' PART OF A STEPNAME? Y02668 12031402 BNE AORST09 BR YES - ERROR. '*' MUST Y02668*12031702 BE SPECIFIED ALONE. Y02668 12032002 * RESTART=* HAS BEEN SPECIFIED. Y02668 12032302 OI CRSW1,CRRES1 INDICATE RESTART FIRST STEP. Y02668 12032602 * CHECK FOR CHECKID (CHECKPOINT NAME). Y02668 12032902 AORST01 DS 0H Y02668 12033202 CLI 1(R9),2 CHECKID SPECIFIED? Y02668 12033502 BNE AOFACC5 EXIT IF NOT. Y02668 12033802 * CHECKID HAS BEEN SPECIFIED. Y02668 12034102 SR R1,R1 CLEAR LENGTH REG. Y02668 12034402 IC R1,2(R9) INSERT STEPNAME LENGTH. Y02668 12034702 LA R9,3(R1,R9) COMPUTE ADDR OF CHECKID - Y02668*12035002 (ADDR = 3 (KEY+NUMBER+LENGTH Y02668*12035302 BYTES + LENGTH OF STEPNAME). Y02668 12035602 MVC CWACHIDL(1),0(R9) SAVE CHECKID LENGTH. Y02668 12035902 B AOFACC5 EXIT FROM RESTART CHECK. Y02668 12036202 * Y02668 12036502 * ENTRY FOR RESTART FORMAT ERRORS. Y02668 12036802 AORST09 DS 0H Y02668 12037102 MVI MSGKEY,RESTARJK RESTART KEY FOR SECONDRY MSG.Y02668 12037402 LA R2,ERMSG632 LOAD MESSAGE NUMBER. Y02668 12037702 B E1 Y02668 12038002 * Y02668 12038302 * END OF RESTART PROCESSING. Y02668 12038602 * Y02668 12038902 AOFACC5 DS 0H Y02668 12039202 TM SWZ,EXECSW PROCESSING AN EXEC STMT? Y02668 12040002 BNO FAC1 NOT AN EXEC CARD-NO FIND. Y02668 12040402 * EXEC STATEMENT. Y02668 12040802 TM PSTMT+4,X'08' EXEC CONVERTED FROM PROC STMT?Y02668 12040902 BO FAC1 DUMMY EXEC, DON'T TRY FIND. Y02668 12041002 L R9,TBEGP POINT TO BASE KEY. Y02668 12041202 LA R9,1(R9) POINT TO PARAM COUNT. Y02668 12041602 CLI 0(R9),2 TWO PARAMS? EXEC PROC HAS 2. Y02668 12042002 BL AOFDSRCH BRANCH IF LESS THAN 2 TO CHECK 12042403 * FOR PROC=PROCNAME CONDITION.@ZA13424 12042603 * EXEC PROCNAME STATEMENT. Y02668 12043202 LA R9,1(R9) STEP TO STEPNAME LTH BYTE. Y02668 12043602 SR R1,R1 CLEAR FOR INSERTION OF Y02668 12044002 IC R1,0(R9) STEPNAME LTH. Y02668 12044402 LA R9,1(R9) POINT TO STEPNAME. Y02668 12044802 AR R9,R1 POINT TO PROCNAME LTH BYTE. Y02668 12045202 B AOFDCHCK ERROR CHECK PROCNAME. Y02668 12045602 * CHECK FOR EXEC PROC=PROCNAME STATEMENT. Y02668 12046002 AOFDSRCH DS 0H Y02668 12046402 MVI AOSCHKYS,PROCEK PROC= KEY IN PARM LIST. Y02668 12046802 MVI AOSCHKYS+1,ENDLISTI SET END OF LIST INDICATOR. Y02668 12047202 BAL RE,AOKSRCHR SEARCH FOR KEY IN TEXT. Y02668 12048002 * AOKSRCHR RETURNS ADDRESS OF FOUND KEY IN R9, ZERO IF KEY Y02668 12048402 * NOT FOUND. Y02668 12048802 LTR R9,R9 CHECK IF KEY FOUND. Y02668 12049202 BZ FAC1 BRANCH NOT FOUND. Y02668 12049602 * EXEC PROC=PROCNAME STATEMENT. Y02668 12050002 * R9 POINTS TO PROC= KEY. Y02668 12050402 LA R9,2(R9) POINT TO PROCNAME LTH. Y02668 12050802 * CHECK PROCEDURE NAME LENGTH. Y02668 12051202 AOFDCHCK DS 0H Y02668 12051602 CLI 0(R9),8 LENGTH EXCEED MAX? Y02668 12052002 BH AOFDERR2 BRANCH YES TO ISSUE IEF642I. Y02668 12052402 CLI 0(R9),0 IS PROC NAME MISSING? @ZA13367 12052503 BE AOFDERR4 YES,ISSUE ERROR MSG IEF646I @ZA13367 12052703 MVC TWORK(1),1(R9) VALIDITY CHECK 1ST CHAR. MUST Y02668*12052802 BE ALPHABETIC. Y02668 12053202 NI TWORK,X'F0' ZERO LOW ORDER BITS. Y02668 12053602 XI TWORK,C'0' TEST FOR NUMERIC ZONE BITS. Y02668 12054002 BE AOFDERR3 NUMERIC - ISSUE IEF644I. Y02668 12054402 CLI 1(R9),C'*' ASTERISK? Y02668 12054802 BE AOFDERR3 YES, ERROR. Y02668 12055202 CLI 1(R9),C'/' SLASH? Y02668 12055602 BE AOFDERR3 YES, ERROR. Y02668 12056002 CLI 1(R9),C'+' PLUS? Y02668 12056402 BE AOFDERR3 YES, ERROR. Y02668 12056802 CLI 1(R9),C'-' MINUS? Y02668 12057202 BE AOFDERR3 YES, ERROR. Y02668 12057602 SR R1,R1 CLEAR FOR INSERTION OF Y02668 12058002 IC R1,0(R9) PROCNAME LTH. Y02668 12058402 BCTR R1,0 DECREMENT FOR EXECUTED MOVE Y02668 12058802 MVC AOFDPCSV(8),AOPCSVBL BLANK PROCNAME AREA. Y02668 12059202 EX R1,AOFDMOVE MOVE PROCNAME TO BUF FOR FIND.Y02668 12059602 MVC AOFDPCL(1),0(R9) MOVE NAME LTH TO BUF FOR FIND.Y02668 12060002 TM SWE,PROC PROC SWITCH ON? Y02668 12060402 BZ AOFDIST1 BR NO TO PROCESS PROCEDURE. Y02668 12060802 * PROCEDURE WITHIN PROCEDURE ERROR. Y02668 12062002 LA R2,ERMSG613 LOAD ERR MSG CODE. Y02668 12062402 B E1 BRANCH TO PROCESS ERROR. Y02668 12063202 AOFDIST1 DS 0H Y02668 12064002 L R7,IWAWKBF ADDRESS OF INSTRM WORK AREA. Y02668 12064402 LTR R7,R7 INSTRM WORK AREA ? YM06865 12064502 BZ AOFDIST3 NO - GO TO FIND RTN. YM06865 12064602 USING WORKAREA,R7 Y02668 12064802 SR R1,R1 CHECK Y02668 12065202 IC R1,WKCT IF ANY INSTREAM PROCS Y02668 12065602 LTR R1,R1 ARE LISTED IN THE DIRECTORY. Y02668 12066002 BZ AOFDIST3 NONE LISTED. Y02668 12066402 * SEARCH THE DIRECTORY FOR THE PROCEDURE NAME. Y02668 12066802 LA R6,WKPROCN1 LOAD ADDR OF 1ST PROCNAME. Y02668 12067202 AOFDIST2 DS 0H Y02668 12067602 CLC 0(8,R6),AOFDPCSV INSTREAM PROC? Y02668 12068002 BE AOFDIST4 BR YES TO BUILD PARM LIST FOR Y02668*12068402 EXPAND RTNE. Y02668 12068802 LA R6,11(R6) POINT TO NEXT PROCNAME. Y02668 12069202 BCT R1,AOFDIST2 CHECK NEXT ENTRY. Y02668 12069602 AOFDIST3 DS 0H Y02668 12070002 LA R0,AOFDPCSV LOAD PROCNAME ADDRESS. Y02668 12070802 L R1,PDCBP LOAD PROC DCB ADDRESS. Y02668 12071202 TM IWAEXTS,IWASFIND SPECIAL FIND EXIT SPECIFIED? Y02668 12071602 BO AOFDSPFD BRANCH YES. Y02668 12072002 FIND (1),(0),D Y02668 12072402 AOFDBRNC DS 0H Y02668 12072802 B *+4(RF) BRNACH ON RETURN CODE. Y02668 12073202 B AOFDSWCH PROCEDURE FOUND. Y02668 12073602 B AOFDERR1 PROCEDURE NOT FOUND. Y02668 12074002 LA R5,2 PROC LIB DEVICE I/O ERROR YM02700 12074402 L RF,IEFVHRV ISSUE Y02668 12074802 BALR RE,RF WTO ERROR MESSAGE. Y02668 12075202 LA R2,ERMSG614 LOAD ERR MSG CODE. Y02668 12075602 B E1 ISSUED ON SYSOUT. Y02668 12076402 AOFDERR1 DS 0H Y02668 12076802 XC SYMTTR(VFA4),SYMTTR CLEAR PTR TO SYMBOLIC PARAMETER 12076903 * TABLE @ZA06243 12077103 LA R2,ERMSG612 LOAD ERR MSG CODE. Y02668 12077202 B E1 ISSUED ON SYSOUT. Y02668 12077602 AOFDERR2 DS 0H Y02668 12078002 LA R2,ERMSG632 LOAD ERR MSG CODE. Y02668 12078402 B E1 BRANCH TO ERROR EXIT. Y02668 12079202 AOFDERR3 DS 0H Y02668 12079602 LA R2,ERMSG647 LOAD ERR MSG CODE. Y02668 12080002 B E1 ERROR EXIT. Y02668 12080802 AOFDERR4 DS 0H PROC NAME MISSING @ZA13367 12080903 LA R2,ERMSG646 ERROR MSG CODE. @ZA13367 12081003 B E1 ERROR EXIT. @ZA13367 12081103 AOFDIST4 DS 0H Y02668 12081503 MVC WKPTR2(3),8(R6) MOVE TTR OF INSTREAM PROC. Y02668 12081602 OI IWAPARM,INSTPROC SET INSTR PROC SWITCH. Y02668 12082402 XR RF,RF INDICATE PROC FOUND. Y02668 12082802 B AOFDBRNC BRANCH TO CHECK RETURN CODE. Y02668 12083202 AOFDMOVE MVC AOFDPCSV(0),1(R9) EXECUTED MOVE - PROCNM TO BUF.Y02668 12083602 * Y02668 12084002 * SPECIAL FIND ROUTINE - SAVE INTERFACE AS FIND SVC. Y02668 12084402 * Y02668 12084802 AOFDSPFD DS 0H Y02668 12085202 XC AOFDTMP1(4),AOFDTMP1 CLAAR LOAD SPACE Y02668 12085602 MVC AOFDTMP1+1(3),IWAFINDP MOVE PTR FOR LOAD. Y02668 12086002 L RF,AOFDTMP1 LOAD PTR TO SPECIAL FIND RTNE.Y02668 12086402 BALR RE,RF BRANCH TO RTNE. Y02668 12086802 B AOFDBRNC BRANCH TO CHECK RETURN CODE. Y02668 12087202 * Y02668 12087602 * PROCEDURE FOUND - SET PROC (PROCLIB BEING USED) AND PRCV Y02668 12088002 * (PRIME PROCEDURE BUFFER) SWITCHES IN THE IWA. Y02668 12088402 * Y02668 12088802 AOFDSWCH DS 0H 12089202 MVI SWE,PROC+PRCV INIT PROC SWITCHES YM02703 12089302 XC PDNM(L'PDNM+L'PSNM+L'RDNM+L'RSNM+L'PPSN),PDNM YM02703 12089402 * CLEAR O'RIDE WORK AREA YM02703 12089502 OI SWC,PEXP SET PROC EXEC STMT EXPECTED. Y02668 12089802 L RF,TEXTBUFP TEXT STRING ADDRESS. Y02668 12090002 USING TEXT,RF PREFIX ADDRESSABILITY. Y02668 12091002 OI STREINDC,ETXPRCV INDICATE STMT INVOKES PROC. Y02668 12092002 DROP RF Y02668 12093002 FAC1 DS 0H Y02668 12094002 TM SWA,DLM DLM FOUND THIS CARD ? YM03459 12094902 BZ AOEXIT NO. GO TO EXIT YM03459 12095802 MVI AOSCHKYS,DLMK PUT DLM KEY IN SEARCH LIST YM03459 12096702 MVI AOSCHKYS+1,ENDLISTK INDICATE END OF LIST YM03459 12097602 BAL RE,AOKSRCHR GO TO FIND DLM KEY YM03459 12098502 LTR R9,R9 WAS DLM KEY FOUND ? YM03459 12099402 BZ AOEXIT NO. GO TO EXIT YM03459 12100702 CLI 1(R9),X'01' DLM PARAMETER EXCEED 1 ? YM03459 12101702 BNH FAC2 NO. GO CHECK FOR DLM LTH YM03459 12102702 LA R2,ERMSG640 SET EXCESSIVE PARMS MSG CODE YM03459 12103702 B FAC3 GO TO PUT OUT MSG YM03459 12104702 FAC2 DS 0H YM03459 12105702 CLI 2(R9),X'02' DLM OPERAND GREATER THAN 2 ? YM03459 12106702 BNH AOEXIT NO. GO TO EXIT YM03459 12107702 LA R2,ERMSG642 SET EXCESSIVE PARM LTH CODE YM03459 12108702 FAC3 DS 0H YM03459 12117502 MVI MSGKEY,DLMK SET DLM SECONDARY MSG CODE YM03459 12118002 B E1 GO TO ERROR EXIT YM06094 12118502 EJECT 12119502 AOEXIT DS 0H Y02668 12120002 L RF,IEFVHFHA RETURN Y02668 12125002 BR RF TO VHF. Y02668 12130002 DS 0H Y02668 12140002 TBUFLTH DC H'2000' CONSTANT FOR TEXTBUF LENGTH. Y02668 12150002 FAG DC C'DATA' 12170016 FAI DC C'DUMMY ' CONSTANT FOR DD. 12200000 FAJ DC C'DYNAM' CONSTANT FOR DD 20033 12210020 STPCTLEN EQU X'07' LENGTH OF STEPCAT NAME. Y02113 12210602 STEPCATN DC C'STEPCAT' NAME FOR COMPARE. Y02113 12211202 EJECT 12220000 * ********************************************************** 12240000 * * * 12260000 * * THIS ROUTINE MOVES PARAMETERS AND SUBPARAMETERS * 12280000 * * FROM THE JCL STATEMENT INTO THE TEXT BUFFER. * 12300000 * * * 12320000 * ********************************************************** 12340000 T1 DS 0H 12360000 LM R2,R5,TKEYP GET TEXT PTRS 12363017 * R2= TKEYP 12366017 * R3=TNUMP ( NOT USED ) 12369017 * R4=TLENP 12372017 * R5=TENDP 12375017 * AACA 12378017 SCSW O,LPBYSWZ,T102 BR IF BYPASS SW ON AACA 12381017 * NOW CHECK FOR MORE THAN ONE PARAM AACA 12384017 * AACA 12387017 CLI 1(R2),1 IS THERE AT LEAST ONE PARAM AACA 12390017 BL T102 NO, BYPASS FURTHER CHECKS AACA 12393017 * AACA 12396017 * MORE THAN ONE PARAM - CHECK IF IN PARENS AACA 12399017 * AACA 12402017 LH R3,CURLE CHECK IF CURRENT LEVEL OF PARENSAACA 12405017 LTR R3,R3 IS MORE THAN ONE AACA 12408017 BNZ T102 OK, BYPASS AACA 12411017 * 12414017 XI FPRNSWZ,FPRNSW FLIP THE LEFT PAREN BIT AACA 12417017 BZ T102 RESULT=0 LAST PARAMETER IN PARENS 12420017 * RESULT=1 ERROR OUTSIDE PARENS AACA 12423017 * 12426017 LA R2,ERMES19 FORMAT ERROR 12429017 B E1 12432017 SPACE 12435017 T102 DS 0H 12438017 LM R2,R3,CBSYP GET CHAR STRING PTRS 12441017 SR R3,R2 COMPUTE LENGTH OF SYMBOL 12460000 * THREE INSTRUCTIONS DELETED HERE @ZA16422 12490003 L R5,TNUMP GET NUMBER POINTER. 12640000 CLI 0(R5),X'FF' IS PARAM CT ALREADY AT 255? Y02668 12642002 BL AOT1 BRANCH NO. Y02668 12644002 * PARAMETERS EXCEED ONE BYTE MAXIMUM COUNT OF 255. Y02668 12646002 LA R2,ERMES3 SET CODE FOR EXCESSIVE PARAMS.Y02668 12648002 B E1 TAKE ERROR EXIT. Y02668 12650002 AOT1 DS 0H Y02668 12652002 SCSW O,PDASSWW,T3 PERIOD AND AST SWITCHES ON. 12660000 SCSW Z,LDLX,T6 LAST DEL SWITCH OFF. 12680000 SR R6,R6 CLEAR REGISTER. 12700000 AH R6,CURLE CURRENT LEVEL. 12720000 SH R6,LASLE LAST LEVEL. 12740000 BC EQUAL+LOW,T6 TRANSFER. 12760000 L R6,TKEYP GET TEXT KEY POINTER. 12780000 LA R6,1(R6) BUMP POINTER. 12800000 SR R6,R5 TKEYP EQUAL TO TNUMP. 12820000 BNH T3A TRANS TNUMP NOT HIGH @G29AN2E 12840003 LA R2,ERMES1 GET ERROR NUMBER. 12860000 B E1 GO TO ERROR ROUTINE. 12880000 T3 DS 0H ENTRY FOR PERD AND AST. 12900000 SCSW O,JGCY,T6 SWITCH ON TRANSFER. 12920000 SCSW S,JGCY SET SWITCH ON. 12940000 T3A DS 0H @G29AN2E 12942003 L R5,TKEYP GET ADDR OF KEY @G29AN2E 12944003 CLI 0(R5),SUBSYSK IS IT THE SUBSYS KEY @G29AN2E 12946003 BNE T4 NO, PROCEED NORMALLY @G29AN2E 12948003 LA R2,ERMSG641 IMPROPER SUBPARM. LIST @G29AN2E 12950003 MVI MSGKEY,SUBSYSK IN THE SUBSYS FIELD @G29AN2E 12952003 B E1 GO ISSUE MESSAGE @G29AN2E 12954003 T4 DS 0H ENTRY 12960000 L R5,TKEYP INSURE REG. 5 POINTS TO YA24040 12966002 LA R5,1(R5) REAL NBR BYTE, NOT SUBLIST. YA24040 12972002 IC R6,0(R5) GET TEXT NUMBER BYTE 12980000 LA R6,1(R6) ADD ONE TO NUMBER BYTE. 13000000 STC R6,0(R5) PUT NUMBER BYTE BACK. 13020000 OI 0(R4),HONE OR HIGH ONE IN LENGTH BYTE. 13040000 SR R6,R6 CLEAR REGISTER. 13060000 LR R5,R4 SET REG WITH TNUMP. 13080000 LA R4,1(R4) BUMP TO NEW TLENP. 13100000 STC R6,0(R4) ZERO TEXT LENGTH BYTE. 13120000 T6 DS 0H ENTRY 13140000 STC R3,0(R4) PUT LENGTH IN TEXT LENGTH BYTE. 13160000 LA R4,1(R4) BUMP TLENP BY ONE. 13180000 LPR R6,R3 SAVE LENGTH 13200000 BC 8,T7 TRANSFER LENGTH IS ZERO 13220000 BCTR R3,R0 DECREMENT LENGTH. 13240000 EX R3,T8 EXECUTE MOVE. 13260000 T7 DS 0H ENTRY. 13280000 AR R4,R6 COMPUTE NEW LENGTH BYTE. 13300000 SR R6,R6 CLEAR REGISTER 13320000 STC R6,0(R4) ZERO NEW LENGTH BYTE. 13340000 ST R4,TLENP SAVE LENGTH ADDRESS. 13360000 IC R6,0(R5) GET NUMBER BYTE. 13380000 LA R6,1(R6) ADD ONE TO NUMBER BYTE. 13400000 STC R6,0(R5) PUT BACK NUMBER BYTE 13420000 SR R6,R6 CLEAR REGISTER. 13440000 AH R6,CURLE CURRENT LEVEL. 13460000 SH R6,LASLE LAST LEVEL. 13480000 BC NOT-LOW,T71 TRANSFER HIGH AND EQUAL. 13500000 L R5,TKEYP GET TEXT KEY POINTER. 13520000 LA R5,1(R5) BUMP POINTER. 13540000 T71 DS 0H ENTRY. 13560000 ST R5,TNUMP SAVE TEXT NUMBER POINTER. 13580000 SR R6,R6 13600000 AH R6,CURLE 13620000 STH R6,LASLE 13640000 BR R7 RETURN. 13660000 T8 MVC 0(0,R4),0(R2) 13680000 EJECT 13682002 * ******************************************************Y02668 13690002 * * *Y02668 13692002 * * AOTXTLTH *Y02668 13694002 * * *Y02668 13696002 * * THIS ROUTINE CALCULATES THE LENGTH OF AN *Y02668 13698002 * * INTERNAL TEXT STRING(INCLUDING PREFIX). IT THEN *Y02668 13698402 * * PLACES THIS LENGTH INTO THE STRLTH FIELD OF THE *Y02668 13698802 * * PREFIX. *Y02668 13699202 * * *Y02668 13699602 * ******************************************************Y02668 13699702 SPACE 2 13699802 AOTXTLTH DS 0H Y02668 13708602 L R5,TEXTBUFP SET UP ADDRESSABILITY FOR Y02668 13710602 USING TEXT,R5 TEXT STRING PREFIX Y02668 13712602 L R1,TLENP GET THE END OF TEXT STRING Y02668 13713002 LA R1,1(R1) PLUS END KEY Y02668 13713102 SR R1,R5 CALC TEXT STRING LENGTH Y02668 13713202 STH R1,AOSTRLTH MOVE TEXT STRING LENGTH Y02668 13719902 MVC STRLTH(AONUML),AOSTRLTH INTO TEXT PREFIX Y02668 13722002 DROP R5 Y02668 13724002 BR RE RETURN TO CALLER Y02668 13726002 EJECT 13726602 * ********************************************************** 13733302 * * * 13740000 * * THIS ROUTINE INSERTS KEY INTO TEXT BUFFER AND * 13760000 * * STORES ZERO IN THE NUMBER AND LENGTH BYTES. * 13780000 * * ALSO CHECK FOR BUFFER OVERFLOW AND TRANSFERS * 13800000 * * TO B1 ROUTINE IF OVERFLOW OCCURS. * 13820000 * * * 13840000 * ********************************************************** 13860000 K1 DS 0H 13880000 L R4,TLENP GET ADDRESS OF LENGTH BYTE. 13900000 L R6,TENDP GET ADDRESS OF END BYTE. 13920000 LA R3,1(R4) COMP ADDR OF NEW LTH BYTE Y02668 13940002 STC R7,0(R4) ENTER KEY IN KEY BYTE. Y02668 14090002 CLI 0(R4),ENDK WAS IT AN END KEY? Y02668 14100002 BC NOT-EQUAL,K4 THIS STATEMENT. NO, CONTINUE. Y02668 14110002 * END OF TEXT FOR STATEMENT. Y02668 14110402 TM SWZ,JOBSW+EXECSW JOB OR EXEC STATEMENT? YM01546 14110802 BZ AOK10 BRANCH IF NEITHER. YM01546 14110902 SCSW O,VERBCSWZ,AOK10 BR IF PROC STMT-NO DEFAULTS. YM01546 14111002 LA R6,WAJOBPFX ADDRESS OF PSEUEDO JOB PFX. Y02668 14111202 USING TEXT,R6 PREFIX ADDRESSABILITY. Y02668 14111302 TM STRJINDC,JTXJOBFL WAS JOB FAILED? Y02668 14111402 BO AOK10 BR YES, BYPASS DEFAULT RTNE. Y02668 14111602 * JOB OR EXEC STATEMENT AND JOB HAS NOT BEEN FAILED. YM01546 14112002 * CHECK FOR OMITTED PARAMETERS FOR WHICH DEFAULTS ARE SUPPLIED. Y02668 14112402 BAL R6,AODFAULT PERFORM DEFAULT PROCESSING. Y02668 14112802 L R6,TEXTBUFP ADDR OF TEXT PREFIX. YM01546 14113202 TM STRJINDC,JTXJOBFL JOB FAILED BY DEFAULT RTNE? Y02668 14113302 BO E1 BR YES, ERR CODES ALL SET UP. Y02668 14113402 DROP R6 Y02668 14113502 AOK10 DS 0H Y02668 14113702 XC MSGKEY,MSGKEY TELL VGM NO SECONDARY MSG YM00393 14115002 OI AOSW1,AOTXTWRT SET TEXT WRITE SW. FOR VHCB Y02668 14116002 ST R4,TLENP SET PTR FOR NEXT VERB KEY Y02668 14120002 * IN CASE E1 ENTERS ON DFLT ERR YM01536 14121002 BR R9 RETURN. YM01536 14130002 SPACE 1 Y02668 14140002 * TEXT STRING NOT YET COMPLETED. ENTER NEXT KEY. Y02668 14145002 K4 DS 0H Y02668 14150002 STC R7,MSGKEY SAVE KEY FOR SECONDARY MSG. Y02668 14155002 ST R4,TKEYP SAVE POINTER FOR NEXT KEY. Y02668 14160002 XC 1(2,R4),1(R4) ZERO NUMBER AND LENGTH BYTES. Y02668 14170002 LA R4,2(R4) POINT TO LENGTH BYTE AND Y02668 14180002 ST R4,TLENP SAVE POINTER. Y02668 14190002 BCTR R4,0 POINT TO NUMBER BYTE AND Y02668 14200002 ST R4,TNUMP SAVE POINTER. Y02668 14210002 BR R9 RETURN. Y02668 14220002 EJECT 14222002 * ******************************************************* 14224002 * * *Y02668 14226002 * * TEXT STRING PREFIX CREATION *Y02668 14228002 * * *Y02668 14230002 * ******************************************************* 14232002 SPACE 2 14234002 AOPX DS 0H Y02668 14236002 ST RE,AODSPCSA SAVE RETURN ADDR Y02668 14238002 L R1,TEXTBUFP GET BEGINNING OF TEXT BUFFER Y02668 14240002 USING TEXT,R1 TEXT STRING ADDRESS ABILITY Y02668 14244002 L R0,TENDP GET ADDR OF TEXT BUF END Y02668 14246002 CLI VERB(RF),JOB Q. JOB VERB Y02668 14248002 BNE AOPX2 NO, CHECK FOR EXEC Y02668 14250002 XC STRLTH(STRJPFXL),STRLTH ZERO PREFIX BYTES Y02668 14252002 OI STRINDCS,JOBSTR INDICATE JOB STNT IN PREFIX Y02668 14254002 LA R1,STRJPFXL(R1) BUMP PTR BY JOB PREFIX LTH Y02668 14256002 B AOPX10 STORE UPDATED TBEGP Y02668 14258002 AOPX2 DS 0H Y02668 14260002 CLI VERB(RF),PROCV Q. PROC VERB Y02668 14262002 BNE AOPX3 NO, CHECK FOR EXEC Y02668 14264002 XC STRLTH(STREPFXL),STRLTH ZERO PREFIX Y02668 14266002 OI STRINDCS,PROCSTR INDICATE PROC STMT, IN PREFIX Y02668 14268002 OI STREINDC,ETXPRCV IND POSSIBLE PROC O'RIDES YM00382 14269002 LA R1,STREPFXL(R1) BUMP PTR BY PROC/EXEC PFX LTH Y02668 14270002 B AOPX10 STORE UPDATED TBEGP Y02668 14272002 AOPX3 DS 0H Y02668 14274002 CLI VERB(RF),EXEC Q. EXEC VERB Y02668 14276002 BNE AOPX5 NO, ASSUME DD STMT Y02668 14278002 XC STRLTH(STREPFXL),STRLTH ZERO PREFIX Y02668 14280002 OI STRINDCS,EXECSTR INDICATE EXEC STMT,IN PREFIX Y02668 14282002 LA R1,STREPFXL(R1) BUMP PTR BY PROC/EXEC PFX LTH Y02668 14284002 B AOPX10 STORE UPDATED TBEGP Y02668 14286002 AOPX5 DS 0H Y02668 14288002 XC STRLTH(STRDPFXL),STRLTH ZERO PREFIX Y02668 14290002 OI STRINDCS,DDSTR INDICATE DD STMT IN PREFIX Y02668 14292002 LA R1,STRDPFXL(R1) BUMP PTR BY DD PFX LTH Y02668 14294002 AOPX10 DS 0H Y02668 14296002 ST R1,TBEGP SET PTR TO BYTE AT WHICH Y02668 14298002 * VERB KEY WILL BE INSERTED Y02668 14300002 L RE,AODSPCSA RESTORE RETURN ADDR Y02668 14302002 BR RE RETURN TO CALLER Y02668 14304002 DROP R1 Y02668 14305002 EJECT Y02668 14748002 * ******************************************************Y02668 14750002 * * *Y02668 14752002 * * AODFAULT - DEFAULT PROCESSING ROUTINE. *Y02668 14754002 * * *Y02668 14756002 * * AODFAULT IS ENTERED AFTER ALL THE JCL PARAMETERS *Y02668 14758002 * * FOR A JOB STATEMENT HAVE BEEN PROCESSED AND CON- *Y02668 14760002 * * VERTED TO INTERNAL TEXT. AODFAULT CHECKS IF PARTI- *Y02668 14762002 * * CULAR PARAMS HAVE BEEN SPECIFIED ON THE STATEMENT. *Y02668 14764002 * * *Y02668 14766002 * * FOR THOSE PARAMS WHICH HAVE BEEN OMITTED, AODFAULT*Y02668 14768002 * * SUPPLIES A DEFAULT IN THE FOLLOWING WAY: A PREBUILT*Y02668 14770002 * * TEXT SEGMENT FOR A PARTICULAR PARAM IS APPENDED TO *Y02668 14772002 * * THE TEXT STRING FOR THE STATEMENT. THE ACTUAL *Y02668 14774002 * * DEFAULT VALUE FOR THE PARAM IS THEN OBTAINED FROM *Y02668 14776002 * * THE NEL AND IS ENTERED IN THE APPROPRIATE PLACE IN *Y02668 14778002 * * THE APPENDED SEGMENT. THE TEXT POINTER IS UPDATED *Y02668 14780002 * * WITH EACH ADDITION OF DEFAULT TEXT. AFTER ALL *Y02668 14782002 * * DEFAULT PROCESSING IS COMPLETE, THE K1 ROUTINE *Y02668 14784002 * * ENTERS AN END KEY IN TEXT AFTER THE LAST APPENDED *Y02668 14786002 * * SEGMENT. *Y02668 14788002 * * *Y02668 14790002 * * IN ADDITION, THE ACCOUNT NUMBER AND PROGRAMMER NAME*Y02668 14790302 * * OPTIONS, IF SPECIFIED, ARE PROPAGATED FROM THE NEL *Y02668 14790602 * * TO THE JOB STRING PREFIX, FOR PROCESSING BY THE *Y02668 14790902 * * INTERPRETER (IEFVJA). *Y02668 14791202 * * *Y02668 14791502 * * INPUT - *Y02668 14792002 * * .R4 - ADDRESS FOR APPENDED TEXT. *Y02668 14794002 * * *Y02668 14796002 * * OUTPUT - *Y02668 14798002 * * .R4 - ADDRESS FOR END KEY. *Y02668 14800002 * * *Y02668 14802002 * * NOTES - *Y02668 14804002 * * .AODFAULT USES THE AOPRMCHK RTNE TO CHECK IF A *YM01546 14806002 * * VALUE HAS BEEN SPECIFIED IN JCL FOR A PARTICULAR *YM01546 14809002 * * KEYWORD. *YM01546 14812002 * * INPUT TO AOPRMCHK IS THE KEYWORD CODE IN R3. *YM01546 14815002 * * OUTPUT FROM AOPRMCHK IS A ZERO IN R9 IF A VALUE *YM01546 14818002 * * HAS NOT BEEN SPECIFIED. *YM01546 14821002 * * .CONTENTS OF R4 ARE PLACED IN R7, AND R7 IS USED *YM08105 14822002 * * IN APPENDING DEFAULT TEXT TO THE TEXT STRING. *YM08105 14823002 * * *Y02668 14824002 * ******************************************************Y02668 14826002 SPACE 2 Y02668 14828002 * R4 POINTS TO NEXT KEY BYTE IN THE TEXT BUFFER. Y02668 14830002 AODFAULT DS 0H Y02668 14832002 STM R1,R7,AODFLTSA SAVE CALLER'S REGS. Y02668 14834002 ST R9,AODSPCSA SAVE K1 CALLER'S RETURN REG. YM01546 14835002 LR R7,R4 MOVE KEY BYTE ADD TO SAFE REG.Y02668 14836002 L R1,WANELPTR LOAD NEL ADDRESS. Y02668 14838002 USING NEL,R1 NEL ADDRESSABILITY. Y02668 14840002 SCSW O,EXECSWY,AOEDFL10 BRANCH IF EXEC STMT. YM01546 14840602 * JOB STATEMENT. PERFORM JOB DEFAULT PROCESSING. YM01546 14841202 * MSGCLASS CHECK. Y02668 14842002 LA R3,MSGCLAJK LOAD KEY. Y02668 14844002 BAL R6,AOPRMCHK CHECK IF DEFAULT REQUIRED. YM01546 14846002 * AOPRMCHK RETURNS WITH ZERO IN R9 IF DEFAULT TEXT TO BE ADDED. YM01546 14847002 LTR R9,R9 DEFAULT REQUIRED? YM01546 14848002 BNZ AODFLT10 NO, BRANCH TO TRY NEXT. YM01546 14849002 * MSGCLASS VALUE NOT SPECIFIED ON JCL. DEFAULT IS SUPPLIED. YM01546 14850002 MVC 0(AOMGCLTH,R7),AOMSGCTX APPEND PREBUILT TEXT. Y02668 14854002 MVC AOMGCDSP(1,R7),NELMSGCL ENTER DEFAULT. Y02668 14856002 LA R7,AOMGCLTH(R7) ADD TEXT LTH TO KEY BYTE PTR. Y02668 14858002 MVI 0(R7),ENDK SET END KEY FOR TEXT SEARCH. YM01546 14859002 * MSGLEVEL CHECK. Y02668 14860002 AODFLT10 DS 0H Y02668 14862002 * INITIALIZE WORK AREA WITH DEFAULTS. THESE WILL BE REPLACED YM08105 14862402 * BY VALUES ON THE JOB CARD, IF ANY WERE SPECIFIED. YM08105 14862802 MVC WAMSGL1(1),NELMSGL1 JCL MSGL DEFAULT TO WK AREA. YM08105 14863202 MVC WAMSGL2(1),NELMSGL2 ALC MSGL DEFAULT TO WK AREA. YM08105 14863602 LA R3,MSGLEVJK LOAD KEY. Y02668 14864002 BAL R6,AOPRMCHK CHECK IF DEFAULT REQUIRED. YM00154 14866002 LTR R9,R9 DEFAULT REQUIRED? YM00154 14868002 BZ AODFLT15 BR YES TO SUPPLY BOTH DFLTS. YM08105 14870002 * KEYWORD NOT NULL, BUT ONLY ONE PRM OR AN EXCESSIVE NUMBER OF YM08105 14870102 * PRMS MAY HAVE BEEN SPECIFIED. CHECK FOR BOTH. YM08105 14870202 CLI 1(R9),2 MORE THAN 2 PRMS? YM08105 14870302 BNH AODFLT12 BRANCH NO. YM08105 14870402 * MORE THAN 2 PRMS. FAIL JOB AND ISSUE ERROR MESSAGE. YM08105 14870502 MVI MSGKEY,MSGLEVJK SET KEY FOR SECONDARY MSG. YM08105 14870602 LA R2,ERMES3 EXCESSIVE PARAM MSG CODE. YM08105 14870702 B AODFLT69 BR TO FAIL JOB, ISSUE MSG. YM08105 14870802 * YM08105 14870902 * LEGAL NUMBER OF PRMS. YM08105 14871002 AODFLT12 DS 0H YM08105 14871102 BAL RE,AOMGL1DF CHECK IF ONE DEFAULT OMITTED.YM08105 14871202 * AOMGL1DF WILL REPLACE DEFAULTS IN THE WORK AREA WITH ANY YM08105 14871302 * VALUES SPECIFIED ON THE JOB STATEMENT. YM08105 14871402 AODFLT15 DS 0H YM08105 14871502 * MOVE MSGLEVEL VALUES (SPECIFIED OR DEFAULTS) FROM WA TO TEXT.YM08105 14872002 MVC 0(AOMGLLTH,R7),AOMSGLTX APPEND PREBUILT TEXT. Y02668 14874002 MVC AOMGLDP1(1,R7),WAMSGL1 ENTER WA VALUE IN TEXT. YM08105 14876002 MVC AOMGLDP2(1,R7),WAMSGL2 ENTER WA VALUE IN TEXT. YM08105 14878002 LA R7,AOMGLLTH(R7) ADD TEXT LTH TO KEY BYTE PTR. Y02668 14880002 MVI 0(R7),ENDK SET END KEY FOR TEXT SEARCH. YM01546 14881002 * PRTY CHECK. Y02668 14882002 AODFLT20 DS 0H Y02668 14884002 LA R3,PRTYJK LOAD KEY. Y02668 14886002 BAL R6,AOPRMCHK CHECK IF DEFAULT REQUIRED. YM00154 14888002 LTR R9,R9 DEFAULT REQUIRED? YM00154 14890002 BNZ AODFLT30 NO, BRANCH TO TRY NEXT. YM00154 14892002 * PRTY VALUE NOT SPECIFIED ON JCL. DEFAULT IS SUPPLIED. YM00154 14894002 MVC 0(AOPRTLTH,R7),AOPRTYTX APPEND PREBUILT TEXT. Y02668 14896002 MVC AOPRTDSP(2,R7),NELJPRTY ENTER DEFAULT. Y02668 14898002 LA R7,AOPRTLTH(R7) ADD TEXT LTH TO KEY BYTE PTR. Y02668 14900002 MVI 0(R7),ENDK SET END KEY FOR TEXT SEARCH. YM01546 14901002 * REGION CHECK. Y02668 14902002 AODFLT30 DS 0H Y02668 14904002 L RF,TEXTBUFP ADDRESS OF TEXT STRING. YM01546 14904602 USING TEXT,RF TEXT ADDRESSABILITY. YM01546 14905202 LA R3,REGINJK LOAD KEY. Y02668 14906002 BAL R6,AOPRMCHK CHECK IF DEFAULT REQUIRED. YM00154 14908002 LTR R9,R9 DEFAULT REQUIRED? YM00154 14910002 BNZ AODFLT50 NO, BRANCH TO TRY NEXT. YM00154 14912002 * REGION VALUE NOT SPECIFIED ON JCL. DEFAULT IS SUPPLIED. YM00154 14914002 MVC 0(AOREGLTH,R7),AOREGNTX APPEND PREBUILT TEXT. Y02668 14916002 MVC AOREGDSP(3,R7),NELREG ENTER DEFAULT. Y02668 14918002 OI STRJINDC,JTXREGDF INDICATE REGION IS A DEFAULT. Y02668 14919202 LA R7,AOREGLTH(R7) ADD TEXT LTH TO KEY BYTE PTR. Y02668 14920002 MVI 0(R7),ENDK SET END KEY FOR TEXT SEARCH. YM01546 14921002 *****************************************************************Y02668 14942102 * *Y02668 14942202 * PROPAGATE OPTIONS TO THE JOB TEXT PREFIX, FOR PROCESSING *Y02668 14942302 * BY THE INTERPRETER (IEFVJA). *Y02668 14942402 * *Y02668 14942502 *****************************************************************Y02668 14942602 AODFLT50 DS 0H Y02668 14942702 TM NELPARMO,NELPGMN PROGR NAME REQUIRED OPTION? Y02668 14942802 BZ AODFLT54 BRANCH NO. Y02668 14942902 OI STRJINDC,JTXPROGN YES, PROPAGATE OPTION TO PFX. Y02668 14943002 AODFLT54 DS 0H Y02668 14943102 TM NELPARMO,NELACCT ACCT # REQUIRED OPTION ? Y02668 14943202 BZ AODFLT60 BRANCH NO. Y02668 14943302 OI STRJINDC,JTXACCTN YES, PROPAGATE OPTION TO PFX. Y02668 14943402 * LABEL CHECK. Y02668 14944002 *****************************************************************Y02668 14946002 * *Y02668 14948002 * LABEL DEFAULT PROCESSING IS AN EXCEPTIONAL CASE. THE ACTUAL *Y02668 14950002 * CHECK FOR THE SPECIFICATION OF LABEL PROCESSING PARAMETERS IS *Y02668 14952002 * MADE IN THE INTERPRETER (IEFVDA). WHAT THIS ROUTINE DOES IS *Y02668 14954002 * MERELY TRANSMIT TO THE INTERPRETER THE LABEL PROCESSING *Y02668 14956002 * DEFAULTS SUPPLIED IN THE NEL. THIS IS DONE BY MEANS OF LABEL *Y02668 14958002 * FLAGS IN THE PREFIX OF THE JOB STATEMENT TEXT STRING, RATHER *Y02668 14960002 * THAN BY APPENDING PREBUILT LABEL TEXT, TO RETAIN COMPATIBILITY*Y02668 14962002 * WITH EXISTING CODE IN IEFVDA. *Y02668 14964002 * *Y02668 14966002 *****************************************************************Y02668 14968002 AODFLT60 DS 0H Y02668 14970002 CLI NELLABEL,C'0' CHAR EQUAL 0? Y02668 14976002 BNE AODFLT64 NO, CHECK FOR 1. Y02668 14978002 * CHARACTER IS 0. Y02668 14980002 MVI STRJLABD,JTXLABNL SET BIT FOR NL. Y02668 14984002 B AODFLT70 EXIT. Y02668 14986002 AODFLT64 DS 0H Y02668 14988002 CLI NELLABEL,C'1' CHAR EQUAL 1? Y02668 14990002 BNE AODFLT68 NO,INVALID SPECIFICATION. Y02668 14992002 * CHARACTER IS 1. Y02668 14994002 MVI STRJLABD,JTXLABLP SET BIT FOR BLP. Y02668 14996002 B AODFLT70 EXIT. Y02668 14998002 * NEITHER 0 NOR 1 - INVALID CHARACTER. Y02668 15000002 AODFLT68 DS 0H Y02668 15001002 MVI MSGKEY,LABELK SET KEY FOR SECONDARY MSG. Y02668 15002002 LA R2,ERMSG639 'INVALID CLASS' MSG CODE. Y02668 15003002 * YM08105 15004002 * COMMON ERROR ENTRY FOR SETTING JOB FAIL BIT AND ENTERING YM08105 15005002 * ERROR MSG CODE IN REG 2 FOR IEFVGM. YM08105 15006002 AODFLT69 DS 0H YM08105 15007002 L RF,TEXTBUFP ADDRESS OF JOB TEXT STRING. YM08105 15008002 OI STRJINDC,JTXJOBFL SET JOB FAIL SWITCH FOR K1. YM08105 15009002 DROP RF YM08105 15010002 ST R2,AODFLTSA+4 SET ERR CODE IN R2 SLOT. YM01546 15014602 B AODFLT70 EXIT. YM01546 15014802 EJECT YM01546 15015002 ****************************************************************YM01546 15015202 * *YM01546 15015402 * EXEC STATEMENT DEFAULT PROCESSING - *YM01546 15015602 * *YM01546 15015802 * .SPECIFICATION OF A PARAMETER ON AN EXEC STATEMENT INVOKING *YM01546 15016002 * A PROCEDURE (EXEC PROC) RESULTS IN AN OVERRIDE OF THE VALUE *YM01546 15016202 * SPECIFIED ON THE EXEC STATEMENT (EXEC PGM) CONTAINED IN THE *YM01546 15016402 * PROCEDURE. *YM01546 15016602 * .SPECIFICATION OF A NULL PARAMETER (KEYWORD=,) ON THE EXEC *YM01546 15016802 * PROC STATEMENT, RESULTS IN AN OVERRIDE WITH A DEFAULT VALUE,*YM01546 15017002 * OF THE VALUE SPECIFIED ON THE EXEC PGM STATEMENT. *YM01546 15017202 * .ABSENCE OF A PARTICULAR KEYWORD FROM BOTH THE EXEC PROC AND *YM01546 15017402 * THE EXEC PGM STATEMENTS, RESULTS IN THE ASSIGNMENT OF A *YM01546 15017602 * DEFAULT VALUE FOR THE KEYWORD. *YM01546 15017802 * .ABSENCE OF THE TIME KEYWORD FORM THE EXEC PROC STMT RESULTS *YM01546 15018002 * IN THE ASSIGNMENT OF THE TIME VALUE SPECIFIED ON THE EXEC *YM01546 15018202 * PGM STMT. IF NONE WAS SPECIFIED, THE TIME DEFAULT VALUE *YM01546 15018402 * IS THEN ASSIGNED. *YM01546 15018602 * *YM01546 15018802 ****************************************************************YM01546 15019002 * YM01546 15019202 * CHECK IF TIME KEYWORD SPECIFIED. YM01546 15019402 AOEDFL10 DS 0H YM01546 15019602 TM PSTMT+4,8 EXEC CONVERTED FROM PROC ST? YM01546 15019802 BO AOEDFL90 YES, BYPASS DEFAULTS. YM01546 15020002 L R6,TBEGP POINT TO BASE KEY. YM01546 15020202 LA R6,1(R6) POINT TO PARAM COUNT. YM01546 15020402 CLI 0(R6),2 TWO PRMS? EXEC PROC HAS 2. YM01546 15020602 BE AOEDFL15 BR YES TO EXEC PROC CODE. YM01546 15020802 * ONE PARAM - STMT MAY BE EXEC PROC=PROCNAME OR PGM=PROGNM. YM01546 15021002 * CHECK FOR PROC= KEY. YM01546 15021202 MVI AOSCHKYS,PROCEK ENTER KEY IN SEARCH LIST. YM01546 15021402 MVI AOSCHKYS+1,ENDLISTI END OF LIST INDICATOR. YM01546 15021602 BAL RE,AOKSRCHR SEARCH FOR KEY IN TEXT. YM01546 15021802 * AOKSRCHR RETURNS ADDR OF FOUND KEY IN R9, ZERO IF NOT FOUND. YM01546 15022002 LTR R9,R9 PROC= KEY FOUND? YM01546 15022202 BZ AOEDFL30 BR NO, EXEC PGM. YM01546 15022402 * YM01546 15022602 * STATEMENT INVOKES PROC. IF NULL TIME SPECIFIED (TIME=,) THE YM01546 15022802 * DEFAULT IS SUPPLIED, TO OVERRIDE TIME VALUES SPECIFIED ON YM01546 15023002 * THE EXEC STMTS IN THE PROC. IF TIME KEYWORD WAS NOT YM01546 15023202 * SPECIFIED, NO DEFAULT IS SUPPLIED, TO PERMIT TIME VALUES YM01546 15023402 * SPECIFIED ON THE EXEC STMTS IN THE PROC TO TAKE EFFECT. YM01546 15023602 * YM01546 15023802 AOEDFL15 DS 0H YM01546 15024002 MVI AOSCHKYS,TIMEEEK ENTER KEY IN SEARCH LIST. YM01546 15024202 MVI AOSCHKYS+1,ENDLISTK END OF LIST INDICATOR. YM01546 15024402 LR R3,R7 SAVE R7. AOKSRCHR SAVES R3. YM01546 15024602 BAL RE,AOKSRCHR SEARCH TEXT FOR KEY. YM01546 15024802 LR R7,R3 RESTORE R7. YM01546 15025002 * AOKSRCHR RETURNS ADDR IN R9 IF KEY FOUND, ZERO IF NOT FOUND. YM01546 15025202 LTR R9,R9 KEY FOUND? YM01546 15025402 BZ AOEDFL90 BR NO TO EXIT, NO DEFAULTS. YM01546 15025602 * KEY FOUND. FALL THROUGH TO CHECK FOR NULL VALUE. YM01546 15025802 AOEDFL30 DS 0H YM01546 15026002 LA R3,TIMEEEK LOAD KEY. YM01546 15026202 BAL R6,AOPRMCHK CHECK IF DEFAULT REQUIRED. YM01546 15026402 * AOPRMCHK RETURNS WITH ZERO IN R9 IF DEFAULT TEXT TO BE ADDED. YM01546 15026602 LTR R9,R9 DEFAULT REQUIRED? YM01546 15026802 BNZ AOEDFL90 BRANCH NO TO EXIT. YM01546 15027002 * TIME NOT SPECIFIED ON STATEMENT, OR TIME PARAM WAS NULL - YM01546 15027202 * I.E., 'TIME=,'. YM01546 15027402 * R7 CONTAINS POINTER TO END OF TEXT + 1. YM01546 15027602 MVC 0(AOTIMLTH,R7),AOTIMETX APPEND PREBUILT TEXT. YM01546 15027802 MVC AOTIMDP1(4,R7),NELTIME ENTER MINUTES DEFAULT. YM01546 15028002 MVC AOTIMDP2(2,R7),NELTIME+4 ENTER SECONDS DEFAULT. YM01546 15028202 DROP R1 YM01546 15028402 LA R7,AOTIMLTH(R7) ADD TEXT LTH TO KEY BYTE PTR.YM01546 15028602 MVI 0(R7),ENDK SET END KEY FOR STRING. YM01546 15028802 AOEDFL90 DS 0H YM01546 15029002 * FALL THROUGH TO EXIT. YM01546 15029202 EJECT YM01546 15029402 * ALL CHECKS COMPLETED. EXIT FROM DEFAULT PROCESSING. YM01546 15029602 AODFLT70 DS 0H YM01546 15029802 ST R7,AODFLTSA+12 REPLACE OLD KEY BYTE PTR(R4) YM01546*15030002 WITH UPDATED POINTER. YM01546 15030202 LM R1,R7,AODFLTSA RESTORE CALLER'S REGS. YM01546 15030402 L R9,AODSPCSA RESTORE K1 CALLER'S RET REG. YM01546 15030602 BR R6 RETURN. YM01546 15030802 EJECT YM01546 15031002 ****************************************************************YM01546 15031202 * * *YM01546 15031402 * * AOPRMCHK - PARAMETER CHECK ROUTINE. *YM01546 15031602 * * *YM01546 15031802 * * AOPRMCHK CHECKS TO SEE IF THE KEY FOR A PARTICULAR*YM01546 15032002 * * KEYWORD EXISTS IN TEXT, AND IF SO, WHETHER AN *YM01546 15032202 * * ACTUAL OR NULL PARAMETER HAS BEEN SUPPLIED. *YM01546 15032402 * * SPECIFICATION OF A NULL PARAMETER REPRESENTS, IN *YM01546 15032602 * * EFFECT, A REQUEST FOR THE ASSIGNMENT OF A DEFAULT *YM01546 15032802 * * VALUE FOR THE KEYWORD. *YM01546 15033002 * * *YM01546 15033202 * * INPUT - *YM01546 15033402 * * .R3 - KEY FOR WHICH SEARCH IS TO BE MADE. *YM01546 15033602 * * .R7 - PTR TO END OF TEXT + 1. *YM01546 15033802 * * *YM01546 15034002 * * OUTPUT - *YM01546 15034202 * * .R9 - NON-ZERO IF PARAMETER SPECIFIED, *YM01546 15034402 * * ZERO IF KEYWORD NOT SPECIFIED, OR SPECIFIED *YM01546 15034602 * * WITH NULL PARAMETER. *YM01546 15034802 * * *YM01546 15035002 * * NOTES - *YM01546 15035202 * * .AOPRMCHK USES AOKSRCHR TO FIND THE KEY IN TEXT. *YM01546 15035402 * * .AOPRMCHK SAVES R7 IN R3, TO INSURE ITS SAFETY, *YM01546 15035602 * * SINCE AOKSRCHR SAVES ONLY RE THROUGH R6. *YM01546 15035802 * * .R6 IS THE BRANCH AND RETURN REG FOR THIS RTNE. *YM01546 15036002 * * .R3 AND R9 ARE USED AND NOT SAVED BY THIS RTNE. *YM01546 15036202 * * .AOPCHK2 IS AN ALTERNATE ENTRY POINT, IF ONLY THE *YM08105 15036402 * * TEXT OVERLAY FUNCTION OF AOPRMCHK IS DESIRED. *YM08105 15036502 * * *YM08105 15036602 ****************************************************************YM08105 15036702 * YM08105 15036802 AOPRMCHK DS 0H YM08105 15036902 STC R3,AOSCHKYS ENTER KEY IN SEARCH LIST. YM01546 15037202 MVI AOSCHKYS+1,ENDLISTK END OF LIST INDICATOR. YM01546 15037402 LR R3,R7 SAVE R7. AOKSRCHR SAVES R3. YM01546 15037602 BAL RE,AOKSRCHR SEARCH TEXT FOR KEY. YM01546 15037802 LR R7,R3 RESTORE R7. YM01546 15038002 * AOKSRCHR RETURNS ADDR IN R9 IF KEY FOUND, ZERO IF NOT FOUND. YM01546 15038202 LTR R9,R9 KEY FOUND? YM01546 15038402 BZ AOPCHK10 BR NO TO RETURN. YM01546 15038602 * KEYWORD WAS SPECIFIED. CHECK FOR NULL PARAM (I.E., KEYWORD=,).YM01546 15038802 CLI 1(R9),1 ONE PARAMETER? YM01546 15039002 BH AOPCHK10 MORE THAN 1 MEANS PARM VALID YM01546*15039202 OR JCL ERROR. YM01546 15039402 CLI 2(R9),0 IS PARAM LTH ZERO? YM01546 15039602 BNE AOPCHK10 NON-ZERO LTH MEANS PRM VALID YM01546 15039802 ****************************************************************YM01546 15040002 * NULL PARAMETER WAS SPECIFIED. ELIMINATE TEXT FOR KEYWORD, SO YM01546 15040202 * THAT APPENDED DEFAULT TEXT WILL NOT REPRESENT DUPLICATION OF YM01546 15040402 * TEXT FOR THE KEYWORD. THIS IS ACCOMPLISHED BY OVERLAYING THE YM01546 15040602 * THREE BYTES OF TEXT FOR THE NULL PARAM WITH THE REMAINDER OF YM01546 15040802 * THE TEXT STRING. YM01546 15041002 ****************************************************************YM01546 15041102 LA R2,3 LTH OF TEXT TO BE OVERLAID. YM08105 15041202 * R2 = LENGTH OF TEXT TO BE OVERLAID. YM08105 15041302 * R7 = ADDRESS OF END OF TEXT +1 YM08105 15041402 * R9 = ADDRESS OF TEXT SEGMENT TO BE OVERLAID. YM08105 15041502 AOPCHK2 DS 0H ENTRY FOR TEXT OVERLAY. YM08105 15041602 STM R4,R7,IWAIOSA SAVE REGS USED BELOW. YM01546 15041702 LR R4,R9 INITIALIZE TARGET REG. YM01546 15041802 LR R5,R7 COPY EOTEXT +1 ADDRESS. YM01546 15041902 LA R6,0(R2,R4) ADD LTH TO TARGET PTR TO GET YM01546*15042402 SOURCE ADDR(TEXT AFTER NULL) YM01546 15042602 SR R5,R6 COMPUTE LTH OF MOVE - YM01546*15042802 LTH=EOTEXT ADDR-SOURCE ADDR. YM01546 15043002 MVCL R4,R6 OVERLAY NULL PARAM TEXT. YM01546 15043202 LM R4,R7,IWAIOSA RESTORE REGS. YM01546 15043402 SR R7,R2 UPDATE EOTEXT ADDRESS TO YM08105*15043602 REFLECT NEW TEXT STRING LTH. YM01546 15043802 SR R9,R9 INDICATE DEFAULT REQUIRED. YM01546 15044002 AOPCHK10 DS 0H YM01546 15044202 BR R6 RETURN. YM01546 15044402 * YM01546 15044602 EJECT 15045002 ****************************************************************YM08105 15047002 * * *YM08105 15049002 * * MSGLEVEL KEYWORD SPECIFIED IN NON-NULL FORM. THIS*YM08105 15051002 * * ROUTINE CHECKS IF BOTH PRMS HAVE BEEN SPECIFIED. *YM08105 15053002 * * IF THERE HAS BEEN AN OMISSION, A DEFAULT IS *YM08105 15055002 * * SUPPLIED. *YM08105 15057002 * * LISTED BELOW ARE MSGLEVEL VARIATIONS FOR WHICH *YM08105 15059002 * * THIS ROUTINE CHECKS, AND THE DEFAULTS SUPPLIED. *YM08105 15061002 * * *YM08105 15063002 * * A. MSGLEVEL=X ALLOC DEFAULT. *YM08105 15065002 * * B. MSGLEVEL=(X,) ALLOC DEFAULT. *YM08105 15067002 * * C. MSGLEVEL=(X,Y) NO DEFAULT. *YM08105 15069002 * * D. MSGLEVEL=(,Y) JCL DEFAULT. *YM08105 15071002 * * E. MSGLEVEL=(,) JCL AND ALLOC DEFAULTS. *YM08105 15073002 * * *YM08105 15075002 ****************************************************************YM08105 15077002 * R9 = ADDRESS OF MSGLEVEL KEY IN TEXT STRING. YM08105 15079002 * R2 = POINTER TO MSGLEVEL TEXT CONTROL FIELDS. YM08105 15081002 * RE = BRANCH AND RETURN REG. YM08105 15083002 AOMGL1DF DS 0H YM08105 15085002 LA R2,2(R9) SET PTR TO JCL PRM LTH. YM08105 15087002 CLI 0(R2),1 NON-NULL, LEGAL JCL LTH? YM08105 15089002 BH AOMSGL90 BR EXCESSIVE PRM LTH. YM08105 15091002 BL AOMSGL50 BR NULL TO CHECK ALLOC PRM. YM08105 15093002 * NON-NULL JCL PRM - VAR A, B OR C. YM08105 15095002 LA R2,1(R2) SET PTR TO JCL VALUE. YM08105 15097002 MVC WAMSGL1(1),0(R2) JCL VALUE FROM TEXT TO WA. YM08105 15099002 * YM08105 15101002 * CHECK ALLOC PRM. YM08105 15103002 AOMSGL50 DS 0H YM08105 15105002 CLI 1(R9),2 ALLOC PRM INDICATED? YM08105 15107002 BL AOMSGL70 BR NO TO OVERLAY TEXT-VAR A. YM08105 15109002 * ALLOC PRM INDICATED - VAR B THRU E. YM08105 15111002 LA R2,1(R2) SET PTR TO ALLOC LTH. YM08105 15113002 CLI 0(R2),1 NON-NULL, VALID ALLOC LTH? YM08105 15115002 BH AOMSGL90 BR EXCESSIVE PRM LTH. YM08105 15117002 BL AOMSGL70 BR NULL ALLOC PRM. YM08105 15119002 * NON-NULL ALLOC PRM - VAR C OR D. YM08105 15121002 LA R2,1(R2) SET PTR TO ALLOC VALUE. YM08105 15123002 MVC WAMSGL2(1),0(R2) ALLOC VALUE FROM TEXT TO WA. YM08105 15125002 * YM08105 15127002 * ENTRY TO OVERLAY EXISTING MSGLEVEL TEXT AND APPEND YM08105 15129002 * DEFAULT TEXT. YM08105 15131002 * R2 POINTS TO LAST BYTE OF MSGLEVEL TEXT. YM08105 15133002 AOMSGL70 DS 0H YM08105 15135002 LA R2,1(R2) ADD 1 FOR LAST BYTE. YM08105 15137002 SR R2,R9 COMPUTE LTH OF MSGLEVEL TEXT.YM08105 15139002 BAL R6,AOPCHK2 BR TO OVERLAY EXISTING TEXT. YM08105 15141002 BR RE RETURN. YM08105 15143002 * YM08105 15145002 * ENTRY FOR EXCESSIVE PRM LENGTH ERROR. YM08105 15147002 AOMSGL90 DS 0H YM08105 15149002 LA R2,ERMSG642 EXCESSIVE PRM LTH MSG CODE. YM08105 15151002 MVI MSGKEY,MSGLEVJK SET KEY FOR SECONDARY MSG. YM08105 15153002 B AODFLT69 BR TO FAIL JOB, ISSUE MSG. YM08105 15155002 EJECT 15180000 * ******************************************************Y02668 15180202 * * *Y02668 15180402 * * PREBUILT TEXT SEGMENTS FOR PARAMETERS FOR WHICH *Y02668 15180602 * * DEFAULTS ARE SUPPLIED BY THE SYSTEM. *Y02668 15180802 * * *Y02668 15181002 * ******************************************************Y02668 15181202 SPACE 2 Y02668 15181402 * MSGCLASS TEXT. Y02668 15181602 AOMSGCTX DS 0C Y02668 15181802 DC AL1(MSGCLAJK) MSGCLASS KEY. Y02668 15182002 DC AL1(1) NUMBER OF PARAMS. Y02668 15182202 DC AL1(1) PARAM LENGTH Y02668 15182402 AOMGCDFL DC AL1(0) NULL PARAM - DEFAULT SLOT. Y02668 15182602 AOMGCEND DS 0C END OF TEXT. Y02668 15182802 AOMGCLTH EQU AOMGCEND-AOMSGCTX LTH OF TEXT. Y02668 15183002 AOMGCDSP EQU AOMGCDFL-AOMSGCTX DISPLACEMENT FOR DEFAULT. Y02668 15183202 * Y02668 15183402 * MSGLEVEL TEXT. Y02668 15183602 AOMSGLTX DS 0C Y02668 15183802 DC AL1(MSGLEVJK) MSGLEVEL KEY. Y02668 15184002 DC AL1(2) NUMBER OF PARAMS. Y02668 15184202 DC AL1(1) FIRST PARAM LTH. Y02668 15184402 AOMGLDF1 DC AL1(0) NULL PARAM - DEFAULT SLOT. Y02668 15184602 DC AL1(1) SECOND PARAM LTH. Y02668 15184802 AOMGLDF2 DC AL1(0) NULL PARAM - DEFAULT SLOT. Y02668 15185002 AOMGLEND DS 0C END OF TEXT. Y02668 15185202 AOMGLLTH EQU AOMGLEND-AOMSGLTX LTH OF TEXT. Y02668 15185402 AOMGLDP1 EQU AOMGLDF1-AOMSGLTX DISPLACEMENT FOR DEFAULT. Y02668 15185602 AOMGLDP2 EQU AOMGLDF2-AOMSGLTX DISPLACEMENT FOR DEFAULT. Y02668 15185802 * Y02668 15186002 * PRTY TEXT. Y02668 15186202 AOPRTYTX DS 0C Y02668 15186402 DC AL1(PRTYJK) PRTY KEY. Y02668 15186602 DC AL1(1) NUMBER OF PARAMS. Y02668 15186802 DC AL1(2) PARAM LENGTH Y02668 15187002 AOPRTDFL DC AL2(0) NULL PARAM - DEFAULT SLOT. Y02668 15187202 AOPRTEND DS 0C END OF TEXT. Y02668 15187402 AOPRTLTH EQU AOPRTEND-AOPRTYTX LTH OF TEXT. Y02668 15187602 AOPRTDSP EQU AOPRTDFL-AOPRTYTX DISPLACEMENT FOR DEFAULT. Y02668 15187802 * Y02668 15188002 * REGION TEXT. Y02668 15188202 AOREGNTX DS 0C Y02668 15188402 DC AL1(REGINJK) REGION KEY. Y02668 15188602 DC AL1(1) NUMBER OF PARAMS. Y02668 15188802 DC AL1(4) PARAM LENGTH. Y02668 15189002 AOREGDFL DC AL3(0) NULL PARAM - DEFAULT SLOT. Y02668 15189202 DC C'K' REGION IDENTIFIER. Y02668 15189402 AOREGEND DS 0C END OF TEXT. Y02668 15189602 AOREGLTH EQU AOREGEND-AOREGNTX LTH OF TEXT. Y02668 15189802 AOREGDSP EQU AOREGDFL-AOREGNTX DISPLACEMENT FOR DEFAULT. Y02668 15190002 * Y02668 15190202 * TIME TEXT. Y02668 15190402 AOTIMETX DS 0C Y02668 15190602 DC AL1(TIMEEEK) TIME KEY. YM01546 15190802 DC AL1(2) NUMBER OF PARAMS. Y02668 15191002 DC AL1(4) FIRST PARAM LTH. Y02668 15191202 AOTIMDF1 DC AL4(0) NULL PARAM - DEFAULT SLOT. Y02668 15191402 DC AL1(2) SECOND PARAM LTH. Y02668 15191602 AOTIMDF2 DC AL2(0) NULL PARAM - DEFAULT SLOT. Y02668 15191802 AOTIMEND DS 0C END OF TEXT. Y02668 15192002 AOTIMLTH EQU AOTIMEND-AOTIMETX LTH OF TEXT. Y02668 15192202 AOTIMDP1 EQU AOTIMDF1-AOTIMETX DISPLACEMENT FOR DEFAULT. Y02668 15192402 AOTIMDP2 EQU AOTIMDF2-AOTIMETX DISPLACEMENT FOR DEFAULT. Y02668 15192602 WAMSGL1 EQU AOHEBSA JCL PRM VALUE FOR MSGLEVEL. YM08105 15192802 WAMSGL2 EQU AOHEBSA+1 ALC PRM VALUE FOR MSGLEVEL. YM08105 15193002 EJECT 15193202 * ********************************************************** 15200000 * * * 15220000 * * ERROR ROUTINE * 15240000 * * SETS SWITCH TO FAIL JOB * 15260000 * * SETS ERROR SWITCH FOR DD STATEMENT * 15280000 * * MOVES FAKE JOB TEXT FOR JOB STATEMENT * 15300000 * * MOVES FAKE EXEC TEXT FOR EXEC STATEMENT * 15320000 * * USES MESSAGE MODULE TO ISSUE ERROR MESSAGE * 15340000 * * GOES TO SCAN EXIT ROUTINE * 15360000 * * * 15380000 * ********************************************************** 15400000 E1 DS 0H ENTRY TO ERROR ROUTINE. 15420000 L RF,IEFVGMV LOAD VCON 15421000 SCSW O,CXPNZ,E102 CTL RTNE ISSUES MSG YM00393 15424002 BALR RE,RF GO TO ISSUE MSG YM00393 15427002 E102 DS 0H 15431000 SCSW S,PROCERRZ SET ERROR INDICATOR FOR PROC O RIDE 15440000 LA R1,WAJOBPFX ADDRESS OF PSEUEDO JOB PFX. Y02668 15460002 USING TEXT,R1 PREFIX ADDRESSABILITY. Y02668 15462002 OI STRJINDC,JTXJOBFL SET JOB FAILED BIT. Y02668 15464002 DROP R1 Y02668 15466002 SCSW O,VERBCSWZ,E104 TRANSFER PROC VERB 15470000 SCSW O,JOBSWY,E2 TRANSFER JOB. 15480000 SCSW O,EXECSWY,E3 TRANSFER EXEC. 15500000 E104 DS 0H 15510000 SCSW S,FERRORA SET ERROR FOR DD AND PROC VERB 15520000 B E4 TRANSFER. 15540000 E2 DS 0H ENTER FOR JOB. 15560000 MVC WAJBNAME(8),DUMNAME CHANGE JOBNAME TO 'JOBFAIL', Y02668 15570002 LA R1,DUMMYJCT POINTER TO CANNED JOBFAIL TXT.Y02668 15580002 LA R5,JOTEXLEN LOAD LENGTH OF TEXT. Y02668 15590002 B E33 MOVE FAIL TEXT TO TEXT BUFFER.Y02668 15600002 E3 DS 0H ENTER FOR EXEC. 15620000 NI SRCHSW1,SRCHCLR-SRCHF8 TURN OFF SYMBOLIC @ZA03299 15622003 * BYPASS SW. SO THAT IT IS@ZA03299 15623003 * NOT APPLIED TO THE NEXT @ZA03299 15624003 * STMT. NORMALLY TURNED @ZA03299 15625003 * OFF IN COMMA OR BLANKS @ZA03299 15626003 * ROUTINE. @ZA03299 15627003 L R1,TEXTBUFP PREFIX ADDRESSABILITY @ZA25564 15628003 USING TEXT,R1 @ZA25564 15629003 TM STREINDC,ETXPROC IS STATEMENT FROM A PROC @ZA25564 15630003 DROP R1 @ZA25564 15631003 BO E31 YES,DO NOT CLEAR SYMBUF PTR @ZA25564 15632003 XC SYMTTR(VFA4),SYMTTR CLEAR PTR TO SYMBUF @ZA15003 15635003 E31 DS 0H @ZA15003 15636003 LA R1,DUMMYSCT PTR TO CANNED EXEC FAIL TEXT. Y02668 15640002 LA R5,EXTEXLEN LOAD LENGTH OF TEXT. Y02668 15641002 E33 DS 0H Y02668 15642002 L R4,TEXTBUFP POINT TO START OF BAD TEXT Y02668 15643002 BCTR R5,0 REDUCE TEXT LTH FOR MOVE. Y02668 15644002 EX R5,DUMTXTMV MOVE FAIL TEXT OVER BAD TEXT. Y02668 15645002 LA R5,0(R4,R5) ADD START ADDR AND TEXT LTH-1.Y02668 15646002 LA R5,1(R5) ADD 1 TO GET ADDR OF NEXT Y02668 15647002 ST R5,TLENP AVAILABLE BYTE IN TEXT BUF. Y02668 15648002 E4 DS 0H ENTER FOR ALL. 15660000 BAL RE,AOTXTLTH GO TO UPDATE TEXT LENGTH Y02668 15662002 LA R7,ENDK ENTER END KEY FOR Y02668 15666002 BAL R9,K1 TEXT STRING IN ERROR. Y02668 15672002 SCSW O,CXPNZ,FAD1 CONTRL RTN ISSUES CONTIN NOT RCVD MSG 15680000 OI CMTZ,CMT+ENDS TURN ON COMMENT AND END SCAN SWS AACA 15710016 B FAC TRANSFER. 15760000 DUMTXTMV MVC 0(0,R4),0(R1) EXECUTED MV-FAIL TEXT TO BUF. Y02668 15770002 DUMMYJCT DS 0C FAKE JOB TEXT. 15780000 DC AL2(ENDDJCT-DUMMYJCT) LTH OF JOBFAIL TEXT. Y02668 15784002 DC AL1(JOBSTR) PREFIX - JOB STMT BIT ON Y02668 15788002 DC AL1(JTXJOBFL+JTXMHEDR) IND JOB FAILED & MSG WRTN Y02668 15790002 DC X'00' Y02668 15792002 DC X'00' Y02668 15796002 DC AL1(JOBK) JOB KEY. 15800000 DC X'03' NUMBER BYTE. 15820000 DC X'08' LENGTH BYTE. 15840000 DUMNAME DS 0C 15850002 DC C'JOBFAIL ' LABEL 15860000 DC X'08' LENGTH BYTE. 15880000 DC C'JOBFAILB' ACCOUNT NUMBER. 15900000 DC X'08' LENGTH BYTE. 15920000 DC C'JOBFAILC' PROGRAMMER NAME. 15940000 DC AL1(MSGLEVJK) MSGLEVEL KEY 15960000 DC X'01' NUMBER BYTE 15980000 DC X'01' LENGTH BYTE 16000000 DC C'1' MSGLEVEL =1 16020000 ENDDJCT DS 0C END OF FAKE TEXT. 16060000 DUMMYSCT DS 0C FAKE EXEC TEXT. 16080000 DC AL2(ENDDSCT-DUMMYSCT) LTH OF EXECFAIL TEXT. Y02668 16082002 DC AL1(EXECSTR) INDICATE EXEC TEXT STRING Y02668 16084002 DC X'00' Y02668 16092002 DC AL1(EXECK) EXEC KEY. 16100000 DC X'01' NUMBER BYTE. 16120000 DC X'08' LENGTH BYTE. 16140000 DC C'EXECFAIL' EXEC LABEL. 16160000 DC AL1(PGMEK) PGM EQUAL KEY. 16180000 DC X'01' NUMBER BYTE. 16200000 DC X'08' LENGTH BYTE. 16220000 DC C'EXECNONE' PROGRAM NAME. 16240000 ENDDSCT DS 0C END OF FAKE EXEC TEXT. 16280000 JOTEXLEN EQU (ENDDJCT-DUMMYJCT) JOBFAIL TEXT LENGTH Y02668 16286002 EXTEXLEN EQU (ENDDSCT-DUMMYSCT) EXECFAIL TEXT LENGTH. Y02668 16293002 EJECT 16300000 * ********************************************************** 16320000 * * * 16340000 * * BRANCH ROUTINE * 16360000 * * TRANSLATES JCL STATEMENT AND BRANCHES TO * 16380000 * * ROUTINE TO PROCESS DELIMITER. * 16400000 * * * 16420000 * ********************************************************** 16440000 FB1 DS 0H ENTRY TO BRANCH ROUTINE. 16460000 L R1,CSTRP GET CHARACTER STRING POINTER. 16480000 FB2 DS 0H ENTRY TO BRANCH ROUTINE. 16500000 LA R1,1(R1) BUMP CHARACTER STRING POINTER. 16520000 ST R1,CBSYP SAVE CHARACTER STRING POINTER. 16540000 L R3,AFB7 GET ADDRESS OF TRANSLATE TABLE 16560000 B FB4 TRANSFER. 16580000 FB3 DS 0H SECONDARY ENTRY TO BRANCH ROUTINE. 16600000 LA R1,1(R1) BUMP CHARACTER STRING POINTER. 16620000 FB4 DS 0H ENTRY FROM ABOVE 16640000 L R5,CENDP GET END POINTER. 16660000 SR R2,R2 ZERO REGISTER. 16680000 SR R5,R1 COMPUTE LENGTH CHARACTER STRING. 16700000 BC 12,BKR TRANSFER TO BLANK RTN 16720000 EX R5,FB6 EXECUTE TRT INSTRUCTION 16740000 LM R5,R6,TKEYP R5= TKEYP 16746017 * R6= TNUMP 16752017 BC 9,BKR TRANSFER TO BLANK ROUTINE. 7821 16758017 TM ENDKYSWP,ENDKYSW IS KEYWORD DELIMITER EXPECTED A28668 16758320 BZ FB41 NO - TRANSFER A28668 16758620 CLI 0(R1),C'=' IS DLIMITER EQUAL A28668 16758920 BE EQR YES. BRANCH TO EQUAL ROUTINE A28668 16759220 CLI 0(R1),C'.' IS DELIMITER PERIOD A28668 16759520 BE FB41 YEW. BRANCH TO CONTINUE A28668 16759820 CLI 0(R1),C'&&' IS DELIMITER AMPERSAND A28668 16760120 BE FB41 YES. TRANSFER TO CONTINUE A28668 16760420 CLI 0(R1),C' ' IS DELIMITER BLANK A28668 16760720 BNE FB401 NO TRANSFER ERROR A28668 16761020 BCTR R1,R0 DECREMENT CSTRP A28668 16761320 CLI 0(R1),C',' WAS LAST CHARACTER COMMA A28668 16761620 BE BKR3 YES, TRANSFER CONTINUATION A28668 16761920 FB401 DS 0H A28668 16762220 LA R2,ERMES19 NO. DELIMITER NOT FOR KEYWORD A28668 16762520 B E1 GO TO ERROR RTN. 16762820 FB41 DS 0H A28668 16763120 LA R0,EQ EQUAL SIGN FUNCTION BYTE VALUE. 7821 16764017 CR R2,R0 WAS DELIMITER AN '='. 7821 16770017 BE EQR YES-BRANCH TO EQUAL SIGN ROUTINE. 7821 16776017 STC R2,DLMFBYTE NO-SAVE DELIMITER FUNCTION BYTE. 7821 16782017 B FB5-4(R2) BRANCH TO PROPER ROUTINE. 7821 16788017 FB5 DS 0H BRANCH TABLE. 16800000 B BKR BLANK ROUTINE. 16820000 B PRR PERIOD ROUTINE. 16840000 B TTR ILLEGAL AND SLASH ROUTINE. 16860000 B LPR LEFT PAREN ROUTINE 16880000 B PLR PLUS ROUTINE 16900000 B AMR AMPERSAND ROUTINE. 16920000 B ASR ASTERICK ROUTINE 16940000 B RPR RIGHT PAREN ROUTINE. 16960000 B COR COMMA ROUTINE. 16980000 B APR APOST ROUTINE 17000000 B EQR EQUAL ROUTINE. 17020000 B MIR MINUS ROUTINE 17040000 B SLR SLASH ROUTINE 17060000 FB6 DS 0H LABEL FOR TRANSLATE. 17080000 TRT 0(0,R1),0(R3) EXECUTES THE TRANSLATE TABLE. 17100000 EJECT 17120000 TTR DS 0H ENTRY FOR ILLEGAL ROUTINE. 17140000 SPACE 17141017 * THE 'PLUS 0' CHARACTER ( 12-0 MULTIPUNCH ) IS USED IN SOME DATAAACA 17142017 * MNGMT MODULE NAMES. A CHECK IS MADE HERE TO DETERMINE IF AACA 17143017 * THE CHARACTER IS 1). A PLUS 0 AND 2). IN DSN FIELD. AACA 17144017 SPACE 17145017 CLI 0(R1),X'C0' IS THIS PLUS 0 AACA 17146017 BNE TTR08 NO - ERROR AACA 17147017 SPACE 17148017 BAL RE,ORRTN GO SEE IF THIS KEY IS O'RIDDEN AACA 17149017 SPACE 17150017 CLI 0(R5),DSNAMEK IS IT DSN AACA 17151017 BE FB3 YES - RET TO SCAN AACA 17152017 CLI 0(R5),DSIDK IS IT THE DSID KEY? @Y30OPSB 17152303 BE FB3 YES,12/0 OK WITH DSID AS WELL... @Y30OPSB 17152603 TTR08 DS 0H NO - ERROR AACA 17153017 LA R2,ERMES8 LOAD ERROR NUMBER 17160000 B E1 TRANSFER TO ERROR ROUTINE. 17180000 EJECT 17200000 BKR DS 0H ENTRY TO BLANK ROUTINE 17220000 BCTR R1,R0 DECREMENT CSTRP. 17240000 CLI 0(R1),C',' IS LAST DELIMITER COMMA. 17260000 BC EQUAL,BKR3 YES TRANSFER 17280000 SCSW O,COLSTY,BKR4 TRANSFER COL 72 NON BLANK 17300000 BKR11 DS 0H 17320000 LA R1,1(R1) RESTORE CSTRP. 17340000 SCSW O,FLUSHSWW,BKR2 TRANSFER FLUSH SW ON. 17360000 TM SRCHSW1,SRCHF8 SYMBOLIC TO BE BYPASSED A32730 17366020 BO BKR21 YES - BRANCH A32730 17372020 SCSW O,RPRSWW,BKR1 TRANSFER RT PAREN SW ON. 17380000 ST R1,CESYP SAVE CHARACTER END SYMBOL POINTER. 17400000 BKR1 DS 0H ENTRY 17420000 L R7,DELPTR GET RSTMT/PSTMT POINTER YM00399 17428002 * IF THERE IS NO OPERAND, THE OPER DISPLACEMENT IS 71 (COL 71). YM0399 17436002 CLI LISTPTR(R7),71 IS THERE AN OPERAND? YM00399 17444002 BE BKR1A NO DO NOT ENTER TEXT YM02708 17452002 BAL R7,T1 ENTER TEXT. 17460000 BKR1A DS 0H YM02708 17462002 SCSW Z,POVRDZ,BKR2 TRANSFER NO DD OVERRIDE 17464016 * SET COMMENT SW TO HANDLE POSSIBILITY 17468016 * THAT THIS OVERRIDE IS 17472016 * FOLLOWED BY A COMMENT 17476016 * CONTINUATION. THE SW 17480016 * IS CLEARED WHEN ALL 17484016 * COMMENT CONTINS ARE 17488016 SCSW S,CMTZ PROCESSED. 17492016 B FAB GO TO SCAN EXIT 17496016 BKR21 NI SRCHSW1,SRCHCLR-SRCHF8 SYMBOLIC BYPASS SWITCH OFF A32730 17498020 BKR2 DS 0H ENTRY 17500000 LA R7,ENDK GET END KEY 17520000 BAL R9,K1 ENTER END KEY. 17540000 SCSW C,CLEARSWW CLEAR SWITCHES 17560000 SCSW S,ENDSZ SET END SCAN SWITCH ON. 17580000 B FAA TRANSFER 17600000 BKR3 DS 0H ENTRY 17620000 SCSW S,COLSTY SET COL 72 SW ON AACA 17650016 SCSW S,CXPOPZ SET CONT EXP FOR OPERANDS @ZA12458 17660003 B FAA AACA 17680016 BKR4 DS 0H ENTRY TO CHECK FOR DELIMITER 17720000 L R7,CENDP 17740000 BCTR R7,R0 PTR TO COL 71 17760000 CLR R7,R1 IS OPERAND FIELD LESS THAN COL 72 17780000 BC HIGH,BKR11 YES - CONTINUE 17800000 CLI 0(R7),C' ' IS COL 71 BLANK 17820000 BC EQUAL,BKR11 YES - CONTINUE PROCESSING 17840000 LA R2,ERMES6 OPERAND FIELD NOT TERM IN COMMA 17860000 MVI MSGKEY,0 CLEAR SECONDARY MSG 17880000 B E1 17900000 EJECT 17920000 PRR DS 0H ENTRY TO PERIOD ROUTINE. 17940000 SCSW O,PROCSWZ,PRR0 TRANS-EXEC PROC OR PROC VERB 20978 17950018 BAL RE,ORRTN GO SEE IF THIS KEY IS O'RIDDEN AACA 17960017 PRR0 DS 0H 20978 17970018 MVI MSGSVE,ERMES10 ERROR NUMBER FOR POSSIBLE ERROR 17980000 * DETECTED BY EQUAL RTN 18000000 CLC 1(1,R1),0(R1) PERIOD THEN A PERIOD A33203 18010020 BE PRR13 CHECK IF PROGRAMMER NAME FLD M0745 18012001 SCSW O,RPRSWW,PRR4 TRANSFER PERIOD ERROR. 18020000 * R5= TKEYP AACA 18040017 SCSW O,PDASSWW,PRR3 TRANSFER PERIOD DEL & AST SW ON 18060000 BCTR R1,0 LOOK AT PRIOR BYTE IN BUFFER@ZA10120 18062003 CLI 0(R1),C'=' IS IT '=.' CONDITION? @ZA20640 18064003 LA R1,1(R1) RESTORE SCAN REG TO NORMAL @ZA10120 18066003 BC NOT-EQUAL,PRR01 TRANSFER IF NOT '=.' @ZA20640 18068003 LA R2,ERMES10 INCORRECT USE OF PERIOD @ZA20640 18070003 B E1 GO TO ERROR ROUTINE @ZA10120 18072003 PRR01 EQU * @ZA10120 18078003 CLI 0(R5),SUBALLOK IS KEY SUBALLOC. 18080000 BC NOT-EQUAL,PRR1 NO TRANSFER. 18100000 LA R7,1(R5) SET POINTER TO BASE NUMBER BYTE 18120000 CLI 0(R7),2 IS NUMBER TWO. 18140000 BC NOT-EQUAL,PRR1 NO TRANSFER 18160000 SCSW S,PDASSWW TURN ON PERIOD DEL & AST SW. 18180000 SCSW S,LPBYSWZ SET LEFT PAREN SW AACA 18190017 B PRR3 TRANSFER FOR TEXT ENTRY. 18200000 PRR1 DS 0H ENTRY. 18220000 * R6= TNUMP AACA 18240017 CLI 0(R6),X'82' IS NUMBER UP A LEVEL AT TWO. 18260000 BC NOT-EQUAL,PRR11 NO. 18280000 CLI 0(R5),CONDPEK YES IS KEY EXEC COND PERIOD. 18300000 BC EQUAL,PRR3 YES TRANSFER FOR TEXT ENTRY. 18320000 CLI 0(R5),CONDEEK NO IS KEY EXEC COND EQUAL. 18340000 BC EQUAL,PRR3 YES TRANSFER FOR TEXT ENTRY. 18360000 PRR11 DS 0H 18380000 CLI 0(R6),2 TRANSFER IF NO. OF POSITIONAL M0745 18400001 BC NOT-EQUAL,PRR12 PARAMETERS IS NOT EQUAL TO TWO M0745 18420001 CLI 0(R5),JOBK TRANSFER IF THIS IS NOT M0745 18440001 BC EQUAL,FB3 A JOB STATEMENT. M0745 18490001 PRR12 DS 0H 18500001 CLI 0(R6),0 TRANSFER IF NO. OF POSITIONAL M0745 18510001 BC NOT-EQUAL,PRR2 PARAMETERS IS NOTEQUAL TO ZERO M0745 18520001 CLI 0(R5),PGMEK IS THIS THE PGM= KEY M0745 18540001 BC EQUAL,PRR4 TRANSFER - ERROR - IF PGM KEY M0745 18560001 SCSW O,PDELSWW,FB3 TRANSFER IF PERIOD IS EXPECTED M0745 18580001 PRR2 DS 0H NO ENTRY FOR DICT LOOK UP. 18600000 TM EXECSWY,EXECSW IS THIS AN EXEC STMT A33229 18606020 BNO PRR4 IF NOT THEN AN ERROR A33229 18612020 OI ENDKYSWP,ENDKYSW SET END KEY SWITCH A33229 18618020 OI SWY2,KEYNXTSW SET NEXT KEY SWITCH A33229 18624020 B EQR11 GO SEARCH SCAN DICT. A33229 18630020 *********************************************************************** 18630401 * M0745 18630801 * THIS PTM WAS WRITTEN TO ALLOW A PERIOD TO BE FOLLOWED BY A M0745 18631201 * PERIOD IN THE PROGRAMMER NAME FIELD ON THE JOB STATEMENT M0745 18631601 * M0745 18631701 *********************************************************************** 18631801 PRR13 DS 0H M0745 18632001 CLI 0(R6),2 TRANSFER IF NO. OF POSITIONAL M0745 18634001 BC NOT-EQUAL,PRR4 PARAMETERS IS NOT EQUAL TO TWO M0745 18636001 CLI 0(R5),JOBK TRANSFER IF THIS IS M0745 18638001 BC EQUAL,FB3 A JOB STATEMENT. M0745 18638401 B PRR4 TRANSFER ERROR M0745 18638801 PRR3 DS 0H ENTRY FOR TEXT. 18640000 ST R1,CESYP SAVE END SYMBOL POINTER 18660000 ST R1,CSTRP 18680000 BAL R7,T1 ENTER TEXT 18700000 SCSW S,LDLX TURN ON LAST DEL SW 18720000 B FB1 TRANSFER TO BRANCH ROUTINE. 18740000 PRR4 DS 0H ENTRY FOR ERROR 18760000 LA R2,ERMES10 GET ERROR NUMBER 18780000 B E1 TRANSFER TO ERROR ROUTINE 18800000 EJECT 18820000 LPR DS 0H ENTRY TO LEFT PAREN ROUTINE 18840000 LH R4,CURLE GET CURRENT LEVEL OF PARENS AACA 18860017 SCSW S,FPRNSWZ SET LEFT PAREN INDICATOR AACA 18880017 LA R4,1(R4) BUMP LEVEL BY ONE FOR LEFT PAREN 18900000 STH R4,CURLE SAVE CURRENT LEVEL 18920000 CL R1,CBSYP IS PTR STILL EQ TO STRING PTR AACA 18950017 BE LPR3 CHECK FOR ILLEGAL LEFT PAREN A36292 18960020 LPRORRTN TM FLUSHSWW,FLUSHSW IS THIS KEY OVERRIDDEN A20874 18986018 BC ZERO,LPR2 BRANCH AROUND IF NOT OVERRIDE A20874 18992018 B FB2 RETURN TO SCAN A28667 19001019 LPR2 DS 0H A20874 19010018 SCSW O,RPRSWW,LPR1 NO TRANSFER IF RT PAREN SW ON. 19020000 * R5= TKEYP AACA 19040017 CLI 0(R5),DSNAMEK IS KEY DSNAME 19060000 BC NOT-EQUAL,LPR1 NO TRANSFER FOR LEFT PAREN ERROR 19080000 * R6= TNUMP AACA 19100017 CLI 0(R6),0 19120000 BC NOT-EQUAL,LPR1 NO TRANSFER FOR LEFT PAREN ERROR 19140000 ST R1,CESYP SAVE END SYMBOL POINTER. 19160000 ST R1,CSTRP 19180000 BAL R7,T1 ENTER TEXT. 19200000 SCSW C,PDASSWW TURN OFF PERIOD DEL & AST SW. 19220000 B FB1 TRANSFER TO BRANCH ROUTINE 19240000 LPR1 DS 0H ENTRY FOR ERRORS 19260000 LA R2,ERMES11 LOAD ERROR NUMBER. 19280000 B E1 TRANSFER TO ERROR ROUTINE 19300000 LPR3 CLI 0(R5),DSNAMEK IS KEY DSNAME A36292 19312020 BC NOT-EQUAL,FB2 RETURN TO SCAN NOT DSNAME A36292 19314020 SCSW O,FLUSHSWW,FB2 RETURN IF KEY OVERRIDEN M6150 19314420 BCTR R1,0 BACK UP TO PREVIOUS CHARACTER A36292 19316020 CLI 0(R1),C'=' WAS LAST CHARACTER EQUAL SIGN A36292 19318020 LA R1,1(R1) RESTORE SCAN REG TO NORMAL A36292 19318420 BE LPR1 EQUAL SIGN LEFT PAREN ERROR A36292 19318820 B FB2 RETURN TO SCAN A36292 19319220 EJECT 19320000 PLR DS 0H ENTRY FOR PLUS RTN 19340000 BAL RE,ORRTN GO SEE IF THIS KEY IS O'RIDDEN AACA 19360017 SCSW O,RPRSWW,PLR1 TRANSFER ERROR. 19380000 * R5= TKEYP AACA 19400017 * R6= TNUMP AACA 19420017 CLI 0(R5),DSNAMEK IS KEY DSNAME. 19440000 BC NOT-EQUAL,PLR1 NO TRANSFER 19460000 * SYNTAX CHECK FOR + IN THE WRONG POSITION 3565 19463016 CLI 0(R6),X'81' IS THIS SECOND OPERAND 3565 19466016 BNE PLR1 NO, ERROR 3565 19469016 CL R1,CBSYP IS IT FIRST CHARACTER 3565 19472016 BNE PLR1 NO, ERROR 3565 19475016 ST R1,CBSYP YES SET BEGIN SYMBOL POINTER 19480000 B FB3 GO BACK TO SCAN 19500000 PLR1 DS 0H ENTRY FOR ERRORS 19520000 LA R2,ERMES12 LOAD ERROR NUMBER. 19540000 B E1 TRANSFER TO ERROR ROUTINE. 19560000 EJECT 19580000 MIR DS 0H ENTRY FOR MINUS ROUTINE 19600000 BAL RE,ORRTN GO SEE IF THIS KEY IS O'RIDDEN AACA 19620017 SCSW O,RPRSWW,MIR1 ERROR 19640000 * R5= TKEYP AACA 19670017 * R6= TNUMP AACA 19700017 SPACE 19730017 LA RF,MIRTAB 19760017 BAL RE,XKRTN 19790017 CLI 0(RF),0 WAS KEY FOUND IN TABLE? Y02668 19820002 BE MIRA NO, CONTINUE Y02668 19830002 CLI 0(RF),JOBK JOB KEY? Y02668 19840002 BNE FB3 BRANCH TO CONTINUE PROCESSING Y02668 19850002 TM AOSW1,AOFSTPOS 2ND POSITIONAL RECEIVED? @ZA14268 19860003 BO MIR1 YES, ERROR Y02668 19870002 B FB3 BRANCH TO CONTINUE PROCESSING Y02668 19880002 MIRA DS 0H 19900000 CLI 0(R5),UNITK IS IT UNIT KEY 19920000 BC NOT-EQUAL,MIR1 NO TRANSFER ERROR 19940000 CLI 0(R6),0 YES IS NUMBER ZERO 19960000 BC EQUAL,FB3 CONTINUE SCAN 19980000 MIR1 DS 0H ENTRY FOR ERROR 20000000 LA R2,ERMES18 LOAD ERROR NUMBER 20020000 B E1 TRANSFER TO ERROR RTN 20040000 EJECT 20060000 AMR DS 0H ENTRY TO AMPERSAND ROUTINE 20080000 CLI 1(R1),C'&&' IS THIS DOUBLE AMPERSANDS 20101000 BE AMR02 YES - TRANSFER 20102000 CLI INTBUF,0 NO - IS AMPERSAND IN INTBUF 20103000 BNE AMR03 YES - DO NOT PROCESS AS SYMBOLIC 20104000 SCSW O,VERBCSWZ,AMR1 AMP ON PROC VERB IS ERROR AACA 20105017 OC SYMTTR(VFA4),SYMTTR DOES SYMBUF HAVE A TTR? Y02621 20106002 BZ AMR03 NO - THERE ARE NO SYMBOLICS Y02621 20107002 L RF,FIEFVFB GET SYMBOLIC PARAMETER RTN 20109000 BALR RE,RF 20110000 CLI INTBUF,0 IS TEXT IN INTBUF 20111000 BE AMR03 NO - PROCESS AS NO SYMBOLIC 20112000 B FB1 YES - GO TO SCAN INTBUF 20113000 AMR02 DS 0H 20114000 L R6,CBSYP BUMP BEGIN POINTER 20115000 LA R6,1(R6) 20116000 ST R6,CBSYP 20117000 LA R1,1(R1) BUMP TO SECOND AMPERSAND 20118000 * 20119000 * NOTE - DD PROCESSING ROUTINE SYMTAX CHECKS DSNAME FIELD 20120000 * 20121000 AMR03 DS 0H 20122000 BAL RE,ORRTN GO SEE IF THIS KEY IS O'RIDDEN AACA 20128017 SCSW O,FBLITRLZ,APR8 BR- INCOMPLETE LITERAL EXPRESSION 20134000 LM R5,R6,TKEYP 20144017 CLI 0(R5),DSNAMEK IS KEY DSNAME. 20160000 BC NOT-EQUAL,AMR1 NO TRANSFER FOR ERROR 20180000 CLI 0(R6),0 IS NUMBER ZERO. 20220000 BC NOT-EQUAL,AMR1 NO TRANSFER FOR ERROR 20240000 SCSW C,PDELSWW TURN OFF PER DEL SW. 20260000 B FB3 TRANSFER TO BRANCH ROUTINE 20280000 AMR1 DS 0H ENTRY FOR ERRORS 20300000 LA R2,ERMES13 LOAD ERROR NUMBER. 20320000 B E1 TRANSFER TO ERROR ROUTINE. 20340000 EJECT 20360000 SLR DS 0H ENTRY FOR SLASH ROUTINE 20380000 BAL RE,ORRTN GO SEE IF THIS KEY IS O'RIDDEN AACA 20400017 SCSW O,RPRSWW,SLR1 TRANSFER ERROR 20420000 * R5= TKEYP AACA 20440017 * R6= TNUMP AACA 20460017 CLI 0(R5),UNITK IS KEY UNIT 20480000 BC NOT-EQUAL,SLR1 NO ERROR 20500000 CLI 0(R6),0 YES IS NUMBER BYTE ZERO 20520000 BC EQUAL,FB3 YES CONTINUE SCAN 20540000 SLR1 DS 0H ENTRY FOR ERROR 20560000 LA R2,ERMES17 LOAD ERROR NUMBER 20580000 B E1 TRANSFER TO ERROR RTN 20600000 EJECT 20620000 ASR DS 0H ENTRY TO ASTERICK ROUTINE 20640000 BAL RE,ORRTN GO SEE IF THIS KEY IS O'RIDDEN AACA 20650017 * R5= TKEYP AACA 20658017 CLI 0(R5),DDK IS THIS DD* STATEMENT AABA 20666016 BE FB3 YES - RET TO TRANSLATE AABA 20667016 CLI 0(R5),RESTARJK IS IT RESTART= AAAA 20670015 BE FB3 YES- RETURN TO TRANSLATE RTN AAAA 20675015 CLI 0(R5),SYSOUTK IS IT SYSOUT= ? YM03227 20676002 BE FB3 YES RETURN TO TRANSLATE YM03227 20677002 SCSW O,RPRSWW,ASR1 TRANSFER ERROR 20680000 SCSW Z,PDELSWW,ASR1 TRANSFER ERROR 20700000 SCSW O,ASTSWW,ASR1 TRANSFER ERROR 20720000 * SYNTAX CHECK FOR * IN THE WRONG POSITION 3565 20722016 * R6= TNUMP AACA 20724017 CLI 0(R6),0 IS IT FIRST OPERAND 3565 20726016 BNE ASR1 NO, ERROR 3565 20728016 CL R1,CBSYP IS IT FIRST CHARACTER 3565 20730016 BNE ASR1 NO, ERROR 3565 20732016 CLI 1(R1),C' ' IF LAST CHARACTER (FOLLOWED M18103 20734018 BE ASR1 BY BLANK), IT'S AN ERROR M18103 20736018 SCSW S,ASTSWW TURN ON AST SW 20740000 SCSW S,LPBYSWZ SET LEFT PAREN BYPASS AACA 20750017 B FB3 GO CONTINUE SCAN 20760000 ASR1 DS 0H ENTRY FOR ERROR 20780000 LA R2,ERMES14 LOAD ERROR NUMBER 20800000 B E1 TRANSFER TO ERROR ROUTINE 20820000 EJECT 20840000 RPR DS 0H ENTRY FOR RIGHT PAREN ROUTINE. 20860000 SR R4,R4 CLEAR REGISTER. 20880000 AH R4,CURLE GET CURRENT LEVEL. 20900000 BP RPR02 TRANSFER CURLE HIGH - OK 20904000 LA R2,ERMES7 CURLE NOT HIGH - NG 20908000 B E1 GO TO ERROR RTN 20912000 RPR02 DS 0H 20916000 DEC1 EQU 1 22520 20916318 DEC0 EQU 0 22520 20916618 LA R5,DEC1(R1) GET PTR TO NEXT CHARACTER 22520 20916918 LA RF,RPRTAB PT TO LAST TABLE ENTRY 22520 20917218 BAL RE,XKRTN GO TO SEARCH TABLE 22520 20917518 CLI DEC0(RF),DEC0 22520 20917818 BNE RP06 YES, CONTINUE. @ZA01934 20918103 RP03 DS 0H @ZA01934 20918203 LA R2,ERMES19 NO, ERROR 22520 20918418 B E1 GO TO ERROR ROUTINE 22520 20918718 RP04 DS 0H 22520 20919018 CLI DEC0(RF),AMPERSAN IS NEXT CHAR SYMBOLIC? A45828 20919401 BE RP05 YES,SKIP UPDATING PAREN A45828 20919801 * CURLE,ON RETURN FROM VFB WILL A45828 20919901 * SCAN SAME PAREN AGAIN. A45828 20926601 BCTR R4,R0 DECREMENT CURRENT LEVEL FOR RIGHT P. 20933301 STH R4,CURLE SAVE CURRENT LEVEL. 20940000 RP05 BAL RE,ORRTN GO SEE IF THIS KEY IS O'RIDDEN A45828 20965001 SCSW O,RPRSWW,FB3 TRANSFER RIGHT PAREN SW ON. 20980000 ST R1,CESYP SAVE END SYMBOL POINTER 21000000 SCSW S,RPRSWW SET RIGHT PAREN SWITCH ON. 21020000 B FB3 TRANSFER TO BRANCH ROUTINE. 21040000 RP06 DS 0H @ZA01934 21041003 SR R4,R4 CLEAR REGISTER @ZA01934 21042003 RP07 DS 0H @ZA01934 21043003 CLI DEC0(RF),RPARENT IS NEXT CHAR RT PAREN? @ZA01934 21044003 BNE RP08 NO,CONTINUE. @ZA01934 21045003 LA R4,DEC1(R4) BUMP COUNT @ZA01934 21046003 LA R5,DEC1(R5) GET PTR TO NEXT CHARACTER @ZA01934 21047003 LA RF,RPRTAB PT TO LAST TABLE ENTRY @ZA01934 21048003 BAL RE,XKRTN GO SEARCH TABLE 21049003 CLI DEC0(RF),DEC0 VALID CHARACTER? @ZA01934 21050003 BE RP03 NO, ERROR @ZA01934 21051003 B RP07 CONTINUE RT PAREN SEARCH @ZA01934 21052003 RP08 DS 0H @ZA01934 21060003 SR R5,R4 RESTORE CHAR POINTER @ZA01934 21063003 SR R4,R4 CLEAR REGISTER @ZA01934 21066003 AH R4,CURLE GET CURRENT LEVEL @ZA01934 21069003 B RP04 CONTINUE @ZA01934 21072003 EJECT 21075003 COR DS 0H ENTRY TO COMMA ROUTINE 21080000 ST R1,CSTRP SAVE CHARACTER STRING POINTER. 21100000 SCSW O,FLUSHSWW,FB1 TRANSFER FLUSH SWITCH ON. 21120000 TM SRCHSW1,SRCHF8 SYMBOLIC TO BE BYPASSED? A32730 21126020 BO COR4 YES - BRANCH A32730 21132020 SCSW O,RPRSWW,COR1 TRANSFER RT PAREN SW ON. 21140000 ST R1,CESYP SAVE CHAR END SYMBOL POINTER. 21160000 COR1 DS 0H ENTRY 21180000 ST R1,CSTRP SAVE CHAR STRING PT. 21200000 COR2 DS 0H ENTRY FROM APOST ROUTINE. 21220000 SR R6,R6 CLEAR REGISTER Y02668 21220802 AH R6,CURLE GET CURRENT PAREN LEVEL Y02668 21221602 BNZ COR3 TRANSFER PARAMETER NOT ENDED Y02668 21222402 TM SWY2,KEYNXTSW HAS FIRST KEYWORD BEEN RCVD A28668 21224020 BZ COR3 NO. TRANSFER TO CONTINUE A28668 21228020 OI ENDKYSWP,ENDKYSW SET SWITCH FOR END OF PARAM A28668 21244020 * NEW KEYWORD SHOULD FOLLOW A28668 21248020 COR3 DS 0H A28668 21252020 BAL R7,T1 ENTER TEXT 21260000 SCSW Z,EXECSWY,COR3A CHECK FOR EXEC STMT. Y02668 21264002 * ON EXEC, FIRST POSITIONAL IS A PROCNAME - //S EXEC PROCNAME,.Y02668 21268002 OI AOSW2,AOPROCNM INDICATE POSITIONAL PROCNAME. Y02668 21272002 OI SWH,PROCSW SET PROC INVOKED SWITCH. Y02668 21274002 COR3A DS 0H Y02668 21276002 SCSW C,RPASWW TURN OFF RT PAREN AST & PER DEL 21280000 SCSW S,LDLX TURN ON LAST DEL SW. 21300000 SCSW Z,JGCY,FB1 21320000 SCSW C,JGCY 21340000 L R5,TKEYP 21360000 LA R5,1(R5) 21380000 ST R5,TNUMP 21400000 B FB1 21420000 COR4 NI SRCHSW1,SRCHCLR-SRCHF8 SYMBOLIC BYPASS SWITCH OFF A32730 21426020 B FB1 RETURN TO TRT ROUTINE A32730 21432020 EJECT 21440000 APR DS 0H ENTRY TO APOST ROUTINE. 21460000 * R5= TKEYP AACA 21480017 * R6= TNUMP AACA 21500017 CL R1,CBSYP ERROR. INTERVENING TEXT BETWEEN AACA 21540017 BNE APR6 LAST DELIM AND APOST. AACA 21560017 B APROVRD BRANCH TO OVERRIDE RTN. A33221 21566020 APR0 DS 0H A33221 21572020 SPACE 21580017 LA RF,APRTAB ARRD OF TABLE 21600017 BAL RE,XKRTN 21620017 CLI 0(RF),0 WAS KEY IN TABLE AACA 21640017 BNE APR1 YES - OK 21660017 CLI 0(R5),DSNAMEK DSN AACA 21680017 BC NOT-EQUAL,APR6 NO TRANSFER 21740000 L R7,TEXTBUFP ADDR OF TEXT STRING. Y02668 21750002 USING TEXT,R7 PREFIX ADDRESSABILITY. Y02668 21752002 OI STRDINDC,DTXDSNLT SET DSN LITERAL BIT. Y02668 21754002 DROP R7 Y02668 21756002 APR1 DS 0H ENTRY 21760000 SCSW S,FBLITRLZ SET SW TO INDICATE LITERAL 21766000 ST R1,SAVEP SAVE STRING PTR 21772000 LA R1,1(R1) BUMP CSTRP. 21780000 ST R1,CBSYP SAVE CHARACTER BEGIN POINTER 21800000 LR R4,R1 LOAD POINTER FOR CREATED SYMBOL. 21820000 L R7,CENDP GET CHARACTER END POINTER. 21840000 B APR3 TRANSFER. 21860000 APR2 DS 0H ENTRY. 21880000 LA R4,1(R4) BUMP POINTER 21900000 LA R1,1(R1) BUMP POINTER 21920000 APR3 DS 0H ENTRY 21940000 CLR R1,R7 IS CSTRP ABOVE COL 71. 21960000 BC HIGH+EQUAL,APR6 YES TRANSFER. 21980000 CLI 0(R1),C'''' IS CHARACTER APOST. 22000000 BC EQUAL,APR5 YES TRANSFER. 22020000 CLI 0(R1),C'&&' IS IT AMPERSAND 22026000 BC EQUAL,APR7 YES TRANSFER 22032000 APR4 DS 0H ENTRY 22040000 MVC 0(0,R4),0(R1) MOVE A CHARACTER. 22060000 B APR2 TRANSFER. 22080000 APR5 DS 0H ENTRY. 22100000 LA R1,1(R1) BUMP POINTER 22120000 CLR R1,R7 IS CSTRP ABOVE COL 71. 22140000 BC HIGH,APR6 YES TRANSFER 378 22160000 CLI 0(R1),C'''' IS CHARACTER APOST. 22180000 BC EQUAL,APR4 YES GO BACK 22200000 ST R1,CSTRP SAVE CHARACTER STRING POINTER 22220000 ST R4,CESYP SAVE END CHARACTER SYMBOL POINTER. 22240000 SCSW C,FBLITRLZ CLEAR SW 22250000 CLI 0(R1),C' ' IS CHARACTER BLANK. 22260000 BC EQUAL,BKR1 YES TRANSFER. 22280000 CLI 0(R1),C',' IS CHARACTER COMMA. 22300000 BC EQUAL,COR2 YES TRANSFER 22320000 SCSW S,RPRSWW SET RT. PAREN SW AAAA 22330015 CLI 0(R1),C')' IS CHAR RT PAREN 22340000 BC EQUAL,RPR YES - TRANSFER 22360000 APR6 DS 0H ENTRY FOR ERROR 22380000 LA R2,ERMES15 GET ERROR NUMBER 22400000 B E1 TRANSFER TO ERROR ROUTINE. 22420000 SPACE 22421000 APR7 DS 0H 22422000 LA R1,1(R1) BUMP PTR 22423000 CLR R1,R7 IS CSTRP ABOVE COL 71 22424000 BC HIGH,APR6 YES TRANSFER 22425000 CLI 0(R1),C'&&' IS CHAR AMPERSAND 22426000 BC EQUAL,APR4 YES GO BACK 22427000 BCTR R1,R0 22428000 CLI 0(R5),PARMEEK PARM KEYWORD ALLOWS A39526 22428401 BE APR70 SYMBOLIC IN QUOTES A39526 22428801 CLI 0(R5),PARMPEK NO OTHER KEYWORD DOES A39526 22428901 BE APR70 A39526 22429401 B APR4 ALLOW SINGLE AMPERSAND IN TEXT M0702 22430401 APR70 DS 0H PARM KEYWORD A39526 22439301 CLI INTBUF,0 IS TEXT IN INTBUF 22441001 BNE APR4 GO BACK - NOT A SYMBOLIC PARAM 22442701 L R7,SAVEP A SYMBOLIC - RESET PTR 22444401 ST R7,CBSYP 22446101 B AMR GO TO AMPERSAND RTN 22447801 APR8 DS 0H ENTRY HERE MEANS THE 22449501 * LITERAL CONTAINS A SINGLE 22451201 * AMPERSAND. HOWEVER, SYMBOLIC 22452901 * PARAMETERS ARE NOT ALLOWED 22454601 * ON THIS STATEMENT - AS DETERMINED 22456301 * BY THE SYMBOLIC PARAM RTN. 22458001 * 22459701 L R7,SAVEP RESTORE CBSYP TO BEFORE A33221 22461401 LA R7,1(R7) TRANSFER TO AMR TTN. A33221 22463101 ST R7,CBSYP THE SINGLE AMPER. IS TREATED A33221 22464801 L R7,CENDP AS IF DOUBLE AMPER. HAD A33221 22466501 B APR4 BEEN CODED. A33221 22468201 APROVRD DS 0H A33221 22469901 TM FLUSHSWW,FLUSHSW IS THIS FIELD OVERRIDDEN A33221 22471601 BC ZERO,APR0 NO - CONTINUE NORMAL PROCEDURE A33221 22473301 L R7,CENDP COLUMN 72 POINTER A33221 22475001 APROVRD1 LA R1,1(R1) INCREMENT STRING POINTER A33221 22476701 CLR R1,R7 IS CSTRP BEYOND COL. 71 A33221 22478401 BC HIGH+EQUAL,APR6 YES - ERROR ROUTINE A33221 22480101 CLI 0(R1),C'''' CLOSING APOSTROPHE FOUND A33221 22481801 BC NOT-EQUAL,APROVRD1 NO - CONTINUE SCAN A33221 22483501 CLI 1(R1),C'''' WAS IT SINGLE CLOSING APOS. A33221 22485201 BC NOT-EQUAL,APROVRD2 YES - STORE POINTERS A33221 22486901 LA R1,1(R1) NO - INCREMENT POINTER A33221 22488601 B APROVRD1 AND REENTER SCAN LOOP A33221 22490301 APROVRD2 DS 0H A33221 22492001 ST R1,CESYP YES - STORE END POINTER A33221 22493701 LA R1,1(R1) INCREMENT STRING POINTER A33221 22495401 ST R1,CSTRP SAVE CHARACTER STRING POINTER A33221 22497101 B FB4 RETURN TO TRT ROUTINE A33221 22498801 EJECT 22500501 EQR DS 0H ENTRY TO EQUAL ROUTINE 22502201 OI SWY2,KEYNXTSW SET FIRST EQUAL RECEIVED. NO A28668 22503901 * MORE POSITIONAL PARAMETERS EXPECTED 22505601 OI AOSW1,AOFSTPOS TURN OFF SWITCH FOR JOB CARD @ZA14268 22506103 * SECOND POSITIONAL @ZA14268 22506603 NI ENDKYSWP,255-ENDKYSW TURN OFF KEYWORD EXPECTED A28668 22507301 MVC LASLE,CURLE RESET LASLE, IN THE EVENT IT A27943 22509001 * HASN'T BEEN RESET IN THE TEXT A27943 22510701 * BUILD ROUTINE (T1) WHERE IT IS NORMALLY DONE. LASLE WILL NOT A27943 22512401 * BE RESET IN T1 IN CASES WHERE THE SUBPARAMETER IMMEDIATELY A27943 22514101 * PRECEDING A RIGHT PAREN HAS BEEN OVERRIDDEN - E.G., THE DEN A27943 22515801 * SUBPARAMETER IN THE STRING DCB=(...,DEN=2). FAILURE TO RESET A27943 22517501 * LASLE MAY CAUSE AN ERROR IN THE BUILDING OF SUBLIST TEXT FOR A27943 22519201 * THE PARAMETERS WHICH FOLLOW. A27943 22520901 * A27943 22522601 SR R4,R4 CLEAR REGISTER 22524301 IC R4,DLMFBYTE GET PREVIOUS DELIMITER FUNCTION BYTE.7821 22526001 CR R2,R4 IS THE CURRENT DELIMITER FUNCTION 7821 22527701 * BYTE(X'2C' IN R2) EQUAL TO THE 7821 22529401 * PREVIOUS DELIMITER FUNCTION BYTE(IN 7821 22531101 * R4). I.E. DO WE HAVE THE 'KEYWORD= 7821 22532801 * KEYWORD=' SITUATION. 7821 22534501 BNE EQR04 NO-BRANCH. A49940 22536201 OI DLMFBYTE,EQDELSW YES-TURN THE EQDELSW SWITCH 7821 22537901 * ('KEYWORD=KEYWORD=' INDICATOR) ON. 7821 22539601 B EQR010 IT IS NOT NECESSARY TO STORE THE 7821 22541301 * CURRENT DELIMITER FUNCTION BYTE INTO 7821 22543001 * THE 'DLMFBYTE' SINCE THEY ARE 7821 22544701 * ALREADY EQUAL AT THIS POINT. 7821 22546401 SPACE 22548101 EQR04 EQU * A49940 22548501 CLI DLMFBYTE,PR IS PREVIOUS A PERIOD? A49940 22548901 BNE EQR05 NO, CONTINUE. A49940 22549301 TM DDSWY,DDSW IS THIS A DD STATEMENT? A49940 22549701 BNO EQR05 NO, CONTINUE. A49940 22553001 LA R2,ERMES16 YES, LOAD MSG. NUMBER. SM4180 22555001 B E1 GO TO ERROR ROUTINE. A49940 22555401 EQR05 DS 0H 7821 22556901 STC R2,DLMFBYTE STORE THE CURRENT DELIMITER FUNCTION 7821 22560201 * BYTE OVER THE PREVIOUS ONE. 7821 22563501 EQR010 DS 0H 7821 22566801 SR R4,R4 CLEAR REGISTER. 7821 22570101 MVI MSGSVE,ERMES16 ERROR NUMBER FOR POSSIBLE LATER USE 22573401 SCSW O,DDSWY,EQR3 TRANSFER DD 22576701 AH R4,CURLE IS CURRENT LEVEL ZERO 22580000 BC NOT-EQUAL,EQRL5 TRANSFER CURRENT LEVEL NOT ZERO 22600000 SCSW O,EXECSWY,EQR1 TRANSFER EXEC SW ON 22620000 L RF,AJ5L ADDR OF JOB KEYWORDS AADA 22640018 B EQRD TRANSFER 22660000 EQR1 DS 0H ENTRY 22680000 CLI 0(R6),0 IS THIS FIRST OPERAND 22700000 BC NOT-EQUAL,EQR11 BRANCH NO. Y02668 22720002 CLI 0(R5),PROCEK IS KEY PROC? Y02668 22730002 BNE EQR10 BRANCH NO. Y02668 22740002 OI SWH,PROCSW SET PROC INVOKED SWITCH. Y02668 22750002 EQR10 DS 0H Y02668 22760002 LA RF,XKTAB ADDR OF TABLE TO SEARCH. Y02668 22770002 BAL RE,XKRTN SEE IF KEY IS EXEC O'RIDE AACA 22810017 CLI 0(RF),0 22840017 BNE EQR2 YES - GO PROCESS O'RIDE AACA 22870017 EQR11 DS 0H ENTRY FOR EXEC PERIOD KEYS 22940000 L RF,AE4L ADDR OF EXEC KEYWORDS AADA 22960018 B EQRD TRANSFER 22980000 EQR2 DS 0H ENTRY 23000000 SCSW S,LPBYSWZ SET LEFT PAREN BYPASS SW AACA 23010017 ST R1,CSTRP SAVE CHAR STRING POINTER 23020000 ST R1,CESYP SAVE CHAR END SYMBOL POINTER 23040000 BAL R7,T1 ENTER TEXT 23060000 L R5,TKEYP GET TEXT KEY POINTER 23080000 CLI 0(R5),CONDPEK LAST KEY COND PERIOD 23100000 BC NOT-EQUAL,FB1 NO TRANSFER 23120000 SCSW S,LDLX TURN ON LAST DELIMITER SWITCH 23140000 B FB1 TRANSFER 23160000 EQR3 DS 0H ENTRY 23180000 SCSW Z,OVKEYSWZ,EQR31 TRANSFER PREVIOUS KEY NOT O'RIDDEN 23200000 CLI OVKEYSVE,DCBK WAS OVERRIDEN KEY DCB = 16368 23206016 BNE EQR304 A24421 23208019 AH R4,CURLE A24421 23210019 BC HIGH,EQRB A24421 23212019 B EQR301 A24421 23214019 EQR304 DS 0H 23216019 CLI OVKEYSVE,UNITK WAS PREVIOUS O'RIDDEN KEY UNIT= 23220000 BC NOT-EQUAL,EQR301 NO -CHECK ALL DD KEYS 23240000 L R9,CSTRP 23260000 CLI 0(R9),C'=' YES - IS UNIT AFF POSSIBLE 23280000 BC EQUAL,EQR30 YES - SEARCH UNIT MINOR KEYS 23300000 AH R4,CURLE NO - IS UNIT SEP POSSIBLE 23320000 BC NOT-HIGH,EQR301 NO - CHECK ALL KEYS 23340000 EQR30 DS 0H ENTRY TO SEARCH UNIT MINOR KEYS 23360000 L RF,AD4LUS ADDR OF UNIT MINOR KEYWORDS AADA 23380018 B EQRD 23400000 EQR301 DS 0H ENTRY TO CHECK ALL DD KEYS 23420000 L RF,AD4L ADDR OF DD MAJORS AADA 23440018 B EQRD 23460017 EQR31 DS 0H ENTRY - PREVIOUS KEY NOT O'RIDDEN 23480000 AH R4,CURLE IS CURRENT LEVEL ZERO 23500000 BC HIGH,EQR5 TRANSFER CURRENT LEVEL HIGH 23520000 CLI 0(R6),0 IS TEXT LENGTH ZERO 23540000 BC EQUAL,EQR4 YES TRANSFER 23560000 B EQRC 16505 23600017 EQR4 DS 0H ENTRY FROM ABOVE 23640000 CLI 0(R5),UNITK IS KEY UNIT 23660000 BC NOT-EQUAL,EQR6 NO TRANSFER 19200 23680019 L RF,AD4LUA ADDR OF UNIT AFF KEYWORD AADA 23700018 B EQRD TRANSFER 23720000 EQR5 DS 0H ENTRY CURRENT LEVEL HIGH 23740000 CLI 0(R5),UNITK IS KEY UNIT 23760000 BC NOT-EQUAL,EQR50 NO TRANSFER Y01113 23780001 L RF,AD4LUS ADDR OF UNIT MINOR KEYWORDS AADA 23800018 B EQRD TRANSFER 23820000 EQR50 DS 0H ENTRY KEY NOT UNIT Y01113 23822001 CLI 0(R5),AMPK IS KEY AMP? Y01113 23830001 BE EQRL5 ISSUE UNBALANCED PARENS MSG Y01113 23832001 EQR6 DS 0H ENTRY KEY NOT UNIT 23840000 LA RF,DCBTAB ADDR. OF DCB MINOR TABLE 19200 23860019 BAL RE,XKRTN TABLE SEARCH ROURINE 19200 23880019 CLI 0(RF),0 IF ZERO NOT IN DCB MINOR TABLE 19200 23900019 BNE EQRB IN TABLE THEN TAKE BRANCH 19200 23920019 CLI 0(R5),VOLUMEK IS KEY VOLUME 23960000 BC NOT-EQUAL,EQR8 NO TRANSFER 23980000 L RF,AD4LV ADDR OF VOL MINOR KEYWORDS AADA 24000018 B EQRD TRANSFER 24020000 EQR8 DS 0H ENTRY KEY NOT VOLUME 24040000 CLI 0(R5),LABELK IS KEY LABEL 24060000 BC NOT-EQUAL,EQRA NO TRANSFER 24080000 L RF,AD6LL ADDR OF LABEL MINOR KEYWORDS AADA 24100018 B EQRD TRANSFER 24120000 EQRA DS 0H ENTRY KEY NOT LABEL 24140000 CLI 0(R5),DCBK IS KEY DCB 24160000 BC NOT-EQUAL,EQRC NO TRANSFER 24180000 EQRB DS 0H ENTRY 24200000 L RF,AD4LD ADDR OF DCB MINOR KEYWORDS AADA 24220018 B EQRD TRANSFER 24240000 EQRC DS 0H ENTRY KEY NOT DCB 24260000 L RF,AD4L ADDR OF DD MAJOR KEYWORDS AADA 24270018 SR R9,R9 20664 24282017 AH R9,CURLE 20664 24284017 BZ EQRD05 20664 24286017 LA R2,ERMES7 20664 24288017 B E1 20664 24290017 EQRD05 DS 0H 20664 24292017 EQRD DS 0H ENTRY 24300000 NI SWV,255-FPRNSW-LPBYSW CLEAR LEFT PAREN SW AND AACA 24306017 * BYPASS SW AACA 24312017 ST R1,CSTRP SAVE CHAR STRING POINTER 24320000 L R9,CBSYP GET CHAR END SYMBOL POINTER 24340000 SR R1,R9 COMPUTE CHAR LENGTH 24360000 SR R4,R4 CLEAR REGISTER 24380000 B EQRD3 TRANSFER 24400000 EQRD1 DS 0H ENTRY 24420000 CLC 1(0,RF),0(R9) IS KEYWORD IN TABLE AADA 24440018 EQRD2 DS 0H 24460000 AR RF,R4 BUMP TO NEXT KEYWORD AADA 24480018 EQRD3 DS 0H 24500000 IC R4,0(RF) GET KEYWORD LENGTH AADA 24520018 LTR R4,R4 TABLE END 24540000 BC ZERO,EQRL YES TRANSFER 24560000 EX R1,EQRD1 EXECUTE KEY WORD COMPARE 24580000 BC NOT-EQUAL,EQRD2 TRANSFER BACK NOT FOUND 24600000 LR R9,RF SAVE RF IN R9 AADA 24600318 TM DLMFBYTE,EQDELSW DO WE HAVE 'KEYWORD=KEYWORD=' 7821 24600717 * CONDITION. 7821 24601417 BZ EQRE NO-CONTINUE NORMAL PROCESSING. 7821 24602117 SPACE 24602817 * IF THE EQDELSW IS ON IT MEANS WE HAVE A 'KEYWORD=KEYWORD=' 7821 24603517 * SITUATION IN THE JCL. THE ONLY TIME THIS CONDITION IS PERMIS- 7821 24604217 * SABLE IS WHEN EITHER VOL,DCB,UNIT, OR LABEL IS SPECIFIED. 7821 24604917 * THESE KEYWORDS WILL BE CHECKED AND IF NONE ARE FOUND AN ERROR 7821 24605617 * MESSAGE (IEF632I FORMAT ERROR) WILL BE ISSUED. 7821 24606317 SPACE 24607017 LA RF,KEYEQTAB ADDRESS OF TABLE CONTAINING THE KEYS 7821 24607717 * OF VOL,DCB,UNIT, AND LABEL. 7821 24608417 L R5,TKEYP POINTER TO TEXT KEY(NOT OVERRIDDEN). 7821 24609117 TM OVKEYSWZ,OVKEYSW HAS KEY BEEN OVERRIDDEN. 7821 24609817 BZ EQRD5 NO-BRANCH. 7821 24610517 LA R5,OVKEYSVE YES-GET ADDRESS OF OVERRIDDEN 7821 24611217 * KEY. 7821 24611917 EQRD5 DS 0H 7821 24612617 BAL RE,XKRTN ROUTINE TO SEARCH KEYS. 7821 24613317 CLI 0(RF),0 WAS KEY FOUND. 7821 24614017 BE EQRD6 NO-ERROR CONDITION. 7821 24614717 NI DLMFBYTE,255-EQDELSW TURN OFF EQDELSW SWITCH(HIGH 7821 24615417 * ORDER BIT). 7821 24616117 B EQRE CONTINUE NORMAL PROCESSING. 7821 24616817 EQRD6 DS 0H 7821 24617517 LA R2,ERMES19 GET ERROR MESSAGE NUMBER. 7821 24618217 B E1 ERROR PROCESSOR. 7821 24618917 EQRE DS 0H ENTRY FOUND 24620000 LR RF,R9 RESTORE RF SAVED IN R9 AADA 24630018 SCSW C,OVKEYSWZ CLEAR OVERRIDDEN KEY SW 24640000 LA R9,2(R1,RF) GET POINTER TO KEY AADA 24660018 SR R3,R3 CLEAR REGISTER 24680000 IC R3,0(R9) GET KEY 24700000 AR RF,R4 BUMP POINTER TO NEXT KEYWORD AADA 24720018 LR R7,R3 KEY FOR K1 ROUTINE 24740000 BAL R6,I1 GET PTR TO BYTE IN DUPTB TO TEST BIT 24760000 EX R5,EQRE1 IS THE BIT ON IN DUPTB 24780000 BC O,EQRJ YES TRANSFER TO CHECK FOR OVERRIDE 24800000 ST R9,SAVEP SAVE PTR TO KEY 24820000 LA R3,KEYTAB-DUPTAB(R3) BUMP TO KEYTAB 19874 24840019 EX R5,EQRF1 SET BIT IN KEYTAB 24860000 ST RF,WORK1 SAVE VALUE OF RF A26796 24870019 BAL R9,K1 PUT KEY IN TEXT 24880000 L RF,WORK1 RESTORE VALUE OF RF A26796 24890019 L R9,SAVEP RESTORE PTR TO KEY 24900000 EQRF DS 0H 24920000 L R3,TEXTBUFP ADDR OF TEXT STRING. @G29AN2E 24922003 USING TEXT,R3 PREFIX ADDRESSABILITY. @G29AN2E 24922803 CLI 0(R9),DDNAMEK IS THIS DDNAME KEYWORD AABA 24923603 BNE EQRF03 BR NO @G29AN2E 24924403 OC DUPTAB(EDASTAB1-DASTAB1),DASTAB1 SET ALL BITS @ZA13371 24926003 * FOR KEYS MUTUALLY EXCLUSIVE @ZA13371 24927003 * WITH DDNAME WHILE PRESERVING @ZA13371 24928003 * OVERRIDING DCB VALUES. @ZA13371 24929003 OI STRDINDC,DTXDDNM SET DDNAME SWITCH. Y02668 24932003 ***************************************************************@G32HPPJ 24932103 * @G32HPPJ 24932203 * IN AN SU ENVIRONMENT IT IS NECESSARY TO CHECK TO SEE IF THE @G32HPPJ 24932303 * SU BIT IS ON WHEN A KEYWORD WHICH IS NEW FOR AN SU IS FOUND @G32HPPJ 24932403 * IF THE SU BIT IS NOT ON FOR THE PARTICULAR KEYWORD, THEN THE@G32HPPJ 24932503 * KEYWORD SHOULD BE TREATED AS AN INVALID @G32HPPJ 24932603 * @G32HPPJ 24932703 ***************************************************************@G32HPPJ 24932803 EQRF03 DS 0H @G32HPPJ 24932903 L RE,16 GET ADDRESS OF CVT @G32HPPJ 24933003 USING CVTMAP,RE ESTABLISH ADDR. TO CVT @G32HPPJ 24933103 L R2,CVTIHASU GET ADDR INSTALLED SU BITS @G32HPPJ 24933203 USING SUBITS,R2 SU BIT MAPPING @G32HPPJ 24933303 CLI 0(R9),SUBSYSK IS THIS SUBSYS KEY ? @G32HPPJ 24933403 BNE EQRF040 NO CHECK NEXT @G32HPPJ 24933503 TM SUBYTE4,SU29BIT YES,IS SU29 INSTALLED ? @G32HPPJ 24933603 BO EQRF055 YES PROCESS SUBSYS @G32HPPJ 24933703 EQRF035 DS 0H @G32HPPJ 24933803 MVI MSGKEY,DDK NO, INDICATE DD STMT @G32HPPJ 24933903 LA R2,ERMES16 ISSUE UNIDENTIFIED KEYWORD @G32HPPJ 24934003 B E1 @G32HPPJ 24934103 EQRF040 DS 0H @G32HPPJ 24934203 CLI 0(R9),PROTECTK IS THIS PROTECT KEY? @G32HPPJ 24934303 BE EQRF045 NO CONTINUE @G32HPPJ 24934403 CLI 0(R9),CHARSK IS THIS CHARS KEY? @G16APPJ 24934503 BE EQRF050 CHECK FOR SU10 @G16APPJ 24934603 CLI 0(R9),BURSTK IS THIS BURST KEY @G16APPJ 24934703 BE EQRF050 CHECK FOR SU10 @G16APPJ 24934803 CLI 0(R9),MODIFYK IS THIS MODIFY KEY? @G16APPJ 24934903 BE EQRF050 CHECK FOR SU10 @G16APPJ 24935003 CLI 0(R9),FLASHK IS THIS FLASH KEY ? @G16APPJ 24935103 BE EQRF050 CHECK FOR SU10 @G16APPJ 24935203 B EQRF04 CONTINUE PROCESSING @G16APPJ 24935303 EQRF045 TM SUBYTE5,SU32BIT YES, IS SU32 INSTALLED? @G16APPJ 24935403 BNO EQRF035 NO, ISSUE ERROR MESSAGE @G32HPPJ 24935503 B EQRF04 YES, CONTINUE PROCESSING @G32HPPJ 24935603 EQRF050 DS 0H @G16APPJ 24935703 TM SUBYTE2,SU10BIT IS SU10 INSTALLED ? @G16APPJ 24935803 BNO EQRF035 NO ISSUE ERROR MSG @G16APPJ 24935903 B EQRF04 YES CONTINUE PROCESSING @G16APPJ 24936003 EQRF055 DS 0H PROCESSING FOR SUBSYS KEY @G32HPPJ 24936103 MVC AOSUBSYS,TKEYP SAVE ADDR OF SUBSYS KEY @G32HPPJ 24936203 OI STRDINDC,DTXSUBSK SET SUBSYS KEY SWITCH @G32HPPJ 24936303 DROP RE @G32HPPJ 24936403 DROP R2 @G32HPPJ 24936503 DROP R3 @G29AN2E 24936603 EQRF04 DS 0H AABA 24936703 SR R3,R3 CLEAR REGISTER 24940000 IC R3,0(R9) GET KEY 24960000 BAL R6,I1 GET PTR TO BYTE IN DUPTB TO SET BIT 24980000 EX R5,EQRF1 SET BIT ON IN DUPTB 25000000 LA R9,1(R9) BUMP TO NEXT KEY 25020000 TM SWZ,DDSW IS THIS A DD CARD? 19874 25026019 BC ZERO,EQRF5 NO,BYPASS OVERRIDE TEST 19874 25032019 TM 0(R9),X'80' IS IT OVERRIDDEN KEY 25040000 BC O,EQRG YES TRANSFER 25060000 EQRF5 DS 0H 19874 25070019 CLR R9,RF END OF SCAN DICT ENTRY AADA 25080018 BC LOW,EQRF04 NO CONTINUE PROCESSING AABA 25100016 EQRG DS 0H ENTRY FOR OVERRIDDEN KEY 25120000 SCSW C,FLUSHSWW CLEAR FLUSHSW 25140000 L R5,TKEYP GET POINTER TO KEY 25160000 CLI 0(R5),CONDEEK IS KEY COND EQUAL 25180000 BC EQUAL,EQRG1 YES TRANSFER 25200000 CLI 0(R5),CONDJK IS KEY JOB COND 25220000 BC NOT-EQUAL,EQRH NO TRANSFER 25240000 EQRG1 DS 0H 25260000 SCSW S,LDLX TURN ON LAST DELIMITER SW 25280000 B FB1 TRANSFER 25300000 EQRE1 DS 0H 25320000 TM 0(R3),0 TEST FOR BIT IN DUPTB 25340000 EQRF1 DS 0H 25360000 OI 0(R3),0 TURN ON BIT IN DUPTB 25380000 EQRH DS 0H 25400000 SCSW C,LDLX CLEAR LAST DELIMITER SW 25420000 CLI 0(R5),DSNAMEK IS KEY DSNAME 25440000 BC EQUAL,EQRI YES TRANSFER 25460000 CLI 0(R5),REFMK IS KEY REF 25480000 BC EQUAL,EQRI YES TRANSFER 25500000 CLI 0(R5),PGMEK IS KEY PGM EQUAL 25520000 BC NOT-EQUAL,EQRH1 BRANCH NO. Y02668 25540002 NI SWC,255-PEXP CLEAR PROC EXEC EXPECTED SW. Y02668 25540302 TM AOSW2,AOPROCNM POSITIONAL PROCNAME SPECIFIED?Y02668 25540702 BZ EQRI BRANCH NO. Y02668 25541402 * ERROR - BOTH A POSITIONAL PROCNAME AND PGM= SPECIFIED. Y02668 25542102 LA R2,ERMSG632 'FORMAT ERROR' MSG CODE. Y02668 25542802 B E1 BR TO ERROR ROUTINE. Y02668 25544202 EQRH1 DS 0H Y02668 25544902 CLI 0(R5),RESTARJK IS IT RESTART AAAA 25546015 BE EQRI0 YES - TRANSFER AAAA 25552015 CLI 0(R5),DCBK IS KEY DCB 25560000 BC NOT-EQUAL,EQRI01 NO TRANSFER 25580000 SCSW S,DCBSWW TURN ON DCB SWITCH 25600000 EQRI DS 0H 25620000 SCSW S,LDLX SET LAST DELIMITER SW AAAA 25626015 EQRI0 DS 0H AAAA 25632015 SCSW S,PDELSWW TURN ON PERIOD DELIMITER SWITCH 25640000 B FB1 TRANSFER 25680000 EQRI01 DS 0H 25700000 L RF,TEXTBUFP ADDR OF TEXT STRING. Y02668 25706002 USING TEXT,RF PREFIX ADDRESSABILITY. Y02668 25712002 CLI 0(R5),SYSOUTK IS KEY SYSOUT 25720000 BC NOT-EQUAL,EQRI02 NO TRANSFER 25740000 L R1,CSTRP RESTORE CHAR STRING PTR. A39022 25742001 CLI 1(R1),COMMA IS SYSOUT BEING NULLIFIED A39022 25750001 BC EQUAL,EQRI02 YES-TRANSFER DO NOT SET SWITCH A39022 25752001 CLI 1(R1),BLANK IS SYSOUT BEING NULLIFIED A39022 25754001 BC EQUAL,EQRI02 YES-TRANSFER DO NOT SET SWITCH A39022 25756001 OI STRDINDC,DTXSYOUT SET SYSPUT SWITCH. Y02668 25792002 B FB1 TRANSFER 25800000 EQRI02 DS 0H 25820000 SPACE 25822001 * IF DLM APPEARS ON A DD STM. OTHER THAN DD * OR DD DATA, 21009 25830001 * MUTUAL EXCLUSIVE ERROR MESSAGE IS GIVEN 21009 25840001 SPACE 25840401 CLI 0(R5),DLMK IS THIS A DLM KEY? 21009 25842001 BC NOT-EQUAL,EQRI04 NO, NORMAL PROCESSING 21009 25844001 OI SWA,DLM DLM FOUND THIS CARD ? YM03459 25845002 LR R9,R5 STORE KEY FOR MESSAGE 21009 25846001 TM STRDINDC,DTXSYSIN THIS A DD */DATA STMT? Y02668 25848002 BC Z,EQRL1 NO, MUTUAL EXCLUSIVE ERROR @ZA01931 25848403 DROP RF Y02668 25848602 EQRI04 DS 0H 21009 25848801 SPACE 25850017 LA RF,XKTAB 25880017 BAL RE,XKRTN CHECK IF EXEC O'RIDE 25910017 CLI 0(RF),0 KEY IN TABLE 25940017 BE FB1 NO - NOT EXEC O'RIDE 25970017 EQRI03 DS 0H 26040000 SR R3,R3 CLEAR REGISTER 26060000 IC R3,0(R5) GET KEY 26080000 BAL R6,I1 GET PTR TO BYTE IN DUPTB 26100000 LCR R5,R5 EXPRESS AS TWO'S COMPLEMENT 26120000 BCTR R5,R0 DECREMENT REGISTER 26140000 EX R5,D3 TURN OFF BITS IN DUPTB 26160000 B FB1 TRANSFER 26180000 D3 NI 0(R3),0 16368 26190016 EQRJ DS 0H 26200000 SCSW Z,DDOVZ,EQRL1 TRANSFER OVERRIDE SW OFF - ERROR 26220000 SCSW S,FLUSHSWW SET FLUSH SWITCH 26240000 SCSW S,OVKEYSWZ SET OVERRIDDEN KEY SW 26260000 STC R7,OVKEYSVE SAVE OVERRIDDEN KEY 26280000 EQRK DS 0H 26300000 SR R3,R3 CLEAR REGISTER 26320000 IC R3,0(R9) GET THE KEY 26340000 TM SWZ,DDSW IS THIS A DD CARD 19874 26346019 BC ZERO,EQRK1 NO, LEAVE HIGH ORDER BIT SET 19874 26352019 LA R4,X'7F' LOAD MASK FOR AND 26360000 NR R3,R4 AND OUT HIGH ORDER BIT 26380000 EQRK1 EQU * 19874 26390019 BAL R6,I1 GET PTR TO BYTE IN DUPTB 26400000 EX R5,EQRF1 TURN ON BIT IN DUPTB 26420000 LA R9,1(R9) BUMP TO NEXT KEY 26440000 CLR R9,RF END OF SCAN DICT ENTRY AADA 26460018 BC LOW,EQRK NO CONTINUE PROCESSING 26480000 B FB1 TRANSFER 26500000 EQRL DS 0H 26520000 SCSW Z,EXECSWY,EQRLA1 TRANSFER NOT EXEC VERB 26522000 L R1,CSTRP POINTER FOR SYMBOLIC PARAM RTN 26524000 L RF,FIEFVFB GET SYMBOLIC PARAMETER RTN 26526000 BALR RE,RF 26528000 B FB1 RETURN TO STATEMENT SCAN 26530000 EQRLA1 DS 0H 26532000 SCSW O,OVKEYSWZ,EQRLB TRANSFER LAST KEY OVERRIDDEN 26540000 EQRLA DS 0H 26560000 SR R2,R2 26580000 IC R2,MSGSVE ERROR MSG NUMBER 26600000 B E1 26620000 EQRLB DS 0H 26640000 L R5,AD6LL PTR TO LAST OF DD KEYS 26660000 CLR RF,R5 IS THIS THE END AADA 26680018 BC HIGH,EQRLA YES - ISSUE ERROR MSG 26700000 LA RF,1(RF) NO- BUMP PTR AADA 26720018 B EQRD3 CONTINUE SEARCH 26740000 EQRL1 DS 0H ENTRY FOR MUTUALLY EXCLUSIVE ERROR 26760000 MVC MSGKEY(1),0(R9) KEY FOR SECONDARY MESSAGE 26780000 LA R2,ERMES2 ERROR MESSAGE NUMBER 26800000 L RF,IEFVGMV 26820000 BALR RE,RF ISSUE MSG 26840000 EQRL2 DS 0H ENTRY FOR SECOND HALF OF MESSAGE 26860000 L R5,TBEGP GET VERB KEY FOR THIS STMT Y02668 26900002 MVC MSGKEY(1),0(R5) FOR ENTRY IN SECONDARY MSG. Y02668 26920002 SCSW Z,VERBCSWZ,EQRL3 TRANSFER NOT PROC VERB AABA 26940016 MVI MSGKEY,PSECMSG GET PROC SECONDARY MSG AABA 26980016 EQRL3 DS 0H 27020016 MVI INTBUF,0 AABA 27060016 LA R2,ERMES2B AABA 27100016 B E1 GO TO ERROR RTN 27140016 EQRL5 DS 0H ENTRY FOR INVALID SUBPARAM 27220000 LA R2,X'29' 27240000 B E1 27260000 EJECT 27260317 * AACA 27260617 * THIS RTN CHECKS IF THE PARAMS FOR THE KEYWORD ARE BEING AACA 27260917 * FLUSHED (IGNORED) DUE TO A DD O'RIDE AACA 27261217 ORRTN DS 0H 27261517 SPACE 27261817 SCSW O,FLUSHSWW,FB3 RET TO TRANS RTN IF O'RIDE AACA 27262117 BR RE RET IF NO O'RIDE AACA 27262417 SPACE 27262717 * AACA 27263017 XKRTN DS 0H 27263317 * AACA 27263617 * THIS RTN SEARCHES A TABLE OF ONE BYTE KEYS AACA 27263917 * 27264217 * INPUT- R5 PTR TO SEARCH ARGUMENT AACA 27264517 * R14 RET REG AACA 27264817 * R15 PTR TO LAST TABLE ENTRY AACA 27265117 * 27265417 * OUTPUT- R5 UNCHANGED AACA 27265717 * R14 UNCHANGED AACA 27266017 * R15 PTR TO FOUND ENTRY OR ZERO ENTRY AACA 27266317 * 27266617 * 27266917 XKRTN01 DS 0H 27267217 CLI 0(RF),0 IS ENTRY 0 27267517 BE XKRTN05 KEY NOT FOUND 27267817 CLC 0(1,RF),0(R5) COMP TO SEARCH ARG 27268117 BE XKRTN05 FOUND - RETURN AACA 27268417 BCT RF,XKRTN01 CHECK NEXT 27268717 XKRTN05 DS 0H 27269017 BR RE RETURN 27269317 * TABLE OF O'RIDE KEYS 27269617 DC AL1(0) 27269917 DC AL1(ACCTPEK) 27270217 DC AL1(PRFMPEK) Y02655 27270302 DC AL1(CONDPEK) 27270517 DC AL1(DYNMPEK) Y02670 27270602 DC AL1(PARMPEK) 27270817 DC AL1(TIMEPEK) 27271117 DC AL1(ROLLPEK) 27271417 DC AL1(ADRSPPEK) 27271501 DC AL1(RDPEK) 27271717 DC AL1(SDPPEK) I241 27271818 XKTAB DC AL1(REGINPEK) 27272017 SPACE 27272317 * TABLE OF KEYS WHERE PARAMS MAY BE IN QUOTES 27272617 DC AL1(0) 27272917 DC AL1(SUBSYSK) @G29AN2E 27273003 DC AL1(DLMK) 21009 27273103 DC AL1(JOBK) 27273403 DC AL1(ACCTEEK) 27273517 DC AL1(PARMEEK) 27273817 DC AL1(ACCTPEK) 27274117 DC AL1(AMPK) Y01113 27274201 DC AL1(PARMPEK) 27274417 DC AL1(SERMK) 27274717 APRTAB DC AL1(RESTARJK) 27275017 * AACA 27275317 * TABLE OF KEYS WHERE HYPHEN IS OK AACA 27275617 DC AL1(0) 27275917 DC AL1(DSIDK) @Y30OPSB 27276003 DC AL1(SERMK) 27276217 DC AL1(JOBK) 27276517 DC AL1(ACCTEEK) 27276817 DC AL1(ACCTPEK) 27277117 MIRTAB DC AL1(DSNAMEK) 27277417 * 7821 27277717 * TABLE OF KEYS WHERE 'KEYWORD=KEYWORD=' IS ALLOWABLE. 7821 27278017 DC AL1(0) 7821 27278317 DC AL1(DCBK) 7821 27278617 DC AL1(VOLUMEK) 7821 27278917 DC AL1(UNITK) 7821 27279217 KEYEQTAB DC AL1(LABELK) 7821 27279517 EJECT 27280000 * ********************************************************** 27300000 * TABLE OF CHARTERS APPEARING AFTER RIGHT PAREN. 22520 27301018 DC AL1(0) 22520 27302018 DC AL1(COMMA) 22520 27303018 DC AL1(BLANK) 22520 27304018 DC AL1(AMPERSAN) 22520 27305018 RPRTAB DC AL1(RPARENT) 22520 27306018 COMMA EQU C',' 22520 27307018 BLANK EQU C' ' 22520 27308018 AMPERSAN EQU C'&&' 22520 27309018 RPARENT EQU C')' 22520 27310018 * ********************************************************** 27311018 * * * 27320000 * * ROUTINE TO SELECT BITS IN DUPLICATE TABLE. * 27340000 * * * 27360000 * ********************************************************** 27380000 AOKEYBIT DS 0H Y02668 27400002 LA R2,KEYTAB TEST THE BITS IN KEYTAB Y02668 27403002 B AOKSI5 Y02668 27406002 I1 DS 0H Y02668 27409002 LA R2,DUPTAB TEST THE BITS IN DUPTAB Y02668 27412002 AOKSI5 DS 0H Y02668 27415002 LA R4,X'07' 27420000 NR R4,R3 27440000 LA R5,X'80' 27460000 SRL R5,0(R4) 27480000 SRL R3,3 27500000 LA R3,0(R2,R3) BIT @ IN REQUESTED TABLE Y02668 27520002 BR R6 27540000 EJECT 27540519 * *********************************************************19200 27541019 * 19200 27541519 * TABLE OF DCB MINOR KEYWORDS 19200 27542019 DC AL1(0) 19200 27542519 DC AL1(BFALNMK) 19200 27543019 DC AL1(BFTEKMK) 19200 27543519 DC AL1(BLKSIZMK) 19200 27544019 DC AL1(BUFLMK) 19200 27544519 DC AL1(BUFNOMK) 19200 27545019 DC AL1(BUFRQMK) 19200 27545519 DC AL1(CODEMK) 19200 27546019 DC AL1(CPRIMK) 19200 27546519 DC AL1(CYLOFLMK) 19200 27547019 DC AL1(HIARCHMK) 19200 27547519 DC AL1(DENMK) 19200 27548019 DC AL1(DIAGNSK) 21042 27548401 DC AL1(DSORGMK) 19200 27548519 DC AL1(EROPTMK) 19200 27549019 DC AL1(FRIDMK) Y02668 27549202 DC AL1(INTVLMK) 19200 27549519 DC AL1(KEYLENMK) 19200 27550019 DC AL1(LIMCTMK) 19200 27550519 DC AL1(LRECLMK) 19200 27551019 DC AL1(MODEMK) 19200 27551519 DC AL1(NCPMK) 19200 27552019 DC AL1(NTMMK) 19200 27552519 DC AL1(OPTCDMK) 19200 27553019 DC AL1(PRTSPMK) 19200 27553519 DC AL1(RECFMMK) 19200 27554019 DC AL1(RKPMK) 19200 27554519 DC AL1(SOWAMK) 19200 27555019 DC AL1(STACKMK) 19200 27555519 DC AL1(TRTCHMK) 19200 27556019 DC AL1(GNCPMK) 19200 27556519 DC AL1(GDSORGMK) 19200 27557019 DC AL1(BUFOFFMK) 19200 27557120 DC AL1(BUFINMK) 20002 27557220 DC AL1(BUFOUTMK) 20002 27557320 DC AL1(BUFMAXMK) 20002 27557420 DC AL1(BUFSIZMK) 20002 27557520 DC AL1(PCIMK) 20002 27557620 DC AL1(RESERVMK) 20002 27557720 DC AL1(THRESHMK) 20002 27557920 DC AL1(IPLTXIDK) Y01948 27567901 DCBTAB DS 0C END OF DCB MINOR KEYS 27607901 DC AL1(FUNCMK) 21088 27617901 * *********************************************************19200 27657901 AOPCSVBL DC CL8' ' Y02668 27677902 EJECT 27707902 * ******************************************************Y02668 27708702 * * *Y02668 27709502 * * AOKSRCHR - TEXT KEY SEARCH ROUTINE. *Y02668 27710302 * * *Y02668 27711102 * * AOKSRCHR SEARCHES A TEXT STRING TO FIND A KEY *Y02668 27711902 * * PROVIDED AS A SEARCH ARGUMENT BY ITS CALLER. IT *Y02668 27712702 * * CHECKS FOR A MATCH ON THE BASE KEY. IF THERE IS NO *Y02668 27713502 * * MATCH, IT PASSES THE ADDRESS OF THE KEY TO ROUTINE *Y02668 27714302 * * AOKSR1, WHICH THEN COMPUTES THE ADDRESS OF THE *Y02668 27715102 * * NEXT KEY IN TEXT. *Y02668 27715902 * * *Y02668 27716702 * * ON RETURN FROM AOKSR1, AOKSRCHR PERFORMS THE *Y02668 27717502 * * FOLLOWING LOGIC: *Y02668 27718302 * * *Y02668 27719102 * * .CHECKS IF THE NEXT KEY IS A TEXT ENDING KEY (ENDK,*Y02668 27719902 * * JENDK) OR A KEYWORD KEY. *Y02668 27720702 * * .IF A TEXT ENDING KEY, SETS R9 TO ZERO AND RETURNS *Y02668 27721502 * * TO CALLER. *Y02668 27722302 * * .IF A KEYWORD KEY, CHECKS IF KEY MATCHES THE *Y02668 27723102 * * SEARCH KEY. *Y02668 27723902 * * .IF KEYS MATCH, RETURNS TO CALLER WITH ADDRESS OF *Y02668 27724702 * * KEY IN R9. *Y02668 27725502 * * .IF KEYS DO NOT MATCH, BRANCHES TO AOKSR1 TO OBTAIN*Y02668 27726302 * * ADDRESS OF NEXT KEY IN TEXT, AND PERFORMS THE *Y02668 27727102 * * ABOVE LOGIC AGAIN. *Y02668 27727902 * * *Y02668 27728702 * * INPUT - *Y02668 27729502 * * .R9 - ADDRESS OF TEXT STRING TO BE SEARCHED. *Y02668 27730302 * * .AOSCHKEY - KEY WHICH IS TO BE LOCATED IN THE *Y02668 27731102 * * TEXT STRING. *Y02668 27731902 * * *Y02668 27732702 * * OUTPUT - *Y02668 27733502 * * *Y02668 27734302 * * .R9 - ADDRESS OF KEY, IF FOUND. ZERO IF KEY NOT *Y02668 27735102 * * FOUND. *Y02668 27735902 * * *Y02668 27736702 * * NOTES - *Y02668 27737502 * * .AOKSRCHR USES SUBROUTINE AOKSR1 FOR SKIPPING FROM *Y02668 27738302 * * KEY TO KEY IN TEXT. *Y02668 27739102 * * *Y02668 27739902 * ******************************************************Y02668 27740702 SPACE 2 Y02668 27741502 AOKSRCHR DS 0H Y02668 27742302 STM RE,R5,AOKSCHSA SAVE CALLER'S REGS. YM01546 27743102 L R9,TEXTBUFP POINT TO PREFIX FOR SEARCH. YM01546 27743502 USING TEXT,R9 SET TEXT STRNG ADDRESSABILITY.Y02668 27743902 TM STRINDCS,JOBSTR JOB STRING? Y02668 27744702 BZ AOKS03 BRANCH NO. Y02668 27745502 LA R9,STRJPFXL(R9) POINT TO JOB BASE KEY. Y02668 27746302 B AOKS010 BRANCH TO SEARCH. Y02668 27747102 AOKS03 DS 0H Y02668 27747902 TM STRINDCS,EXECSTR+PROCSTR EXEC OR PROC STRING? Y02668 27748702 BZ AOKS06 BRANCH IF NEITHER. Y02668 27749502 LA R9,STREPFXL(R9) POINT TO BASE KEY - PREFIX Y02668*27750302 IS SAME LENGTH FOR BOTH. Y02668 27751102 B AOKS010 BRANCH TO SEARCH. Y02668 27751902 * ONLY DD STRING LEFT. Y02668 27752702 AOKS06 DS 0H Y02668 27753502 LA R9,STRDPFXL(R9) POINT TO BASE DD KEY. Y02668 27754302 * SEARCH KEY IS IN AOSCHKYS. MAY BE KEYWORD OR STRING END KEYS. Y02668 27755102 AOKS010 DS 0H Y02668 27755902 LA RF,AOSCHKYS ADDRESS OF SEARCH LIST. Y02668 27756702 AOKS020 DS 0H Y02668 27757502 CLI 0(RF),ENDLISTI END OF SEARCH LIST? Y02668 27758302 BE AOKS030 BR YES, GET NEXT KEY IN TEXT. Y02668 27759102 * MORE SEARCH LIST ENTRIES TO GO. Y02668 27759902 CLC 0(1,RF),0(R9) ENTRY MATCH CURRENT KEY? Y02668 27760702 BE AOKS060 BRANCH YES, KEY FOUND. Y02668 27761502 LA RF,1(RF) STEP TO NEXT LIST ENTRY. Y02668 27762302 B AOKS020 BR TO COMPARE NEXT ENTRY. Y02668 27763102 * CURRENT KEY IN TEXT DOES NOT MATCH ANY ENTRIES IN SEARCH KIST. Y02668 27763902 AOKS030 DS 0H Y02668 27764702 CLI 0(R9),ENDK CURRENT KEY 'END OF STRING'? Y02668 27765502 BE AOKS080 BRANCH YES. Y02668 27766302 * CURRENT KEY IS NOT A TEXT ENDING KEY. MORE KEYS TO GO. Y02668 27768702 BAL RE,AOKSR1 SKIP TO NEXT KEY IN TEXT. Y02668 27769502 B AOKS010 COMPARE NEXT KEY TO LIST. Y02668 27770302 * MATCH FOUND TO SEARCH LIST ENTRY. Y02668 27771102 * RF POINTS TO MATCHING LIST ENTRY, R9 TO MATCHING KEY IN TEXT. Y02668 27771902 * THE MATCHING ENTRY IS MOVED TO THE TOP OF THE LIST. Y02668 27772702 AOKS060 DS 0H Y02668 27773502 LA RE,AOSCHKYS GET ADDR OF 1ST LIST ENTRY. Y02668 27774302 CR RF,RE MATCHING ENTRY ALREADY FIRST? Y02668 27775102 BE AOKS090 BRANCH YES. Y02668 27775902 * MATCHING ENTRY NOT THE FIRST ENTRY. Y02668 27776702 * ENTRIES ABOVE ARE MOVED DOWN OVER THE MATCHING ENTRY, AND Y02668 27777502 * THE MATCHING ENTRY IS PLACED IN THE FIRST SLOT. Y02668 27778302 IC R0,0(RF) LOAD MATCHING ENTRY. Y02668 27779102 LR R1,RF COPY ADDR OF MATCHING ENTRY. Y02668 27779902 SR R1,RE GET DISPLACEMENT OF ENTRY. Y02668 27780702 BCTR RF,0 POINT TO 1ST ENTRY ABOVE Y02668*27781502 MATCHING ENTRY. Y02668 27782302 EX R1,AOKS100 MOVE LIST DOWN 1 SLOT OVER Y02668*27783102 MATCHING ENTRY. AN EXTRA BYTE Y02668*27783902 IS MOVED, BUT NO HARM DONE. Y02668 27784702 STC R0,AOSCHKYS PLACE MATCHING ENTRY AT TOP. Y02668 27785502 B AOKS090 BR TO EXIT. R9 CONTAINS ADDR Y02668*27786302 OF MATCHING KEY IN TEXT. Y02668 27787102 * END OF TEXT HAS BEEN REACHED AND NO MATCHES FOUND. Y02668 27787902 AOKS080 DS 0H Y02668 27788702 SR R9,R9 SET CODE FOR KEY(S) NOT FOUND.Y02668 27789502 AOKS090 DS 0H Y02668 27790302 LM RE,R5,AOKSCHSA RESTORE REGS. YM01546 27791102 BR RE AND RETURN. Y02668 27791902 SPACE 2 Y02668 27792702 AOKS100 MVC 1(0,RF),0(RF) EX MOVE OVER MATCHING ENTRY. Y02668 27793502 ENDLISTI EQU X'00' END OF LIST INDICATOR. Y02668 27797502 EJECT 27799102 * ******************************************************Y02668 27799902 * * *Y02668 27800702 * * AOKSR1 - KEY SEARCH SERVICE ROUTINE. *Y02668 27801502 * * *Y02668 27802302 * * AOKSR1 IS ENTERED TO FIND THE NEXT KEY IN A TEXT *Y02668 27803102 * * STRING. THE CALLING ROUTINE PROVIDES A SEARCH *Y02668 27803902 * * STARTING ADDRESS, AND PARAMETERS NECESSARY FOR *Y02668 27804702 * * SEARCHING THROUGH TEXT. AOKSR1 RETURNS THE ADDRESS *Y02668 27805502 * * OF THE KEY. *Y02668 27806302 * * *Y02668 27807102 * * INPUT - *Y02668 27807902 * * .R9 - ADDRESS OF KEY WHOSE TEXT IS TO BE SKIPPED *Y02668 27808702 * * *Y02668 27809502 * * OUTPUT - *Y02668 27810302 * * .R9 - ADDRESS OF KEY AT WHICH SEARCH WAS STOPPED. *Y02668 27811102 * * ENDING KEY MAY BE A TEXT ENDING KEY OR KEYWORD KEY*Y02668 27811902 * * *Y02668 27812702 * * NOTES - *Y02668 27813502 * * .AOKSR1 MOVES DATA FROM TEXT INTO THE FOLLOWING *Y02668 27814302 * * WORK AREAS: *Y02668 27815102 * * .AOKSRPRM - TWO BYTE PARAMETER LIST COMPRISING - *Y02668 27815902 * * .AOKSRNBR - NUMBER OF PARAMS LEFT FOR THIS KEYWORD.*Y02668 27816702 * * .AOKSRSCT - CONTENTS OF THE BYTE IN TEXT FOLLOWING *Y02668 27817502 * * THE NUMBER BYTE. CONTENTS MAY BE - *Y02668 27818302 * * SUBLIST COUNT *Y02668 27819102 * * LENGTH OF NEXT PARAMETER.*Y02668 27819902 * * .AOKSRBY3 - CONTENTS OF THE 2ND BYTE IN TEXT FOLLOW*Y02668 27820702 * * ING THE NUMBER BYTE. IF AOKSRSCT CONTAINS A SUB- *Y02668 27821502 * * LIST COUNT, THEN AOKSRBY3 CONTAINS THE LTH OF THE *Y02668 27822302 * * FIRST PARAM IN THE SUBLIST. *Y02668 27823102 * * OTHERWISE THE BYTE IS IGNORED. *Y02668 27823902 * * *Y02668 27824702 * ******************************************************Y02668 27825502 SPACE 2 Y02668 27826302 AOKSR1 DS 0H Y02668 27827102 * R9 POINTS TO KEY BYTE. NUMBER BYTE FOLLOWS. Y02668 27827902 MVC AOKSRPRM(3),1(R9) MOVE NBR, LTH AND LTH+1 BYTES Y02668*27828702 FOR THIS KEY, TO WORK AREA. Y02668 27829702 LA R9,2(R9) POINT TO LENGTH BYTE. Y02668 27830702 CLI AOKSRNBR,0 IS PARAM NBR ZERO? Y02668 27831702 BC 8,0(RE) RETURN IF YES. ZERO PARAM NBR Y02668*27832702 IS KEYWORD=KEYWORD CASE. Y02668 27833702 * NON-ZERO PARAM NUMBER. INITIALIZE FOR SEARCH. Y02668 27834702 STM RE,RF,AOKSR1SA SAVE REGS. Y02668 27835702 SR RE,RE ZERO PARAM NUMBER Y02668 27837502 SR RF,RF AND PARAM LENGTH REGS. Y02668 27838302 * ENTRY FROM WITHIN LOOP. Y02668 27839102 AOKSR110 DS 0H Y02668 27839902 IC RE,AOKSRNBR LOAD PARAM NUMBER. Y02668 27840702 XC AOKSRNBR(1),AOKSRNBR ZERO NBR FIELD TO INDICATE Y02668 27841502 * NO SUBLIST BEING PROCESSED. Y02668 27842302 AOKSR120 DS 0H Y02668 27843102 IC RF,AOKSRSCT LOAD PRESUMED LENGTH. Y02668 27843902 TM AOKSRSCT,SUBLST SUBLIST BIT ON? Y02668 27844702 BZ AOKSR150 BRANCH NO. Y02668 27845502 * SUBLIST BIT IS ON. LENGTH BYTE CONTAINS A SUBLIST COUNT Y02668 27846302 * INSTEAD OF AN ACTUAL LENGTH VALUE. Y02668 27847102 BCTR RE,0 REDUCE NBR BY 1 FOR SUBLIST. Y02668 27847902 STC RE,AOKSRNBR SAVE REMAINING NUMBER. Y02668 27848702 IC RE,AOKSRSCT LOAD SUBLIST CT IN NBR REG, Y02668*27849502 TO BE USED AS NUMBER. Y02668 27850302 IC RF,AOKSRBY3 LOAD ACTUAL LTH FROM BYTE 3. Y02668 27851102 N RE,AOSBLOFF CLEAR SUBLIST BIT TO GET Y02668*27851902 USABLE COUNT. Y02668 27852702 LA R9,1(R9) POINT TO LENGTH BYTE. Y02668 27853102 * LENGTH BYTE CONTAINS VALID LENGTH VALUE. Y02668 27853502 AOKSR150 DS 0H Y02668 27854302 LA R9,1(RF,R9) ADD PARAM LTH, PLUS 1 FOR LTH Y02668*27855102 BYTE, TO POINT TO NEXT Y02668*27855602 CONTROL BYTE. Y02668 27856102 MVC AOKSRSCT(2),0(R9) MOVE NEW LENGTH AND BYTE Y02668 27856702 * FOLLOWING, TO TEST AREA. Y02668 27857502 BCTR RE,0 REDUCE NBR FOR THIS PARAM. Y02668 27858302 LTR RE,RE ANY MORE PARAMS TO GO? Y02668 27859102 BNZ AOKSR120 BRANCH YES . Y02668 27859902 * NUMBER REG IS ZERO. TEST IF SUBLIST WAS BEING PROCESSED. Y02668 27860702 CLI AOKSRNBR,0 WAS PARM NBR SAVED BEFORE? Y02668 27861502 BNE AOKSR110 BRANCH YES TO PROCESS NBR. Y02668 27862302 * NUMBER REG IS ZERO AND NO SUBLIST WAS BEING PROCESSED. Y02668 27863102 AOKSR190 DS 0H Y02668 27863902 LM RE,RF,AOKSR1SA RESTORE REGS Y02668 27864702 BR RE AND RETURN. Y02668 27865502 SPACE 2 Y02668 27866302 AOSBLOFF DC A(255-SUBLST) MASK TO TURN OFF SUBLIST BIT. Y02668 27867102 SUBLST EQU X'80' SUBLIST SWITCH. Y02668 27874302 EJECT 27880000 * ************************************************** 27900000 * * * 27920000 * * A AND V ADDRESS CONSTANT TABLE. * 27940000 * * * 27960000 * ************************************************** 27980000 * 28000000 * V ADDRESS CONSTANTS. 28020000 * 28040000 IEFVHFHA DC V(IEFVHF) CONTROL ROUTINE. 28060000 IEFVGMV DC V(IEFVGM) MESSAGE ROUTINE. 28140000 IEFVHRV DC V(IEFVHR) WTO ROUTINE. Y02668 28150002 FIEFVHQ DC V(IEFVHQ) Q MANAGER. 28160000 FIEFVFB DC V(IEFVFB) SYMBOLIC PARAMETER ROUTINE. 28170000 * 28180000 * A ADDRESS CONSTANTS 28200000 * 28220000 AFB7 DC A(FB7) ADDRESS OF TRANSLATE TABLE. 28240000 AJ5L DC A(J5L) ADDRESS FOR JOB KEY WORDS. 28260000 AE4L DC A(E4L) ADDRESS FOR EXEC KEY WORDS. 28280000 AD4L DC A(D4L) ADDRESS FOR DD MAJOR KEY WORDS. 28300000 AD4LD DC A(D4LD) ADDRESS FOR DD DCB MINOR KEY WORDS. 28320000 AD4LUS DC A(D4LUS) ADDRESS FOR DD UNIT MINOR KEY WORDS. 28340000 AD4LUA DC A(D4LUA) ADDRESS FOR DD UNIT AFF KEY WORD. 28360000 AD4LV DC A(D4LV) ADDRESS FOR DD VOLUME MINOR KEY WORDS 28380000 AD6LL DC A(D6LL) ADDRESS FOR DD LABEL MINOR KEY WORDS. 28400000 * 28420000 NULLFILE DC C'NULLFILE' TEST FOR DUMMY DSNAME @ZA26370 28422003 SPACE 2 28424002 *********************PREFIX EQUATES *****************************Y02668 28428002 JOB EQU 1 Y02668 28436002 EXEC EQU 2 Y02668 28440002 PROCV EQU 8 Y02668 28444002 AONUML EQU 2 Y02668 28448002 *********************PATCH SPACE ******************************@G29AN2E 28500003 DC C'PTCH' PATCH SPACE IDENTIFIER @G29AN2E 28550003 PATCH DC 110F'0' PATCH SPACE @G29AN2E 28600003 EJECT @G29AN2E 28650003 DICT JCLD 28700003 EJECT 28750003 FB7 JTRT TT,(BK,PR,LP,PL,AM,AS,RP,MI,SL,CO,AP,EQ),AL,NC 28800003 END 28850003