00001000 CONTROL ASIS 00002000 /* TITLE: NESTCHK CHECK NESTING OF " DO " AND " END " GROUPS */ 00003000 /* USERS: TSO ISPF EDIT USERS | SCRIPT USERS */ 00005000 /* CONTRIBUTED: 1986/04/24 DAVID MCRITCHIE */ 00006000 /* */ 00007000 /* EXAMPLE: NESTCHK ...NO OPERANDS REALLY REQUIRED... */ 00007100 /* */ 00008000 /* OPTIONS: */ 00009200 /* LPTR-RANGE | ENTIRE (OPTIONAL) LINE POINTER RANGE */ 00009300 /* CLIST | PLI | SAS */ 00009400 /* */ 00181000 ISREDIT MACRO (TOK1,TOK2,TOK3,TOK4,TOK5,TOK6,TOK7,TOK8,TOK9,TOK10,TOK11,TOK12,TOK13,+ 00182000 TOK14,TOK15,TOK16,TOK17,TOK18,TOK19,TOK20,TOK21,TOK22,TOK23,TOK24,TOK25,TOK26,+ 00183000 TOK27,TOK28,TOK29,TOK30,TOK31,TOK32,TOK33,TOK34,TOK35,TOK36,TOK37,TOK38,TOK39,+ 00184000 TOK40,TOK41,TOK42,TOK43,TOK44,TOK45,TOK46,TOK47,TOK48) 00185002 ISREDIT (IMAC) = IMACRO 00290000 SET BLANKS = &STR( ) 00290100 SET BLANKS = &STR(&BLANKS. ) 00291000 SET E = 0 00300000 SET P = 0 00312000 SET I = 1 00313000 DO WHILE &I <= 48 00313300 SET TOKEN = &&TOK&I 00313400 SET TOKEN = &STR(&SYSCAPS(&TOKEN)) 00313500 IF &TOKEN = &STR() THEN GOTO END_TOK 00313600 IF ALL =&STR(&TOKEN) | NEXT =&STR(&TOKEN) | FIRST =&STR(&TOKEN) - 00313700 | LAST =&STR(&TOKEN) | PREV =&STR(&TOKEN) - 00313800 | X =&STR(&TOKEN) | NX =&STR(&TOKEN) THEN - 00313900 DO 00314000 SET &ZEDSMSG = &STR(&TOKEN INVALID) 00314100 SET &ZEDLMSG = &STR("&TOKEN" NOT PROVIDED FOR NOR ARE NEXT ALL FIRST LAST PREV) 00314200 ISPEXEC SETMSG MSG(ISRZ000) 00314300 EXIT CODE(12) 00314400 END 00314500 IF DETAIL = &TOKEN THEN DO 00315000 SET DETAIL = &TOKEN 00316000 GOTO NXT_TOK 00317000 END 00317100 IF CLIST = &TOKEN THEN DO 00317200 SET CLIST = &TOKEN 00317300 GOTO NXT_TOK 00317400 END 00317500 IF PLI = &TOKEN THEN DO /* END */ 00317600 SET PLI = &TOKEN 00317700 GOTO NXT_TOK 00317800 END /* DO */ 00317900 IF SAS = &TOKEN THEN DO 00318000 SET SAS = &TOKEN 00318100 GOTO NXT_TOK 00319000 END 00319100 IF &SUBSTR(1:4,&STR(&TOKEN) ) = &STR(COL&STR(&LP)) THEN DO 00319200 IF &STR(&COL1) = &STR() THEN DO 00319300 SET COL1 = &SUBSTR(5:&EVAL(&LENGTH(&STR(&TOKEN))-1),&STR(&TOKEN) ) 00319400 WRITE &COL1 00319500 GOTO NXT_TOK 00319600 END 00319700 ELSE DO 00319800 IF &STR(&COL2) = &STR() THEN DO 00319900 SET COL2 = &SUBSTR(5:&EVAL(&LENGTH(&STR(&TOKEN))-1),&STR(&TOKEN) ) 00320000 WRITE &COL2 00320100 GOTO NXT_TOK 00320200 END 00320300 SET &ZEDSMSG = &STR(&TOKEN 3RD USE) 00320400 SET &ZEDLMSG = COL(&COL1.) COL(&COL2.) ALREADY SPECIFIED FOR LEFT/RIGHT BOUNDARIES 00320500 ISPEXEC SETMSG MSG(ISRZ000) 00320600 END 00320700 EXIT CODE(12) 00321000 END 00321500 IF &TOKEN = ENTIRE THEN DO /* ENTIRE | LPTR-RANGE */ 00321600 SET ENTIRE = ENTIRE 00321700 GOTO NXT_TOK 00321800 END 00324200 IF &TOKEN = &STR()) THEN DO 00324300 SET &ZEDSMSG = &STR(LOST PARENTHESIS) 00324400 SET &ZEDLMSG = BLANKS SEPARATE ALL OPERANDS; THEREFORE INVALID IN FROM() TO() COL() BEGIN() 00324500 ISPEXEC SETMSG MSG(ISRZ000) 00324600 EXIT CODE(12) 00324700 END 00324800 SET REMAIN = &STR(&REMAIN &TOKEN) 00324900 NXT_TOK: - 00325000 SET I = &I + 1 00325100 END 00325200 END_TOK: SET JJ = &I 00325300 /***************************************************************** 00325400 /***************************************************************** 00327300 IF &STR(&LABF) = &STR() THEN SET ENTIRE = ENTIRE 00327400 IF ENTIRE = &ENTIRE THEN DO /************* LABELS ARE REQUIRED ****************/ 00327500 IF &LABF = &STR() THEN DO 00327600 SET LABF = .ZFIRST 00327700 SET LABL = .ZLAST 00327800 END 00327900 ELSE DO 00328000 SET &ZEDSMSG = &STR(LABEL CONFLICT) 00328100 SET &ZEDLMSG = &STR("ENTIRE" IMPLIES .ZFIRST .ZLAST CONFLICTS WITH "&LABF" AND "&LABL") 00328200 ISPEXEC SETMSG MSG(ISRZ000) 00328300 EXIT CODE(12) 00328400 END 00328500 END 00330000 ISREDIT (#LABF) = LINENUM &LABF 00330100 IF &LASTCC ^= 0 THEN DO 00330300 SET &ZEDSMSG = &STR(&LABF. LABEL) 00330500 SET &ZEDLMSG = &STR(&ZEDSMSG DOES NOT EXIST) 00330700 ISPEXEC SETMSG MSG(ISRZ000) 00330800 EXIT CODE(12) 00330900 END 00331000 ISREDIT (#LABL) = LINENUM &LABL 00331100 IF &LASTCC ^= 0 THEN DO 00331200 SET &ZEDSMSG = &STR(&LABL. LABEL) 00331300 SET &ZEDLMSG = &STR(&ZEDSMSG DOES NOT EXIST) 00331400 ISPEXEC SETMSG MSG(ISRZ000) 00331500 EXIT CODE(12) 00331600 END 00331700 /********************************** END OF LABEL REQUIREMENTS **********************/ 00331800 ISREDIT RESET 00333800 ISREDIT (DWIDTH) = DATA_WIDTH 00333900 SET LLADJ = 0 00334000 ISREDIT (VAR049) = NUMBER 00334100 ISREDIT (VAR047) = RECFM 00334200 IF &VAR047 = V AND &VAR049 = ON THEN DO 00334300 SET LLADJ = 8 00334400 END 00334500 ISREDIT RES .ZFIRST .ZLAST 00334600 /* ISREDIT LINE_BEFORE .ZFIRST = NOTELINE "&VAR049 &VAR047 &LLADJ" 00334700 /************************************** END OF MODIFIED PATTERN CODE ***************/ 00334800 /************************************** END OF MODIFIED PATTERN CODE ***************/ 00334900 ISREDIT FIND .ZFIRST .ZLAST FIRST X'75' 00335000 SET CC = &LASTCC 00335100 IF &CC ^= 0 THEN DO 00335200 ISREDIT FIND .ZFIRST .ZLAST FIRST X'76' 00335300 SET CC = &LASTCC 00335400 END 00335500 IF &CC = 0 THEN DO 00336000 SET &ZEDSMSG = &STR(X'75' | X'76') 00337000 SET &ZEDLMSG = &STR(&ZEDSMSG. ENCOUNTERED IN YOUR ORIGINAL DATA CAN'T FINISH CHECKING) 00338000 ISPEXEC SETMSG MSG(ISRZ000) 00339000 ISREDIT LINE_AFTER &LABL. = NOTELINE "*ERROR** &ZEDLMSG." 00340000 ISPEXEC SETMSG MSG(ISRZ000) 00350002 IF &STR(&IMAC) = NONE THEN ISREDIT DOWN MAX 00360100 EXIT CODE(12) 00361000 END 00362000 /************************************************************************************/ 00363001 ISREDIT FIND ';DO;' FIRST 00364000 SET CC = &LASTCC 00365000 IF &CC ^= 0 THEN DO 00366001 ISREDIT FIND ';END;' FIRST 00367000 SET CC = &LASTCC 00368000 END 00369000 IF &CC = 0 THEN DO 00369100 ISREDIT LINE_BEFORE .ZFIRST = NOTELINE "&SYSTIME. CANNOT HANDLE ';DO;' OR ';END;' -- CHECKING CONTINUES" 00369200 ISREDIT LINE_AFTER .ZLAST = NOTELINE "&SYSTIME. FOR BETTER CHECKING PLEASE USE '; DO;' OR '; END;" 00369300 ISREDIT LINE_AFTER .ZLAST = NOTELINE "&SYSTIME. CANNOT HANDLE ';DO;' OR ';END;'-- CHECKING CONTINUES" 00369400 END 00369500 /************************************************************************************/ 00369601 ISREDIT FIND 1 'DO' FIRST 00369700 SET CC = &LASTCC 00369800 IF &CC ^= 0 THEN DO 00369901 ISREDIT FIND 1 'END' FIRST 00370000 SET CC = &LASTCC 00370100 END 00370200 IF &CC = 0 THEN DO 00370300 ISREDIT LINE_BEFORE .ZFIRST = NOTELINE "&SYSTIME. CANNOT HANDLE ' DO ' OR ' END ' IN COLUMN COL 1-2" 00370400 ISREDIT LINE_AFTER .ZLAST = NOTELINE "&SYSTIME. FOR BETTER CHECKING PLEASE USE '; DO;' OR '; END;" 00370500 ISREDIT LINE_AFTER .ZLAST = NOTELINE "&SYSTIME. CANNOT HANDLE ';DO;' OR ';END;' -- CHECKING CONTINUES" 00370600 END 00370700 /************************************************************************************/ 00370800 ISREDIT LINE_BEFORE &LABF. = NOTELINE "&SYSDATE. &SYSTIME. X'75' AND X'76' BEING INSERTED INTO DATA" 00370900 SET PLID1 = ' DO ' 00371000 SET PLIX1 = '²DO ' /* CONTAINS HEX X'75' */ 00371100 SET PLID2 = ' DO;' 00371200 SET PLIX2 = '²DO;' /* CONTAINS HEX X'75' */ 00371300 SET PLID3 = ' BEGIN;' 00371400 SET PLIX3 = '²BEGIN;' /* CONTAINS HEX X'75' */ 00371500 SET PLID4 = ' PROC ' 00371600 SET PLIX4 = '²PROC ' /* CONTAINS HEX X'75' */ 00371700 SET PLID5 = ' PROC(' 00371800 SET PLIX5 = '²PROC(' /* CONTAINS HEX X'75' */ 00371900 SET PLID6 = ' END;' 00372000 SET PLIX6 = 'üEND;' /* CONTAINS HEX X'76' */ 00372100 SET PLID7 = ' END ' 00373000 SET PLIX7 = 'üEND ' /* CONTAINS HEX X'76' */ 00373200 /************************************************************************************/ 00373800 /************************************************************************************/ 00373900 ISREDIT C ALL &LABF. &LABL. &PLID1. &PLIX1. 00374000 IF &STR(&PLI) ^= PLI AND &STR(&SAS) ^= SAS THEN GOTO EDCLIST 00374100 ISREDIT C ALL &LABF. &LABL. &PLID2. &PLIX2. 00374200 IF &STR(&PLI) = SAS THEN GOTO EDCLIST 00374300 ISREDIT C ALL &LABF. &LABL. &PLID3. &PLIX3. 00374400 ISREDIT C ALL &LABF. &LABL. &PLID4. &PLIX4. 00374500 ISREDIT C ALL &LABF. &LABL. &PLID5. &PLIX5. 00374600 ISREDIT C ALL &LABF. &LABL. &PLID6. &PLIX6. 00374700 EDCLIST: - 00374800 ISREDIT C ALL &LABF. &LABL. &PLID7. &PLIX7. 00374900 ISREDIT (#LABF) = LINENUM &LABF 00375000 ISREDIT (#LABL) = LINENUM &LABL 00375100 /************************************************************************************/ 00375200 SET I = 1 00375300 IF &STR(&COL1) = &STR() THEN SET COL1 = 1 00375400 ELSE SET COL1 = &COL1 - &LLADJ. 00375500 IF &STR(&COL2) = &STR() THEN DO 00375600 SET COL2 = &DWIDTH 00375700 IF &COL2 > 80 THEN SET COL2 = 80 00376000 END 00377000 ELSE SET COL2 = &COL2 - &LLADJ. 00380200 ISREDIT EXCLUDE .ZFIRST .ZLAST ALL 00380400 /* WRITE &COL1 &COL2 LBOUND=&LBOUND + &LLADJ = &LLBOUND RBOUND=&RBOUND DWIDTH=&DWIDTH DISPLAY(&VAR019,&VAR020) 00380700 DO WHILE &I < &COL2 00380901 ISREDIT F P'^' &COL1 &I FIRST 00381000 IF &LASTCC ^= 0 THEN DO 00381200 IF DETAIL = &DETAIL THEN ISREDIT LINE_BEFORE .ZFIRST = NOTELINE "COLUMN &EVAL(&I + &LLADJ.) NOT A LINE START" 00382000 GOTO NXT_III 00383000 END 00390000 ISREDIT EXCLUDE &LABF. &LABL. ALL 00391000 ISREDIT FIND &LABF. &LABL. P'^' &I ALL 00400000 IF &I > &COL1. THEN ISREDIT EXCLUDE &LABF. &LABL. ALL &COL1 &EVAL(&I-1) P'^' 00410000 /* ISREDIT EXCLUDE &LABF. &LABL. ALL &I ' ' 00410100 ISREDIT EXCLUDE &LABF. &LABL. ALL X'75' /* EXCLUDE DO */ 00410200 ISREDIT EXCLUDE &LABF. &LABL. ALL X'76' /*EXCLUDE END */ 00411000 ISREDIT FIND &LABF. &LABL. ALL &I '/*' 00420000 ISREDIT FIND &LABF. &LABL. ALL &I "'" 00421000 ISREDIT FIND &LABF. &LABL. ALL &I "WRITE " 00430000 ISREDIT C ALL NX X'75' ' ' 00431000 ISREDIT C ALL NX X'76' ' ' 00431100 ISREDIT F ALL X'75' 00431200 ISREDIT F ALL X'76' 00431300 ISREDIT EXCLUDE &LABF. &LABL. ALL &I ' ' 00432000 ISREDIT FIND &LABF. &LABL. P'^' &I ALL 00432200 IF &I > &COL1. THEN DO 00432300 ISREDIT EXCLUDE &LABF. &LABL. ALL 1 &EVAL(&I-1) P'^' 00432400 ISREDIT FIND &LABF. &LABL. X'75' &EVAL(&I.-1) ALL 00432500 ISREDIT FIND &LABF. &LABL. X'76' &EVAL(&I.-1) ALL 00432600 IF &I > &EVAL(&COL1.+1) THEN ISREDIT EXCLUDE &LABF. &LABL. ALL &COL1 &EVAL(&I-2) P'^' 00432700 END 00433000 ISREDIT SEEK NX ALL X'75' 00440000 ISREDIT (VAR023D,VAR024D) = SEEK_COUNTS 00450000 ISREDIT SEEK NX ALL X'76' 00460000 ISREDIT (VAR023E,VAR024E) = SEEK_COUNTS 00461000 IF DETAIL = &DETAIL THEN ISREDIT LINE_BEFORE .ZFIRST = NOTELINE "COLUMN &EVAL(&I + &LLADJ.) BEING CHECKED (&VAR023D. &VAR024D.) (&VAR023E. &VAR024E.)" 00470000 IF &EVAL(&VAR023D) ^= &EVAL(&VAR023E) THEN DO 00480000 IF &STR(&NOTE1) = &STR() THEN DO 00481000 SET NOTE1 = NOTE1 00482000 ISREDIT LINE_BEFORE .ZFIRST = NOTELINE "COLUMN XX BEING CHECKED (------ DO -------) (----- END ------)" 00483000 ISREDIT LINE_BEFORE .ZFIRST = NOTELINE "COLUMN XX BEING CHECKED (STRINGS LINES ) (STRINGS LINES )" 00484000 END 00490000 SET P = &E 00490200 SET E = &I 00491000 IF &VAR023D > &VAR023E THEN DO 00491100 SET T = DO 00491200 WRITE &I COLUMN (&EVAL(&I + &LLADJ)) UNMATCHED DO 00491300 ISREDIT LINE_BEFORE .ZFIRST = NOTELINE "COLUMN &EVAL(&I + &LLADJ) UNMATCHED DO (&VAR023D. &VAR024D.) (&VAR023E. &VAR024E.)" 00491400 END 00492000 IF &VAR023D < &VAR023E THEN DO 00493000 SET T = END 00493100 WRITE &I COLUMN (&EVAL(&I + &LLADJ)) UNMATCHED END 00493300 ISREDIT LINE_BEFORE .ZFIRST = NOTELINE "COLUMN &EVAL(&I + &LLADJ) UNMATCHED END (&VAR023D. &VAR024D.) (&VAR023E. &VAR024E.)" 00494000 END 00495000 SET BAD = &STR(&BAD. &EVAL(&I.+&LLADJ.) &T.|&EVAL(&VAR023D.)|&EVAL(&VAR023E.), ) 00510000 END 00511000 ELSE DO 00511100 ISREDIT CHANGE ALL NX X'75' X'40' 00511200 ISREDIT CHANGE ALL NX X'76' X'40' 00512000 END 00513000 NXT_III: - 00520000 SET I = &I + 1 00530000 END 00530100 DONE: - 00530300 ISREDIT EXCLUDE ALL .ZFIRST .ZLAST /* DONT TOUCH NOTES THANK-YOU*/ 00530400 ISREDIT CHANGE X'75' X'40' ALL 00530500 ISREDIT CHANGE X'76' X'40' ALL 00530600 ISREDIT RESET CHANGE 00530700 ISREDIT LINE_BEFORE &LABF. = NOTELINE "&SYSDATE. &SYSTIME. X'75' AND X'76' HAVE BEEN REMOVED FROM DATA" 00540700 /*************************************************************/ 00571100 IF &STR(&BAD.) = &STR() THEN DO 00572000 SET &ZEDSMSG = &STR(COMPLETED) 00573000 SET &ZEDLMSG = &STR(--SUCCESS-- NESTCHK HAS NOT FOUND ANY UNMATCHED DO/END GROUPS) 00573100 ISREDIT LINE_AFTER &LABL. = NOTELINE "&SYSDATE. &SYSTIME. &ZEDLMSG" 00573200 END 00573300 ELSE DO 00573400 IF &LENGTH(&STR(&BAD)) > 40 THEN SET BAD = &SUBSTR(1:40,&STR(&BAD.&BLANKS.)) 00573500 SET &ZEDSMSG = &STR(MISALIGNED) 00573600 SET &ZEDLMSG = &STR(&ZEDSMSG. " DO " AND " END " COLS &BAD.) 00573700 ISREDIT LINE_AFTER &LABL. = NOTELINE "&B. &BAD." 00573800 IF &STR(&LLADJ) ^= 0 THEN - 00573900 ISREDIT LINE_AFTER &LABL. = NOTELINE "&B HAVE ADDED +&LLADJ. TO COLUMN NUMBERS COLUMN|DO CNT|END CNT" 00574000 ISREDIT LINE_AFTER &LABL. = NOTELINE "&SYSDATE. &SYSTIME. -- CHECK ALIGNMENT OF DO/END GROUPS -- COLS. &P. &E." 00574100 SET COLHD = &STR(1...5...10...15...20...25...30...35...40...45...50...55...60...65...70...75...80...85...90) 00574200 ISREDIT LINE_AFTER &LABL. = NOTELINE "&SUBSTR(&EVAL(1+&LLADJ):72,&STR(&COLHD.))" 00574300 ISREDIT LINE_BEFORE &LABF. = NOTELINE "&SUBSTR(&EVAL(1+&LLADJ):72,&STR(&COLHD.))" 00574402 IF &STR(&IMAC) = NONE THEN ISREDIT DOWN MAX 00574500 END 00575000 ISPEXEC SETMSG MSG(ISRZ000) 00580000 EXIT CODE(0)