Mainframe Utility: Preview

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.
            


Leave a Reply

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