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.
0 Comments