*********************************************************************** 00005014 * * 00006014 * MODULE NAME - IEFVFB * 00007402 * * 00008014 * DESCRIPTIVE NAME - SYMBOLIC PARAMETER ROUTINE * 00008402 * * 00008802 * COPYRIGHT - N/A * 00008902 * * 00010302 * STATUS - OS/VS2 RELEASE 3.0 AND 3.7 PTF @ZA18227 00020303 * * 00022102 * FUNCTION - 1. PROCESS EXEC PROCEDURE STATEMENTS WHICH ASSIGN * 00022202 * VALUES TO SYMBOLIC PARAMETERS. SYMBOLIC AND * 00023602 * VALUE ARE ENTERED IN A DICTIONARY FOR SYMBOLIC * 00025002 * PARAMETERS. (SYMBUF) * 00026402 * * 00027802 * 2. PROCESS SYMBOLIC PARAMETERS APPEARING ON STATE- * 00029202 * MENTS IN A CATALOGUED PROCEDURE. VALUE ASSIGN- * 00030602 * MENTS ARE SUBSTITUTED WHERE SYMBOLICS APPEAR. * 00032002 * * 00033402 * * 00034802 * OPERATION - THERE ARE TWO BASIC FLOWS THROUGH THE RTN. (1) TO * 00036202 * PROCESS SYMBOLIC PARAMETER VALUE ASSIGNMENTS FROM * 00037602 * EXEC PROCEDURE STATEMENTS OR PROC VERB STATEMENTS * 00039002 * AND (2) TO PROCESS THE SYMBOLIC PARAMETERS WHICH * 00040402 * APPEAR ON DD AND EXEC STATEMENTS IN A CATALOGUED * 00041802 * PROCEDURE. * 00043202 * * 00044602 * 1. VALUE ASSIGNMENTS ON EXEC PROCEDURE STATEMENTS * 00046002 * * 00047402 * A. AFTER MODULE INITIALIZATION, THE SYMBOLIC * 00048802 * PARAMETER DICTIONARY (SYMBUF) IS SEARCHED * 00050202 * USING THE SYMBOLIC AS SEARCH ARGUMENT. IF * 00051602 * THE SYMBOLIC IS FOUND ( INDICATING THE PARAM * 00053002 * WAS PREVIOUSLY DEFINED ) RETURN IS TO SCAN * 00054402 * ROUTINE WITH NO ENTRY BEING MADE IN SYMBUF. * 00055802 * IF THE SYMBOLIC PARAMETER WAS NOT PREVIOUSLY * 00057202 * DEFINED, IT IS ENTERED INTO THE DICTIONARY. * 00058602 * * 00060002 * B. VALUE ASSIGNMENTS ASSOCIATED WITH THE PARAM * 00061402 * ARE ALSO ENTERED INTO THE DICTIONARY. * 00062802 * * 00064202 * C. POINTERS ARE SET FOR SCAN ROUTINE TO RESUME * 00065602 * PROCESSING OF THE INPUT STATEMENT. * 00067002 * * 00068402 * D. RETURNS TO SCAN ROUTINE VIA REG 14 * 00069802 * * 00071202 * * 00078202 * 2. SYMBOLIC PARAMETERS ON STATEMENTS IN A PROC * 00079602 * * 00081002 * A. SYMBOLIC PARAMS ARE PROCESSED BY BUILDING * 00082402 * INTERMEDIATE TEXT COMPOSED OF VALUE ENTRIES * 00083802 * TAKEN FROM THE SYMBOLIC PARAMETER DICTIONARY * 00085202 * IN COMBINATION WITH TEXT CONCATENATED IN THE * 00086602 * INPUT STATEMENT. * 00088002 * * 00089402 * B. POINTERS ARE SET CAUSING SCAN RTN TO PROCESS * 00090802 * THE INTERMEDIATE TEXT. ( WHEN INTERMEDIATE * 00092202 * TEXT IS PROCESSED BY SCAN RTN, POINTERS ARE * 00093602 * RESET BACK TO THE INPUT STATEMENT AND SCAN * 00095002 * CONTINUES. ) * 00096402 * * 00097802 * * 00099202 * NOTES - THE HIGH ORDER BIT OF THE 'LENGTH OF PARM ' FIELD IS SET * 00100402 * WHEN VALUE ASSIGNMENT IS MADE. THE BIT IS CLEARED WHEN * 00100502 * THE VALUE FIELD IS MOVED TO THE INTERMEDIATE BUFFER. * 00100602 * THE BIT FOR EACH ENTRY IS CHECKED IN THE CONVERTER PROC * 00100702 * EOF ROUTINE. ANY BITS LEFT ON(MEANING SYMBOLICS HAVE * 00100802 * NOT BEEN USED) RESULTS IN AN ERROR CONDITION WHICH * 00100902 * CAUSES JOB FAILURE. * 00101402 * * 00102402 * 00102502 * CHARACTER CODE DEPENDENCIES - EBCDIC * 00102702 * DEPENDENCIES - NONE * 00103102 * RESTRICTIONS - NONE * 00103202 * REGISTER CONVENTIONS - REG 12 PTR TO CONVERTER WORK AREA * 00103302 * PATCH-LABEL - PATCH * 00103502 * * 00103902 * 00104002 * MODULE TYPE - BAL * 00104302 * PROCESSOR - ASSEMBLER * 00104502 * ATTRIBUTES - REFRESHABLE,PRIVILEGED,KEY 0, PAGEABLE LPA * 00104902 * * 00105302 * 00105402 * 00105602 * ENTRY POINT - IEFVFB FROM IEFVFA * 00106002 * PURPOSE - TO SAVE SYMBOLIC PARAMETER VALUES AND WHEN NECESSARY * 00106102 * MAKE SUBSTITUTIONS IN PROCEDURE STATEMENTS. * 00106302 * LINKAGE - BALR * 00106702 * INPUT - * 00106802 * REGISTER 1 - DELIMETER POINTER * 00106902 * REGISTER 8 - PTR TO SCAN LOCAL WORK AREA * 00107202 * REGISTER 12 - PTR TO CONVERTER WORK AREA * 00107602 * REGISTER 13 - PTR TO REGISTER SAVE AREA * 00108002 * REGISTERS SAVED - REG14-REG12 * 00108102 * REGISTER CONTENTS DURING PROCESSING - * 00108202 * R0 - WORK REG * 00108602 * R1 - DELIMETER PTR * 00108702 * R2 - MSG CODE AND WORK REG * 00111202 * R3 - WORK REG * 00113802 * R4 - PTR TO CURRENT SYMBUF ENTRY * 00115802 * R5 - RETURN ADDR FOR SUBROUTINES * 00117802 * R6 - WORK REG * 00119802 * R7 - PTR TO PARM VALUE * 00119902 * R8 - PTR TO SCAN LOCAL WORK AREA * 00120002 * R9 - LINKAGE REG TO SUBROUTINES * 00120102 * R10 - WORK REG * 00120602 * R11 - IEFVFB BASE REG * 00121002 * R12 - PTR TO CONVERTER WORK AREA * 00121402 * R13 - PTR TO REG SAVE AREA * 00121502 * R14 - RETURN REG * 00121802 * R15 - LINKAGE REG * 00122202 * REGISTERS RESTORED - REG14-REG12 * 00122602 * * 00123002 * 00123102 * EXIT-NORMAL - BR 14 TO CALLER * 00123402 * CONDITIONS - SYMBOLIC PARM SAVED OR SUBSTITUTED * 00123802 * OUTPUT - SYMBOLIC PARM DICTIONARY TO SWA * 00123902 * PTR TO SUBSTITUTED VALUE * 00124202 * RETURN CODES - NONE * 00124602 * * 00125002 * 00135002 * EXIT-ERROR - BR 14 TO CALLER'S ERROR ROUTINE * 00175002 * CONDITIONS - INVALID SYMBOLIC PARAMETER * 00177002 * OUPUT - REG 2 CONTAINS ERROR MESSAGE CODE * 00179002 * RETURN CODES - NONE * 00181002 * * 00182202 * 00183202 * EXTERNAL REFERENCES - SWA MANAGER INTERFACE * 00185002 * ROUTINES - IEFVHQ * 00186002 * DATA AREAS - CONVERTER WORK AREA, SCAN LOCAL WORK AREA, * 00187002 * SYMBOLIC PARM DICTIONARY,STMT BUFFERS * 00188002 * CONTROL BLOCKS - QMPA * 00189002 * TABLES - CONVERTER/INTERPRETER KEYS(IEFVKEYS) * 00190002 * MACROS - SAVE,IEFSAVER,IEFRELSE,RETURN,SCSW,GETMAIN,FREEMAIN * 00191002 * ENQUEUE RESOURCES - NONE * 00192002 * CHANGE LEVEL - Y02668(MVM C/I),OZ05366,ZA08218,ZA18227 @ZA18227* 00193003 * * 00194002 * 00194402 * MESSAGES - * 00195002 * IEF630I UNIDENTIFIED KEYWORD * 00197002 * IEF618I OPERAND FIELD NOT TERMINATED IN COMMA OR BLANK * 00199002 * IEF623I SOURCE TEXT CONTAINS UNDEFINED OR ILLEGAL * 00199402 * CHARACTERS * 00199802 * IEF642I EXCESSIVE PARAMETER LENGTH * 00199902 * IEF647I NON-ALPHA FIRST CHARACTER * 00204502 * * 00211402 * * 00280402 *********************************************************************** 00282402 EJECT 00284402 *********************************************************************** 00284802 * FORMAT OF ENTRIES IN SYMBOLIC PARAMETER DICTIONARY (SYMBUF) * 00285002 * * 00289602 * ***************************************************************** * 00294202 * * * * * * * * * * 00298802 * * TTR OF * TTR OF * LENGTH * LENGTH * * LENGTH * * * 00303402 * * THIS * NEXT * OF * OF * SYMBOLIC * OF * VALUE * * 00308002 * * BUFFER * BUFFER * ENTRY * PARAM * PARAM * VALUE * * * 00312602 * * * * (LE) * (LP) * * (LV) * * * 00317202 * * * * * * * * * * 00321802 * ***************************************************************** * 00326402 * * 00331002 * 4 BYTES 4 BYTES 1 BYTE 1 BYTE VARIABLE 1 BYTE VARIABLE * 00335602 * LENGTH LENGTH * 00340202 *********************************************************************** 00381602 EJECT 00386202 IEFQMNGR 00390802 EJECT 00395402 IEFVKEYS 00400014 EJECT 00500014 IEFCOMWA Y02668 00600002 IEFCVRWA Y02668 00650002 EJECT 00700014 IEFVMSWA 00800014 SPACE 00900014 * FB EQUATES 01000014 FEQUAL EQU C'=' EQUAL 01100014 FAPOST EQU C'''' APOST 01200014 FBLANK EQU C' ' BLANK 01300014 FCOMMA EQU C',' COMMA 01400014 FAMP EQU C'&&' AMPERSAND 01500014 FPERIOD EQU C'.' PERIOD A37550 01550001 FRPAREN EQU C')' RIGHT PAREN. A51024 01560001 FBSMAX EQU 7 MAX LENGTH OF SYMBOLIC PARAMETER 01600014 ITBL EQU 120 MAX LENGTH OF TEXT IN INTBUF 01650014 MSGMAX EQU 120 MAX LENGTH OF MSG TEXT 01655003 TWO7 EQU 27 LENGTH OF MSG HEA&ER. A37550 01660001 ONE EQU 1 DISPLACEMENT. A37550 01670001 SIX9 EQU 69 MAX LENGTH FOR MOVE1 YM01591 01673002 BUFLNGTH EQU TWO7+SIX9+ITBL SIZE OF MAX BUFFER REQ'D YM01591 01676002 FBFOUR EQU 4 LENGTH VALUE OF FOUR Y02621 01680002 * FB ERROR MESSAGE CODES 01700014 ERMSB01 EQU X'1E' UNDIENTIFIED KEYWORD 01800014 * 02100014 ERMSB03 EQU X'12' OPERAND FIELD NOT TERM IN COMMA OR BLANK 02200014 ERMSB04 EQU X'17' SOURCE TEXT CONTAINS UNIDENTIFIED CHARACTERS 02300014 ERMSB05 EQU X'2A' EXCESSIVE PARAMETER LENGTH -TOO MANY INTBUF CHARS 02400014 * 02600014 ERMSB06 EQU X'2F' NON ALPH FIRST CHARACTER 02700014 ERMSB07 EQU X'2A' EXCESSIVE PARAMETER LENGTH 02750014 * FB SECONDARY MESSAGE CODES 02760014 * 02770014 SMSGS EQU INTKEY1 SYMBOLIC PARAMETER 19874 02777019 SMSGP EQU INTKEY2 VALUE FIELD OF THE ..... 19874 02784019 SMSGV EQU INTKEY3 ON THE PROC STATEMENT 19874 02791019 FBSVN EQU 7 DISPLACEMENT CONSTANT Y02621 02794002 SYMBUFID EQU X'25' ID FOR WRITING SYMBUF RECORD. Y02621 02797002 NUMB EQU X'01' DISP TO COUNT FIELD IN TEXT. Y02668 02798002 RECNO1 EQU X'01' Y02668 02798602 RECNO2 EQU X'20' Y02668 02799202 SPACE 2 02800014 IEFVFB CSECT 02900014 * ADDED STATEMENT AFTER LABEL FBCHN @ZA05366 02920003 * CODE & COMMENTS CHANGED NEAR LABELS AROUND & FBDEL02X, @ZA08218 02934003 * BUILDING MULTIPLE SUBSTITUTION @ZA08218 02935003 * JCL MESSAGE @ZA08218 02939003 * ADDED CODE TO DETECT DUMM= AFTER LABEL FBDEL02 @ZA18227 02944003 DASBIT EQU 16 **********TEMP************ YM01590 02950002 SAVE (14,12) SAVE REGISTERS 03000014 BALR RB,R0 FB BASE 03100014 USING *,RB 03200014 *****************************************************************Y02668 03205002 * MODULE TRACE CODE - FOR TESTING. Y02668 03210002 L RF,TRACEV LOAD TRACE RTNE ADDR. Y02668 03215002 BALR RE,RF ENTER MOD ID IN TRACE RECORD. Y02668 03220002 TRACEV DC V(TRACE) TRACE RTNE ADDR. Y02668 03225002 DC C'VFB ' MOD ID USED BY TRACE. Y02668 03230002 * TRACE RETURNS HERE. Y02668 03235002 *****************************************************************Y02668 03240002 B VFB01 BRANCH AROUND ID Y02668 03250002 MODID BR=NO Y02668 03350002 DC C'SPLT' Y02668 03450002 DC C'04' LEVEL NUMBER (SWA SUPPORT). Y02668 03550002 DC C'REL3PTF' PTF UZ01541 0B0-C IN VHA READING @ZA05366 03560003 * DC C'01' DICTIONARY NOT WRITTEN TO SWA @ZA05366 03590003 * DC C'02' ALLOW AS MANY IEF653I SUBSTITUTION JCL 03592003 * MSGS AS NEEDED TO SHOW ALL 03594003 * SUBSTITUTIONS @ZA08218 03596003 DC C'03' CHANGE DUMM= TO DUMMY IN SUBSTITUTION @ZA18227 03600003 * JCL MESSAGE @ZA18227 03604003 VFB01 DS 0H Y02668 03650002 EJECT 03800014 *********************************************************************** 03900014 * * 04000014 * INITIALIZATION * 04100014 * * 04200014 * R1 = POINTER TO STATEMENT DELIMITER * 04300014 * R4 = CURRENT ENTRY IN SYMBUF * 04400014 * * 04500014 *********************************************************************** 04600014 SPACE 04700014 LA R4,SYMBUF+8 CURRENT SYMBUF ENTRY 04900014 L R7,CBSYP CHAR STRING PTR 05000014 * 05100014 * CHECK IF FROM KEYWORD RTN 05200014 * 05300014 CLI 0(R1),FEQUAL IS DELIMITER AN EQUAL SIGN 05400014 BE FBB YES- PROCESS TO ASSIGN A VALUE 05430014 CLI 0(R1),C'.' NO - IS THIS INCORRECT USE OF PERIOD 05460014 BNE FBC NO - PROCESS FOR SUBSTITUTION 05490014 LA R2,ERMES10 GET ERROR CODE 05520014 B FBERR ERROR RETURN 05550014 * 05600014 *********************************************************************** 05700014 * * 05800014 * PROCESSING RTN TO ASSIGN A VALUE TO A SYMBOLIC PARAMETER * 05900014 * * 06000014 * ROUTINE FIRST TEST FOR EXEC PROC STATEMENT * 06100014 * * 06200014 *********************************************************************** 06300014 SPACE 06400014 FBB DS 0H 06500014 L R5,TBEGP GET PTR TO VERB KEY Y02668 06700002 CLI 1(R5),NUMB Q. EXEC VERB HAVE OVER 1 PARM Y02668 06750002 BH FBB0 YES - GO SET PROC SW 06800014 LA R6,PROCEK NO - CHECK FOR PROC= KEY 06900014 BAL R9,FBI HAVE FBI CHECK ON IT 07000014 LA R6,KEYTAB(R6) OFFSET TO KEY TABLE 07100014 EX R2,FBB010 IS PROC KEY BIT ON 07200014 * R2 HAS BIT PATTERN FOR PROC 07300014 * R6 HAS OFFSET TO KEYTAB 07400014 BZ FBB020 TRANSFER BIT OFF - ERROR 07500014 FBB0 DS 0H 07600014 SCSW S,PROCSWZ THIS IS EXEC PROC - SET INDICATOR 07700014 OC SYMTTR(FBFOUR),SYMTTR DOES SYMBUF HAVE A TTR? Y02621 07750002 BNE FBB030 YES - GO TO SEARCH FIRST BUFFER 07800014 XC SYMBUF(176),SYMBUF NO - CLEAR THE BUFFER 07850014 * 07900014 * ASSIGN TTR TO SYMBUF AND SAVE TTR IN SYMTTR 08000014 * 08100014 * 08200014 XC QLINKWA(8),QLINKWA CLEAR PARMLIST Y02668 08300002 LA R3,QLINKWA GET ADDR OF EXTERNAL PARMLIST Y02668 08330002 ST R3,QPARM+QMPCL-QMNAM SAVE PTR IN QMPA Y02668 08360002 MVI QPARM+QMPCM-QMNAM,RECNO2 ASSIGN TWO SVA'S(ONE FOR Y02668 08390002 * SYMBUF AND THE OTHER FOR A Y02668 08420002 * SYMBUF EXTENSION Y02668 08450002 MVI QPARM+QMPOP-QMNAM,QMASGN 08500014 BAL R6,FBQMAN02 GO TO ASSIGN TTR 08560014 L R3,QPARM+QMPCL-QMNAM 08620014 MVC TNEXT(4),0(R3) SAVE ASSIGNED TTR 08700014 MVC SYMBUF(4),4(R3) INSERT SVA IN SYMBUF Y02668 08720002 MVC SYMTTR(4),4(R3) ALSO SAVE IT IN THE CWA FOR Y02668 08740002 * VFA AND VHA TO CHECK. A NON - Y02668 08760002 * ZERO VALUE HERE INDICATES Y02668 08780002 * SYMBOLICS WERE PRESENT IN A Y02668 08800002 * PROCEDURE Y02668 08820002 B FBB030 08900014 FBB010 DS 0H EXECUTED 09000014 TM 0(R6),0 TEST BIT 09100014 FBB020 DS 0H 09200014 LA R2,ERMSB01 09300014 B FBERR GO TO ERROR RTN 09400014 SPACE 2 09500014 *********************************************************************** 09600014 * * 09700014 * STATEMENT IS EXEC PROC - SEARCH SYMBUF FOR SYMBOLIC PARAM * 09800014 * * 09900014 * FOUND = DO NOT MAKE ENTRIES IN SYMBUF * 10000014 * NOT FOUND = OK (ENTER SYMBOLIC IN TABLE) * 10100014 * * 10200014 *********************************************************************** 10300014 SPACE 10400014 FBB030 DS 0H 10500014 BAL R5,FBSCH GO TO TABLE SEARCH ROUTINE 10600014 LTR RF,RF IS SYMBOLIC ALREADY IN TABLE 10700014 BZ FBB1 NO - GO ENTER SYMBOLIC 10800014 SCSW S,FBFLUSHZ SET FLUSH SW - NO UPDATE OF SYMBUF 10900014 * 11100014 * 11200014 * CHECK SYMBOLIC FOR FIRST CHARACTER ALPHA 11300014 * 11400014 FBB1 DS 0H 11500014 LTR RA,RA NULL SYMBOLIC 11510014 BZ FBB020 TRANSFER NULL - ERROR 11520014 MVI MSGKEY,SMSGS SECONDARY MESSAGE 11550014 MVC FAWA4(1),0(R7) MOVE FIRST CHAR TO WORK AREA 11600014 NI FAWA4,X'F0' ZERO LOW ORDER BITS 11700014 XI FAWA4,C'0' TEST FOR DIFFERENCE IN ZONE BITS 11800014 BC 7,FBB102 TRANSFER - NOT NUMERIC 11900014 LA R2,ERMSB06 ERROR MSG NUMBER 12000014 B FBERR0 12100014 FBB102 DS 0H 12200014 * 12300014 * CHECK SYMBOLIC FOR SPECIAL CHARACTERS AND MAX LENGTH 12400014 * 12500014 LA R5,FBSMAX MAX LENGTH 12600014 CLR RA,R5 RA HAS LENGTH OF THIS SYMBOLIC 12700014 BNH FBB104 TRANSFER - SYMBOLIC NOT TOO LONG 12740014 LA R2,ERMSB07 ERROR MSG NUMBER 12780014 B FBERR0 12820014 FBB104 DS 0H 12860014 BAL R9,FBSCR GO TO TRANSLATE SYMBOLIC 12900014 * NO ERROR - CONTINUE PROCESSING 12930014 SPACE 2 12960014 *********************************************************************** 13000014 * * 13100014 * GO TO TABLE BUILD RTN TO ENTER SYMBOLIC IN SYMBUF * 13200014 * * 13300014 * R1 = DELIMITER PTR * 13400014 * R4 = CURRENT SYMBUF ENTRY * 13500014 * R5 = RETURN ADDRESS * 13600014 * R7 = POINTER TO FIRST CHARACTER * 13700014 * * 13800014 *********************************************************************** 13900014 SPACE 2 14000014 FBB110 DS 0H 14100014 BAL R5,FBBLD GO TO TABLE BUILD RTN (RF=0) 14200014 * SYMBOLIC IS IN SYMBUF 14300014 OI 1(R4),HONE SET FLAG IN LP BYTE 14400014 * 14500014 * CHECK IF VALUE IS ENCLOSED IN APOST 14600014 * 14700014 LA R1,1(R1) 14800014 LR R7,R1 UPDATE STRING PTR 14850014 CLI 0(R1),FAPOST IS FIRST CHAR = APOST 14900014 BE FBB2 YES-TRANSFER FOR SPECIAL CHARS 15000014 * 15200014 * PROCESSING FOR VALUE NOT IN APOSTS 15300014 * 15400014 FBB120 DS 0H 15500014 LA R3,1 COUNT FOR MOVE RTN 15600014 LR R2,R1 PTR FOR MOVE RTN 15650014 CLI 0(R1),FBLANK BLANK 15700014 BE FBB130 YES- TRANSFER 15800014 CLI 0(R1),FCOMMA NO - COMMA 15900014 BE FBB130 YES- TRANSFER 16000014 BAL R5,FBMVC NO - MOVE CHAR TO INTBUF 16100014 LA R1,1(R1) BUMP CHARACTER POINTER 16200014 B FBB120 LOOP 16300014 * 16400014 * SPECIAL CHARACTER CHECK 16500014 * 16600014 FBB130 DS 0H 16700014 MVI MSGKEY,SMSGP SECONDARY MESSAGE 16800014 BAL R9,FBSCR GO TO SPECIAL CHARACTER ROUTINE 16900014 B FBB3 GO TO MOVE VALUE TO SYMBUF 17000014 * 17100014 * PROCESSING FOR VALUE IN APOSTS 17200014 * 17300014 FBB2 DS 0H 17400014 LA R1,1(R1) FIRST CHAR OF VALUE 17500014 FBB220 DS 0H 17600014 CLI 0(R1),FAPOST IS THIS APOST 17700014 BE FBB240 YES TRANSFER 17800014 * NO MOVE THIS CHAR TO INTBUF 17900014 FBB230 DS 0H 18000014 LA R3,1 COUNT FOR MOVE RTN 18100014 LR R2,R1 18200014 CL R2,CENDP DOES OPERAND GO INTO COL 72 AACA 18230017 BH FBTRR07 BR IF INTO COL 72 - ERROR AACA 18260017 BAL R5,FBMVC MOVE BYTE TO INTBUF 18300014 B FBB2 LOOP 18400014 FBB240 DS 0H 18500014 LA R1,1(R1) BUMP CHAR PTR 18600014 CLI 0(R1),FAPOST IS THIS TWO APOST 18700014 BE FBB230 YES MOVE ONE TO INTBUF 18800014 CLI 0(R1),FBLANK IS CHARACTER A BLANK? A51024 18850001 BE FBB3 YES, MOVE VALUE TO SYMBUF. A51024 18860001 CLI 0(R1),FCOMMA IS CHARACTER A COMMA? A51024 18870001 BE FBB3 YES, MOVE VALUE TO SYMBUF A51024 18880001 CLI 0(R1),FRPAREN IS CHARACTER A RIGHT PAREN? A51024 18890001 BE FBB3 YES, MOVE VALUE TO SYMBUF. A51024 18892001 LA R2,ERMES6 GET ERROR CODE. A51024 18894001 B FBERR ERROR RETURN. A51024 18896001 * NO END OF VALUE 18900014 SPACE 2 19000014 *********************************************************************** 19100014 * * 19200014 * PREPARE TO MOVE VALUE TO SYMBUF * 19300014 * * 19400014 * R1 = PTR TO DELIMITER * 19500014 * R4 = CURRENT SYMBUF PTR * 19600014 * R5 = RET ADDRESS * 19700014 * R7 = PTR TO FIRST CHARACTER * 19800014 * * 19900014 *********************************************************************** 20000014 SPACE 20100014 FBB3 DS 0H 20200014 LA R7,INTBUF+1 FIRST CHAR OF VALUE 20300014 ST R1,CESYP SAVE DELIMITER FOR SCAN RTN 20400014 BCTR R1,R0 20430014 ST R1,CSTRP 20460014 SR R1,R1 20500014 IC R1,INTBUF 20600014 LA R1,INTBUF+1(R1) DELIMITER POINTER FOR BUILD RTN 20700014 BAL R5,FBBLD GO TO TABLE BUILD RTN 20800014 * 20900014 * VALUE IS IN TABLE - RETURN TO SCAN ROUTINE 21000014 * 21100014 FBB440 DS 0H 21900014 OI SRCHSW1,SRCHF8 NO TEXT INTO TEXTBUF A32730 21960020 B FBRET 22020014 EJECT 22100014 *********************************************************************** 22200014 * * 22300014 * PROCESSING RTN TO DEFINE A SYMBOLIC PARAMETER * 22400014 * * 22500014 * BUILDS INTERMEDIATE TEXT IN INTBUF * 22600014 * * 22700014 *********************************************************************** 22800014 SPACE 22900014 FBC DS 0H 23000014 MVI INTBUF+1,C' ' 23040014 MVC INTBUF+2(ITBL-1),INTBUF+1 BLANK INTBUF 23080014 MVC INTBUF-ITBMSGL(ITBMSGL),FBCMSG1 INITIALIZE MSG BUFFER 23120014 MVI INTBUF,0 ZERO COUNT FIELD 23160014 SCSW Z,VERBCSWZ,FBC02 TRANSFER NOT A PROC VERB 23170014 MVI MSGKEY,SMSGV INITIALIZE SECONDARY ERROR MESSAGE 23180014 FBC02 DS 0H 23190014 TM SWE,PROC+PREF IS THIS STATEMENT IN A PROC YA02705 23200002 BC 5,FBAMR YES - GO TO PROCESS AMPERSAND YA02705 23300002 SCSW O,POVRDZ,FBAMR NO - TRANSFER IF OVERRIDE DD 23400014 B FBRET RETURN 23500014 SPACE 2 23508014 * 23516014 * FOLLOWING TEXT PRECEDES THE INTBUF. THE MESSAGE AND 23524014 * THE VARIABLE LENGTH TEXT IN INTBUF ARE PRINTED 23532014 * IF A JCL ERROR IS DETECTED WHILE THE INTBUF 23540014 * IS BEING SCANNED. 23548014 * NOTE - IF THE TEXT OF MSG IS CHANGED AND LENGTH IS ALTERED, 23556014 * THE EQUATE 'ITBMSGL' MUST BE CHANGED ACCORDINGLY. 23564014 * 23572014 FBCMSG1 DS 0H 23580014 DC C'IEF653I SUBSTITUTION JCL - ' I68 23590018 EJECT 23600014 *********************************************************************** 23700014 * * 23800014 * TRANSLATE AND TEST ROUTINE R1= CHARACTER STRING PTR * 23900014 * * 24000014 *********************************************************************** 24100014 SPACE 24200014 FBTRR0 DS 0H 24230014 LA R1,1(R1) BUMP PTR 24260014 FBTRR DS 0H 24300014 L R3,FATRP ADDRESS OF TRANSLATE TABLE 24400014 L R5,CENDP END OF STATEMENT 24500014 LA R5,1(R5) BUMP ONE TO ACCEPT COL. 72 PTM122 24550014 SR R2,R2 24600014 SR R5,R1 IS TEXT TOO LONG 24700014 BC 12,FBTRR06 YES - ERROR 24800014 EX R5,FBTRR04 EXECUTE TRANSLATE INSTRUCTION 24900014 BC 6,FBTRR02-4(R2) 25000014 FBTRR02 DS 0H 25100014 B FBBKR BLANK 25200014 B FBPRR PERIOD 25300014 B FBTTR ILLEGAL 25400014 B FBLPR LEFT PAREN 25500014 B FBPLR PLUS 25600014 B FBAMR AMPERSAND 25700014 B FBASR ASTERISK 25800014 B FBRPR RIGHT PAREN 25900014 B FBCOR COMMA 26000014 B FBAPR APOST 26100014 B FBEQR EQUAL 26200014 B FBMIR MINUS 26300014 B FBSLR SLASH 26400014 FBTRR04 DS 0H 26500014 TRT 0(0,R1),0(R3) 26600014 * 26700014 FBTRR06 DS 0H 26800014 SCSW Z,FBLITRLZ,FBTRR08 TRANSFER NO LITERAL 26810014 BCTR R1,R0 26820014 SCSW C,FBLITRLZ CLEAR THE LITERAL INDICATOR 26840014 B FBDEL02 GO PREPARE FOR RET TO SCAN RTN 26850014 FBTRR07 DS 0H 26853017 MVI INTBUF,0 INDICATE NO TEXT IN BUFFER AACA 26856017 FBTRR08 DS 0H 26860014 LA R2,ERMSB03 26900014 MVI MSGKEY,0 ZERO SECONDARY MSG 26950014 B FBERR 27000014 EJECT 27100014 * 27200014 * ROUTINE TO PROCESS AMPERSAND 27300014 * 27400014 FBAMR DS 0H AMPERSAND 27500014 BAL R9,FBTXT TEXT RTN 27600014 LR R7,R1 BUMP STRING PTR (& NOT PART OF TEXT) 27700014 CLI 0(R1),FAMP DOUBLE AMPERSANDS 27800014 BE FBTRR0 YES - RETURN TO BUMP PTR 28000014 SCSW S,AMPSWZ NO - SET SW TO INDICATE SYMBOLIC 28200014 B FBTRR RETURN TO TRANSLATE RTN 28400014 SPACE 2 28500014 * 28600014 * ROUTINE TO PROCESS APOST 28700014 * 28800014 FBAPR DS 0H APOST 28900014 CLI 1(R1),FAPOST DOUBLE APOST 29100014 BE FBAPR01 YES - TRANSFER 29250014 XI FBLITRLZ,FBLITRL NO - FLIP THE LITERAL INDICATOR 29320014 B FBSPR 29400014 FBAPR01 DS 0H 29420014 BAL R9,FBTXT GO TO TEXT RTN 29440014 B FBTRR0 RETURN TO TRANSLATE 29460014 SPACE 2 29500014 * 29600014 * ROUTINE TO PROCESS PERIOD 29700014 * 29800014 FBPRR DS 0H PERIOD 29900014 SCSW Z,AMPSWZ,FBTRR0 TRANSFER TEXT NOT CONCATENATED 30000014 BAL R9,FBTXT TEXT ROUTINE 30100014 LR R7,R1 DO NOT ALLOW PERIOD INTO TEXT 30150014 B FBTRR RETURN TO TRANSLATE 30200014 SPACE 2 30600014 * 30700014 * ROUTINE TO PROCESS LEFT PAREN 30800014 * 30900014 FBLPR DS 0H LEFT PAREN 31000014 SCSW Z,AMPSWZ,FBTRR0 TRANSFER NO SYMBOLIC BEFORE LPRA41170 31050001 BAL R9,FBTXT TEXT ROUTINE FOR SYMBOLIC A41170 31060001 B FBTRR RETURN TO TRANSLATE NEXT CHAR A41170 31100001 SPACE 2 31300014 * 31400014 * ROUTINE TO PROCESS SPECIAL CHARACTERS 31500014 * 31600014 FBSPR DS 0H SPECIAL CHARACTER 31700014 FBTTR DS 0H ILLEGAL 31800014 FBPLR DS 0H PLUS 31900014 FBASR DS 0H ASTERISK 32000014 FBRPR DS 0H RIGHT PAREN 32100014 FBEQR DS 0H EQUAL 32200014 FBMIR DS 0H MINUS 32300014 FBSLR DS 0H SLASH 32400014 FBCOR DS 0H COMMA 32450014 BAL R9,FBTXT TEXT ROUTINE 32500014 B FBTRR RETURN TO TRANSLATE 32600014 SPACE 2 32700014 * 32800014 * ROUTINE TO PROCESS DELIMITERS (BLANK AND COMMA) 32900014 * 33000014 FBDEL DS 0H DELIMITERS 33100014 FBBKR DS 0H BLANK 33200014 SCSW O,FBLITRLZ,FBSPR TRANSFER IF IN A LITERAL -SET BY SCAN 33400014 BAL R9,FBTXT MOVE TEXT 33500014 LR R7,R1 33550014 BCTR R7,R0 33600014 BAL R9,FBTXT MOVE DELIMITER TO INTBUF 33800014 * 33900014 * RESET POINTERS TO CAUSE SCAN RTN TO SCAN INTBUF 34000014 * 34100014 FBDEL02 DS 0H 34150014 LA R2,INTBUF 34200014 ST R2,CSTRP 34300014 LA R2,INTBUF+ITBL+1 NEW END OF TEXT 34400014 ST R2,CENDP 34500014 SCSW C,RPRSWW CLEAR RT PAREN SW 34550014 TM SWY2,DASBIT DONE ANY SUBSTITUTION? YM01590 34555002 BZ FBRET NO, RETURN TO SCAN YM01590 34560002 NI SWY2,255-DASBIT YES, RESET BIT AND CONTINUE YM01590 34565002 TM IWAJMSGL,AOMSGLV1 MSGLEVEL=1? Y02668 34570502 BZ FBRET I68 34571018 LA R0,BUFLNGTH GET SIZE OF WORK BUFFER YM01591 34571502 GETMAIN R,LV=(0) GET 216 BYTE BUFFER YM01591 34572002 LR R9,R1 R9=PTR BEG WKBUF I68 34572518 MVC 0(ITBMSGL,R9),INTBUF-ITBMSGL MSG HDR TO WKBUF I68 34573018 LA R5,ITBMSGL(R9) R5 PTR TO NEXT FREE SPACE I68 34573518 SR R3,R3 I68 34574018 L R2,DELPTR PTR TO STMT PTR I68 34574518 IC R3,LISTPTR(R2) OFFSET TO OPERAND FIELD I68 34575018 L R2,0(R2) ADDR OF STMT I68 34575518 AR R2,R3 R2 PTR TO OPER TO BE MOVED I68 34576018 LA R4,79 I68 34576518 SR R4,R3 LENGTH-1 OF FLD TO BE MOVED I68 34577018 EX R4,MOVE1 I68 34577518 CLC FBDUMM(5),0(R5) IS THIS DUMM= KEYWORD @ZA18227 34577603 BNE FBDEL03 NO, BRANCH AROUND @ZA18227 34577703 MVI 4(R5),C'Y' YES, OVERLAY '=' WITH 'Y' @ZA18227 34577803 * FOR SUBSTITUTION MSG @ZA18227 34578303 FBDEL03 L R4,CBSYP PTR TO 1ST & 34578403 SR R4,R2 LENTH OF 1ST OPERAND IN PROC I68 34578803 AR R5,R4 I68 34579018 SR R3,R3 I68 34579518 IC R3,INTBUF TEXT LENGTH I68 34580018 LR RF,R3 --PUT ACTUAL LENGTH IN RF I68 34582518 SPACE 34583018 FBDEL04 DS 0H I68 34583518 BCTR RF,R0 DECREMENT FOR MOVE I68 34584018 EX RF,MOVE2 MOVE SUBSTITUTED TEXT I68 34584518 LA R4,ITBMSGL(R3,R4) CALCULATE LENGTH OF MSG NOW I68 34585018 * IN WORKBUFFER I68 34585518 EJECT 34586020 **************************************************************** A37550 34586420 * * A37550 34586520 * APAR 37550 CONCERNED THE INCOMPLETE REPRESENTATION * A37550 34586920 * OF SYMBOLIC PARAMETER SUBSTITUTION IN MESSAGE IEF653I * A37550 34587020 * DUE TO THE LENGTH OF THE SUBSTITUTIONS. * A37550 34587420 * THE CODE ADDED FOR APAR 37550 WILL CREATE AS MANY @ZA08218 34587503 * IEF653I MESSAGE NEEDED TO SHOW ALL SUBSTITUTIONS MADE.@ZA08218 34587603 * * A37550 34588020 **************************************************************** A37550 34588420 SPACE 2 34588520 LR R7,R9 SAVE PTR TO WORKBUFFER. A37550 34588920 LA R5,MSGMAX 120 COMPERAND A37550 34589003 CR R5,R4 MSG LONGER THAN 120 BYTES A37550 34589103 BNL FBNORMAL NO-CONTINUE A37550 34589520 OI SRCHSW1,SRCHF5 SET SECOND MSG INDICATOR A37550 34589920 LA R2,TWO7 SET COUNTER. A37550 34590020 LOOP LA R3,0(R2,R9) SET UP TO SCAN WORKBUFFER. A37550 34590420 CLI 0(R3),FCOMMA IS CHARACTER A COMMA . A37550 34590520 BE SETUP YES-SAVE POINTER TO CHARACTER. A37550 34590920 CLI 0(R3),FPERIOD IS CHARACTER A PERIOD. A37550 34591020 BE SETUP YES-SAVE POINTER TO CHARACTER. A37550 34591420 CLI 0(R3),FEQUAL IS CHARACTER AN EQUAL SIGN. A37550 34591520 BNE BACK NO,LOOK AT NEXT CHARACTER. A37550 34591920 SETUP LR RF,R3 ADDRESS OF SEPARATOR. A37550 34592020 BACK CR R2,R5 REACHED 120 YET. A37550 34592403 BNL AROUND A37550 34592803 LA R2,ONE(R2) INCREMENT COUNTER. A37550 34592920 B LOOP CONTINUE SCAN A37550 34593020 AROUND SR RF,R9 LENGTH OF FIRST MESSAGE A37550 34593403 NEXTMSG EQU * @ZA08218 34593703 LA R3,0(RF,R9) BEGINNING OF NEXT MESSAGE. A37550 34593803 LA R2,TWO7 SUBTRACT HEADER LENGTH FOR A37550 34597903 SR R3,R2 ADDRESS OF BEGINNING OF NEXT MSG. A37550 34599903 SR R4,RF LENGTH OF NEXT MESSAGE. A37550 34600603 STC RF,IWAMSLEN STORE LENGTH OF MESSAGE. A37550 34602020 B FBDEL02X A37550 34604020 FBNORMAL STC R4,IWAMSLEN STORE ACTUAL LENGTH. A37550 34604420 FBDEL02X DS 0H A37550 34604820 SR R2,R2 A37550 34605220 OI AOSW1,AOVFBSW SET VFB SWITCH FOR VGM Y02668 34605402 IEFSAVER SAVEPTR A37550 34605620 L RF,IEFVGMV MESSAGE MODULE ADDRESS A37550 34605720 BALR RE,RF PUT MESSAGE IN SMB A37550 34605820 IEFRELSE SAVEPTR A37550 34605920 TM SRCHSW1,SRCHF5 SECOND MESSAGE TO CONSTRUCT. A37550 34613620 BZ FBMSGOUT NO - FREE WORKBUFFER AND RETURN. A37550 34615620 MVC 0(ITBMSGL,R3),INTBUF-ITBMSGL MOVE IN HEADER. A37550 34617620 LR R9,R3 UPDATE PTR TO WORKBUF MSG AREA. A37550 34618020 LA R4,TWO7(R4) INCLUDE HEADER IN MSG LENGTH. A37550 34620020 LA R5,MSGMAX MAXIMUM LENGTH OF MESSAGE @ZA08218 34620103 CR R4,R5 ANOTHER MSG AFTER CURRENT MSG@ZA08218 34620203 BH SETUPMSG SET FOR CURRENT & NEXT MSG @ZA08218 34620603 NI SRCHSW1,SRCHCLR-SRCHF5 NEXT MESSAGE INDICATOR OFF A37550 34620703 B FBNORMAL WRITE LAST MESSAGE. @ZA08218 34620803 SETUPMSG EQU * @ZA08218 34622903 LR RF,R5 MAXIMUM MSG LENGTH FOR CURRENT 34623803 * MESSAGE @ZA08218 34624703 B NEXTMSG @ZA08218 34625603 FBMSGOUT DS 0H A37550 34626503 LR R1,R7 PTR TO WORKBUFFER A37550 34627403 LA R0,BUFLNGTH GET SIZE OF WORK BUFFER YM01591 34628303 FREEMAIN R,LV=(0),A=(1) I68 34629220 MVI IWAMSLEN,X'5A' RESTORE LENGTH TO NINETY YM02715 34636902 B FBRET RETURN TO SCAN ROUTINE 34644620 MOVE1 MVC 0(0,R5),0(R2) MOVE OPERAND FLD FROM PROC TO WKBUF I68 34652320 MOVE2 MVC 0(0,R5),INTBUF+1 OVERLAY WITH SUBSTIT STRING I68 34660018 EJECT 34700014 * 34800014 * SELECTS BITS TO TEST FOR PROC IN KEYTAB 34900014 * INPUT (R6= ONE BYTE KEY) 35000014 * OUTPUT (R2= BIT PATTERN) 35100014 * (R6= OFFSET INTO TABLE) 35200014 * R9 = RETURN REG 35300014 * 35400014 FBI DS 0H 35500014 LA R3,X'07' 35600014 NR R3,R6 35700014 LA R2,X'80' 35800014 SRL R2,0(R3) 35900014 SRL R6,3 36000014 BR R9 36100014 SPACE 2 36200014 * 36300014 * SPECIAL CHARACTER CHECK ROUTINE 36400014 * 36500014 FBSCR DS 0H 36600014 LR RA,R1 SAVE DELIMITER 36800014 LR R5,R1 36900014 LR R1,R7 STRING POINTER 37000014 SR R5,R7 COMPUTE STRING LENGTH 37060014 BZ FBSCR01 TRANSFER NULL VALUE 37120014 BCTR R5,R0 37200014 L R3,FATRP ADDRESS OF TRANSLATE TABLE 37300014 EX R5,FBTRR04 EXECUTE TRAN 37400014 BC 7,FBSCR02 SPECIAL CHARS 37500014 FBSCR01 DS 0H 37650014 LR R1,RA RESTORE DELIMITER PTR 37670014 BR R9 RETURN - NO SPECIAL CHARACTERS 37700014 FBSCR02 DS 0H 37800014 LA R2,ERMSB04 ERROR MSG NUMBER 37900014 B FBERR0 38000014 EJECT 38100014 *********************************************************************** 38200014 * * 38300014 * TEXT ROUTINE MOVES TEXT TO INTBUF FROM EITHER * 38400014 * THE VALUE FIELD IN SYMBUF OR * 38500014 * FROM INPUT STATEMENT * 38600014 * R1 = DELIMITER PTR * 38700014 * R4 = CURRENT SYMBUF ENTRY * 38800014 * R7 = CHARACTER STRING PTR * 38900014 * R9 = RETURN ADDR * 39000014 * * 39100014 *********************************************************************** 39200014 SPACE 39300014 FBTXT DS 0H 39400014 SCSW O,AMPSWZ,FBTXT10 TRANSFER IF SYMBOLIC 39500014 * 39600014 * CHECK FOR NULL VALUE 39700014 * 39800014 CLR R7,R1 NULL 39900014 BNE FBTXT02 NO - TRANSFER 40000014 LA R1,1(R1) 40100014 BR R9 YES - RETURN 40200014 FBTXT02 DS 0H 40300014 LR R2,R7 NO - PTR FOR MOVE RTN 40400014 LR R3,R1 40500014 SR R3,R7 LENGTH FOR MOVE 40600014 BAL R5,FBMVC MOVE TEXT TO INTBUF 40700014 B FBTXT22 RETURN 40800014 * 40900014 * ENTRY TO SEARCH TABLE FOR SYMBOLIC 41000014 * 41100014 FBTXT10 DS 0H 41200014 BAL R5,FBSCH GO TO TABLE SEARCH ROUTINE 41300014 LTR RF,RF SYMBOLIC FOUND 41400014 BNE FBTXT12 YES - TRANSFER 41500014 * NO - MOVE SYMBOLIC TO INTBUF 41530014 BCTR R7,R0 POINTER TO AMPERSAND 41560014 LR R2,R7 POINTER FOR MOVE RTN 41590014 * NOTE - RA = LENGTH OF SYMBOLIC 41620014 LA R3,1(RA) GET LENGTH OF SYMBOLIC(INCLUDING &) 41650014 * FOR MOVE RTN 41680014 B FBTXT16 GO MOVE SYMBOLIC TO INTBUF 41710014 FBTXT12 DS 0H 41800014 NI 1(R4),255-HONE HIT - CLEAR HIGH ORDER BIT LP BYTE 41900014 OI SWY2,DASBIT INDICATE SUBSTITUTION OCCURRED YM01590 41950002 * 42000014 * GET POINTER TO VALUE IN R2 FOR MOVE ROUTINE 42100014 * AND LENGTH OF TEXT IN R3 42200014 * 42300014 * LENGTH OF PARAM IN RA 42400014 LA R2,2(R4,RA) PTR TO LV BYTE 42500014 IC RA,0(R2) LV IN RA 42600014 LTR R3,RA IS VALUE A NULL (R3=LENGTH FOR MOVE) 42700014 BZ FBTXT20 YES - RETURN 42800014 LA R2,1(R2) NO - PTR TO VALUE IN R2 42900014 FBTXT16 DS 0H 42950014 BAL R5,FBMVC MOVE RTN 43000014 FBTXT20 DS 0H 43100014 SCSW C,AMPSWZ CLEAR SW 43200014 * 43300014 FBTXT22 DS 0H 43400014 LR R7,R1 43500014 LA R1,1(R1) 43700014 BR R9 43800014 SPACE 2 43900014 * 44000014 *********************************************************************** 44100014 * * 44200014 * MOVE ROUTINE GETS POINTER TO NEXT OPEN BYTE IN INTBUF * 44300014 * UPDATES INTBUF COUNT BYTE * 44400014 * * 44500014 * REGS ON ENTRY R3 = LENGTH OF TEXT TO BE MOVED * 44600014 * R2 = PTR TO TEXT * 44700014 * R5 = RETURN REG * 44800014 * * 44900014 *********************************************************************** 45000014 SPACE 45100014 FBMVC DS 0H 45200014 SCSW O,FBFLUSHZ,FBMVC01 TRANSFER IF IN FLUSH MODE 45250014 SR R6,R6 45300014 IC R6,INTBUF LENGTH OF TEXT IN INTBUF 45400014 LA RA,INTBUF+1(R6) FIRST OPEN BYTE 45500014 AR R6,R3 45600014 CH R6,FBMVC06 DOES LENGTH EXCEED MAX 45700014 BH FBMVC04 YES - TRANSFER 45800014 * NO - UPDATE LENGTH BYTE 45900014 STC R6,INTBUF NEW LENGTH BYTE 46000014 BCTR R3,R0 DECREMENT FOR EXECUTE 46100014 EX R3,FBMVC02 46200014 FBMVC01 DS 0H 46250014 BR R5 46300014 FBMVC02 DS 0H 46400014 MVC 0(0,RA),0(R2) 46500014 FBMVC04 DS 0H 46600014 LA R2,ERMSB05 46700014 MVI MSGKEY,SMSGS SECONDARY MSG NUMBER 46750014 B FBERR 46800014 FBMVC06 DS 0H 46900014 DC AL2(ITBL) 47000014 EJECT 47100014 *********************************************************************** 47200014 * * 47300014 * ROUTINE TO SEARCH SYMBUF FOR SYMBOLIC PARAMETER * 47400014 * * 47500014 * R1 = PTR TO DELIMITER * 47600014 * R4 = CURRENT ENTRY IN AMPBUF * 47700014 * R5 = RETURN REG * 47800014 * R7 = PTR TO FIRST CHARACTER OF SEARCH ARGUMENT * 47900014 * * 48000014 *********************************************************************** 48100014 SPACE 48200014 FBSCH DS 0H 48300014 LR RA,R1 SAVE DELIMITER PTR 48400014 SR RA,R7 LENGTH OF FIELD IN RA 48500014 BZ FBSCH14 ZERO LENGTH - GO INDICATE NO HIT 48600014 * 48700014 * CHECK IF SYMBUF HAS TTR 48800014 * 48900014 FBSCH01 DS 0H 49000014 OC SYMTTR(FBFOUR),SYMTTR IS THERE A TTR FOR SYMBUF? Y02621 49100002 BZ FBSCH14 NO - RETURN Y02621 49200002 * 49400014 * CHECK IF FIRST SYMBUF IS IN CORE 49500014 * 49600014 FBSCH02 DS 0H 49700014 CLC SYMBUF(4),SYMTTR IS THIS THE FIRST SYMBUF 49800014 BE FBSCH04 YES - TRANSFER 49900014 L R2,SYMTTR NO - GET TTR OF FIRST BUFFER 49920014 OC SYMBUF(FBFOUR),SYMBUF DOES THIS ONE HAVE A TTR? Y02621 49940002 BZ FBSCH05 NO - TRANSFER TO READ ONLY 49960002 * YES - WRITE THIS ONE OUT 49980014 FBSCH03 DS 0H 50000014 L R0,SYMBUF TTR OF THIS BUFFER 50020014 MVI QPARM+QMPOP-QMNAM,QMWRTE 50040014 MVI QPARM+QMPNC-QMNAM,RECNO1 SET WRITE OF 1 REC. YM00370 50050002 BAL R6,FBQMAN WRITE OUT THIS BUFFER 50060014 FBSCH05 DS 0H 50080014 LR R0,R2 TTR OF BUFFER TO BE READ IN 50100014 MVI QPARM+QMPOP-QMNAM,QMREAD 50200014 MVI QPARM+QMPNC-QMNAM,RECNO1 SET READ OF 1 REC. YM00370 50250002 BAL R6,FBQMAN GO TO Q MANAGER INTERFACE 50300014 * 50400014 * CURRENT SYMBUF IN OK - NOW SEARCH FOR SYMBOLIC 50500014 * 50600014 FBSCH04 DS 0H 50700014 LA R4,SYMBUF+8 FIRST ENTRY 50800014 SR R3,R3 50900014 LA R2,HONE+1 51000014 LCR R2,R2 51100014 FBSCH06 DS 0H 51200014 CLI 0(R4),0 IS THERE AN ENTRY 51300014 BE FBSCH12 NO - TRANSFER 51400014 IC R3,1(R4) YES - GET LP BYTE 51500014 NR R3,R2 CLEAR HIGH ORDER FLAG BIT 51600014 CLR RA,R3 IS LENGTH SAME AS SEARCH ARGUMENT 51700014 BNE FBSCH08 NO - TRANSFER DO NOT COMPARE 51800014 BCTR R3,R0 DECREMENT LENGTH FOR EXECUTE 51900014 EX R3,FBSCH10 COMPARE - IS THIS THE SYMBOLIC 52000014 BE FBSCH16 THIS IS THE ONE 52100014 FBSCH08 DS 0H ENTRY FOR NO HIT 52200014 IC R3,0(R4) LENGTH OF ENTRY IN SYMBUF 52300014 AR R4,R3 R4 POINTS TO NEXT ENTRY 52400014 B FBSCH06 52500014 FBSCH10 DS 0H 52600014 CLC 2(0,R4),0(R7) 52700014 * 52800014 * IS THERE ANOTHER SYMBOLIC PARAM TABLE BUFFER 52900014 * 53000014 FBSCH12 DS 0H 53100014 OC SYMBUF+FBFOUR(FBFOUR),SYMBUF+FBFOUR IS THE NEXT Y02621 53200002 * SYMBUF POINTER IN SYMBUF ZERO? Y02621 53240002 BZ FBSCH14 YES- NO NEXT SYMBUF EXISTS Y02621 53280002 L R2,SYMBUF+4 YES- TTR OF NEXT BUFFER 53320014 B FBSCH03 GO WRITE THIS ONE OUT, READ IN NEXT 53400014 * 53500014 * SYMBOLIC NOT FOUND - INDICATE NO HIT - RF = 0 53600014 * 53700014 FBSCH14 DS 0H 53800014 SR RF,RF 53900014 BR R5 RETURN 54000014 * 54100014 * SYMBOLIC FOUND - INDICATE HIT - RF = 4 54200014 * 54300014 FBSCH16 DS 0H 54400014 LA RF,4 54500014 BR R5 RETURN - R4 IS PTR TO SYMBUF ENTRY 54600014 EJECT 54700014 *********************************************************************** 54800014 * * 54900014 * SYMBOLIC PARAMETER TABLE BUILD ROUTINE * 55000014 * * 55100014 * R1= DELIMITER POINTER * 55200014 * R7= POINTER TO FIRST CHAR * 55300014 * R5= RETURN REG * 55400014 * R4= CURRENT SYMBUF ENTRY * 55500014 * * 55600014 *********************************************************************** 55700014 SPACE 55800014 FBBLD DS 0H 55900014 SCSW O,FBFLUSHZ,FBBLD26 TRANSFER IF FLUSH MODE 55950014 LR RA,R1 DELIM PTR 56000014 SR RA,R7 LENGTH OF FIELD 56100014 BZ FBBLD26 ZERO LENGTH - RETURN 56150014 SR R2,R2 56200014 IC R2,0(R4) LE BYTE 56300014 LA R3,4(R2,RA) COMPUTE NEW END OF TEXT IN SYMBUF 56400014 AR R3,R4 ADD PTR TO CURRENT ENTRY 56450014 LA R6,SYMBUF+175 END OF BUFFER 56500014 CLR R3,R6 IS THERE ROOM FOR TEXT 56600014 BNH FBBLD20 YES - TRANSFER 56700014 * 56800014 * NO ROOM IN THIS BUFFER - WRITE IT OUT, CHAIN BUFFERS, 56900014 * INITIALIZE ANOTHER BUFFER 57000014 * 57100014 CLI 0(R4),0 IS THIS AN ENTRY FOR SYMBOLIC 57200014 BNE FBBLD10 NO - TRANS TO PROCESS 'VALUE' SPILL 57300014 * YES - PROCESS 'PARAM' SPILL 57400014 * 57500014 * SPILL ROUTINE FOR SYMBOLIC 'PARAM' 57600014 * 57700014 BAL R9,FBCHN GO TO CHAIN RTN 57800014 XC SYMBUF+4(172),SYMBUF+4 CLEAR ALL BUT TTR FIELD 57900014 LA R4,SYMBUF+8 INITIALIZE CURRENT ENTRY PTR 58000014 B FBBLD20 GO TO MOVE TEXT 58100014 * 58200014 * SPILL ROUTINE FOR 'VALUE' R2 = CONTENTS OF LE BYTE 58300014 * 58400014 FBBLD10 DS 0H 58500014 MVI 0(R4),0 ZERO LE BYTE IN SPILLED BUFFER 58600014 BAL R9,FBCHN GO TO CHAIN RTN 58700014 STC R2,SYMBUF+8 LE BYTE 58800014 BCTR R2,R0 58900014 EX R2,FBBLD12 MOVE IN LP BYTE AND PARAM 59000014 LA R4,SYMBUF+8 INITIALIZE CURRENT ENTRY 59100014 LA R9,1(R2,R4) FIRST BYTE TO BE CLEARED 59200014 LA R3,SYMBUF+174 59300014 SR R3,R9 DECREMENTED COUNT IN R3 59400014 EX R3,FBBLD14 CLEAR REMAINDER OF BUFFER 59500014 B FBBLD20 GO TO MOVE TEXT 59600014 FBBLD12 DS 0H 59700014 MVC SYMBUF+9(0),1(R4) 59800014 FBBLD14 DS 0H 59900014 XC 0(0,R9),0(R9) 60000014 * 60100014 * 60200014 * BUFFERS OK - MOVE TEXT TO SYMBUF RA = LENGTH OF FIELD 60300014 * 60400014 FBBLD20 DS 0H 60500014 SR R3,R3 60600014 IC R3,0(R4) LE BYTE 60700014 LTR R3,R3 IS LE BYTE ZERO (IS THIS PARAM TEXT) 60800014 BNE FBBLD22 NO - TRANSFER FOR VALUE 60900014 STC RA,1(R4) YES - ENTER LP BYTE 61000014 LA R6,3(RA) COMPUTE LENGTH OF ENTRY (LE) BYTE 61060014 * ( LE INCLUDES A NULL LV BYTE) 61120014 STC R6,0(R4) ENTER LE BYTE 61200014 LA R6,2(R4) PARAM FIELD PTR 61300014 B FBBLD24 61400014 FBBLD22 DS 0H ENTRY FOR VALUE 61500014 LA R6,0(RA,R3) COMPUTE NEW LENGTH OF ENTRY 61600014 STC R6,0(R4) NEW LE BYTE 61700014 LA R6,0(R3,R4) 61760014 BCTR R6,R0 PTR TO NEW LV BYTE 61820014 STC RA,0(R6) NEW LV BYTE 61900014 LA R6,1(R6) PTR TO VALUE FIELD 62000014 FBBLD24 DS 0H 62100014 BCTR RA,R0 62200014 EX RA,FBBLD30 MOVE TEXT TO SYMBUF 62300014 MVI INTBUF,0 ZERO COUNT BYTE 62400014 FBBLD26 DS 0H 62450014 BR R5 62500014 FBBLD30 DS 0H 62600014 MVC 0(0,R6),0(R7) 62700014 EJECT 62800014 * 62900014 * BUFFER CHAIN ROUTINE WRITES CURRENT BUFFER TO QUEUE, 63000014 * CHAINS BUFFERS 63100014 FBCHN DS 0H 63200014 MVC SYMBUF+4(4),TNEXT TTR OF NEXT BUFFER 63300014 L R0,SYMBUF TTR OF THIS BUFFER 63400014 MVI QPARM+QMPOP-QMNAM,QMWRTA SET WRITE AND ASSIGN. YM00370 63420002 MVI QPARM+QMPNC-QMNAM,RECNO1 SET WRITE OF 1 REC. YM00370 63440002 OI QPARM+QMPCM-QMNAM,X'10' SET ASSIGN OF 1 REC. YM00370 63460002 BAL R6,FBQMAN GO TO QUEUE INTERFACE RTN 63500014 OI AOSW2,X'80' INDICATE SYMBOLIC WRITE TO SWA @ZA05366 63550003 * 63600014 * INITIALIZE NEW BUFFER 63700014 * 63800014 MVC SYMBUF(4),TNEXT CHAIN 63900014 MVC TNEXT(4),0(R3) SAVE ASSIGNED TTR 64000014 XC SYMBUF+4(4),SYMBUF+4 CLEAR CHAIN TTR FIELD 64100014 BR R9 64200014 EJECT 64300014 *********************************************************************** 64400014 * * 64500014 * QUEUE MANAGER INTERFACE ROUTINE * 64600014 * R6 = RETURN REG * 64700014 * R0 = TTR OF RECORD TO READ OR WRITE * 64800014 * * 64900014 *********************************************************************** 65000014 SPACE 65100014 FBQMAN DS 0H 65200014 LA R3,QLINKWA GET ADDR OF EXTERNAL PARMLIST Y02668 65400002 ICM R3,8,QPARM+QMPNC-QMNAM INSERT RECORD COUNT, TO YM00370*65430002 AVOID OVERLAYING IT. YM00370 65440002 ST R3,QPARM+QMPNC-QMNAM SAVE CT AND LISTPTR IN QMPA YM00370 65450002 ST R0,4(R3) TTR THIS RECORD (FOR READ AND WRITE) 65500014 MVI FBSVN(R3),SYMBUFID ID USED FOR WRITE,IGNORED Y02621 65530002 * FOR READ.ONLY WRITE SYMBUF Y02621 65560002 LA R0,SYMBUF 65600014 ST R0,0(R3) POINTER TO RECORD ( READ AND WRITE) 65700014 FBQMAN02 DS 0H ENTRY FOR ASSIGN 65720014 ST R1,SAVEP SAVE R1 65750014 IEFSAVER SAVEPTR 65800014 L RF,FBIEFVHQ 65850014 BALR RE,RF QUEUE MANAGER 65900014 IEFRELSE SAVEPTR 66000014 L R1,SAVEP RESTORE R1 66050014 BR R6 RETURN 66100014 FBDUMM DC C'DUMM=' @ZA18227 66150003 FBIEFVHQ DC V(IEFVHQ) QUEUE MANAGER 66200014 IEFVGMV DC V(IEFVGM) MESSAGE MODULE I68 66220018 EJECT 66250014 *********************************************************************** 66300014 * * 66400014 * ERROR RETURN R2 = ERROR MESSAGE NUMBER * 66500014 * * 66600014 *********************************************************************** 66700014 SPACE 66800014 FBERR0 DS 0H 66830014 MVI INTBUF,0 INDICATE NO TEXT IN INTBUF 66860014 FBERR DS 0H 66900014 L RE,FERRP PTR TO SCAN ERROR RTN 67000014 ST RE,12(RD) 67100014 ST R2,28(RD) ERROR MSG NUMBER 67200014 * 67600014 * RETURN TO SCAN 67700014 * 67800014 FBRET DS 0H 67900014 SCSW C,FBFLUSHZ CLEAR FLUSH SW 67950014 FBRET02 DS 0H 67970014 RETURN (14,12) 68000014 * 68100014 PATCH DC 25F'0' **********PATCH SPACE*********Y02668 70100002 END 72400014