Using the AR/CTL Status Check utility — AR/CTL Tasks
The AR/CTL Status Check utility consists of a module (program ARCACTIV or program AESUVBCS), which can be called from the application program address space, and an accompanying control block ($ARCACTU).
The module tests whether AR/CTL is active in the address space. If AR/CTL is not active in the address space, the module can return a specified return code or can issue an abnormal termination with a specified abend completion code and reason code. The module also returns the subsystem ID of the BCSS that the application program is using; you can use this BCSS ID as input to the AR/CTL Status Check utility (program ARCACTIV or program AESUVBCS).
Member $ARCACTU of the AR/CTL sample library contains a sample $ARCACTU DSECT that you can include in your program. The control block contains fields that you can set for the error return code or for the error abend completion code and the error abend reason code. The control block also contains fields for the return code and the BCSS ID; your program can check these fields after program ARCACTIV or program AESUVBCS sets their values.
The following figure shows the calling sequence for program ARCACTIV in the COBOL language statement.
Calling sequence for COBOL program ARCACTIV
01 ARCACTU-PARMS.
02 ACTU PIC X(8) VALUE '$ARCACTU'.
02 ACTU-COMPLETION PIC X(4) VALUE X'00000000'.
02 ACTU-REASON PIC X(4) VALUE X'00000000'.
02 ACTU-ERROR PIC X(4) VALUE X'00000000'.
02 ACTU-RESERVED-I PIC X(112) VALUE LOW-VALUES.
02 ACTU-RETURN PIC X(4) VALUE X'00000000'.
02 ACTU-BCS-SSID PIC X(4) VALUE SPACES.
02 ACTU-RESERVED-O PIC X(116) VALUE LOW-VALUES.
PROCEDURE DIVISION.
MOVE X'00000010' TO ACTU-ERROR.
CALL 'ARCACTIV' USING ARCACTU-PARMS.
The following figure shows the calling sequence for program ARCACTIV in the PL/1 language statement.
Calling sequence for PL/1 program ARCACTIV
2 ACTU CHAR(8) INIT('$ARCACTU'),
2 ACTU_COMPLETION BIN FIXED(31) INIT(0),
2 ACTU_REASON BIN FIXED(31) INIT(0),
2 ACTU_ERROR BIN FIXED(31) INIT(16),
2 ACTU_RESERVED_I CHAR(112),
2 ACTU_RETURN BIN FIXED(31) INIT(0),
2 ACTU_BCS_SSID CHAR(4) INIT(' '),
2 ACTU_RESERVED_O CHAR(116);
ACTU_RESERVED_I = LOW(112);
ACTU_RESERVED_O = LOW(116);
CALL ARCACTIV(ARCACTU) ;
The following figure shows the calling sequence for program ARCACTIV in the Assembler language statement.
Calling sequence for Assembler program ARCACTIV
LA R1,$ARCACTU_LEN(0,0) * LOAD LENGTH $ARCACTU
LA R14,=CL8'$ARCACTU' * LOAD A(IDENTIFIER VALUE)
LA R15,8(0,0) * LOAD LENGTH IDENTIFIER VALUE
MVCL R0,R14 * INITIALIZE $ARCACTU
*
LA R1,$ARCACTU * LOAD A($ARCACTU)
USING $ARCACTU,R1 * ADDRESSABILITY $ARCACTU
LA R0,16(0,0) * LOAD ERROR RETURN CODE
ST R0,ACTU_ERROR * SAVE ERROR RETURN CODE
DROP R1 * ADDRESSABILITY $ARCACTU
*
LOAD EP=ARCACTIV * LOAD ARCACTIV
LR R15,R0 * LOAD A(ARCACTIV)
LA R0,$ARCACTU * LOAD A($ARCACTU)
ST R0,@$ARCACTU * SAVE A(A($ARCACTU))
LA R1,@$ARCACTU * LOAD A(A($ARCACTU))
BASR R14,R15 * CALL ARCACTIV
LR R2,R15 * SAVE ARCACTIV RETURN CODE
*
DELETE EP=ARCACTIV * DELETE ARCACTIV
*
LTR R2,R2 * AR/CTL ACTIVE?
BNZ ARC_NOT_ACTIVE * NO -- ERROR
.
.
.
$ARCACTU SECTION=$ARCACTU,PREFIX=ACTU