Handling a divide-by-zero condition in a COBOL program

The following routine illustrates how a COBOL program can handle a divide-by-zero condition if one occurs. occur. These actions occur:

  1. The program enables the divide-by-zero exception. Exceptions can be enabled or disabled by calling the CEE3SPM (Query and Modify Language Environment Hardware Condition Enablement) callable service.
  2. The program registers a user-written condition handler that recognizes the divide-by-zero condition.
  3. The program then performs a divide-by-zero, which causes the user-written condition handler to get control.
  4. The handler calls CEE3GRN (Get Name of Routine that Incurred Condition), to return the name of the routine that the condition occurred in.
  5. The handler inserts the routine name and condition token into a user-defined message string, and calls CEEMOUT (Dispatch a Message) to send the message to the Language Environment message file.

    (The Language Environment message file is a file that you can specify to store messages from a given routine or application, or from all routines that run under Language Environment.)

  6. The program uses CEEHDLR to register the user-written condition handler.
       CBL LIB,QUOTE,NODYNAM
      *Module/File Name: IGZTSIGR
      *************************************************
      **                                              *
      ** IGZTSIGR -  Call the following Language      *
      **             Environment services:            *
      **                                              *
      **    : CEEHDLR - register user condition       *
      **                handler                       *
      **    : CEE3GRN - get name of routine that      *
      **                incurred the condition.       *
      **    : CEEMOUT - output message associated     *
      **                with the condition, including *
      **                the name of the routine that  *
      **                incurred the condition.       *
      **                                              *
      **  1. Our example registers user condition     *
      **     handler IGZTSIGH.                        *
      **  2. Our program then divides by zero, which  *
      **     causes a hardware exception condition.   *
      **  3. IGZTSIGH gets control and prints out a   *
      **     message that includes the name of the    *
      **     routine that incurred the divide-by-zero *
      **     condition, IGZTSIGR.                     *
      **  4. IGZTSIGH requests that Condition         *
      **     management resume execution after the    *
      **     point at which the condition occurred.   *
      **  5. IGZTSIGR terminates normally.            *
      **                                              *
      *************************************************

       IDENTIFICATION DIVISION.
       PROGRAM-ID.    IGZTSIGR.

       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  DIVISOR         PIC S9(9) BINARY.
       01  QUOTIENT        PIC S9(9) BINARY.
      **
      **  Declares for condition handling
      **
       01   PGMPTR     USAGE IS PROCEDURE-POINTER.
       01   FBCODE.
           02  Condition-Token-Value.
           COPY  CEEIGZCT.
               03  Case-1-Condition-ID.
                   04  Severity    PIC S9(4) BINARY.
                   04  Msg-No      PIC S9(4) BINARY.
               03  Case-2-Condition-ID
                       REDEFINES Case-1-Condition-ID.
                   04  Class-Code  PIC S9(4) BINARY.
                   04  Cause-Code  PIC S9(4) BINARY.
               03  Case-Sev-Ctl    PIC X.
               03  Facility-ID     PIC XXX.
           02  I-S-Info            PIC S9(9) BINARY.
       77   TOKEN      PIC X(4).       PROCEDURE DIVISION.
       0001-BEGIN-PROCESSING.
           DISPLAY "*********************************".
           DISPLAY "IGZTSIGR COBOL Example is        ".
           DISPLAY "         now in motion.          ".
           DISPLAY "*********************************".
      ** **********************************************
      **  Register user condition handler IGZTSIGH   **
      **           using CEEHDLR                     **
      ** **********************************************
           SET PGMPTR TO ENTRY "IGZTSIGH".
           MOVE 97 TO TOKEN.
           CALL "CEEHDLR" USING PGMPTR, TOKEN, FBCODE.
           IF ( NOT CEE000 of FBCODE ) THEN
               DISPLAY "Error " Msg-No of FBCODE
                  " registering condition handler "
                  " IGZTSIGH" UPON CONSOLE
               STOP RUN
           END-IF.
      *************************************************
      ** Divide by zero to cause a hardware exception**
      ** condition.  Condition handler IGZTSIGH gets **
      ** control and CALLs CEE3GRN to obtain the     **
      ** name of the routine in which the condition  **
      ** was raised.                                 **
      ** IGZTSIGH then prints a message using CEEMOUT**
      ** and passing the name "LEASMSIG."  Control   **
      ** returns and normal termination takes place. **
      ** **********************************************
           MOVE 0 TO DIVISOR.
           DIVIDE  5 BY DIVISOR GIVING QUOTIENT.
           DISPLAY "*********************************".
           DISPLAY "IGZTSIGR COBOL Example has ended.".
           DISPLAY "*********************************".
           GOBACK.
       End program IGZTSIGR .
