This program registers an ILE COBOL Error Handler. After the successful completion of the registration of the error handler, this, program creates a decimal data error. This exception causes the error handler to be called which then logs the software error.
This program calls the Report Software Error (QpdReportSoftwareError) API to perform FFDC, and uses pointers. The ILE program sets a pointer, as shown at (2) to point to the same location as in the OPM program at (1).
This example uses two programs: CBLERR2 program causes the error, and ERRHDL2 program shows how to report the software error using the QPDLOGER API.
PROCESS NOMONOPRC.
IDENTIFICATION DIVISION.
***************************************************************
***************************************************************
*
* Program: Register an ILE COBOL Error Handler
* Cause a decimal data exception to demonstrate
* logging of software errors
*
* Language: ILE COBOL
*
* Description: This program registers an ILE COBOL Error
* Handler. After the successful completion of
* the registration of the error handler, this ,
* program creates a decimal data error. This
* exception causes the error handler to be
* called which then logs the software error.
*
* APIs Used: QlnSetCobolErrorHandler
*
*
***************************************************************
*
***************************************************************
PROGRAM-ID. CBLERR2.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-AS400.
OBJECT-COMPUTER. IBM-AS400.
SPECIAL-NAMES.
LINKAGE TYPE PROCEDURE FOR "QlnSetCobolErrorHandler".
INPUT-OUTPUT SECTION.
FILE-CONTROL.
DATA DIVISION.
WORKING-STORAGE SECTION.
*
* Error Code parameter include. As this sample program
* uses COPY to include the error code structure, only the first
* 16 bytes of the error code structure are available. If the
* application program needs to access the variable length
* exception data for the error, the developer should physically
* copy the QSYSINC include and modify the copied include to
* define additional storage for the exception data.
*
COPY QUSEC OF QSYSINC-QCBLLESRC.
*
* Miscellaneous elements
*
01 MISC.
05 Y PIC S9(09) VALUE 0.
01 ERROR-HANDLER PROCEDURE-POINTER.
01 OLD-ERROR-HANDLER PROCEDURE-POINTER.
01 NUMERIC-GROUP.
05 X PIC 9(03).
*
* Beginning of mainline
*
PROCEDURE DIVISION.
MAIN-LINE.
*
* Register the COBOL Error Handler.
*
* Initialize the error code parameter. To signal exceptions to
* this program by the API, you need to set the bytes provided
* field of the error code to zero. Because this program has
* exceptions sent back through the error code parameter, it sets
* the bytes provided field to the number of bytes it gives the
* API for the parameter.
*
MOVE 16 TO BYTES-PROVIDED.
*
* Set ERROR-HANDLER procedure pointer to entry point of
* ERRHDL1 *PGM
*
SET ERROR-HANDLER TO ENTRY LINKAGE PROGRAM "ERRHDL2".
*
*
* Call the API to register the exit point.
*
CALL "QlnSetCobolErrorHandler" USING ERROR-HANDLER,
OLD-ERROR-HANDLER,
QUS-EC.
*
* If an exception occurs, the API returns the exception in the
* error code parameter. The bytes available field is set to
* zero if no exception occurs and greater than zero if an
* exception does occur.
*
IF BYTES-AVAILABLE > 0
DISPLAY "Error setting handler",
STOP RUN.
*
* If the call to register an error handler is successful, then
* cause a the data decimal error (X is initialized to blanks).
*
ADD X TO Y.
*
* Should not get here due to data decimal error
*
STOP RUN.
*
* End of MAINLINE
*
PROCESS NOMONOPRC.
IDENTIFICATION DIVISION.
***************************************************************
***************************************************************
*
* Program: Log a software error
*
* Language: ILE COBOL
*
* Description: This program receives control for exceptions
* within a COBOL run unit. This program is used
* in conjunction with CBLERR2. ,
* Any exception causes this error handler to be
* called which then logs the software error.
*
* APIs Used: QpdReportSoftwareError
*
***************************************************************
*
***************************************************************
PROGRAM-ID. ERRHDL2.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-AS400.
OBJECT-COMPUTER. IBM-AS400.
SPECIAL-NAMES.
LINKAGE TYPE PROCEDURE FOR "QpdReportSoftwareError".
INPUT-OUTPUT SECTION.
FILE-CONTROL.
DATA DIVISION.
WORKING-STORAGE SECTION.
*
* Error Code parameter include. As this sample program
* uses COPY to include the error code structure, only the first
* 16 bytes of the error code structure are available. If the
* application program needs to access the variable length
* exception data for the error, the developer should physically
* copy the QSYSINC include and modify the copied include to
* define additional storage for the exception data.
*
COPY QUSEC OF QSYSINC-QCBLLESRC.
*
* QpdReportSoftwareError include
*
COPY QPDSRVPG OF QSYSINC-QCBLLESRC.
*
* Miscellaneous elements
*
01 MISC.
05 NBR-OF-RECORDS PIC S9(09) BINARY VALUE 0.
05 MSG-KEYWORD PIC X(03) VALUE "MSG".
01 PROBLEM-RECORDS.
05 PROBLEM-POINTER POINTER OCCURS 100 TIMES.
LINKAGE SECTION.
01 CBL-EXCEPTION-ID PIC X(07).
01 VALID-RESPONSES PIC X(06).
01 PGM-IN-ERROR.
05 PGM-NAME PIC X(10).
05 LIB-NAME PIC X(10).
01 SYS-EXCEPTION-ID PIC X(07).
01 MESSAGE-TEXT PIC X(01).
01 MESSAGE-LENGTH PIC S9(09) BINARY.
01 SYS-OPTION PIC X(01).
01 ERR-MODULE-NAME PIC X(10).
01 CBL-PGM-NAME PIC X(256).
*
* Beginning of mainline
*
PROCEDURE DIVISION USING CBL-EXCEPTION-ID,
VALID-RESPONSES,
PGM-IN-ERROR,
SYS-EXCEPTION-ID,
MESSAGE-LENGTH,
SYS-OPTION,
MESSAGE-TEXT,
ERR-MODULE-NAME,
CBL-PGM-NAME.
MAIN-LINE.
*
* Initialize the error code parameter. To signal exceptions to
* this program by the API, you need to set the bytes provided
* field of the error code to zero. Because this program has
* exceptions sent back through the error code parameter, it sets
* the bytes provided field to the number of bytes it gives the
* API for the parameter.
*
MOVE 16 TO BYTES-PROVIDED.
*
* Record the COBOL Program and Library names
*
MOVE 101 TO KEY-FIELD OF QPD-SUSPECTED-PROGRAM.
MOVE 10 TO PROGRAM-NAME-LENGTH OF QPD-SUSPECTED-PROGRAM.
MOVE 10 TO LIBRARY-NAME-LENGTH OF QPD-SUSPECTED-PROGRAM.
SET PROGRAM-NAME OF QPD-SUSPECTED-PROGRAM (2)
TO ADDRESS OF PGM-NAME OF PGM-IN-ERROR.
SET LIBRARY-NAME OF QPD-SUSPECTED-PROGRAM
TO ADDRESS OF LIB-NAME OF PGM-IN-ERROR.
ADD 1 TO NBR-OF-RECORDS.
SET PROBLEM-POINTER (NBR-OF-RECORDS) TO
ADDRESS OF QPD-SUSPECTED-PROGRAM.
*
* Record the message id
*
MOVE 200 TO KEY-FIELD OF QPD-SYMPTOM.
MOVE 3 TO KEYWORD-LENGTH OF QPD-SYMPTOM.
MOVE 7 TO DATA-LENGTH OF QPD-SYMPTOM.
MOVE "C" TO DATA-TYPE OF QPD-SYMPTOM.
SET KEYWORD OF QPD-SYMPTOM TO ADDRESS OF MSG-KEYWORD.
SET DATA-FIELD OF QPD-SYMPTOM TO ADDRESS OF SYS-EXCEPTION-ID.
ADD 1 TO NBR-OF-RECORDS.
SET PROBLEM-POINTER (NBR-OF-RECORDS) TO
ADDRESS OF QPD-SYMPTOM.
*
* For illustration purposes, dump the program object
*
MOVE 302 TO KEY-FIELD OF QPD-NAMED-SYSTEM-OBJECT.
MOVE PGM-NAME OF PGM-IN-ERROR
TO OBJECT-NAME OF QPD-NAMED-SYSTEM-OBJECT.
MOVE LIB-NAME OF PGM-IN-ERROR
TO OBJECT-LIBRARY OF QPD-NAMED-SYSTEM-OBJECT.
MOVE "*PGM" TO OBJECT-TYPE OF QPD-NAMED-SYSTEM-OBJECT.
ADD 1 TO NBR-OF-RECORDS.
SET PROBLEM-POINTER (NBR-OF-RECORDS) TO
ADDRESS OF QPD-NAMED-SYSTEM-OBJECT.
*
* Call the API to log the software error.
*
CALL "QpdReportSoftwareError" USING PROBLEM-RECORDS,
NBR-OF-RECORDS,
QUS-EC.
*
* If an exception occurs, the API returns the exception in the
* error code parameter. The bytes available field is set to
* zero if no exception occurs and greater than zero if an
* exception does occur.
*
IF BYTES-AVAILABLE > 0 DISPLAY "Cannot log error".
*
* End the current run unit
*
MOVE "C" TO SYS-OPTION.
STOP RUN.
*
* End of MAINLINE
*