Mainframe Utility: COMPMARK

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.
            


Leave a Reply

Your email address will not be published. Required fields are marked *