This SAMPLIB member is an example of a program that uses the CBRXLCS
macro interface.
SPLCS TITLE 'CBRSPLCS - SAMPLE INSTALLATION MANAGEMENT PACKAGE'
CBRSPLCS START 0 SAMPLE INSTALLATION MGMT PACKAGE
SPACE 2
**** START OF SPECIFICATIONS ******************************************
* *
* MODULE NAME: CBRSPLCS *
* *
* DESCRIPTIVE NAME: SAMPLE INSTALLATION MANAGEMENT PACKAGE FOR *
* AUTOMATED TAPE LIBRARIES *
* *
* FUNCTION: *
* MODULE CBRSPLCS IS PART OF THE SAMPLE INSTALLATION *
* MANAGEMENT PACKAGE FOR AUTOMATED TAPE LIBRARIES. IT HANDLES *
* REQUESTS ENTERED VIA AN INPUT TRANSACTION DATASET: *
* 1. EJECT A VOLUME FROM A LIBRARY *
* 2. CHANGE A VOLUME USE ATTRIBUTE TO SCRATCH *
* 3. CHANGE A VOLUME USE ATTRIBUTE TO PRIVATE *
* 4. INITIATE AN IMPORT OPERATION *
* 5. INITIATE AN EXPORT OPERATION *
* 6. PERFORM CARTRIDGE ENTRY INTO AN MTL (MCE) *
* *
* CBRSPLCS DEMONSTRATES THE USE OF THE FOLLOWING FUNCTIONS: *
* 1. THE "QUERY VOLUME RESIDENCE" FUNCTION OF CBRXLCS, USED *
* TO DETERMINE WHETHER A VOLUME RESIDES IN A LIBRARY. *
* 2. THE "CHANGE USE ATTRIBUTE" FUNCTION OF CBRXLCS, USED *
* TO CHANGE THE USE ATTRIBUTE OF A VOLUME TO SCRATCH OR *
* TO PRIVATE. *
* 3. THE "EJECT" FUNCTION OF CBRXLCS, USED TO EJECT A VOLUME *
* FROM A LIBRARY, USING EITHER THE CONVENIENCE OUTPUT *
* STATION OR THE HIGH CAPACITY OUTPUT STATION. *
* 4. THE ABILITY TO PASS 16 CHARACTERS OF INFORMATION TO *
* THE CHANGE USE ATTRIBUTE INSTALLATION EXIT AND TO THE *
* CARTRIDGE EJECT INSTALLATION EXIT. THE CHARACTER STRING *
* PASSED HERE CONTAINS AN AUTHORIZATION CODE, SO THAT THE *
* EXIT CAN DETERMINE THE SOURCE OF THE REQUEST. *
* 5. THE "IMPORT" FUNCTION OF CBRXLCS INITIATES AN IMPORT *
* OPERATION FOR A VOLUME OR VOLUMES INTO A LIBRARY OR *
* TO CANCEL AN IMPORT OPERATION THAT'S ALREADY IN *
* PROCESS. *
* 6. THE "EXPORT" FUNCTION OF CBRXLCS INITIATES AN EXPORT *
* OPERATION FOR A VOLUME OR VOLUMES FROM A LIBRARY OR *
* TO CANCEL AN EXPORT OPERATION THAT'S ALREADY IN *
* PROCESS. *
* 7. THE "MCE" FUNCTION ILLUSTRATES ENTERING A VOLUME *
* INTO AN MTL (MANUAL TAPE LIBRARY). *
* *
* *
* NOTES: *
* *
* CHARACTER CODE: EBCDIC *
* *
* RESTRICTIONS: NONE *
* *
* REGISTER CONVENTIONS: *
* R0 - STANDARD LINKAGE REGISTER *
* - REASON CODE REGISTER *
* - WORK REGISTER *
* R1 - STANDARD LINKAGE REGISTER *
* - WORK REGISTER *
* R2 - NOT USED *
* R3 - NOT USED *
* R4 - NOT USED *
* R5 - NOT USED *
* R6 - NOT USED *
* R7 - NOT USED *
* R8 - NOT USED *
* R9 - LINKAGE REGISTER TO INTERNAL SUBROUTINES *
* R10 - NOT USED *
* R11 - NOT USED *
* R12 - CBRSPLCS BASE REGISTER *
* R13 - STANDARD LINKAGE REGISTER *
* - SAVE AREA ADDRESS *
* R14 - STANDARD LINKAGE REGISTER *
* - RETURN POINT ADDRESS *
* - WORK REGISTER *
* R15 - STANDARD LINKAGE REGISTER *
* - ENTRY POINT ADDRESS *
* - RETURN CODE REGISTER *
* - WORK REGISTER *
* *
* MODULE TYPE: CONTROL SECTION *
* *
* PROCESSOR: ASSEMBLER H *
* *
* ATTRIBUTES: *
* *
* LOCATION: JOB PACK AREA *
* STATE: PROBLEM *
* AMODE: 24 *
* RMODE: 24 *
* KEY: 8 *
* MODE: TASK *
* SERIALIZATION: UNLOCKED *
* TYPE: SERIALLY REUSABLE *
* AUTHORIZATION: APF AUTHORIZED *
* *
* LINKAGE: STANDARD LINKAGE CONVENTIONS *
* *
* CALLING SEQUENCE: *
* CBRSPLCS IS INVOKED DIRECTLY FROM A JCL EXEC STATEMENT. *
* *
* INPUT: *
* INPUT TRANSACTIONS ARE CONTAINED IN DATASET INDD. EACH *
* TRANSACTION CONTAINS THE FOLLOWING INFORMATION: *
* 1. A TRANSACTION CODE, WHICH INDICATES THE REQUESTED *
* FUNCTION: EJECT, CHANGE THE USE ATTRIBUTE TO SCRATCH, *
* CHANGE THE USE ATTRIBUTE TO PRIVATE, IMPORT, *
* EXPORT, OR MCE *
* 2. A TRANSACTION MODIFIER, WHICH INDICATES WHETHER TO *
* VERIFY THAT THE VOLUME RESIDES IN A LIBRARY BEFORE *
* ATTEMPTING THE FUNCTION IN THE TRANSACTION CODE. NOTE *
* THAT CUA MAY BE PERFORMED ON A SHELF-RESIDENT VOLUME, *
* PROVIDED THAT THERE IS A TAPE VOLUME RECORD IN THE *
* TAPE CONFIGURATION DATA BASE, AND THEREFORE THAT THE *
* MODIFIER MAY BE USED TO PREVENT THIS. THE TRANSACTION *
* MODIFIER IS IGNORED FOR MCE PROCESSING. *
* 3. THE VOLUME SERIAL NUMBER. *
* 4. FOR A REQUEST TO CHANGE THE USE ATTRIBUTE TO PRIVATE, *
* THE STORAGE GROUP NAME. THIS MAY BE SUPPLIED AS *
* BLANKS. THE CUA INSTALLATION EXIT MAY THEN SUPPLY A *
* NON-BLANK VALUE OR LEAVE THE BLANK STORAGE GROUP NAME *
* UNCHANGED. *
* 5. FOR AN EJECT REQUEST, A CODE TO SELECT EITHER THE *
* CONVENIENCE OUTPUT STATION OR THE HIGH CAPACITY OUTPUT *
* STATION. *
* 6. FOR AN IMPORT REQUEST, A CODE TO INITIATE A CANCEL *
* TO TERMINATE THE IMPORT FUNCTION. *
* 7. FOR AN EXPORT REQUEST, A CODE TO INITIATE A CANCEL *
* TO TERMINATE THE EXPORT FUNCTION. *
* 8. FOR A MANUAL CARTRIDGE ENTRY REQUEST: *
* A. THE REQUIRED EIGHT CHARACTER LIBRARY NAME INTO *
* WHICH THE VOLUME IS TO BE ENTERED, LEFT-JUSTIFIED *
* IN THE FIELD AND PADDED ON THE RIGHT WITH *
* BLANKS. *
* B. A REQUIRED ONE CHARACTER SEPARATOR (BLANK) *
* C. AN OPTIONAL 1 CHARACTER MEDIA TYPE, SPECIFIED AS *
* 1 - F. *
* *
* OUTPUT: *
* A MESSAGE DESCRIBING THE RESULTS OF PROCESSING IS BUILT *
* FOLLOWING THE INPUT TRANSACTION. THE COMBINED TRANSACTION *
* AND MESSAGE ARE THEN WRITTEN TO DATASET OUTDD AND TO THE *
* TAPE POOL AND TAPE LIBRARY CONSOLE DESTINATIONS. *
* *
* EXIT NORMAL: *
* RETURN TO THE CALLER WITH RETURN CODE ZERO. *
* *
* EXIT ERROR: NONE *
* *
* EXTERNAL REFERENCES: *
* *
* ROUTINES: NONE *
* *
* CONTROL BLOCKS: NONE *
* *
* EXECUTABLE MACROS: *
* CBRXLCS *
* CLOSE *
* GET *
* OPEN *
* PUT *
* RETURN *
* SAVE *
* WTO *
* *
* MESSAGES: NONE *
* *
* ABEND CODES: NONE *
* *
**** END OF SPECIFICATIONS ********************************************
TITLE 'STANDARD REGISTER DEFINITIONS'
*---------------------------------------------------------------------*
* *
* STANDARD REGISTER DEFINITIONS *
* *
*---------------------------------------------------------------------*
R0 EQU 0 GENERAL REGISTER 0
R1 EQU 1 GENERAL REGISTER 1
R2 EQU 2 GENERAL REGISTER 2
R3 EQU 3 GENERAL REGISTER 3
R4 EQU 4 GENERAL REGISTER 4
R5 EQU 5 GENERAL REGISTER 5
R6 EQU 6 GENERAL REGISTER 6
R7 EQU 7 GENERAL REGISTER 7
R8 EQU 8 GENERAL REGISTER 8
R9 EQU 9 GENERAL REGISTER 9
R10 EQU 10 GENERAL REGISTER 10
R11 EQU 11 GENERAL REGISTER 11
R12 EQU 12 GENERAL REGISTER 12
R13 EQU 13 GENERAL REGISTER 13
R14 EQU 14 GENERAL REGISTER 14
R15 EQU 15 GENERAL REGISTER 15
TITLE 'CBRLCSPL - LCS EXTERNAL SERVICES PARAMETER LIST'
CBRLCSPL , LCS EXTERNAL SERVICES PARM LIST
TITLE 'CBRSPLCS - SAMPLE INSTALLATION MANAGEMENT PACKAGE'
*---------------------------------------------------------------------*
* *
* CBRSPLCS ENTRY POINT *
* *
*---------------------------------------------------------------------*
CBRSPLCS CSECT , SAMPLE INSTALLATION MGMT PACKAGE
CBRSPLCS AMODE 24
CBRSPLCS RMODE 24
SAVE (14,12),, SAVE CALLER'S REGISTERS AND +
'CBRSPLCS&SYSDATE MARK ENTRY POINT
LR R12,R15 COPY ENTRY POINT ADDRESS
USING CBRSPLCS,R12 CBRSPLCS BASE REGISTER
ST R13,SAVE+4 BACKWARD CHAIN SAVE AREAS
LA R0,SAVE CBRSPLCS SAVE AREA ADDRESS
ST R0,8(,R13) FORWARD CHAIN SAVE AREAS
LR R13,R0 SET CBRSPLCS SAVE AREA ADDRESS
SPACE 2
*---------------------------------------------------------------------*
* *
* OPEN BOTH DATA CONTROL BLOCKS *
* *
*---------------------------------------------------------------------*
OPEN (INDCB,(INPUT),OUTDCB,(OUTPUT)) OPEN BOTH DCBS
SPACE 2
*---------------------------------------------------------------------*
* *
* READ AND PROCESS THE INPUT TRANSACTION REQUEST DATASET *
* *
*---------------------------------------------------------------------*
CUA1000 DS 0H
GET INDCB,TRANSACT READ FIRST/NEXT TRANSACTION
EJECT ,
*---------------------------------------------------------------------*
* *
* VERIFY THAT THE VOLUME RESIDES IN A LIBRARY, IF REQUESTED *
* *
*---------------------------------------------------------------------*
CLI TRANCODE,TRANMCE MANUAL CARTRIDGE ENTRY?
BE CUA6000 YES, SKIP VERIFY
CLI TRANMOD,TRANVER VERIFY VOLUME IN LIBRARY?
BNE CUA2000 NO. GO CHECK REQUEST TYPE
BAL R9,CUACOPY COPY MODEL TO LCS PARAMETER LIST
CBRXLCS TYPE=TAPE, QUERY VOLUME RESIDENCE CALL +
FUNC=QVR, +
VOLUME=TRANVOL, +
MF=(E,LCSLIST)
LTR R15,R15 VOLUME IN LIBRARY?
BZ CUA2000 YES. GO CHECK REQUEST TYPE
C R15,=A(LCSWARN) WARNING RETURN CODE?
BNE CUA1100 NO. FORMAT ERROR MESSAGE
C R0,=A(LCSFNLRS) VOLUME NOT LIBRARY RESIDENT?
BNE CUA1100 NO. FORMAT ERROR MESSAGE
MVC TRANMSG,=CL45'NOT IN LIBRARY' SET TRANS RESPONSE
BAL R9,CUARESP WRITE TRANSACTION RESPONSE
B CUA1000 GET NEXT TRANSACTION
CUA1100 DS 0H
MVC ERRFUNC,=CL5'QVR' SET ERROR FUNCTION
BAL R9,CUACODES FORMAT RETURN AND REASON CODES
BAL R9,CUARESP WRITE TRANSACTION RESPONSE
B CUA1000 GET NEXT TRANSACTION
EJECT ,
*---------------------------------------------------------------------*
* *
* EJECT A VOLUME FROM ITS LIBRARY, IF REQUESTED *
* *
*---------------------------------------------------------------------*
CUA2000 DS 0H
CLI TRANCODE,TRANEJCT EJECT VOLUME FROM LIBRARY?
BNE CUA3000 NO. CHECK CHANGE USE ATTRIBUTE
BAL R9,CUACOPY COPY MODEL TO LCS PARAMETER LIST
CLI TRANDEST,TRANBULK BULK EJECT REQUEST?
BNE CUA2100 NO. ISSUE EJECT REQUEST
CBRXLCS BULKEJCT=YES, EJECT TO BULK OUTPUT STATION +
MF=(M,LCSLIST)
CUA2100 DS 0H
CBRXLCS TYPE=TAPE, EJECT VOLUME FROM LIBRARY +
FUNC=EJECT, +
VOLUME=TRANVOL, +
EXITINFO=PASSTHRU, +
MF=(E,LCSLIST)
LTR R15,R15 EJECT SUCCESSFULLY SCHEDULED?
BNZ CUA2200 NO. FORMAT ERROR MESSAGE
MVC TRANMSG,=CL45'EJECT SCHEDULED' SET TRANS RESPONSE
BAL R9,CUARESP WRITE TRANSACTION RESPONSE
B CUA1000 GET NEXT TRANSACTION
CUA2200 DS 0H
MVC ERRFUNC,=CL5'EJECT' SET ERROR FUNCTION
BAL R9,CUACODES FORMAT RETURN AND REASON CODES
BAL R9,CUARESP WRITE TRANSACTION RESPONSE
B CUA1000 GET NEXT TRANSACTION
EJECT ,
*---------------------------------------------------------------------*
* *
* CHANGE THE VOLUME USE ATTRIBUTE, IF REQUESTED *
* *
*---------------------------------------------------------------------*
CUA3000 DS 0H
CLI TRANCODE,TRANCHGP CHANGE USE ATTRIBUTE TO PRIVATE?
BNE CUA3100 NO. CHECK CHANGE TO SCRATCH
BAL R9,CUACOPY COPY MODEL TO LCS PARAMETER LIST
CBRXLCS USE=PRIVATE, CHANGE USE ATTRIBUTE TO PRIVATE +
GRPNAME=TRANSGRP, STORAGE GROUP NAME OR BLANKS +
MF=(M,LCSLIST)
B CUA3200 GO INVOKE LCS EXTERNAL SERVICES
CUA3100 DS 0H
CLI TRANCODE,TRANCHGS CHANGE USE ATTRIBUTE TO SCRATCH?
BNE CUA4000 NO. INVALID TRANSACTION CODE
BAL R9,CUACOPY COPY MODEL TO LCS PARAMETER LIST
CBRXLCS USE=SCRATCH, CHANGE USE ATTRIBUTE TO SCRATCH +
MF=(M,LCSLIST)
CUA3200 DS 0H
CBRXLCS TYPE=TAPE, CHANGE USE ATTRIBUTE CALL +
FUNC=CUA, +
VOLUME=TRANVOL, +
EXITINFO=PASSTHRU, +
MF=(E,LCSLIST)
LTR R15,R15 USE ATTRIBUTE CHANGED?
BNZ CUA3300 NO. FORMAT ERROR MESSAGE
MVC TRANMSG,=CL45'USE ATTRIBUTE CHANGED' SET TRANS RESPONSE
BAL R9,CUARESP WRITE TRANSACTION RESPONSE
B CUA1000 GET NEXT TRANSACTION
CUA3300 DS 0H
C R15,=A(LCSWARN) WARNING RETURN CODE?
BNE CUA3500 NO. FORMAT ERROR MESSAGE
C R0,=A(LCSWVAS) VOLUME ALREADY SCRATCH?
BE CUA3400 YES. FORMAT NOT CHANGED MESSAGE
C R0,=A(LCSWVAP) VOLUME ALREADY PRIVATE?
BNE CUA3500 NO. FORMAT ERROR MESSAGE
CUA3400 DS 0H
MVC TRANMSG,=CL45'USE ATTRIBUTE NOT CHANGED' SET TRANS RESP
BAL R9,CUARESP WRITE TRANSACTION RESPONSE
B CUA1000 GET NEXT TRANSACTION
CUA3500 DS 0H
MVC ERRFUNC,=CL5'CUA' SET ERROR FUNCTION
BAL R9,CUACODES FORMAT RETURN AND REASON CODES
BAL R9,CUARESP WRITE TRANSACTION RESPONSE
B CUA1000 GET NEXT TRANSACTION
EJECT ,
*---------------------------------------------------------------------*
* *
* IMPORT FUNCTION *
* *
*---------------------------------------------------------------------*
CUA4000 DS 0H
CLI TRANCODE,TRANIMP IMPORT VOL INTO A VTS LIBRARY
BNE CUA5000 NO. CHECK FOR EXPORT
BAL R9,CUACOPY COPY MODEL TO LCS PARM LIST
CLI TRANCOPT,TRANCAN CANCEL IMPORT REQUEST?
BNE CUA4100 IMPORT VOL INTO A VTS LIBRARY
CBRXLCS TYPE=TAPE, CANCEL IMPORT REQUEST +
FUNC=IMPORT, +
VOLUME=TRANVOL, +
CANCEL=YES, +
MF=(E,LCSLIST)
LTR R15,R15 IMPORT CANCEL SUCCESSFULLY?
BNZ CUA4200 NO. FORMAT ERROR MESSAGE
MVC TRANMSG,=CL45'IMPORT CANCELED' SET TRANS RESPONSE
BAL R9,CUARESP WRITE TRANSACTION RESPONSE
B CUA1000 GET NEXT TRANSACTION
CUA4100 DS 0H
CBRXLCS TYPE=TAPE, IMPORT VOLUME INTO A VTS LIBRARY +
FUNC=IMPORT, +
VOLUME=TRANVOL, +
MF=(E,LCSLIST)
LTR R15,R15 IMPORT SUCCESSFULLY?
BNZ CUA4200 NO. FORMAT ERROR MESSAGE
MVC TRANMSG,=CL45'IMPORT SCHEDULED' SET TRANS RESPONSE
BAL R9,CUARESP WRITE TRANSACTION RESPONSE
B CUA1000 GET NEXT TRANSACTION
CUA4200 DS 0H
MVC ERRFUNC,=CL5'IMP' SET ERROR FUNCTION
BAL R9,CUACODES FORMAT RETURN AND REASON CODES
BAL R9,CUARESP WRITE TRANSACTION RESPONSE
B CUA1000 GET NEXT TRANSACTION
EJECT ,
*---------------------------------------------------------------------*
* *
* EXPORT FUNCTION *
* *
*---------------------------------------------------------------------*
CUA5000 DS 0H
CLI TRANCODE,TRANEXP EXPORT VOLUME FROM LIBRARY?
BNE CUA6000 NO. CHECK FOR MCE
BAL R9,CUACOPY COPY MODEL TO LCS PARM LIST
CLI TRANCOPT,TRANCAN CANCEL EXPORT REQUEST
BNE CUA5100 EXPORT VOL FROM A VTS LIBRARY
CBRXLCS TYPE=TAPE, CANCEL EXPORT REQUEST +
FUNC=EXPORT, +
VOLUME=TRANVOL, +
CANCEL=YES, +
MF=(E,LCSLIST)
LTR R15,R15 EXPORT CANCEL SUCCESSFULLY?
BNZ CUA5200 NO. FORMAT ERROR MESSAGE
MVC TRANMSG,=CL45'EXPORT CANCELED' SET TRANS RESPONSE
BAL R9,CUARESP WRITE TRANSACTION RESPONSE
B CUA1000 GET NEXT TRANSACTION
CUA5100 DS 0H
CBRXLCS TYPE=TAPE, EXPORT VOLUME FROM A VTS LIBRARY +
FUNC=EXPORT, +
VOLUME=TRANVOL, +
MF=(E,LCSLIST)
LTR R15,R15 EXPORT SUCCESSFULLY?
BNZ CUA5200 NO. FORMAT ERROR MESSAGE
MVC TRANMSG,=CL45'EXPORT SCHEDULED' SET TRANS RESPONSE
BAL R9,CUARESP WRITE TRANSACTION RESPONSE
B CUA1000 GET NEXT TRANSACTION
CUA5200 DS 0H
MVC ERRFUNC,=CL5'EXP' SET ERROR FUNCTION
BAL R9,CUACODES FORMAT RETURN AND REASON CODES
BAL R9,CUARESP WRITE TRANSACTION RESPONSE
B CUA1000 GET NEXT TRANSACTION
EJECT ,
*---------------------------------------------------------------------*
* *
* MCE (MANUAL CARTRIDGE ENTRY) *
* *
* THIS ROUTINE WAS CREATED WITH THE MTL CHANGES *
*---------------------------------------------------------------------*
CUA6000 DS 0H
CLI TRANCODE,TRANMCE MANUAL CARTRIDGE ENTRY?
BNE CUA7000 NO, INVALID TRANSACTION CODE
BAL R9,GETVOLST GET STORAGE FOR VOLUMELIST
*
* *---------------------------------------------------*
* * INITIALIZE VOLUME LIST HEADER *
* *---------------------------------------------------*
L R2,MCEADDR ADDRESS OF LCSV FOR MCE
USING LCSV,R2 ADDRESSIBILITY TO LCSV
*
LA R8,LCSVEND+LCSMLEND CALC LEN OF HEADER & VOLIST
ST R8,LCSVBUF STORE INTO LCSV
*
LA R8,1 NUMBER OF VOLUMES IN LIST
ST R8,LCSVCNT STORE INTO LCSV
*
LA R8,LCSMLEND LEN OF SINGLE ENTRY VOLUME LST
ST R8,LCSVLEN STORE INTO LCSV
*
LA R8,LCSVEND(,R2) ADDR OF BEGINNING OF VOL LIST
ST R8,LCSVADDR STORE INTO LCSV
*
* *---------------------------------------------------*
* * INITIALIZE VOLUME LIST ITSELF *
* *---------------------------------------------------*
LR R3,R8 ADDRESS OF VOLUME LIST
USING LCSMLIST,R3 ADDRESSIBILITY TO LCSV
*
MVC LCSMVOL(6),TRANVOL VOLSER TO LIST
*
* *---------------------------------------------------*
* * PROCESS THE MEDIA TYPE *
* *---------------------------------------------------*
CLI TRANMEDT,X'40' MEDIA TYPE NOT SPECIFIED?
BE CUA6100 BR IF NOT SPEC'D, WILL DEFAULT
*
TM TRANMEDT,X'F0' IS HIGH NIBBLE ALL ONES?
BNO CUA6800 BR IF NO, CANT BE NUMERIC
*
MVC LCSMMED(1),TRANMEDT MOVE MEDIATYPE CHAR INTO VLIST
NI LCSMMED,X'0F' ZERO HIGH NIBBLE
*
CUA6100 EQU *
BAL R9,CUACOPY COPY MODEL TO LCS PARM LIST
*
CBRXLCS TYPE=TAPE, MCE REQUEST +
FUNC=MCE, MANUAL CARTRIDGE ENTRY +
LIBNAME=TRANLIBN, LIBRARY NAME PASSED TO US +
VOLLIST=(R2), PTR TO VOLUME HEADER & LIST +
MF=(E,LCSLIST)
*
DROP R2
DROP R3
*
LTR R15,R15 SUCCESSFUL ENTRY?
BNZ CUA6200 NO. FORMAT ERROR MESSAGE
*
MVC TRANMSG,=CL45'VOLUME SUCCESSFULLY ENTERED'
B CUA6900 COMPLETE PROCESSING
*
CUA6200 EQU *
C R15,=A(LCSWARN) WARNING RETURN CODE?
BNE CUA6500 NO. FORMAT ERROR MESSAGE
C R0,=A(LCSWSTMP) SCRATCH THRESHOLD MSG FAILURE?
BE CUA6300 YES, FORMAT MESSAGE
C R0,=A(LCSWSCNU) LIB SCRATCH COUNT NOT UPDATED
BNE CUA6500 NO. FORMAT ERROR MESSAGE
*
MVC TRANMSG,=CL45'LIBRARY SCRATCH COUNT NOT UPDATED'
B CUA6900 COMPLETE PROCESSING
*
CUA6300 EQU *
MVC TRANMSG,=CL45'SCRATCH THRESHOLD PROCESSING FAILURE'
B CUA6900 COMPLETE PROCESSING
*
CUA6500 EQU *
MVC ERRFUNC,=CL5'MCE' SET ERROR FUNCTION
BAL R9,CUACODES FORMAT RETURN AND REASON CODES
B CUA6900 COMPLETE PROCESSING
*
CUA6800 EQU *
MVC TRANMSG,=CL45'INVALID MEDIATYPE SPECIFIED'
*
CUA6900 EQU *
BAL R9,CUARESP WRITE TRANSACTION RESPONSE
BAL R9,RELVOLST RELEASE THE GOTTEN VOLUME LIST
B CUA1000 GET NEXT TRANSACTION
*
EJECT ,
*---------------------------------------------------------------------*
* *
* INVALID TRANSACTION CODE REQUESTED *
* *
*---------------------------------------------------------------------*
CUA7000 DS 0H
MVC TRANMSG,=CL45'INVALID TRANSACTION CODE' SET TRANS RESP
BAL R9,CUARESP WRITE TRANSACTION RESPONSE
B CUA1000 GET NEXT TRANSACTION
EJECT ,
*---------------------------------------------------------------------*
* *
* CLEAN UP AND RETURN TO THE CALLER *
* *
*---------------------------------------------------------------------*
EXIT DS 0H
CLOSE (INDCB,,OUTDCB) CLOSE BOTH DATA CONTROL BLOCKS
L R13,SAVE+4 RESTORE CALLER'S SAVE AREA ADDRESS
RETURN (14,12), RESTORE CALLER'S REGISTERS, THEN +
RC=0 RETURN TO CALLER
EJECT ,
*---------------------------------------------------------------------*
* *
* COPY THE MODEL LCS PARAMETER LIST TO THE ACTUAL LIST *
* *
*---------------------------------------------------------------------*
CUACOPY DS 0H
LA R0,LCSMODEL ADDRESS OF SOURCE
LA R1,LCSPLENG LENGTH OF SOURCE
LA R14,LCSLIST ADDRESS OF TARGET
LR R15,R1 LENGTH OF TARGET
MVCL R14,R0 COPY MODEL TO LCS PARAMETER LIST
BR R9 RETURN TO CALLER
EJECT ,
*---------------------------------------------------------------------*
* *
* FORMAT THE RETURN AND REASON CODES FOR PRINTING *
* *
*---------------------------------------------------------------------*
CUACODES DS 0H
CVD R15,PRETCODE CONVERT TO PACKED DECIMAL
UNPK ZRETCODE,PRETCODE CONVERT TO ZONED DECIMAL
OI ZRETCODE+3,X'F0' CORRECT FINAL ZONE
CVD R0,PRSNCODE CONVERT TO PACKED DECIMAL
UNPK ZRSNCODE,PRSNCODE CONVERT TO ZONED DECIMAL
OI ZRSNCODE+3,X'F0' CORRECT FINAL ZONE
MVC TRANMSG,RETREAS MOVE TEXT TO RESPONSE AREA
BR R9 RETURN TO CALLER
EJECT ,
*---------------------------------------------------------------------*
* *
* GET AND ZERO OUT THE VOLUME LIST FOR THE MCE CALL *
* *
*---------------------------------------------------------------------*
GETVOLST EQU *
LA R8,LCSVEND+LCSMLEND CALC AMOUNT OF STORAGE TO GET
*
STORAGE OBTAIN, INVOKE STORAGE MACRO +
LENGTH=(R8), AMOUNT TO GET +
ADDR=MCEADDR, VARIABLE FOR RETURNED ADDRESS +
COND=YES, CONDITIONAL SO DON'T ABEND +
RTCD=STGRTCD RETURN CODE VARIABLE
*
LTR R15,R15 VIRTUAL STORAGE ACQUIRED?
BNZ GETFAILD BR, IF STORAGE NOT ACQUIRED
*
LA R2,1(,R1) POINT 1 PAST BEGIN OF STORAGE
LR R3,R8 LENGTH TO CLEAR
BCTR R8,0 LENGTH - 1
LR R4,R1 POINT TO BEGINNING OF STORAGE
SR R5,R5 ZERO OUT
*
MVCL R2,R4 CLEAR THE AUTODATA AREA
*
BR R9 RETURN TO CALLER OF GETVOLST
*
GETFAILD EQU *
MVC TRANMSG,=CL45'OBTAIN FAILURE' SET TRANS RESPONSE
RELFAILD EQU *
BAL R9,STGCODES FORMAT RETURN AND REASON CODES
BAL R9,CUARESP WRITE TRANSACTION RESPONSE
B CUA1000 GET NEXT TRANSACTION
EJECT ,
*---------------------------------------------------------------------*
* *
* RELEASE THE VOLUME LIST FOR THE MCE CALL *
* *
*---------------------------------------------------------------------*
RELVOLST EQU *
*
L R2,MCEADDR ADDRESS OF LCSV
USING LCSV,R2 ADDRESSIBILITY TO LCSV
*
L R2,LCSVBUF LENGTH OF RELEASE
*
STORAGE RELEASE, INVOKE STORAGE MACRO +
LENGTH=(R2), AMOUNT TO RELEASE +
ADDR=MCEADDR, VARIABLE FOR RETURNED ADDRESS +
COND=YES, CONDITIONAL RELEASE +
RTCD=STGRTCD RETURN CODE VARIABLE
*
LTR R15,R15 VIRTUAL STORAGE ACQUIRED?
BZR R9 BR, IF STORAGE RELEASED
*
MVC TRANMSG,=CL45'RELEASE FAILURE' SET TRANS RESPONSE
B RELFAILD
*
DROP R2
EJECT ,
*---------------------------------------------------------------------*
* *
* FORMAT FAILED STORAGE RETURN AND REASON CODES FOR PRINTING *
* *
*---------------------------------------------------------------------*
STGCODES DS 0H
L R15,STGRTCD GET FAILING RETURN CODE
CVD R15,STGRCDEC CONVERT TO PACKED DECIMAL
UNPK ZRETCODE,STGRCDEC CONVERT TO ZONED DECIMAL
OI ZRETCODE+3,X'F0' CORRECT FINAL ZONE
CVD R0,PRSNCODE CONVERT TO PACKED DECIMAL
MVC TRANMSG,RETREAS MOVE TEXT TO RESPONSE AREA
BR R9 RETURN TO CALLER
EJECT ,
*---------------------------------------------------------------------*
* *
* WRITE THE TRANSACTION RESPONSE *
* *
*---------------------------------------------------------------------*
CUARESP DS 0H
PUT OUTDCB,TRANSACT WRITE TRANSACTION RESPONSE
WTO TEXT=TRANLEN, WRITE RESPONSE TO OPERATOR +
ROUTCDE=(3,5) SEND TO TAPE POOL, TAPE LIBRARY
BR R9 RETURN TO CALLER
TITLE 'CONSTANTS AND WORK AREAS'
*---------------------------------------------------------------------*
* *
* CONSTANTS AND WORK AREAS *
* *
*---------------------------------------------------------------------*
LTORG , LITERAL CONSTANTS
EJECT ,
*---------------------------------------------------------------------*
* *
* DATA CONTROL BLOCKS *
* *
*---------------------------------------------------------------------*
INDCB DCB DDNAME=INDD, INPUT: TRANSACTION REQUESTS +
DSORG=PS, +
MACRF=GM, +
EODAD=EXIT
EJECT ,
OUTDCB DCB DDNAME=OUTDD, OUTPUT: RESULT NOTIFICATION +
MACRF=PM, +
DSORG=PS, +
RECFM=FB, +
LRECL=80, +
BLKSIZE=400
EJECT ,
*---------------------------------------------------------------------*
* *
* CBRSPLCS TRANSACTION RECORD AND RESPONSE AREA *
* *
*---------------------------------------------------------------------*
TRANLEN DC AL2(L'TRANSACT) LENGTH FOR WTO TEXT
TRANSACT DS 0CL80 TRANSACTION RECORD
TRANCODE DS CL1 TRANSACTION CODE
TRANEJCT EQU C'E' EJECT VOLUME FROM LIBRARY
TRANCHGP EQU C'P' CHANGE VOLUME USE ATTRIBUTE TO
* PRIVATE
TRANCHGS EQU C'S' CHANGE VOLUME USE ATTRIBUTE TO
* SCRATCH
TRANIMP EQU C'I' IMPORT FUNCTION
TRANEXP EQU C'X' EXPORT FUNCTION
TRANMCE EQU C'M' MANUAL CARTRIDGE ENTRY
TRANMOD DS CL1 TRANSACTION CODE MODIFIER
TRANVER EQU C'V' VERIFY VOLUME RESIDES IN LIBRARY
* BEFORE EXECUTING REQUEST
DS CL1 SEPARATOR
TRANVOL DS CL6 VOLUME SERIAL NUMBER
DS CL1 SEPARATOR
TRANSPEC DS CL25 REQUEST-SPECIFIC AREA
ORG TRANSPEC VOLUME EJECT SECTION
TRANDEST DS CL1 EJECT DESTINATION
TRANCONV EQU C'C' CONVENIENCE OUTPUT STATION
TRANBULK EQU C'B' HIGH CAPACITY OUTPUT STATION
ORG TRANSPEC IMPORT/EXPORT SECTION
TRANCOPT DS CL1 CANCEL AREA
TRANCAN EQU C'C' CANCEL REQUEST
ORG TRANSPEC CHANGE USE ATTRIBUTE SECTION
TRANSGRP DS CL8 STORAGE GROUP NAME FOR CHANGE TO
* PRIVATE
ORG TRANSPEC MCE SECTION
TRANLIBN DS CL8 LIBRARY NAME INTO WHICH VOLUME
* IS TO BE ENTERED
DS CL1 SEPARATOR
TRANMEDT DS CL1 OPTIONAL MEDIA TYPE OF VOLUME
ORG , RESTORE LOCATION COUNTER
TRANMSG DS CL45 TRANSACTION COMPLETION MESSAGE
EJECT ,
*---------------------------------------------------------------------*
* *
* CBRXLCS PARAMETER LISTS *
* *
*---------------------------------------------------------------------*
CBRXLCS MF=(L,LCSLIST) LCS EXTERNAL SERVICES PARM LIST
SPACE 2
CBRXLCS MF=(L,LCSMODEL) LCS EXTERNAL SERVICES MODEL LIST
EJECT ,
*---------------------------------------------------------------------*
* *
* MISCELLANEOUS WORK AREAS *
* *
*---------------------------------------------------------------------*
SAVE DC 18F'0' STANDARD SAVE AREA
SPACE 2
PRETCODE DC D'0' CBRXLCS RETURN CODE - PACKED DEC
PRSNCODE DC D'0' CBRXLCS REASON CODE - PACKED DEC
SPACE 2
RETREAS DS 0CL45
ERRFUNC DC CL5' ' QVR, CUA, EJECT, IMP, EXP, OR MCE
DC CL15' RETURN CODE = '
ZRETCODE DC CL4' ' CBRXLCS RETURN CODE - ZONED DEC
DC CL16', REASON CODE = '
ZRSNCODE DC CL4' ' CBRXLCS REASON CODE - ZONED DEC
DC CL1'.'
SPACE 2
PASSTHRU DC CL16'SIMP' PASSTHRU VALUE FOR EJECT, CUA
SPACE 2
MCEADDR DC A(0) ADDR OF GOTTEN MCE STORAGE
STGRTCD DC F'0' RETURN CODE FOR STORAGE CALL
STGRCDEC DC D'0' PACKED DECIMAL STORAGE RC
SPACE 2
END CBRSPLCS
z/OS DFSMS OAM Planning, Installation, and Storage Administration Guide for Tape Libraries
Copyright IBM Corporation 1990, 2014