Problem:
How can the error procedure find out which RTS error number it is currently processing so that it knows whether or not to call fault finder?
Resolution:
When the error procedure is called a RTS error message is passed to it as a parameter. You could parse this parameter to look for the exact RTS error that occurred:
Parameter Passed to the Error Procedure
When an installed error procedure is called, the characters containing the relevant RTS error message is passed as a parameter.
You should define this parameter in the Linkage Section as PIC X(325), and include it in the USING phrase of the entry to the error procedure. An example of the RTS error message string follows:
Load Error : file 'prog-name'\n
error code: 173, pc=0, call=-1, seg=0\n
173 Called program file not found in drive/directory\n
where \n is a new-line character and is a null (x"00") terminator. This format is described in your Error Messages.
Example:
The following is an example of installing an error procedure, and the skeleton of the error procedure that is called if an error occurs.
working-storage section.
01 install-flag pic x comp-x value 0.
01 install-address usage procedure-pointer.
01 status-code pic 9(4) comp value zeros.
local-storage section.
linkage section.
01 err-msg pic x(325).
procedure division.
set install-address to entry "err-proc".
call "CBL_ERROR_PROC"
using install-flag
install-address
returning status-code.
* Error procedure:
entry "err-proc" using err-msg.
* Process err-msg to find out the error number.
* Act accordingly.
...
* Terminate, but allow other error procedures to be executed.
move 1 to return-code
exit program
stop run.