Subprocedures and error routines

Error routines can call CLIST subprocedures, and subprocedures can issue the RETURN statement to return control to the error routine. The error routine itself must issue RETURN to return control to the statement after the one in error. For example, the following error routine calls a subprocedure:

ERROR + 
 DO
  SET &ECODE = 8
  SELECT
  WHEN (&FOOTPRINT=2) SYSCALL ABC ECODE
⋮
  END                 /* End of SELECT
  RETURN              /* return control to CLIST
 END                  /* End of error routine
⋮
ABC: PROC 1 CODEPARM  /* subroutine ABC
SYSREF &CODEPARM      /* refer variable back to caller's &ECODE
free f(indata)        /* free data sets
free f(outdata)
SET &CODEPARM = 12    /* set error code
RETURN                /* return control to error routine
END                   /* end of subroutine ABC

Subprocedures can contain error routines. However, error routines in subprocedures cannot contain nested attention or error routines.

The COPYDATA CLIST

 
/*****************************************************************/
/* THE COPYDATA CLIST COPIES RECORDS FROM A DATA SET INTO AN     */
/* OUTPUT DATA SET. IT IS EQUIPPED TO HANDLE ERRORS CAUSED BY    */
/* END-OF-FILE, ALLOCATION ERRORS, AND ERRORS CAUSED BY OTHER    */
/* STATEMENTS AND COMMANDS IN THE CLIST.                         */
/*****************************************************************/

CONTROL NOFLUSH END(ENDO) /* Protect the stack from being flushed
/* so that when error is caused by end-of-file, CLIST can continue
ERROR + 
 DO
  SET RCODE=&LASTCC /* Save return code
  /* If end-of-file, branch to CLOSFILE statements
  SELECT
  WHEN (&RCODE=400) + 
   DO                    /* IF End-of-file is reached,           */
    SET EOFFLAG = YES    /* Set flag and return to the           */
    RETURN               /* I/O procedure.                       */
   ENDO
  /* If error occurred before allocation, set exit code to 4
  WHEN (&FOOTPRINT=0) SET ECODE=4
  /* If allocation of file OUTDS failed, free file INDATA and set
  /* exit code to 8
  WHEN (&FOOTPRINT=1) + 
   DO
    free f(indata) da(text.data)
    SET ECODE=8
   ENDO
  /* If the error was not caused by end-of-file or allocation error,
  /* free both files and set exit code to 12.  In this case, error was
  /* caused by one of the file I/O statements
  WHEN (&FOOTPRINT=2) + 
   DO
    free f(indata) da(text.data)
    free f(outds)
    SET ECODE=12
   ENDO
  ENDO /* End of SELECT statement
  EXIT CODE(&ECODE) /* For all errors except end-of-file condition,
  /* exit the CLIST with the appropriate exit code
 ENDO /* End of error routine
SET FOOTPRINT=0  /* Identify pre-allocation errors
⋮
SET FOOTPRINT=1 /* Identify allocation error for file INDATA
alloc f(indata) da(d15rbo1.text.data) shr reu /* Allocate input data set
SET FOOTPRINT=2  /* Identify allocation error for file OUTDS
alloc f(outds) sysout(a) /* Allocate output data set
OPENFILE INDATA /* Open input data set
OPENFILE OUTDS OUTPUT  /* Open output data set
/* Copy records from input data set to output data set           */
 DO WHILE &EOFFLAG ¬= YES /* Do the following until EOF is reached*/
 GETFILE INDATA /* Read input record
 IF &EOFFLAG ¬= YES THEN + 
  DO
   SET OUTDS=&INDATA /* Set output record to value of input record
   PUTFILE OUTDS /* Write output record to output data set
  ENDO
ENDO
EOF: CLOSFILE INDATA /* Close input data set
CLOSFILE OUTDS /* Close output data set
ERROR /* From this point on, display statement that causes error
/* along with any error messages
⋮