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 reads a COBOL compiled listing dataset while editing the program
source, and marks the program source with the error messages before the line on
which they occured. COMPMARK brings up a panel to define the location of the
output dataset and the COBOL type (COBOL or COBOL 2). You are told how many
messages are warnings and how many are errors if warnings exist. Then you can
specify whether to mark the warnings. To locate the error message lines type
"l special". If you invoke COMPMARK and specify a PF key (e.g. "compmark
pf19") you can use the PF key to locate the error message lines.
0 Comments