CBL LIB,QUOTE,NODYNAM
      ************************************************
      **                                            **
      ** IGZTSIGH - Call the following Language     **
      **            Environment services:           **
      **                                            **
      **    : CEE3GRN - Get name of routine that    **
      **                incurred a condition.       **
      **    : CEEMOUT - output a user message       **
      **                                            **
      **  This is the user condition handler        **
      **  registered by IGZTSIGR.  It calls CEE3GRN **
      **  to retrieve the name of the routine that  **
      **  incurred the divide-by-zero condition. It **
      **  then calls CEEMOUT to output the message. **
      **
      ************************************************
       IDENTIFICATION DIVISION.
       PROGRAM-ID. IGZTSIGH.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  msgstr.
           02  VarStr-length       PIC S9(4) BINARY.
           02  VarStr-text.
               03  VarStr-char         PIC X,
                           OCCURS 0 TO 256 TIMES
                           DEPENDING ON VarStr-length
                              OF msgstr.       01  Feedback.
           02  Condition-Token-Value.
           COPY  CEEIGZCT.
               03  Case-1-Condition-ID.
                   04  Severity    PIC S9(4) BINARY.
                   04  Msg-No      PIC S9(4) BINARY.
               03  Case-2-Condition-ID
                         REDEFINES Case-1-Condition-ID.
                   04  Class-Code  PIC S9(4) BINARY.
                   04  Cause-Code  PIC S9(4) BINARY.
               03  Case-Sev-Ctl    PIC X.
               03  Facility-ID     PIC XXX.
           02  I-S-Info            PIC S9(9) BINARY.
       77  rtn-name        PIC X(80).
       77  msgdest         PIC S9(9) BINARY.
       77  string-pointer  PIC S9(4) BINARY.
      *
       LINKAGE SECTION.
       01  Current-condition.
           02  Condition-Token-Value.
           COPY  CEEIGZCT.
               03  Case-1-Condition-ID.
                   04  Severity    PIC S9(4) BINARY.
                   04  Msg-No      PIC S9(4) BINARY.
               03  Case-2-Condition-ID
                         REDEFINES Case-1-Condition-ID.
                   04  Class-Code  PIC S9(4) BINARY.
                   04  Cause-Code  PIC S9(4) BINARY.
               03  Case-Sev-Ctl    PIC X.
               03  Facility-ID     PIC XXX.
           02  I-S-Info            PIC S9(9) BINARY.
      **
       01  Token           PIC X(4).
      **
       01  Result-code     PIC S9(9) BINARY.
           88 resume           VALUE +10.
           88 percolate        VALUE +20.
           88 perc-sf          VALUE +21.
           88 promote          VALUE +30.
           88 promote-sf       VALUE +31.
       01  New-condition.
           02  Condition-Token-Value.
           COPY  CEEIGZCT.
               03  Case-1-Condition-ID.
                   04  Severity    PIC S9(4) BINARY.
                   04  Msg-No      PIC S9(4) BINARY.
               03  Case-2-Condition-ID
                         REDEFINES Case-1-Condition-ID.
                   04  Class-Code  PIC S9(4) BINARY.
                   04  Cause-Code  PIC S9(4) BINARY.
               03  Case-Sev-Ctl    PIC X.
               03  Facility-ID     PIC XXX.
           02  I-S-Info            PIC S9(9) BINARY.
       PROCEDURE DIVISION USING current-condition,
                                token, result-code,
                                new-condition.
      *************************************************
      *    Check to see whether this routine was      *
      *    entered due to a divide-by-zero exception, *
      *    or due to some other condition.            *
      *************************************************
           IF CEE349 OF current-condition THEN
      *************************************************
      *      (A divide-by-zero condition has occurred)*
      *************************************************
               SET resume TO TRUE
      *************************************************
      **   Call CEE3GRN to retrieve the name of the  **
      **   program that incurred the divide-by-zero  **
      **   exception. Build user message and include **
      **   the name of the program.                  **
      *************************************************
               CALL "CEE3GRN" USING rtn-name, feedback
               IF ( NOT CEE000 OF feedback ) THEN
                   DISPLAY "Error " Msg-No OF feedback
                       " in obtaining program name."
                       UPON CONSOLE
                   MOVE feedback TO new-condition
                   SET promote TO TRUE
               ELSE
                   MOVE 1 TO string-pointer
                   MOVE 255 TO VarStr-length OF msgstr
                   STRING "The example program "
                          rtn-name
                          " incurred a divide-by-zero"
                          " exception."
                       DELIMITED BY "  "
                       INTO VarStr-text OF msgstr
                       POINTER string-pointer
                   SUBTRACT 1 FROM string-pointer,
                       GIVING VarStr-length OF msgstr
                   MOVE 2 TO msgdest
      *************************************************
      **     Call CEEMOUT to output the user message.**
      *************************************************
                   CALL "CEEMOUT" USING msgstr,msgdest,
                                        feedback
                   IF ( NOT CEE000 OF feedback ) THEN
                       DISPLAY "Error in writing the "
                               "message string."
                       MOVE feedback TO new-condition
                       SET promote TO TRUE
                   END-IF
               END-IF
           ELSE
      *************************************************
      *        (A condition other than               **
      *         divide-by-zero has occurred)         **
      *************************************************
               SET percolate TO TRUE
           END-IF

           GOBACK.

       END PROGRAM IGZTSIGH.