Example: MSGEXIT user exit

The following example shows a MSGEXIT user-exit module that changes message severities and suppresses messages.

For helpful tips about using a message-exit module, see the comments within the code.


      ******************************************************************
      *  IGYMSGXT - Sample COBOL program for MSGEXIT                   *
      ******************************************************************
      *                                                                *
      *  IBM Enterprise COBOL for z/OS                                 *
      *               Start of changeVersion 6 Release 2 Modification 0End of change             *
      *                                                                *
      *  LICENSED MATERIALS - PROPERTY OF IBM.                         *
      *                                                                *
      *  Start of change5655-EC6End of change  COPYRIGHT IBM CORP. Start of change2017End of change                        *
      *  ALL RIGHTS RESERVED                                           *
      *                                                                *
      *  US GOVERNMENT USERS RESTRICTED RIGHTS - USE,                  *
      *  DUPLICATION OR DISCLOSURE RESTRICTED BY GSA                   *
      *  ADP SCHEDULE CONTRACT WITH IBM CORP.                          *
      *                                                                *
      ******************************************************************
      *****************************************************************
      *  Function:  This is a SAMPLE user exit for the MSGEXIT        *
      *             suboption of the EXIT compiler option.  This exit *
      *             can be used to customize the severity of or       *
      *             suppress compiler diagnostic messages and FIPS    *
      *             messages.  This example program includes several  *
      *             sample customizations to show how customizations  *
      *             are done.  If you do not want the sample          *
      *             customizations then either delete the unwanted    *
      *             lines of code or comment them out with a comment  *
      *             indicator in column 7 (*).                        *
      *                                                               *
      *---------------------------------------------------------------*
      *                                                               *
      *  USAGE NOTE: To use this user exit program, make the          *
      *              link-edited load module available to your        *
      *              compiles that will use the MSGEXIT suboption of  *
      *              the EXIT compiler option.  Also, the name should *
      *              be changed, since IBM recommends that you avoid  *
      *              having programs with names that start with IGY.  *
      *              Sample steps to take:                            *
      *              1) Make your customizations                      *
      *              2) Change program name (E.G. MYEXIT)             *
      *              3) Compile and link into a dataset               *
      *              4) Include that dataset in your compile          *
      *                 JCL concatenation for the compile step.       *
      *                 If you link into USER.COBOLLIB:               *
      *                                                               *
      *           //COBOL.STEPLIB DD DSNAME=SYS1.SIGYCOMP,DISP=SHR    *
      *           //              DD DSNAME=USER.COBOLLIB,DISP=SHR    *
      *                                                               *
      *              5) Finally, compile your programs with the       *
      *                 EXIT compiler option, EG:                     *
      *                   EXIT(MSGEXIT(MYEXIT))                       *
      *                                                               *
      *  COMPILE NOTE:  Compile this program with NOEXIT.             *
      *                                                               *
      *                                                               *
      *****************************************************************
       Id Division.
       Program-Id.  IGYMSGXT.
       Data Division.
 
         Working-Storage Section.
 
      *****************************************************************
      *                                                               *
      *   Local variables.                                            *
      *                                                               *
      *****************************************************************
 
          77 EXIT-TYPEN            PIC 9(4).
          77 EXIT-DEFAULT-SEV-FIPS PIC X.
 
      *****************************************************************
      *                                                               *
      *   Definition of the User-Exit Parameter List, which is        *
      *   passed from the COBOL compiler to the user-exit module.     *
      *                                                               *
      *****************************************************************
 
         Linkage Section.
          01 EXIT-TYPE        PIC 9(4)   COMP.
          01 EXIT-OPERATION   PIC 9(4)   COMP.
          01 EXIT-RETURNCODE  PIC 9(9)   COMP.
          01 EXIT-WORK-AREA.
             02 EXIT-WORK-AREA-PTR  OCCURS 6  POINTER.
          01 EXIT-DUMMY       POINTER.
          01 EXIT-MESSAGE-PARMS.
             02 EXIT-MESSAGE-NUM PIC 9(4)   COMP.
             02 EXIT-DEFAULT-SEV PIC 9(4)   COMP.
             02 EXIT-USER-SEV    PIC S9(4)  COMP.
          01 EXIT-STRING.
             02 EXIT-STR-LEN PIC 9(4)   COMP.
             02 EXIT-STR-TXT PIC X(64).
 
      *****************************************************************
      *****************************************************************
      *                                                               *
      *  Begin PROCEDURE DIVISION                                     *
      *                                                               *
      *  Check parameters and perform the operation requested.        *
      *                                                               *
      *****************************************************************
      *****************************************************************
 
       Procedure Division Using EXIT-TYPE       EXIT-OPERATION
                                EXIT-RETURNCODE EXIT-WORK-AREA
                                EXIT-DUMMY      EXIT-MESSAGE-PARMS
                                EXIT-STRING     EXIT-DUMMY
                                EXIT-DUMMY      EXIT-DUMMY.
 
           Compute EXIT-RETURNCODE = 0
 
           Evaluate TRUE
 
      *****************************************************************
      * Handle a bad invocation of this exit by the compiler.         *
      * This could happen if this routine was used for one of the     *
      * other EXITs, such as INEXIT, PRTEXIT or LIBEXIT.              *
      *****************************************************************
             When EXIT-TYPE Not = 6
               Move EXIT-TYPE   to  EXIT-TYPEN
               Display '**** Invalid exit routine identifier'
               Display '**** EXIT TYPE =  '  EXIT-TYPE
               Compute EXIT-RETURNCODE = 16
 
      *****************************************************************
      * Handle the OPEN call to this exit by the compiler             *
      *        Display the exit string (str5 in syntax diagram) from  *
      *        the EXIT(MSGEXIT('str5',mod5)) option specification.   *
      *****************************************************************
             When EXIT-OPERATION = 0
      *        Display 'Opening MSGEXIT'
      *        If EXIT-STR-LEN Not Zero Then
      *          Display ' str5 len = ' EXIT-STR-LEN
      *          Display ' str5 = ' EXIT-STR-TXT(1:EXIT-STR-LEN)
      *        End-If
               Continue
 
      *****************************************************************
      * Handle the CLOSE call to this exit by the compiler            *
      *****************************************************************
             When EXIT-OPERATION = 1
      *        Display 'Closing MSGEXIT'
               Goback
 
      *****************************************************************
      * Handle the customize message severity call to this exit       *
      *        Display information about every customized severity.   *
      *****************************************************************
             When EXIT-OPERATION = 5
      *        Display 'MSGEXIT called with MSGSEV'
               If EXIT-MESSAGE-NUM < 8000 Then
                 Perform Error-Messages-Severity
               Else
                 Perform FIPS-Messages-Severity
               End-If
 
      *        If EXIT-RETURNCODE = 4 Then
      *          Display '>>>> Customizing message ' EXIT=MESSAGE-NUM
      *                  ' with new severity ' EXIT-USER-SEV '  <<<<'
      *          If EXIT-MESSAGE-NUM > 8000 Then
      *            Display 'FIPS sev =' EXIT-DEFAULT-SEV-FIPS '<<<<'
      *          End-If
      *        End-If
 
      *****************************************************************
      * Handle a bad invocation of this exit by the compiler.         *
      * The compiler should not invoke this exit with EXIT-TYPE = 6   *
      * and an opcode other than 0, 1, or 5.  This should not happen  *
      * and IBM service should be contacted if it does.               *
      *****************************************************************
             When Other
               Display '**** Invalid MSGEXIT routine operation '
               Display '**** EXIT OPCODE =  '  EXIT-OPERATION
               Compute EXIT-RETURNCODE = 16
 
           End-Evaluate
 
           Goback.
 
      *****************************************************************
      *    ERROR MESSAGE   PROCESSOR                                  *
      *****************************************************************
       Error-Messages-Severity.
 
      *    Assume message severity will be customized...
           Compute EXIT-RETURNCODE = 4
 
           Evaluate EXIT-MESSAGE-NUM
 
      *****************************************************************
      *   Change severity of message 1154(W) to 12 ('S')              *
      *   This is the case of redefining a large item                 *
      *   with a smaller item, IBM Req # MR0904063236                 *
      *****************************************************************
             When(1154)
               Compute EXIT-USER-SEV = 12
 
      *****************************************************************
      *  Modify the severity of RULES messages to enforce coding      *
      *  standards or highlight coding that you want to avoid.        *
      *  Here are the message numbers and what they flag:             *
     Start of change*   1158  RULES(NOOMITODOMIN)   Missing min idx in ODO table def*End of change
      *   1348  RULES(NOEVENPACK)     Even digit packed-decimal items *
      *   1353  RULES(NOSLACKBYTES)   Slack bytes within records      *
      *   1379  RULES(NOSLACKBYTES)   Slack bytes between records     *
      *   2159  RULES(NOENDPERIOD)    Cond stmt terminated by period  *
     Start of change*   2262  RULES(NOUNREFALL)     Unref'd items (source/copybook) *
      *   2262  RULES(NOUNREFSOURCE)  Unref'd items (source only)     *End of change
      *   2224  RULES(NOLAXPERF)      Ineff. type for PERFORM VARYING *
      *   2246  RULES(NOLAXPERF)      Ineff. type for subscript       *
      *   2247  RULES(NOLAXPERF)      Compiler option NOAWO in effect *
      *   2248  RULES(NOLAXPERF)       Option ARITH(EXTEND) in effect *
      *   2249  RULES(NOLAXPERF)       Option NOBLOCK0 in effect      *
      *   2250  RULES(NOLAXPERF)       Option NOFASTSRT in effect     *
      *   2251  RULES(NOLAXPERF)       Option NUMPROC(NOPFD) in effect*
      *   2252  RULES(NOLAXPERF)       Option OPTIMIZE(0) in effect   *
      *   2253  RULES(NOLAXPERF)       Option SSRANGE in effect       *
      *   2254  RULES(NOLAXPERF)       Option THREAD in effect        *
      *   2255  RULES(NOLAXPERF)       Option TRUNC(STD) in effect    *
      *   2256  RULES(NOLAXPERF)       Option TRUNC(BIN) in effect    *
      *   3084  RULES(NOLAXPERF)      Ineff. type for arith sender    *
      *   3123  RULES(NOLAXPERF)      Lots of padding in alph MOVE    *
      *                                                               *
      *****************************************************************
            Start of changeWhen(1158)             *> Disallow omitting ODO table min
               Compute EXIT-USER-SEV = 12End of change
             When(1348)             *> Disallow even-digit Comp-3
               Compute EXIT-USER-SEV = 12
             When(1353) When(1379)  *> Disallow slack bytes
               Compute EXIT-USER-SEV = 12
             When(2159)             *> Disallow period-termination
               Compute EXIT-USER-SEV = 12    *> of conditional stmts
            Start of changeWhen(2262)             *> Disallow unref'd data items
               Compute EXIT-USER-SEV = 12End of change
      *  Highlight poorly performing COBOL features
             When(2224)             *> Ineff. type for PERFORM VARYING
             When(2246)             *> Ineff. type for subscript
             When(2247)             *> Compiler option NOAWO in effect
             When(2248)             *>  Option ARITH(EXTEND) in effect
             When(2249)             *>  Option NOBLOCK0 in effect
             When(2250)             *>  Option NOFASTSRT in effect
             When(2251)             *>  Option NUMPROC(NOPFD) in effect
             When(2252)             *>  Option OPTIMIZE(0) in effect
             When(2253)             *>  Option SSRANGE in effect
             When(2254)             *>  Option THREAD in effect
             When(2255)             *>  Option TRUNC(STD) in effect
             When(2256)             *>  Option TRUNC(BIN) in effect
             When(3084)             *> Ineff. type for arith sender
             When(3123)             *> Lots of padding in alph MOVE
               Compute EXIT-USER-SEV = 8
 
      *****************************************************************
      *  Change severity of messages 3178(I) to highlight File        *
      *  Definitions that could lead to wrong-length read conditions. *
      *  Message 3178 is issued when the length of the shortest       *
      *  record description is less than the FROM integer in the      *
      *  RECORD IS VARYING clause, and when the length of the         *
      *  longest record description is greater than the TO integer    *
      *  in the RECORD IS VARYING clause.                             *
      *****************************************************************
             When(3178)
               Compute EXIT-USER-SEV = 8
 
      *****************************************************************
      *  Change severity of messages 3188(W) and 3189(W)
      *  to 12 ('S').  This is to force a fix for all
      *  SEARCH ALL cases that might behave differently
      *  between COBOL compilers previous to Enterprise
      *  COBOL release V3R4 and later compilers suchas
      *  Enterprise COBOL Version 4 Release 2.
      *  Another way to handle this migration is to analyze all of
      *  the warnings you get and then change them to I-level when
      *  the analysis is complete.
      *****************************************************************
             When(3188) When(3189)
               Compute EXIT-USER-SEV = 12
 
      *****************************************************************
      *  Change severity of 'optimization' messages to suppress them
      *  so that compilation Return Code can be zero (RC=0)
      * 7300: The code from lines &2 in program '&1' can never
      *       be executed and was therefore discarded.
      * 7301: A zero base was raised to a zero power in a numeric
      *       literal exponentiation. The result was set to 1.
      * 7302: A zero base was raised to a negative power in a numeric
      *       literal exponentiation. The result was set to 0.
      * 7304: An exception "&1" occured while processing numeric
      *       literals. The result of the operation was set to zero.
      * 7307: This statement may cause a program exception at execution
      *       time.
      * 7309: There may be a loop from the "PERFORM" statement at "
      *       "PERFORM (line &1)" to itself.
      *****************************************************************
             When(7300) When(7301) When(7302) When(7304)
             When(7307) When(7309)
               Compute EXIT-USER-SEV = -1    *> Suppress the messages
 
      *****************************************************************
      *  Message severity Not customized
      *****************************************************************
             When Other
               Compute EXIT-RETURNCODE = 0
 
           End-Evaluate
           .
      *****************************************************************
      *  FIPS MESSAGE   PROCESSOR                                     *
      *****************************************************************
       Fips-Messages-Severity.
 
      *    Assume message severity will be customized...
           Compute EXIT-RETURNCODE = 4
 
      *    Convert numeric FIPS(FLAGSTD) 'category' to character
      *    See the Programming Guide for description of FIPS category
 
           EVALUATE EXIT-DEFAULT-SEV
             When 81
               MOVE 'D' To EXIT-DEFAULT-SEV-FIPS
             When 82
               MOVE 'E' To EXIT-DEFAULT-SEV-FIPS
             When 83
               MOVE 'H' To EXIT-DEFAULT-SEV-FIPS
             When 84
               MOVE 'I' To EXIT-DEFAULT-SEV-FIPS
             When 85
               MOVE 'N' To EXIT-DEFAULT-SEV-FIPS
             When 86
               MOVE 'O' To EXIT-DEFAULT-SEV-FIPS
             When 87
               MOVE 'Q' To EXIT-DEFAULT-SEV-FIPS
             When 88
               MOVE 'S' To EXIT-DEFAULT-SEV-FIPS
             When Other
               Continue
           End-Evaluate
 
      *****************************************************************
      *  Example of using FIPS category to force coding
      *  restrictions.  This is not a recommendation!
      *      Change severity of all OBSOLETE item FIPS
      *       messages to 'S'
      *****************************************************************
      *    If EXIT-DEFAULT-SEV-FIPS = 'O' Then
      *      Display '>>>> Default customizing FIPS category '
      *        EXIT-DEFAULT-SEV-FIPS ' msg ' EXIT-MESSAGE-NUM '<<<<'
      *      Compute EXIT-USER-SEV = 12
      *    End-If
 
           Evaluate EXIT-MESSAGE-NUM
      *****************************************************************
      *      Change severity of message 8062(O) to 8 ('E')
      *        8062 = GO TO without proc name
      *****************************************************************
             When(8062)
               Compute EXIT-USER-SEV = 8
 
      *****************************************************************
      *      Change severity of message 8193(E) to 0('I')
      *        8193 = GOBACK
      *****************************************************************
             When(8193)
               Compute EXIT-USER-SEV = 0
 
      *****************************************************************
      *      Change severity of message 8235(E) to 8 (Error)
      *      to disallow Complex Occurs Depending On
      *        8235 = Complex Occurs Depending On
      *****************************************************************
             When(8235)
               Compute EXIT-USER-SEV = 08
 
      *****************************************************************
      *      Change severity of message 8270(O) to -1 (Suppress)
      *        8270 = SERVICE LABEL
      *****************************************************************
             When(8270)
               Compute EXIT-USER-SEV = -1
 
      *****************************************************************
      *      Message severity Not customized
      *****************************************************************
             When Other
      *        For the default set 'O' to 'S' case...
      *        If EXIT-USER-SEV = 12 Then
      *          Compute EXIT-RETURNCODE = 4
      *        Else
                 Compute EXIT-RETURNCODE = 0
      *        End-If
 
           End-Evaluate
           .
       END PROGRAM IGYMSGXT.