Return to Mainframe Utilities Page
Module
ISREDIT MACRO (OPT1,OPT2) ISPEXEC CONTROL ERRORS RETURN /**** SET MESSAGE DISPLAY ON/OFF BASED ON THE DEBUG SWITCH ***/ ISPEXEC VGET (DBGSWTCH) PROFILE IF &DBGSWTCH = &STR(ON) THEN CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &OPT1 = HELP THEN GOTO HELPSEC /********************************************************************** /* UTILITY: COMPMARK * /* AUTHOR: DAVID LEIGH * /* UTILITY: MARK THE COMPILER MESSAGES IN THE COBOL PROGRAM YOU ARE * /* EDITING BY INTERROGATING A COMPILE LISTING DATASET. * /********************************************************************** SET CMBAD = NO ISPEXEC VPUT CMBAD SHARED ISREDIT RESET IF &OPT1 = SPECIFY OR &OPT2 = SPECIFY THEN GOTO SPECSEC /********************************************************************** /* IN THIS NEXT SECTION, PROJECT SPECIFIC CODE SHOULD BE INSERTED TO * /* SPECIFY THE FORMAT OF THE DATASET NAME WHICH CONTAINS THE COMPILE * /* LISTING. CODE ALSO EXISTS TO ALLOW THE USER TO SPECIFY A DATASET * /* NAME IF THEIR LISTING IS IN A NON-STANDARD NAME. * /********************************************************************** ISREDIT (MBR) = MEMBER SET DSN = &STR(&SYSUID..COMPILE.LISTING.&MBR) GOTO GETERROR /********************************************************************** /* THE FOLLOWING SECTION OF CODE PERMITS A USER TO SPECIFY THAT THE * /* DATASET CONTAINING THE COMPILED LISTING IS NOT A STANDARD DATASET * /* (I.E. NOT FOLLOWING PROJECT CONVENTIONS) AND TO SPECIFY WHICH * /* DATASET CONTAINS THE COMPILED LISTING. * /********************************************************************** SPECSEC: + WRITENR ENTER FULLY QUALIFIED COMPILE LISTING DATASET NAME ==> READ DSN IF &STR(&DSN) = THEN + DO SET ZEDLMSG = &STR(*** NO LISTING DATASET NAME ENTERED *** + PROCESSING TERMINATED ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT END /********************************************************************** /* THE FOLLOWING SECTION OF CODE PERMITS A PROJECT TO SPECIFY THAT * /* COBOL OR COBOL II IS THE DEFAULT LANGUAGE. IF THE USER PASSES * /* "COBOL" OR "COBOLII" THEN THEY MAY OVERRIDE THE DEFAULT. * /********************************************************************** GETERROR: + SET TYPE = COBOL2 /*** ENTER PROJECT DEFAULT HERE ***/ IF &OPT1 = COBOL OR &OPT1 = COBOLII OR &OPT1 = COBOL2 THEN + SET TYPE = &OPT1 IF &OPT2 = COBOL OR &OPT2 = COBOLII OR &OPT2 = COBOL2 THEN + SET TYPE = &OPT2 IF &TYPE = COBOL2 OR &TYPE = COBOLII THEN SET TYPE = COB2 IF &TYPE = COBOL THEN SET TYPE = COB SET ZEDLMSG = &STR(*** EXTRACTING COMPILER MESSAGES FROM "&DSN" ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) ISPEXEC EDIT DATASET('&DSN') MACRO(CMMK&TYPE) PROFILE(SYSPRINT) /********************************************************************** /* PROCESS INFORMATIONAL MESSAGES * /********************************************************************** ISPEXEC VGET CMNUMINF SHARED IF &CMNUMINF > 0 THEN + DO SET ZEDLMSG = &STR(*** MARKING INFORMATIONAL + MESSAGES IN THE CODE ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) SET TYPE = I SYSCALL PROCESS_MESSAGES TYPE CMNUMINF END /********************************************************************** /* PROCESS WARNING MESSAGES * /********************************************************************** ISPEXEC VGET CMNUMWAR SHARED IF &CMNUMWAR > 0 THEN + DO SET ZEDLMSG = &STR(*** MARKING WARNING + MESSAGES IN THE CODE ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) SET TYPE = W SYSCALL PROCESS_MESSAGES TYPE CMNUMWAR END /********************************************************************** /* PROCESS ERROR MESSAGES * /********************************************************************** ISPEXEC VGET CMNUMERR SHARED IF &CMNUMERR > 0 THEN + DO SET ZEDLMSG = &STR(*** MARKING ERROR + MESSAGES IN THE CODE ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) SET TYPE = E SYSCALL PROCESS_MESSAGES TYPE CMNUMERR END /********************************************************************** /* PROCESS SEVERE MESSAGES * /********************************************************************** ISPEXEC VGET CMNUMSEV SHARED IF &CMNUMSEV > 0 THEN + DO SET ZEDLMSG = &STR(*** MARKING SEVERE + MESSAGES IN THE CODE ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) SET TYPE = S SYSCALL PROCESS_MESSAGES TYPE CMNUMSEV END /********************************************************************** /* PROCESS "UNABLE TO CONTINUE" MESSAGES * /********************************************************************** ISPEXEC VGET CMNUMUNA SHARED IF &CMNUMUNA > 0 THEN + DO SET ZEDLMSG = &STR(*** MARKING "UNABLE TO CONTINUE" + MESSAGES IN THE CODE ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) SET TYPE = U SYSCALL PROCESS_MESSAGES TYPE CMNUMUNA END /********************************************************************** /* POSITION THE USER AT THE TOP WITH SOME MESSAGES * /********************************************************************** SET KEY = SELECT (&STR(&OPT1)) WHEN (1 ¦ 01 ¦ F1 ¦ F01 ¦ PF1 ¦ PF01) SET KEY = ZPF01 WHEN (2 ¦ 02 ¦ F2 ¦ F02 ¦ PF2 ¦ PF02) SET KEY = ZPF02 WHEN (3 ¦ 03 ¦ F3 ¦ F03 ¦ PF3 ¦ PF03) SET KEY = ZPF03 WHEN (4 ¦ 04 ¦ F4 ¦ F04 ¦ PF4 ¦ PF04) SET KEY = ZPF04 WHEN (5 ¦ 05 ¦ F5 ¦ F05 ¦ PF5 ¦ PF05) SET KEY = ZPF05 WHEN (6 ¦ 06 ¦ F6 ¦ F06 ¦ PF6 ¦ PF06) SET KEY = ZPF06 WHEN (7 ¦ 07 ¦ F7 ¦ F07 ¦ PF7 ¦ PF07) SET KEY = ZPF07 WHEN (8 ¦ 08 ¦ F8 ¦ F08 ¦ PF8 ¦ PF08) SET KEY = ZPF08 WHEN (9 ¦ 09 ¦ F9 ¦ F09 ¦ PF9 ¦ PF09) SET KEY = ZPF09 WHEN (10 ¦ 10 ¦ F10 ¦ PF10) SET KEY = ZPF10 WHEN (11 ¦ 11 ¦ F11 ¦ PF11) SET KEY = ZPF11 WHEN (12 ¦ 12 ¦ F12 ¦ PF12) SET KEY = ZPF12 WHEN (13 ¦ 13 ¦ F13 ¦ PF13) SET KEY = ZPF13 WHEN (14 ¦ 14 ¦ F14 ¦ PF14) SET KEY = ZPF14 WHEN (15 ¦ 15 ¦ F15 ¦ PF15) SET KEY = ZPF15 WHEN (16 ¦ 16 ¦ F16 ¦ PF16) SET KEY = ZPF16 WHEN (17 ¦ 17 ¦ F17 ¦ PF17) SET KEY = ZPF17 WHEN (18 ¦ 18 ¦ F18 ¦ PF18) SET KEY = ZPF18 WHEN (19 ¦ 19 ¦ F19 ¦ PF19) SET KEY = ZPF19 WHEN (20 ¦ 20 ¦ F20 ¦ PF20) SET KEY = ZPF20 WHEN (21 ¦ 21 ¦ F21 ¦ PF21) SET KEY = ZPF21 WHEN (22 ¦ 22 ¦ F22 ¦ PF22) SET KEY = ZPF22 WHEN (23 ¦ 23 ¦ F23 ¦ PF23) SET KEY = ZPF23 WHEN (24 ¦ 24 ¦ F24 ¦ PF24) SET KEY = ZPF24 END SELECT (&STR(&OPT2)) WHEN (1 ¦ 01 ¦ F1 ¦ F01 ¦ PF1 ¦ PF01) SET KEY = ZPF01 WHEN (2 ¦ 02 ¦ F2 ¦ F02 ¦ PF2 ¦ PF02) SET KEY = ZPF02 WHEN (3 ¦ 03 ¦ F3 ¦ F03 ¦ PF3 ¦ PF03) SET KEY = ZPF03 WHEN (4 ¦ 04 ¦ F4 ¦ F04 ¦ PF4 ¦ PF04) SET KEY = ZPF04 WHEN (5 ¦ 05 ¦ F5 ¦ F05 ¦ PF5 ¦ PF05) SET KEY = ZPF05 WHEN (6 ¦ 06 ¦ F6 ¦ F06 ¦ PF6 ¦ PF06) SET KEY = ZPF06 WHEN (7 ¦ 07 ¦ F7 ¦ F07 ¦ PF7 ¦ PF07) SET KEY = ZPF07 WHEN (8 ¦ 08 ¦ F8 ¦ F08 ¦ PF8 ¦ PF08) SET KEY = ZPF08 WHEN (9 ¦ 09 ¦ F9 ¦ F09 ¦ PF9 ¦ PF09) SET KEY = ZPF09 WHEN (10 ¦ 10 ¦ F10 ¦ PF10) SET KEY = ZPF10 WHEN (11 ¦ 11 ¦ F11 ¦ PF11) SET KEY = ZPF11 WHEN (12 ¦ 12 ¦ F12 ¦ PF12) SET KEY = ZPF12 WHEN (13 ¦ 13 ¦ F13 ¦ PF13) SET KEY = ZPF13 WHEN (14 ¦ 14 ¦ F14 ¦ PF14) SET KEY = ZPF14 WHEN (15 ¦ 15 ¦ F15 ¦ PF15) SET KEY = ZPF15 WHEN (16 ¦ 16 ¦ F16 ¦ PF16) SET KEY = ZPF16 WHEN (17 ¦ 17 ¦ F17 ¦ PF17) SET KEY = ZPF17 WHEN (18 ¦ 18 ¦ F18 ¦ PF18) SET KEY = ZPF18 WHEN (19 ¦ 19 ¦ F19 ¦ PF19) SET KEY = ZPF19 WHEN (20 ¦ 20 ¦ F20 ¦ PF20) SET KEY = ZPF20 WHEN (21 ¦ 21 ¦ F21 ¦ PF21) SET KEY = ZPF21 WHEN (22 ¦ 22 ¦ F22 ¦ PF22) SET KEY = ZPF22 WHEN (23 ¦ 23 ¦ F23 ¦ PF23) SET KEY = ZPF23 WHEN (24 ¦ 24 ¦ F24 ¦ PF24) SET KEY = ZPF24 END IF &STR(&KEY) > THEN + DO SET ZEDLMSG = &STR(*** PRESS &SUBSTR(2:5,&STR(&KEY)) TO SEE + THE MARKED LINES ***) SET &&KEY = &STR(LOCATE NEXT SPECIAL) ISPEXEC VPUT &KEY PROFILE END ELSE + SET ZEDLMSG = &STR(*** TYPE "L SPE" TO SEE THE MARKED LINES ***) IF &CMNUMINF = 0 AND &CMNUMWAR = 0 AND &CMNUMERR = 0 AND + &CMNUMSEV = 0 AND &CMNUMUNA = 0 THEN + SET ZEDLMSG = &STR(*** NO COMPILER MESSAGES TO MARK OR NONE + SELECTED TO MARK ***) ISREDIT LOCATE .ZLAST ISREDIT UP MAX ISREDIT (NUM1,NUM2) = NUMBER IF &STR(&NUM1) = ON AND &SYSINDEX(&STR(COBOL),&STR(&NUM2)) > 0 AND + (&CMNUMINF > 0 OR &CMNUMWAR = 0 OR &CMNUMERR = 0 OR + &CMNUMSEV = 0 OR &CMNUMUNA = 0) THEN + ISREDIT RIGHT 6 ISPEXEC SETMSG MSG(UTLZ000W) EXIT /********************************************************************** /* PROCESS THE MESSAGES OF A GIVEN TYPE * /********************************************************************** PROCESS_MESSAGES: PROC 2 TYPE NUMBER SYSREF TYPE NUMBER DO &I = 1 TO &NUMBER SET X = &SUBSTR(&LENGTH(&STR(000&I))-3:&LENGTH(&STR(000&I)),+ &STR(000&I) ISPEXEC VGET (CM&TYPE&X.M CM&TYPE&X.L CM&TYPE&X.O) SHARED SYSCALL INSERT_MESSAGE TYPE CM&TYPE&X.M CM&TYPE&X.L CM&TYPE&X.O IF &EVAL(&I//10) = 0 THEN + DO SET ZEDLMSG = &STR(*** PROCESSED &I OF + &NUMBER TYPE "&TYPE" MESSAGES ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) END END RETURN END /********************************************************************** /* INSERT A SPECIFIC MESSAGE * /********************************************************************** INSERT_MESSAGE: PROC 4 TYPE MESSAGE LINE OCCURANCE SYSREF TYPE MESSAGE LINE OCCURANCE SET PREFIX = &STR(** &TYPE **) IF &SYSINDEX(&STR('),&SYSNSUB(1,&LINE)) > 0 THEN + IF &SYSINDEX(&STR("),&SYSNSUB(1,&LINE)) > 0 THEN + SET NOMARK = YES ELSE + SET QT = &STR(") ELSE + SET QT = &STR(') ISREDIT (NUM1,NUM2) = NUMBER IF &SYSINDEX(&STR(COBOL),&STR(&NUM1)) > 0 OR + &SYSINDEX(&STR(COBOL),&STR(&NUM2)) > 0 THEN + SET COL1 = 1 ELSE SET COL1 = 7 ISREDIT (VAR1,VAR2) = BOUNDS ISREDIT NUMBER OFF ISREDIT (LRECL) = LRECL ISREDIT BOUNDS = 1 &LRECL ISREDIT FIND &QT&STR(&LINE)&QT FIRST &COL1 SET FINDCC = &LASTCC DO &I = 2 TO &OCCURANCE WHILE &LASTCC = 0 AND &FINDCC = 0 ISREDIT FIND &QT&STR(&LINE)&QT NEXT &COL1 END IF &NOMARK = YES OR &FINDCC > 0 THEN + DO ISPEXEC VGET CMBAD SHARED IF &CMBAD = NO THEN + DO SET CMBAD = YES ISPEXEC VPUT CMBAD SHARED SET INSERT = &STR(******* UNABLE TO MARK THE + FOLLOWING MESSAGES AT THE PROPER + PROGRAM LINE *******) ISREDIT LINE_BEFORE .ZFIRST = MSGLINE (INSERT) END ISREDIT FIND FIRST P'=' END DO WHILE &STR(&SYSNSUB(1,&MESSAGE)) > SET LEN = &LENGTH(&STR(&SYSNSUB(1,&MESSAGE))) SET X = 63 IF &LEN < &X THEN + SET X = &LEN ELSE + DO WHILE &SYSINDEX(&STR( ),&STR(&SYSNSUB(1,&MESSAGE))) > 0 AND + &SUBSTR(&X:&X,&STR(&SYSNSUB(1,&MESSAGE))) > &STR( ) SET X = &X - 1 END SET INSERT = &STR(&PREFIX &SUBSTR(1:&X,&SYSNSUB(1,&MESSAGE))) ISREDIT LINE_BEFORE .ZCSR = MSGLINE (INSERT) IF &X = &LEN THEN SET MESSAGE = ELSE + DO SET X = &X + 1 IF &X ª> &LEN THEN + SET MESSAGE = &SUBSTR(&X:&LEN,+ &STR(&SYSNSUB(1,&MESSAGE))) END END IF &NOMARK = YES OR &FINDCC > 0 THEN + DO SET INSERT = &STR(&PREFIX &LINE) ISPEXEC LINE_BEFORE .ZFIRST = MSGLINE (INSERT) END ISREDIT NUMBER = &NUM1 &NUM2 ISREDIT BOUNDS = &VAR1 &VAR2 RETURN END HELPSEC: + ISPEXEC SELECT PGM(ISPTUTOR) PARM(UTILH031) SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR COMPMARK UTILITY + *** NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT
Documentation
This utility allows you to convert 1, some, or all of the fields in a given ISPF table from lower or mixed case to upper case.