This program performs a divide-by-0 operation to cause an exception. This exception is caught using RPGs *PSSR support, and the exception is then logged as a 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).
F********************************************************************
F*
F* Program: Demonstrate use of ILE-based Report Software Error
F*
F* Language: ILE RPG
F*
F* Description: This program performs a divide-by-0 operation to
F* cause an exception. This exception is caught using
F* RPGs *PSSR support, and the exception is then logged
F* as a software error.
F*
F* APIs used: QpdReportSoftwareError
F*
F********************************************************************
D*
D* Include Error Code Parameter
D*
D/COPY QSYSINC/QRPGLESRC,QUSEC
D*
D* Include API structures and constants
D*
D/COPY QSYSINC/QRPGLESRC,QPDSRVPG
D*
D* Array of problem record description pointers and index to array
D*
Dpdr S * dim(20)
Dx S 5B 0 INZ(1)
D*
D* Misc. data elements
D*
Dfactor1 S 5B 0 INZ(10)
Dfactor2 S 5B 0 INZ(0)
Dresult S 5B 0
Drc S 2 INZ('RC')
D*
D* Program status data structure
D*
DPSDS SDS
D pgm_name 1 10
D status 11 15 0
D src_line 21 28
D exception 40 46
D lib_name 81 90
C*
C* Attempt to divide by 0
C*
C factor1 div factor2 result
C*
C* Should not get here due to divide-by-0 exception
C*
C move '1' *INLR
C return
C*
C* Program exception subroutine:
C*
C *PSSR BEGSR
C*
C* Make sure we are not catching an exception due to the *PSSR
C* subroutine itself
C*
C switch ifeq ' '
C move '1' switch 1
C*
C* Set API error code to work in nonexception mode
C*
C eval qusbprv = %size(qusec)
C*
C* Record the suspected program and library name
C*
C eval qpdk01 = 101
C eval qpdpgmnl = %SIZE(pgm_name)
C eval qpdlibnl = %SIZE(lib_name)
C eval qpdpgmn = %ADDR(pgm_name) (2)
C eval qpdlibn = %ADDR(lib_name)
C*
C* and record the key:
C*
C eval pdr(x) = %addr(qpdspgm)
C eval x = x + 1
C*
C* Record the failing source statement number
C*
C eval qpdk07 = 200
C eval qpdkl = %SIZE(rc)
C eval qpddl = %SIZE(src_line)
C eval qpddt = 'C'
C eval qpdk08 = %ADDR(rc)
C eval qpdd = %ADDR(src_line)
C*
C* and record the key:
C*
C eval pdr(x) = %addr(qpds)
C eval x = x + 1
C*
C* Record the status code as data
C*
C eval qpdk11 = 301
C eval qpddl00 = %SIZE(status)
C eval qpddi = 1
C eval qpdd00 = %ADDR(status)
C*
C* and record the key:
C*
C eval pdr(x) = %addr(qpds)
C eval x = x + 1
C*
C* For illustration purposes, dump the program object
C*
C eval qpdk12 = 302
C eval qpdobjn = pgm_name
C eval qpdobjlib = lib_name
C eval qpdobjt = '*PGM'
C*
C* and record the key:
C*
C eval pdr(x) = %addr(qpdnsot)
C eval x = x + 1
C*
C* Call the Report Software Error API
C*
C callb qpdrse
C parm pdr
C parm x
C parm qusec
C*
C* If an error on the API call, then indicate a terminal error
C*
C qusbavl ifgt 0
C 'Terminal err'dsply
C end
C else
C*
C* If error within *PSSR, then indicate *PSSR error
C*
C '*PSSR error' dsply
C end
C*
C* No matter how the program got to the *PSSR, end the program
C*
C move '1' *inlr
C return
C endsr