In the previous example, it is unlikely that an error would occur in the *PSSR and thereby cause a loop. However, depending on how the *PSSR is written, loops may occur if an exception occurs while processing the *PSSR.
One way to avoid such a loop is to set a first-time switch in the subroutine. If it is not the first time through the subroutine, you can specify an appropriate return point, such as *CANCL, for the Factor 2 entry of the ENDSR operation.
*=================================================================*
* NOLOOP: Show how to avoid recursion in a *PSSR subroutine. *
*=================================================================*
*-----------------------------------------------------------------*
* Array that will be used to cause an error *
*-----------------------------------------------------------------*
D Arr1 S 10A DIM(5)
*-----------------------------------------------------------------*
* Generate an array out of bounds error to pass control to *PSSR. *
*-----------------------------------------------------------------*
C Z-ADD -1 Neg1 5 0
C MOVE Arr1(Neg1) Arr1(Neg1)
C MOVE *ON *INLR
*=================================================================*
* *PSSR: Error Subroutine for the procedure. We use the *
* variable InPssr to detect recursion in the PSSR. *
* If we detect recursion, then we *CANCL the procedure. *
*=================================================================*
C *PSSR BEGSR
C IF InPssr = 1
C MOVE '*CANCL' ReturnPt 6
C Z-ADD 0 InPssr 1 0
C ELSE
C Z-ADD 1 InPssr
* *
* We now generate another error in the PSSR to see *
* how the subroutine cancels the procedure. *
* *
C MOVE Arr1(Neg1) Arr1(Neg1)
* *
* Note that the next two operations will not be *
* processed if Neg1 is still negative. *
* *
C MOVE '*GETIN' ReturnPt
C Z-ADD 0 InPssr
C ENDIF
C ENDSR ReturnPt
CRTBNDRPG PGM(MYLIB/NOLOOP) DBGVIEW(*SOURCE)
STRDBG PGM(MYLIB/NOLOOP)
Set a break point on the BEGSR line of the *PSSR subroutine so you can step through the *PSSR subroutine.
The approach used here to avoid looping can also be used within an INFSR error subroutine.