USRHDLR program (COBOL)

The following example shows the user-written condition handler registered by EXCOND to handle the divide-by-zero condition. When the divide-by-zero condition arises, USRHDLR calls CEEMRCR with a 0 type of move. Doing so moves the resume cursor to the point in EXCOND after the call to DIVZERO.

CBL LIB,QUOTE
      *Module/File Name: IGZTDIVU
      ******************************************************
      *                                                    *
      * USRHDLR                                            *
      *                                                    *
      ******************************************************
       IDENTIFICATION DIVISION.
       PROGRAM-ID. USRHDLR.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  MISC-VARIABLES.
           02  MOVE-TYPE-0     PIC S9(9) BINARY VALUE ZERO.
           02  MOVE-TYPE-1     PIC S9(9) BINARY VALUE 1.
       01  FEEDBACK.
           02  FB-SEVERITY     PIC 9(4)  BINARY.
           02  FB-DETAIL       PIC X(10).
      *
       LINKAGE SECTION.
      ******************************************************
      *                                                    *
      *  Note:  the symbolic names of the condition tokens *
      *  for S/370 program interrupt codes 0C1 thru 0CF    *
      *  are CEE341 through CEE34F                         *
      *                                                    *
      ******************************************************
       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  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  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.

           DISPLAY ">>> USRHDLR: Entered User Condition Handler ".
           IF CEE349 of CURRENT-CONDITION THEN
      **********************************************************
      *     Expected condition, divide by zero, occurred...    *
      *     move resume cursor to stack frame which registered *
      *     the handler, and resume execution at that point.   *
      **********************************************************
               CALL "CEEMRCR" USING MOVE-TYPE-0 FEEDBACK
               SET RESUME TO TRUE
               DISPLAY ">>> USRHDLR: Resuming execution"
           ELSE
      **********************************************************
      *        UNexpected condition encountered.. percolate it!*
      **********************************************************
               SET PERCOLATE TO TRUE
               DISPLAY ">>> USRHDLR: Percolating it"
           END-IF.

           GOBACK.
       END PROGRAM USRHDLR.