This program performs a divide by 0 operation to cause an exception. This exception is caught using RPG's *PSSR support, and the exception is then logged as a software error.
Refer to Example in ILE C: Logging software error (OPM API without pointers) for the original example.
F********************************************************************
F*
F* Program: Demonstrate use of OPM based Log 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* RPG's *PSSR support, and the exception is then
F* logged as a software error.
F*
F* APIs used: QPDLOGER
F*
F********************************************************************
D*
D* Include Error Code Parameter
D*
D/COPY QSYSINC/QRPGLESRC,QUSEC
D*
D* Misc. data elements
D*
Dfactor1 S 5B 0 INZ(10)
Dfactor2 S 5B 0 INZ(0)
Dresult S 5B 0
Dline_nbr S 9B 0
Ddata DS 4096
Ddatapt DS
D data_off 9B 0
D data_len 9B 0
Ddata# S 9B 0
Dobjl DS 2590
Dobjl# S 9B 0
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 non-exception mode
C*
C eval qusbprv = %size(qusec)
C*
C* Record line number where error happened
C*
C move src_line line_nbr
C*
C* Record the status code as data
C*
C movel status data
C*
C* Record where status located in data
C*
C eval data_off = 1
C eval data_len = 5
C eval data# = 1
C*
C* For illustration purposes, dump the program object
C*
C eval %SUBST(objl:1:30) = pgm_name (1)
C eval %SUBST(objl:31:30) = lib_name
C eval %SUBST(objl:61:10) = '*PGM'
C eval objl# = 1
C*
C* Call the Report Software Error API
C*
C call 'QPDLOGER'
C parm pgm_name
C parm exception msgid 12
C parm msgkey 4
C parm line_nbr
C parm 'Y' joblog 1
C parm data
C parm datapt
C parm data#
C parm objl
C parm objl#
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