TITLE ' /***************************************************' 00001000 IEFVINE CSECT , 0001 00002000 @PROLOG STM @14,@12,12(@13) 0001 00003000 BALR @11,0 0001 00004000 @PSTART DS 0H 0001 00005000 USING @PSTART,@11 0001 00006000 L @00,@SIZDATD 0001 00007000 GETMAIN R,LV=(0) 00008000 LR @09,@01 0001 00009000 USING @DATD,@09 0001 00010000 LM @00,@01,20(@13) 0001 00011000 XC @ZTEMPS(@ZLEN),@ZTEMPS 00012000 MVC @PC00001(4),0(@01) 0001 00013000 **************************************************************** Y02668 00014000 * MODULE TRACE CODE - FOR TESTING. Y02668 00015000 L 15,TRACEV LOAD TRACE RTNE ADDR. Y02668 00016000 CNOP 2,4 Y02668 00017000 BALR 14,15 ENTER MOD ID IN TRACE RECORD Y02668 00018000 TRACEV DC V(TRACE) TRACE RTNE ADDR. Y02668 00019000 DC C'VINE' MOD ID USED BY TRACE. Y02668 00020000 * TRACE RETURNS HERE Y02668 00021000 **************************************************************** Y02668 00022000 B STRT 00023000 DC X'11111111' 00024000 DC CL4'VINE' 00025000 DC CL4'L.01' 00026000 DC C'MVM' FUNCTION ID AND Y02668 00027000 DC C'01' LEVEL # (TRACE AND PATCH) Y02668 00028000 * 0017 00029000 * 0017 00030000 *STRT:; 0018 00031000 STRT DS 0H 0019 00032000 *FIVE=ONE; 0019 00033000 LR FIVE,ONE 0019 00034000 *TWO=0; /* CLEAR REG2 FOR TRT */ 00035000 SR @12,@12 0020 00036000 LR TWO,@12 0020 00037000 *BEGIN=FIVE+2; 0021 00038000 * 0021 00039000 LA BEGIN,2 0021 00040000 AR BEGIN,FIVE 0021 00041000 */* LABEL SCAN */ 00042000 * 0022 00043000 * IF BEGIN->ONEBYTE=' ' THEN /*IF CARD NOT A CONTINUATION */ 00044000 CLI ONEBYTE(BEGIN),C' ' 0022 00045000 BNE @RF00022 0022 00046000 * DO; /*CHECK IF COL. 3 CONTAINS A */ 00047000 * INCRE=FIVE+3; /*BLANK(LABEL CHECK) IF YES, */ 00048000 LA INCRE,3 0024 00049000 AR INCRE,FIVE 0024 00050000 * LENGTH=0; /*UPDATE POINTER TO COL. 4,SET*/ 00051000 LR LENGTH,@12 0025 00052000 * GOTO NONBLNK; /*LENGTH TO ZERO, AND BRANCH */ 00053000 B NONBLNK 0026 00054000 * END; /*TO VERB CHECK RTN,BYPASSING */ 00055000 * /*LABEL SYNTAX CHECKING */ 00056000 * /* IF LABEL FOUND, CHECK */ 00057000 * /* IF FIRST CHAR IS */ 00058000 * /* ALPHABETIC OR NATIONAL */ 00059000 *GENERATE; 0028 00060000 @RF00022 DS 0H 0028 00061000 TRT 0(1,BEGIN),TRTTAB 00062000 BNZ LABERR IF NO, ERROR 00063000 * IF BEGIN->ONEBYTE>='F0'X THEN GOTO LABERR; /*IF 1ST NUMERIC,ERROR*/ 00064000 CLI ONEBYTE(BEGIN),X'F0' 0029 00065000 BNL @RT00029 0029 00066000 * /* IS REMAINING PART OF LABEL */ 00067000 * /* ALPHA-NUMERIC. */ 00068000 *GENERATE; 0031 00069000 TRT 1(8,BEGIN),TRTTAB 00070000 BZ LABERR IF LABEL TOO LONG, ERROR 00071000 * IF TWO ^=4 THEN GOTO LABERR; /* IF NOT, LABEL INVALID */ 00072000 CH TWO,@CH00038 0032 00073000 BNE @RT00032 0032 00074000 *INCRE=ONE; /* IF LABEL VALID, UPDATE PTR */ 00075000 LR INCRE,ONE 0034 00076000 *LENGTH=ONE-BEGIN; /*PASSED THE LABEL AND */ 00077000 LR LENGTH,ONE 0035 00078000 SR LENGTH,BEGIN 0035 00079000 * /* CALCULATE THE LABEL LENGTH */ 00080000 *NONBLNK:IF INCRE->ONEBYTE^=' ' THEN GOTO CHECK; /* CHECK FOR */ 00081000 NONBLNK CLI ONEBYTE(INCRE),C' ' 0036 00082000 BNE @RT00036 0036 00083000 *INCRE=INCRE+1; /* BEGINNING OF VERB */ 00084000 AH INCRE,@CH00050 0038 00085000 *GOTO NONBLNK; 0039 00086000 B NONBLNK 0039 00087000 *CHECK:; /*M3122*/ 00088000 CHECK DS 0H 0041 00089000 * IF INCRE->VERB=PRC THEN /* IF 'PROC' VERB FOUND M3122*/ 00090000 CLC VERB(5,INCRE),PRC 0041 00091000 BNE @RF00041 0041 00092000 * DO; /*M3122*/ 00093000 * RE:RETCODE=LENGTH; /* SET RETURN CODE EQUAL M3122*/ 00094000 RE ST LENGTH,RETCODE(,R13) 0043 00095000 * RETURN; /* TO THE LABEL LENGTH M3122*/ 00096000 @EL00001 DS 0H 0044 00097000 @EF00001 L @00,@SIZDATD 0044 00098000 LR @01,@09 0044 00099000 FREEMAIN R,LV=(0),A=(1) 00100000 @ER00001 LM @14,@12,12(@13) 0044 00101000 BR @14 0044 00102000 * END; /* AND RETURN CONTROL TO M3122*/ 00103000 * /* IEFVINA. M3122*/ 00104000 * IF INCRE->VERB=PND THEN GOTO RE;/* IF 'PEND' VERB FOUND M3122*/ 00105000 @RF00041 CLC VERB(5,INCRE),PND 0046 00106000 BE @RT00046 0046 00107000 * /* PROCESS LIKE PROC STMTM3122*/ 00108000 *LABERR:; /* IF NEITHER VERB FOUND M3122*/ 00109000 LABERR DS 0H 0049 00110000 * RETCODE=12; /* OR INVALID LABEL M3122*/ 00111000 MVC RETCODE(4,R13),@CF00083 0049 00112000 * /* PREVIOUSLY DETECTED M3122*/ 00113000 * /* SET RETURN CODE TO 12 M3122*/ 00114000 * RETURN; /*AND RETURN TO IEFVINA M3122*/ 00115000 B @EL00001 0050 00116000 *END IEFVINE; 0051 00117000 B @EL00001 0051 00118000 @DATA DS 0H 00119000 @CH00050 DC H'1' 00120000 @CH00038 DC H'4' 00121000 @DATD DSECT 00122000 DS 0F 00123000 @PC00001 DS 1F 00124000 @ZTEMPS DS C 00125000 @ZTEMPND EQU * 00126000 @ZLEN EQU @ZTEMPND-@ZTEMPS 00127000 @TEMPS EQU @ZTEMPS 00128000 @L EQU @ZLEN 00129000 IEFVINE CSECT 00130000 DS 0F 00131000 @CF00083 DC F'12' 00132000 @DATD DSECT 00133000 DS 0D 00134000 @ENDDATD EQU * 00135000 @DATEND EQU * 00136000 IEFVINE CSECT 00137000 DS 0F 00138000 @SIZDATD DC AL1(0) 00139000 DC AL3(@ENDDATD-@DATD) 00140000 @SIZ001 EQU @SIZDATD 00141000 DS 0D 00142000 PRC DC CL5'PROC ' 00143000 PND DC CL5'PEND ' 00144000 PATCH DC XL100'0' 00145000 TRTTAB DC 64AL1(8) 00146000 DC AL1(4) 00147000 DC 26AL1(8) 00148000 DC AL1(0) 00149000 DC 31AL1(8) 00150000 DC 2AL1(0) 00151000 DC 68AL1(8) 00152000 DC 9AL1(0) 00153000 DC 7AL1(8) 00154000 DC 9AL1(0) 00155000 DC 8AL1(8) 00156000 DC 8AL1(0) 00157000 DC 6AL1(8) 00158000 DC 10AL1(0) 00159000 DC 6AL1(8) 00160000 @00 EQU 00 EQUATES FOR REGISTERS 0-15 00161000 @01 EQU 01 00162000 @02 EQU 02 00163000 @03 EQU 03 00164000 @04 EQU 04 00165000 @05 EQU 05 00166000 @06 EQU 06 00167000 @07 EQU 07 00168000 @08 EQU 08 00169000 @09 EQU 09 00170000 @10 EQU 10 00171000 @11 EQU 11 00172000 @12 EQU 12 00173000 @13 EQU 13 00174000 @14 EQU 14 00175000 @15 EQU 15 00176000 @0 EQU 00 00177000 @1 EQU 01 00178000 @2 EQU 02 00179000 @3 EQU 03 00180000 @4 EQU 04 00181000 @5 EQU 05 00182000 @6 EQU 06 00183000 @7 EQU 07 00184000 @8 EQU 08 00185000 @9 EQU 09 00186000 @A EQU 10 00187000 @B EQU 11 00188000 @C EQU 12 00189000 @D EQU 13 00190000 @E EQU 14 00191000 @F EQU 15 00192000 ONE EQU @01 00193000 TWO EQU @02 00194000 FIVE EQU @05 00195000 R13 EQU @13 00196000 BEGIN EQU @04 00197000 INCRE EQU @03 00198000 LENGTH EQU @06 00199000 VERB EQU 0 00200000 RETCODE EQU 16 00201000 ONEBYTE EQU 0 00202000 DUMMY EQU 0 00203000 @RT00029 EQU LABERR 00204000 @RT00032 EQU LABERR 00205000 @RT00036 EQU CHECK 00206000 @RT00046 EQU RE 00207000 @EL01 EQU @EL00001 00208000 @ENDDATA EQU * 00209000 END IEFVINE 00210000