** CBL.CTL(SSCHK)   *** L=003 --- 2016/03/04 15:48:24 (L05)
*
*  Routines to execute XRST/SYMCHKP.
*  SSCHKEQU equates are a pre-requisite.
*


==XRST==    * Extended restart - (Normal start if chkpid is blank).
*
* Restores the user workarea following a checkpoint restart. i.e. If
* the Checkpoint ID is not blank and exists in the recovery log.
*
  if     pos chkpf  ones  chk_call_on      * If XRST already called.
    then pos chkpf  and   chk_xrst_off     * Switch of restart flag.
    then goto XRST_end                     * Execute routine once only.
    else pos chkpf    =   x'00' stopaft=1  * Initialise flag byte.

* Initialise ASMTDLI (IMS DB Assembler interface) parameters...
  pos chkvb     =  'XRST'        * chkvb     --> Function name (XRST).
  pos chknp     = x'0000,0006'   * chknp     --> #input parms.  BIN(4)
                                 * parm-2    --> I/O DB PCB
                                 * chkid_L   --> Chkp ID len.   BIN(4)
                                 * chkid     --> Checkpoint ID.
                                 * uxlrecl-8 --> Work Area len. BIN(4)
                                 * 1         --> Work Area.

  call asmtdli  chknp  chkvb  parm-2  chkid_L chkid   uxlrecl-8  1

  pos        chkpf   or   chk_call_on  * ON  => XRST called.

  if pos chkid, chkid+chkid_L-1 = ' '  fill=' '   * If not a restart.
    then pos chkpf  and   chk_xrst_off * OFF => normal start.
    else pos chkpf   or   chk_xrst_on  * ON  => restart.

 =XRST_end=
  return





==SYMCHKP==           * Symbolic Checkpoint.
*
* Symbolic checkpoint to save an area of storage. i.e. The user work
* area buffer  defined by OPT WORKLEN= at the start of this program.
*
* Initialise ASMTDLI (IMS DB Assembler interface) parameters...
  pos chkvb     =  'CHKP'        * chkvb     --> Function name (XRST).
  pos chknp     = x'0000,0006'   * chknp     --> #input parms. BIN(4)
                                 * parm-2    --> I/O DB PCB
                                 * chkid_L   --> Chkp ID len.  BIN(4)

  if pos chkpf  zeros  chk_xrst_on          * If a normal start.
   then pos chkid =  'SELC    '  stopaft=1  * Initialise Chkp ID pfix.
   then pos chkno = x'0000,0000' stopaft=1  * Initialise Chkp number.

  add  1  to  chkno_L at chkno type=b       * Increment  Chkp number.
  cvbc        chkno_L at chkno   to   chkid+4 fmt=9999
                                            * Append to ID in char fmt.

                                 * chkid     --> Checkpoint ID.
                                 * uxlrecl-8 --> Work Area len. BIN(4)
                                 * 1         --> Work Area.

  call asmtdli  chknp  chkvb  parm-2  chkid_L chkid   uxlrecl-8  1

 *SYMCHKP_end*
  return