PROC ST$$DOC;
# TITLE ST$$DOC - DOCUMENTATION FOR FILE STAGING. #
BEGIN # ST$$DOC #
#
*
*
* S T A G I N G O V E R V I E W
*
* A USER MAKES A PERMANENT FILE MANAGER (*PFM*) REQUEST TO *ATTACH*
* OR *GET* A PERMANENT FILE. *PFM* DETECTS THAT THE FILE DOES NOT
* EXIST ON DISK AND NEEDS TO BE STAGED TO DISK FROM THE M860.
* *PFM* BUILDS A STAGING (*TDAM*) REQUEST WHICH TOGETHER WITH THE
* M860 CATALOGS (*SFMCAT* FILES) PROVIDES ALL THE INFORMATION
* NEEDED BY THE *SSEXEC* TO LOCATE THE DATA FOR THE FILE ON THE
* M860 CARTRIDGE(S) AND STAGE THIS DATA BACK TO DISK.
*
* *PFM* MAKES A SYSTEM MONITOR REQUEST TO TRANSFER THIS *TDAM*
* ENTRY TO *SSEXEC* WHERE IT IS STORED AT LOCATION *RA$TDAM* IN THE
* FIELD LENGTH OF *SSEXEC*.
*
* ON A MASTER MAINFRAME, THE STAGING *TDAM* REQUEST IS MOVED FROM
* *RA$TDAM* TO A QUEUE CALLED THE REAL TIME REQUEST QUEUE (*RTRQ*).
* ITS STAYS IN THIS QUEUE UNTIL IT CAN BE SCHEDULED FOR STAGING AT
* WHICH TIME IT IS PLACED INTO AN *HLRQ* ENTRY. WHEN THE FILE IS
* STAGED, A SYSTEM EVENT IS POSTED WHICH WILL RESTART ANY JOB
* WAITING FOR THIS FILE SO THE ORIGINAL *ATTACH* OR *GET* REQUEST
* CAN BE SATISFIED.
*
* ON A SLAVE MAINFRAME, THE STAGING *TDAM* REQUEST IS WRITTEN TO A
* FILE (IN *ECS*) USED TO COMMUNICATE *TDAM* REQUESTS FROM THE
* SLAVE MAINFRAME TO THE MASTER MAINFRAME. *SSEXEC* ON THE MASTER
* MAINFRAME PERIODICALLY EXAMINES THIS COMMUNICATION FILE. WHEN IT
* SEES A NEW STAGING REQUEST, IT ADDS IT TO THE *RTRQ*. WHEN THE
* FILE HAS BEEN STAGED, A RESPONSE TO THE STAGE REQUEST IS WRITTEN
* ON A COMPANION COMMUNICATION FILE USED TO SEND INFORMATION FROM
* THE MASTER TO THE SLAVE MAINFRAME. UPON RECEIPT OF THE RESPONSE,
* THE SLAVE MAINFRAME ISSUES A SYSTEM EVENT TO RESTART ANY JOBS
* WAITING FOR THE FILE TO BE STAGED.
#
CONTROL EJECT;
#
* R O U T I N E S U S E D T O S T A G E F I L E S
*
* F O R M A S T E R M A I N F R A M E J O B S
*
* 1) MAINLOOP/NEWWORK WHEN *MAINLP* SENSES A *TDAM* REQUEST IN
* *RA$TDAM*, IT CALLS *TRYTDAM* TO PUT THE *TDAM* ENTRY INTO THE
* *RTRQ*. *MAINLP* ALSO SENSES *TDAM* ENTRIES IN THE *RTRQ* AND
* WHEN APPROPRIATE, CALLS *NEWWORK* TO CALL *TDAM$RP* TO PROCESS
* THESE *TDAM* REQUESTS. FOR STAGING *TDAM* REQUESTS, THIS
* CONSISTS OF BUILDING AN *HLRQ* ENTRY FOR THE FILE TO BE STAGED.
*
* 2) TRYTDAM CALLS *ENTDAM* TO ADD THE STAGING REQUEST TO THE
* *RTRQ*. IT SETS A BIT IN THE *TDAM* REQUEST TO INDICATE THAT THE
* REQUEST CAME FROM A JOB ON THE MASTER MAINFRAME. IT ALSO CLEARS
* *RA$TDAM* SO THE NEXT *TDAM* REQUEST CAN BE SUBMITTED.
*
* 3) ENTDAM SEARCHES THE *RTRQ* AND ACTIVE *HLRQ* CHAINS TO SEE
* IF A DUPLICATE OF THIS REQUEST ALREADY EXISTS. IF ITS NOT A
* DUPLICATE AND AN *RTRQ* ENTRY IS AVAILABLE, THE *TDAM* ENTRY IS
* ADDED TO THE *RTRQ*.
*
* 4) TDAM$RP IS CALLED BY *NEWWORK* TO SCHEDULE A FILE TO BE
* STAGED. *TDAM$RP* WILL NOT SCHEDULE A FILE TO BE STAGED WHEN ITS
* CARTRIDGE IS IN USE, OR IF THE STORAGE MODULE TO BE USED HAS NO
* AVAILABLE TRANSPORTS ON WHICH THE CARTRIDGE CAN BE MOUNTED. IF A
* FILE IS BEING DESTAGED TO THE SAME CARTRIDGE, THE *DOSTG* FLAG
* IS SET IN THE *HLRQ* ENTRY SO THE *HLRQ* CAN BE PREEMPTED FROM
* DESTAGING AND USED TO STAGE THIS FILE BEFORE THE CARTRIDGE IS
* UNLOADED. *TDAM$RP* ALSO BUILDS A MASK IN *STG$MSK* TO CONTROL
* THE NEXT TIME IT IS TO BE CALLED. SEE ADDITIONAL DOCUMENTATION
* FOR THIS IN *TDAM$RP* AND *COMXMSC*.
*
* 5) STAGER ACTUALLY CONTROLS THE STAGING OF THE FILE. IT USES
* THE *ASA* VALUE FROM THE FILE'S *TDAM* ENTRY TO LOCATE THE
* INITIAL PORTION OF THE FILE DATA (VOLUME) ON AN M860 CARTRIDGE.
* IT USES LINKAGE INFORMATION IN THE *SFMCAT* FILE TO IDENTIFY
* OTHER VOLUMES CONTAINING THE REMAINING PORTIONS OF THE FILE DATA.
* IT CALLS *HLLOAD* TO LOAD THE CARTRIDGE AND *HLCPYCD* TO COPY THE
* DATA FROM THE CARTRIDGE TO DISK. WHEN THE LAST VOLUME HAS BEEN
* COPIED, *STAGER* CALLS *PFM* TO UPDATE THE *PFC* ENTRY FOR THE
* FILE TO LINK TO THE DISK IMAGE. FINALLY, *STAGER* CALLS *PFM* TO
* POST A SYSTEM EVENT INDICATING THAT THE FILE HAS BEEN STAGED SO
* ANY JOBS WAITING FOR THIS FILE CAN BE RESTARTED. *STAGER* THEN
* CALLS *STNTDAM* TO GET A *TDAM* ENTRY FOR ANOTHER FILE WHICH CAN
* BE RETRIEVED FROM THE CURRENTLY AVAILABLE CARTRIDGE.
*
* 6) STNTDAM SCANS THE *RTRQ* TO LOCATE A FILE WHICH CAN BE
* STAGED FROM THE CURRENTLY LOADED CARTRDIGE. IF SEVERAL SUCH
* FILES ARE FOUND, IT WILL SELECT THE ONE CLOSEST TO THE BEGINNING
* OF THE CARTRIDGE. IF NONE IS FOUND, THE *HLRQ* ENTRY IS RELEASED
* AND THE NEXT FILE TO BE STAGED WILL BE SELECTED BY *TDAM$RP*.
#
CONTROL EJECT;
#
* M U L T I M A I N F R A M E R O U T I N E S
*
* 7) SLAVERP/SLVRBP *SLAVERP* IS PERIODICALLY CALLED BY BOTH THE
* MAINLOOP AND THE IDLE ROUTINE (*DOZER*) OF *SSEXEC* TO READ THE
* SLAVE TO MASTER COMMUNICATION FILE(S) AND RECOGNIZE ANY NEW
* STAGING *TDAM* REQUESTS. IF *SLAVERP* IS CALLED BY *DOZER* IT
* CLEARS A FLAG WHICH CAUSES CONTROL TO BE RETURNED TO THE
* MAINLOOP. IF CALLED BY THE MAINLOOP WHEN A NEW REQUEST IS FOUND,
* IT CALLS *SLVRBP* WHICH CALLS *SLVTDAM* WHICH CALLS *ENTDAM* TO
* ADD THE REQUEST TO THE *RTRQ*.
*
* 8) SLVTDAM CALLS *ENTDAM* TO ADD THE REQUEST TO THE *RTRQ*.
* IF THIS REQUEST CAN NOT BE ACCEPTED BECAUSE THE *RTRQ* IS FULL, A
* FLAG IS SET WHICH ENSURES THAT THIS REQUEST WILL BE THE FIRST
* ACCEPTED *TDAM* REQUEST FROM ANY OF THE SLAVE MAINFRAMES.
*
* 9) TELLSLV IS CALLED BY *STAGER* WHEN A FILE IS STAGED IF A
* SLAVE MAINFRAME ISSUED A *TDAM* REQUEST TO STAGE THE FILE. IT
* WRITES A RESPONSE TO THE COMMUNICATION FILE USED TO SEND REPLIES
* FROM THE MASTER TO THE SLAVE MAINFRAME.
#
CONTROL EJECT;
#
* S T A G I N G P R O C E S S I N G F L O W
*
* ( D E T A I L E D )
*
* THE PROCEDURE *STAGER* USES THE FOLLOWING STEPS AS IT STAGES A
* FILE FROM A CARTRIDGE TO DISK. THIS SEQUENCE OF STEPS WILL BE
* REFERENCED IN THE FOLLOWING DISCUSSION OF STAGING ERROR
* PROCESSING.
*
* 1) IT CALLS *PFM* WITH AN *ASIGNPF* REQUEST TO ENSURE THAT A
* DIRECT ACCESS FILE IS STAGED TO A DISK (RESPECTING THE SECONDARY
* DEVICE MASKS) WHICH HAS ENOUGH SPACE TO HOLD THE ENTIRE FILE.
*
* 2) IT CALLS *ACQ$FCT* TO READ THE *FCT* ENTRY FOR THE FIRST
* CARTRIDGE TO MEMORY AND THEN CALLS *HLLOAD* TO LOAD THE CARTRIDGE
* SO DATA CAN BE READ FROM IT.
*
* 3) IT THEN PREPARES TO COPY DATA FROM THE FIRST (NEXT) VOLUME TO
* DISK.
*
* 4) IT THEN CALLS *HLCPYCD* TO COPY DATA FROM THE FIRST (NEXT)
* VOLUME FROM THE CARTRIDGE TO DISK.
*
* 5) STEPS 2-4 ARE REPEATED AS NECESSARY UNTIL THE ENTIRE FILE IS
* COPIED TO DISK.
*
* 6) *PFM* IS THEN CALLED TO BIND THE DISK IMAGE TO THE FILE'S
* *PFC* ENTRY.
*
* 7) *PFM* IS CALLED TO CLEAR THE *ASA* VALUE IN THE FILE'S *PFC*
* ENTRY IF APPROPRIATE.
*
* 8) PROCEDURE *EESET* IS THEN CALLED IF A JOB ON THE MASTER
* MAINFRAME WANTED THIS FILE TO BE STAGED. PROCEDURE *TELLSLV* IS
* CALLED IF A JOB ON A SLAVE MAINFRAME WANTED THIS FILE TO BE
* STAGED.
#
CONTROL EJECT;
#
* S T A G I N G E R R O R P R O C E S S I N G
*
*
* TWO TYPES OF ERRORS CAN BE ENCOUNTERED WHILE TRYING TO STAGE A
* FILE TO DISK (RESOLVED AND UNRESOLVED). RESOLVED ERRORS ARE
* DEFINED TO BE THOSE WHICH PRESENT A DEFINITIVE STATUS BACK TO THE
* JOB ATTEMPTING TO ACCESS THE FILE WHICH WAS TO BE STAGED. AN
* EXAMPLE OF A RESOLVED ERROR IS AN UNRECOVERABLE READ ERROR WHICH
* IS REPORTED TO A JOB AS A PERMANENT ERROR. ANOTHER EXAMPLE
* WOULD BE WHEN THE USER PURGED THE FILE AS IT WAS BEING STAGED.
* *STAGER* WOULD NOT BE ABLE TO BIND THE DATA TO THE (NON-EXISTING)
* *PFC* ENTRY AND WOULD REPORT THIS AS AN ERROR. THE USER WOULD
* NOT BE IN DOUBT ABOUT THE STATUS OF THE STAGE SINCE THE FILE
* WOULD NO LONGER EXIST. AN EXAMPLE OF AN UNRESOLVED ERROR IS WHEN
* A CARTRIDGE IS LOST OR THE PATH TO THE HARDWARE IS DOWN SO THAT
* THE STAGE OF THE FILE CAN NOT BE ATTEMPTED. IN THESE EXAMPLES,
* THE STAGING SOFTWARE CAN NOT DECLARE A PERMANENT ERROR BECAUSE
* THE ERROR CONDITION MAY BE RESOLVED. HOWEVER, THE USER WILL BE
* WAITING FOR THE FILE TO BE STAGED WITHOUT RECEIVING A STATUS OF
* THE PROBLEM FROM THE SOFTWARE. ALSO, THE *SSEXEC* WILL
* CONTINUALLY BE REQUESTED TO STAGE THE FILE BECAUSE *PFM* REISSUES
* THE STAGING *TDAM* REQUEST EVERY FEW SECONDS. CONSEQUENTLY, FOR
* UNRESOLVED ERRORS, THE OPERATOR WILL BE REQUESTED TO INTERVENE
* AND PASS A STATUS BACK TO THE REQUESTING JOB TO RESOLVE THIS
* STALEMATE.
#
CONTROL EJECT;
#
* THE FOLLOWING ERRORS CAN OCCUR IN EACH OF THE STEPS USED TO STAGE
* A FILE. THE NUMBER OF EACH PARAGRAPH CORRESPONDS TO THE NUMBER OF
* THE PARAGRAPH IN THE PRECEEDING SECTION ON STAGING PROCESSING
* FLOW.
*
* 1) THE *ASIGNPF* REQUEST CAN REPORT THAT NO DISK HAS ENOUGH
* SPACE FOR THE SPECIFIED DIRECT ACCESS FILE. THIS IS AN
* UNRESOLVED ERROR. THE OPERATOR WILL BE EXPECTED TO TAKE SOME
* ACTION TO FREE DISK SPACE.
*
* 2) ACQ$*FCT* ERRORS: SEVERAL ERROR STATUS REPLIES ARE POSSIBLE
* WHEN CALLING *ACQ$FCT* TO READ THE *FCT* ENTRY TO MEMORY. IF THE
* SUBFAMILY CATALOG CANNOT BE FOUND, AN UNRESOLVABLE ERROR IS
* DECLARED. THIS COULD OCCUR IF A REMOVABLE FAMILY WAS MOUNTED
* AFTER THE *SSEXEC* WAS INITIALIZED. THE RESOLUTION IS FOR THE
* OPERATOR TO RESTART *SSEXEC*. IF THE STORAGE MODULE OR *FCT*
* ENTRY CANNOT BE LOCATED IN THE SUBFAMILY CATALOG, A PERMANENT
* ERROR IS DECLARED WITH THE APPROPRIATE ERROR BIT SET IN THE
* FILE'S *PFC* ENTRY. THIS COULD OCCUR IF THE FILE'S *PFC* ENTRY
* HAD BEEN RELOADED FROM AN OBSOLETE DUMP TAPE. OPERATOR ACTION IS
* ALSO REQUIRED TO RECOVER FROM AN READ/WRITE ERROR WHICH OCCURS
* WHEN ACCESSING A SUBFAMILY CATALOG.
*
* CARTRIDGE LOAD ERRORS: UNRESOLVED LOAD ERRORS INCLUDE HAVING
* THE HARDWARE DOWN SO THE STORAGE MODULE CAN NOT BE ACCESSED AND
* THE CARTRIDGE BEING LOST ( NOT LOCATED IN ITS ASSIGNED CUBICLE).
* IF A LABEL CHECK ERROR OCCURS WITH THE CARTRIDGE, A PERMANENT
* ERROR IS DECLARED FOR THE FILE WHICH WAS TO BE STAGED.
*
* 3) IF *STAGER* DETERMINES THAT THE ALLOCATION UNITS OF THE NEXT
* VOLUME TO BE STAGED ARE INVALID, IT DECLARES A PERMANENT ERROR.
* IF *STAGER* OR *SSVAL* HAVE DETECTED NON-FATAL ERRORS WITH THE AU
* OF THE VOLUME TO BE STAGED, AN INTERNAL FLAG IS SET WHICH WILL
* CAUSE THE *ASA* VALUE IN THE FILE'S *PFC* ENTRY TO BE CLEARED
* UPON SUCCESSFUL COMPLETION OF THE STAGE. THIS PREVENTS THE DISK
* SPACE FROM BEING RELEASED WITHOUT FIRST MAKING A CLEAN COPY OF
* THE FILE VIA ANOTHER DESTAGE.
#
CONTROL EJECT;
#
* 4) THE FOLLOWING UNRESOLVED ERRORS CAN OCCUR WHILE COPYING A
* VOLUME OF DATA TO DISK - DISK WRITE ERROR, DISK FULL, HARDWARE
* DOWN. IF AN UNRECOVERABLE READ ERROR IS DETECTED, THE STAGER
* WILL RESTAGE THE FILE, FIRST UNLOADING THE CARTRIDGE SO IT WILL
* HOPEFULLY BE RELOADED ON THE OTHER DATA RECORDING DEVICE. IF TWO
* UNRECOVERABLE READ ERRORS ARE DETECTED, A PERMANENT ERROR STATUS
* IS RECORDED IN THE FILE'S *PFC* ENTRY. ANOTHER TYPE OF PERMANENT
* ERROR WILL BE REPORTED IF THE SYSTEM LINKAGE INFORMATION RECORDED
* ON EACH VOLUME DOES NOT AGREE WITH WHAT IS EXPECTED. THIS
* INFORMATION CONSISTS OF THE FILE'S USER INDEX, THE CREATION DATE
* AND TIME, AND THE IDENTITY OF PREVIOUS VOLUME (CARTRIDGE, VOLUME
* AND VOLUME LENGTH).
*
* 5) SEE STEPS 2-4 FOR ANY ERROR CONDITIONS.
*
* 6) A REQUEST TO RESTORE THE FILE'S DISK IMAGE CAN FAIL, BUT
* THESE ERRORS ARE CONSIDERED TO BE RESOLVED SINCE THEY SHOULD ONLY
* OCCUR IF THE USER DID SOMETHING TO THE FILE (PURGE OR REPLACE THE
* DATA FOR AN INDIRECT ACCESS FILE).
*
* 7) AS IN STEP 6, A USER ACTION COULD CAUSE A RESOLVED ERROR TO
* OCCUR WHILE *STAGER* IS CALLING *PFM* TO CLEAR THE FILE'S *ASA*
* VALUE.
*
* 8) NO ERRORS CAN OCCUR IN THIS STEP.
#
END # ST$$DOC #
TERM
PROC STAGER((HLRQADR));
# TITLE STAGER - STAGE A FILE FROM CARTRIDGE TO DISK. #
BEGIN # STAGER #
#
** STAGER - STAGE A FILE.
*
* *STAGER* COPIES A FILE FROM THE M860 TO DISK. UPON COMPLETION OF
* THE STAGE THE DISK ADDRESS OF THE LOCAL FILE IS ENTERED INTO
* THE *PFC* ENTRY TO BIND THE DISK IMAGE TO THE ENTRY.
* PERFORMANCE (TRACE) MESSAGES ARE WRITTEN TO THE ACCOUNT
* DAYFILE IF EXEC IS IN TRACE MODE.
*
* PROC STAGER((HLRQADR))
*
* ENTRY (HLRQADR) - ADDRESS OF THE *HLRQ* ENTRY CONTAINING THE
* STAGE REQUEST.
* THE PROCESS STATE FIELD IN THE *HLRQ* ENTRY IS SET TO
* INDICATE THE NEXT PROCESSING ACTION.
*
* EXIT THE PROCESS STATE FIELD IN THE *HLRQ* ENTRY HAS BEEN
* ADVANCED TO INDICATE WHERE PROCESSING OF THIS REQUEST
* LEFT OFF, AND THUS WHAT TO DO NEXT TO ADVANCE THE
* REQUEST. UPON COMPLETION (SUCCESSFUL OR
* OTHERWISE) OF A FILE STAGE, THE PROCEDURE
* *NEXTSTG* IS CALLED TO OBTAIN THE *TDAM*
* ENTRY FOR THE NEXT FILE TO BE STAGED.
* THE OBJECTIVE IS TO FIND ANOTHER FILE ON THE
* SAME CARTRIDGE TO REDUCE CARTRIDGE ACCESSES
* AND IMPROVE STAGING PERFORMANCE. WHEN NO MORE
* FILES REMAIN TO BE STAGED, *STAGER* IS CALLED
* ONE MORE TIME TO UNLOAD THE LAST USED CARTRIDGE.
* AT THAT TIME, THE PROCESS STATE IS SET TO COMPLETE.
*
* MESSAGES * EXEC ABNORMAL, STAGER.*
*
#
ITEM HLRQADR U; # *HLRQ* ENTRY ADDRESS #
#
**** PROC STAGER - XREF LIST BEGIN.
#
XREF
BEGIN
PROC ABORT; # ABORT #
PROC ACQ$FCT; # ACQUIRE AN *FCT* ENTRY #
PROC ADD$LNK; # ADD ENTRY TO CHAIN #
PROC ASIGNPF; # ASSIGN PERMANENT FILE SPACE #
PROC CFLUSH; # FLUSH MSF CATALOG BUFFER #
PROC CKPFETC; # CHECK *PFM* FET COMPLETION #
PROC CRDAST; # READ MSF CATALOG *AST* #
PROC CWTAST; # WRITE MSF CATALOG *AST* #
PROC DELAY; # TIMED DELAY #
PROC EESET; # SET EVENT TABLE #
PROC HLCPYCD; # CHECK COPY RETURN CODES #
PROC HLLOAD; # CHECK LOAD RETURN CODES #
PROC HLLDSET; # MOVE *HLRQ* INTO *LLRQ* #
PROC UPUSAGE; # UPDATE CART. USAGE DATA #
PROC MESSAGE; # ISSUE MESSAGE #
PROC MSGAFDF; # ISSUE ACCOUNT-DAYFILE MESSAGE #
PROC RECALL; # RELEASE CPU FOR A MOMENT #
PROC REQWEST; # REQUEST EQUIPMENT ASSIGNMENT #
PROC RETERN; # RETURN A FILE #
PROC RLS$FCT; # RELEASE AN *FCT* ENTRY #
PROC SETAF; # SET ALTERNATE STORAGE FLAG #
PROC SETDA; # SET DISK ADDRESS #
PROC STERCAT; # STAGE ERROR PROCESSOR #
PROC STERPFM; # STAGE ERROR PROCESSOR #
PROC STNTDAM; # GET NEXT FILE TO STAGE #
PROC TELLSLV; # NOTIFY SLAVE #
PROC UREPLAC; # UTILITY REPLACE #
PROC ZSETFET; # INITIALIZE A FET #
END
#
**** PROC STAGER - XREF LIST END.
#
DEF LISTCON #0#; # DO NOT LIST COMMON DECKS #
*CALL,COMBFAS
*CALL,COMBCHN
*CALL,COMBCMD
*CALL,COMBCMS
*CALL,COMBCPR
*CALL COMBLRQ
*CALL,COMBKDD
*CALL,COMBFET
*CALL,COMBMCT
*CALL,COMBPFP
*CALL,COMBPFS
*CALL,COMBTDM
*CALL,COMXCTF
*CALL,COMXEMC
*CALL COMBUDT
*CALL,COMXFCQ
*CALL,COMXHLR
*CALL,COMXIPR
*CALL,COMXJCA
*CALL COMXMFD
*CALL,COMXMSC
*CALL,COMSPFM
ITEM FCTQADDR U; # FCTQ ADDRESS #
ITEM FLAG B; # FLAG #
ITEM QADDR U; # *FCTQ* ENTRY ADDRESS #
ITEM ACCL I; # ACCESS LEVEL #
ITEM STAT I; # STATUS #
ITEM DRDCOUNT U; # DRD COUNT #
ITEM STDRDCT I; # DRD-S AVAILABLE FOR STAGING #
ITEM FULL B; # DRD RESERVATION TAKEN #
ITEM I I; # SM INDEX #
ITEM J I; # SUBFAMILY INDEX #
ITEM TFCT U; # ASAFCT #
ITEM CURFCT U; # *FCT* OF A PARALLEL *HLRQ* #
ITEM TTDAMSBF U; # SUBFAMILY NUMBER #
ITEM TEMP I; # TEMPORARY #
ITEM TFAM C(7); # TEMPORARY FAMILY #
ITEM TMSG I; # TRACE MODE INDICATOR #
ITEM PASS B; # TEMPORARY PASS FLAG #
ITEM TEMP1 I; # TEMPORARY #
ARRAY SCR$FET [0:0] P(SFETL); ; # SCRATCH FET #
STATUS STLBL
ST1A, # RETRY *ASIGNPF* CALL #
ST2A, # RETRY *RLS$FCT* CALL #
ST2B, # RETRY *CFLUSH* CALL #
ST2C, # RE-ENTER AFTER "NORMAL" UNLOAD #
ST2D, # RE-ENTER AFTER "FORCED" LOAD #
ST2E, # RE-ENTER AFTER "FORCED" UNLOAD #
ST3A, # RE-ENTRY IF NO *DRD* #
ST3B, # RETRY *ACQ$FCT* CALL #
ST3C, # RE-ENTRY AFTER CARTRIDGE LOAD #
ST4A, # RE-ENTER AFTER *HLCPYCD* CALL #
ST6A, # RETRY *SETDA* OR *UREPLAC* CALL
#
ST6B, # *UREPLACE* COMPLETE #
ST7A, # WAIT FOR K-DISPLAY REPLY #
ST7B, # RETRY *SETAF* CALL #
STEND; # END OF LIST #
SWITCH STGENT:STLBL
ST1A:ST1A,
ST2A:ST2A,
ST2B:ST2B,
ST2C:ST2C,
ST2D:ST2D,
ST2E:ST2E,
ST3A:ST3A,
ST3B:ST3B,
ST3C:ST3C,
ST4A:ST4A,
ST6A:ST6A,
ST6B:ST6B,
ST7A:ST7A,
ST7B:ST7B;
BASED
ARRAY CLEAR [0:0] S(1);
BEGIN
ITEM CLN U(00,36,24); # CLEAR *DRD* ASSIGNMENTS #
ITEM DRDADR U(00,42,18);
END
CONTROL EJECT;
P<HLRQ> = HLRQADR;
P<TDAM> = LOC(HLR$TDAM[0]);
P<FCT> = HLR$FCTQ[0] + FCTQHL;
GOTO STGENT[HLR$HPS[0]];
CONTROL EJECT;
#
* STEP 1 - SET UP TO STAGE THE NEXT FILE.
* - ASSIGN STAGING DISK TO A DIRECT ACCESS FILE.
* - INITIALIZE *HLRQ* FIELDS.
#
ST1A: # TO RETRY *ASIGNPF* CALL #
RETRYFILE: # IF UNRECOVERABLE READ ERRORS #
IF TDAMFC[0] NQ TDAMFCODE"NOREQ"
THEN # A FILE IS TO BE STAGED #
BEGIN # STEP 1 #
HLR$RESP[0] = ERRST"NOERR";
IF NOT TDAMIA[0]
THEN # DIRECT ACCESS #
BEGIN # ASSIGN STAGING DISK #
NAMEC[0] = HLR$FLNM[0];
NAMEC[1] = TDAMFAM[0];
ACCL = TDAMAL[0];
ASIGNPF(NAME[0],STAT,6,TDAMFLN[0], ##
TDAMUI[0],NAME[1],ACCL,LOC(PFMRET));
IF STAT EQ LNP
THEN # LEVEL INVALID ON DEVICE #
BEGIN
HLR$RESP[0] = ERRST"PERM";
HLR$PEF[0] = AFTMP;
HLR$ERRC[0] = STGERRC"NOLVL";
GOTO STGERR;
END
IF STAT NQ OK
THEN
BEGIN
STERPFM(HLRQADR,STAT);
IF HLR$RESP[0] NQ ERRST"NOERR"
THEN
BEGIN
HLR$HPS[0] = STLBL"ST1A";
HLR$ERRC[0] = STGERRC"DSKFULL";
GOTO STGERR;
END
END
END # ASSIGN STAGING DISK #
#
* INITIALIZE *HLRQ* FIELDS.
#
P<ASA> =
LOC(TDAMASA
[0]); HLR$VOLAU[0] = ASAAU[0];
HLR$FCTXN[0] = ASAFCT[0];
HLR$SM[0] = ASASM[0];
HLR$PRU[0] = 0;
HLR$VOLAUP[0] = 0;
HLR$VOLLNP[0] = 0;
HLR$CSNDP[0] = "";
HLR$CCODP[0] = "";
HLR$FFF[0] = TDAMFFF[0];
HLR$FVOL = TRUE;
HLR$EOI[0] = FALSE;
END # STEP 1 #
CONTROL EJECT;
#
* STEP 2 - UNLOAD CARTRIDGE.
* - USE *HLUNLD* TO DO THE UNLOAD.
* IT UPDATES USAGE DATA IN THE *FCT* ENTRY.
* - RELEASE THE *FCT* ENTRY.
* - EXIT FROM STAGER IF NO MORE FILES REMAIN.
#
UNLOAD: # TO RETRY READ ON OTHER *DRD* OR
ADVANCE TO NEXT CARTRIDGE #
IF HLR$UNLD[0] OR ##
(HLR$FCTX[0] NQ 0 AND ##
(HLR$FCTX[0] NQ HLR$FCTXN[0]))
THEN # UNLOAD A CARTRIDGE #
BEGIN # STEP 2 #
IF HLR$FCTQ[0] NQ 0
THEN
BEGIN
UPUSAGE(HLRQADR,HLR$FCTQ[0]);
END
ST2A: # TO RETRY *RLS$FCT* CALL #
IF HLR$FCTQ[0] NQ 0
THEN
BEGIN
RLS$FCT(HLR$FCTQ[0],0,STAT);
IF STAT NQ CMASTAT"NOERR"
THEN
BEGIN
HLR$HPS[0] = STLBL"ST2A";
STERCAT(HLRQADR,STAT);
GOTO STGERR;
END
ST2B:
CFLUSH(TDAMFAM[0],TDAMSBF[0],HLRQADR,STAT);
IF STAT NQ CMASTAT"NOERR"
THEN
BEGIN
HLR$HPS[0] = STLBL"ST2B";
STERCAT(HLRQADR,STAT);
GOTO STGERR;
END
END
HLR$FCTQ[0] = 0;
HLR$FCTX[0] = 0;
IF HLR$HLRQW[0] NQ 0
THEN # SWITCH CONTROL OF *DRD* TO WAITTING *HLRQ* #
BEGIN
TEMP = HLR$DRDRA[0];
TEMP1 = HLR$LRQADR[0];
P<HLRQ> = HLR$HLRQW[0];
HLR$DRDRA[0] = TEMP;
HLR$LRQADR[0] = TEMP1;
IF HLR$LRQADR[0] EQ 0
THEN
BEGIN # TELL NEXT HLRQ CARTRIDGE LOADED BAD #
HLR$RESP[0] = ERRST"TEMP";
END
P<HLRQ> = HLRQADR;
ADD$LNK(HLR$HLRQW[0],LCHN"HL$READY",0);
P<LLRQ> = HLR$LRQADR[0];
LLR$UCPRA[0] = HLR$HLRQW[0]; #INSURE PPU POINTS TO NEW *HLRQ*#
P<CLEAR> = HLR$DRDRA[0] ;
DRDADR = HLR$HLRQW[0];
HLR$HLRQW[0] = 0;
HLR$DRDRA[0] = 0;
HLR$LRQADR[0] = 0;
END
IF HLR$LRQADR[0] NQ 0
THEN
BEGIN # PHYSICAL UNLOAD #
P<LLRQ> = HLR$LRQADR[0];
MSGAFDF("I","UL",0,HLRQADR);
LLR$DR[0] = ERRST"NOERR";
LLR$PRCNME[0] = REQTYP4"UNLD$CART";
LLR$PRCST[0] = PROCST"INITIAL";
HLR$HPS[0] = STLBL"ST2C";
ADD$LNK(HLR$LRQADR[0],LCHN"LL$READY",0);
RETURN;
ST2C: # RETURN FROM UNLOAD OF CARTRIDGE #
IF HLR$RESP[0] NQ RESPTYP4"OK4"
THEN
BEGIN
#
* PROCESS UNLOAD CARTRIDGE ERROR AS FOLLOWS:
* -DRIVER PLACED ORIGINAL CARTRIDGE IN OUTPUT STATION.
* -ASSUME A SECOND CARTRIDGE WAS IN DESTINATION CELL.
* -ATTEMPT TO MOVE THIS 2ND CARTRIDGE TO THE OUTPUT
* STATION BY LOADING IT.
* -IF THE LOAD SUCCEEDS, DO A SECOND UNLOAD BACK TO
* THE ORIGINAL DESTINATION.
#
HLLDSET((HLRQADR)); # SET UP SECOND LOAD #
P<HLRQ> = HLRQADR;
HLR$HPS[0] = STLBL"ST2D";
RETURN;
ST2D: # RETURN FROM SECOND LOAD #
IF HLR$RESP[0] EQ RESPTYP4"OK4"
THEN # UNLOAD 2ND CARTRIDGE #
BEGIN
LLR$PRCNME[0] = REQTYP4"UNLD$CART";
LLR$PRCST[0] = PROCST"INITIAL";
HLR$HPS[0] = STLBL"ST2E";
ADD$LNK(HLR$LRQADR[0],LCHN"LL$READY",0);
RETURN;
ST2E:
END # UNLOAD OF 2ND REQUEST #
END # LOAD OF 2ND REQUEST #
HLR$RESP[0] = ERRST"NOERR";
IF HLR$DRDRA[0] NQ 0
THEN # DROP *DRD* RESERVATION #
BEGIN
P<CLEAR> = HLR$DRDRA[0];
CLN = 0 ;
HLR$DRDRA[0] = 0;
END
END # PHYSICAL UNLOAD #
IF TDAMFC[0] EQ TDAMFCODE"NOREQ"
THEN # NO MORE FILES TO STAGE #
BEGIN
IF DSC$WRESRS NQ 0
THEN # FORCE A DESTAGE RESTART #
BEGIN
DSC$WRESRS = 0;
DSC$INIT = 1;
END
SLOWFOR I=1 STEP 1 UNTIL MAXSMUNIT
DO
BEGIN # FIND *SM* #
IF HLR$SM[0] EQ SM$ID[I]
THEN
BEGIN
IF SM$DSRFW[I] NQ 0
THEN
BEGIN # DESTAGE WAITING *DRD* #
SLOWFOR J = 0 STEP 1 UNTIL MAXSF
DO
BEGIN # CHECK FOR DESTAGE WAITING #
IF B<J>SM$DSRFW0[I] NQ 0
THEN
BEGIN
B<J>SM$DSRFW0[I] = 0;
SCR$WTDRD[J] = FALSE;
DSC$INIT = 1;
GOTO FREE;
END
END # COMPLETED CHECK OF WAITING #
END
END
END
FREE:
IF HLR$DRDRA[0] NQ 0
THEN # DROP *DRD* RESERVATION #
BEGIN
P<CLEAR> = HLR$DRDRA[0];
CLN = 0;
END
HLR$HPS[0] = PROCST"COMPLETE";
RETURN;
END
IF HLR$PRU[0] NQ 0
THEN # CONTINED AU FROM AN OTHER CARTRIDGE #
BEGIN
HLR$CSNTPS[0] = HLR$CSNTCU[0];
END
END # STEP 2 #
CONTROL EJECT;
#
* STEP 3 - LOAD NEXT CARTRIDGE, IF NEEDED.
* - ACQUIRE *FCT* ENTRY FOR NEW CARTRIDGE.
* - SET UP *HLRQ* FIELDS TO IDENTIFY CARTRIDGE.
* - USE *HLLOAD* TO DO THE PHYSICAL LOAD.
* - SET THE FREE FILE FLAG IN THE *HLRQ* IF ITS
* SET IN THE *FCT*.
#
ST3A: # TO RETRY CALL TO *ACQ$FCT* #
SLOWFOR I=1 STEP 1 UNTIL MAXSMUNIT
DO
BEGIN # FIND *SM* #
IF HLR$SM[0] EQ SM$ID[I]
THEN
BEGIN
GOTO SMFOUND;
END
END
SMFOUND:
DRDCOUNT = 0;
FULL = FALSE;
IF D0$ON[I]
THEN
BEGIN
DRDCOUNT = 1;
END
IF D1$ON[I]
THEN
BEGIN
DRDCOUNT = DRDCOUNT + 1;
END
IF SM$REQRES1[I] NQ 0
AND SM$REQRES2[I] NQ 0
THEN
BEGIN
FULL = TRUE;
END
IF DRDCOUNT EQ 1
THEN
BEGIN
IF (SM$REQRES1[I] NQ 0)
OR (SM$REQRES2[I] NQ 0)
THEN
BEGIN
FULL = TRUE;
END
END
HLR$HPS[0] = STLBL"ST3A";
IF HLR$DRDRA EQ 0
THEN
BEGIN
TTDAMSBF = HLR$SBF[0];
TFCT = HLR$FCTXN[0];
TFAM = HLR$FAM[0];
IF NOT SM$LLRQ1[I]
THEN
BEGIN
IF SM$REQRES1[I] NQ 0
AND SM$REQRES1[I] NQ HLRQADR
THEN
BEGIN
P<HLRQ> = SM$REQRES1[I];
IF HLR$FCTX[0] NQ 0
THEN
BEGIN
CURFCT = HLR$FCTX[0];
END
ELSE
BEGIN
CURFCT = HLR$ASAFCT[0];
END
IF (TFCT EQ CURFCT)
AND (TTDAMSBF EQ HLR$SBF[0])
AND (TFAM EQ HLR$FAM[0])
THEN # REQUESTING CARTRIDGE MOUNTED #
BEGIN
NEXTHLRQ:
IF HLR$HLRQW[0] EQ 0
THEN
BEGIN # END OF *HLRQ* WRITING CARTRIDGE #
HLR$HLRQW[0] = HLRQADR;
P<HLRQ> = HLRQADR;
STG$MSK = 0;
RETURN;
END
ELSE
BEGIN # FIND END OF *HLRQ* WRITING #
P<HLRQ> = HLR$HLRQW[0];
GOTO NEXTHLRQ;
END
END
END
END # SM$LLRQ1 CHECK #
IF NOT SM$LLRQ2[I]
THEN
BEGIN
IF SM$REQRES2[I] NQ 0
AND SM$REQRES2[I] NQ HLRQADR
THEN
BEGIN
P<HLRQ> = SM$REQRES2[I];
IF HLR$FCTX[0] NQ 0
THEN
BEGIN
CURFCT = HLR$FCTX[0];
END
ELSE
BEGIN
CURFCT = HLR$ASAFCT[0];
END
IF (TFCT EQ CURFCT)
AND (TTDAMSBF EQ HLR$SBF[0])
AND (TFAM EQ HLR$FAM[0])
THEN # REQUESTING CARTRIDGE MOUNTED #
BEGIN
NEXTHLRQ1:
IF HLR$HLRQW[0] EQ 0
THEN
BEGIN # END OF *HLRQ* WRITING CARTRIDGE #
HLR$HLRQW[0] = HLRQADR;
P<HLRQ> = HLRQADR;
STG$MSK = 0;
RETURN;
END
ELSE
BEGIN # FIND END OF *HLRQ* WRITING #
P<HLRQ> = HLR$HLRQW[0];
GOTO NEXTHLRQ1;
END
END
END
END # SM$LLRQ2 CHECK #
P<HLRQ> = HLRQADR;
FCTQADDR = CHN$BOC[LCHN"FCT$FRSPC"];
IF FULL
OR (FCTQADDR EQ 0)
THEN
BEGIN
ADD$LNK(HLRQADR,LCHN"HL$DRDRESW",0);
RETURN;
END
ELSE
BEGIN
IF SM$REQRES1[I] EQ 0
THEN
BEGIN
SM$REQRES1[I] = HLRQADR;
HLR$DRDRA[0] = LOC(SM$REQRES1[I]);
END
ELSE
BEGIN
SM$REQRES2[I] = HLRQADR;
HLR$DRDRA[0] = LOC(SM$REQRES2[I]);
END
END # RESERVE OF *DRD* #
END # DRD RESERVE #
ST3B: # TO RETRY CALL TO *ACQ$FCT* #
IF HLR$FCTQ[0] EQ 0
THEN
BEGIN # STEP 3 #
HLR$FCTX[0] = HLR$FCTXN[0];
ACQ$FCT(TDAMFAM[0],TDAMSBF[0],HLR$SM[0],HLR$FCTX[0], ##
QADDR,HLRQADR,STAT);
IF STAT NQ CMASTAT"NOERR"
THEN
BEGIN
STERCAT(HLRQADR,STAT);
HLR$HPS[0] = STLBL"ST3B"; # IF WAIT FOR INTERLOCK #
IF HLR$RESP[0] EQ ERRST"WAIT"
THEN
BEGIN
RETURN;
END
ELSE
BEGIN
GOTO STGERR;
END
END
#
REM - CHANGE STERCAT TO REPLY "TEMPERR" NOT ABANDON.
#
#
* UPDATE *HLRQ* TO REFLECT THIS CARTRIDGE.
#
HLR$FCTQ[0] = QADDR;
P<FCT> = QADDR + FCTQHL;
#
* CHECK FOR ZERO *FCT* ENTRY.
#
IF FCT$CSND[0] EQ ""
OR FCT$1ST[0] EQ 0
THEN
BEGIN
STAT = CMASTAT"NOSUBCAT";
STERCAT(HLRQADR,STAT);
GOTO STGERR;
END
HLR$Y[0] = FCT$Y[0];
HLR$Z[0] = FCT$Z[0];
HLR$CSND[0] = FCT$CSND[0];
HLR$CCOD[0] = FCT$CCOD[0];
#
* LOAD CARTRIDGE USING *HLLOAD*.
#
HLR$HPS[0] = STLBL"ST3C";
IF HLR$LRQADR[0] EQ 0
THEN
BEGIN
HLLDSET((HLRQADR)); # MOVE *HLRQ* DATA TO *LLRQ* #
MSGAFDF("I","LD",0,HLRQADR);
RETURN; # WAIT LOAD OF CARTRIDGE #
ST3C: # RETURN FROM DRIVER LOAD #
HLLOAD((HLRQADR)); # CHECK RETURN CODES #
P<HLRQ> = HLRQADR;
P<FCT> = HLR$FCTQ[0] + FCTQHL;
END
IF HLR$RESP[0] NQ ERRST"NOERR"
THEN
BEGIN
HLR$FCTX[0] = 0;
IF HLR$RESP[0] EQ ERRST"RETRY"
THEN
BEGIN
IF HLR$FCTQ[0] NQ 0
THEN
BEGIN # RELEASE *FCT* TABLE #
RLS$FCT(HLR$FCTQ[0],0,STAT);
HLR$FCTQ[0] = 0;
END
GOTO RETRYFILE;
END
ELSE
BEGIN
GOTO STGERR;
END
END
END # STEP 3 #
CONTROL EJECT;
#
* STEP 4 - COPY THE NEXT VOLUME OF DATA TO DISK.
* - ISSUE ACCOUNT-DAYFILE MESSAGE, IF FIRST VOLUME.
* - VERIFY CHAIN CONTROL VALUES ARE CONSISTENT WITH
* WITH FIRST VOLUME STATUS.
* - SET FREE FILE FLAG IF AU CONFLICT FLAG IS SET.
* - USE *HLCPYCD* TO DO THE I/O.
* - IF A READ ERROR OCCURS, TRY AGAIN ON OTHER *DRD*.
#
HLR$FFF[0] = HLR$FFF[0] OR FCT$FCF[0];
IF HLR$FVOL[0]
THEN
BEGIN
MSGAFDF("B","BS",0,HLRQADR); # INDICATE START OF STAGE #
END
NEXTVOL: # USED TO COPY NEXT VOLUME FROM
SAME CARTRIDGE #
#
* VERIFY THE AU TO BE READ ARE VALID.
#
TEMP = HLR$VOLAU[0];
SETFCTX(TEMP);
HLR$VOLLN[0] = FCT$LEN(FWD,FPS) + 1;
TEMP1 = FCT$FLGS1(FWD,FPS);
IF (TEMP LS 1) ##
OR (TEMP1 EQ 0) # NOT ALLOCATED #
OR (TEMP+HLR$VOLLN[0]-1 GR FCT$AVOT[0])
THEN # AU ARE OUT OF RANGE #
BEGIN
HLR$RESP[0] = ERRST"PERM";
HLR$PEF[0] = AFPSE;
HLR$ERRC[0] = STGERRC"AURNG";
GOTO STGERR;
END
TEMP = FCT$CC(FWD,FPS);
FLAG = (TEMP EQ CHAINCON"FIRST") ##
OR (TEMP EQ CHAINCON"ONLY");
IF ( (NOT FLAG) AND HLR$FVOL[0] ) ##
OR ( (NOT HLR$FVOL[0]) AND FLAG) ##
OR (FCT$CAUF(FWD,FPS) EQ 1)
THEN # THEY ARE NOT CONSISTENT #
BEGIN
FCT$AUCF(FWD,FPS) = 1;
END
#
* SET FREE FILE FLAG IF AU CONFLICT OR FROZEN CHAIN FLAGS ARE SET.
#
IF ( FCT$AUCF(FWD,FPS) + FCT$FRCF(FWD,FPS) ) NQ 0
THEN
BEGIN
HLR$FFF[0] = TRUE;
END
HLR$HPS[0] = STLBL"ST4A";
P<LLRQ> = HLR$LRQADR[0];
LLR$PRCNME[0] = REQTYP4"CPY$AD";
LLR$PRCST[0] = PROCST"INITIAL";
LLR$DR[0] = 0;
ADD$LNK(HLR$LRQADR[0],LCHN"LL$READY",0);
RETURN; # START COPY #
ST4A: # RE-ENTER AFTER COPY COMPLETE #
HLCPYCD((HLRQADR)); # CHECK RETURN CODES #
P<HLRQ> = HLRQADR;
P<FCT> = HLR$FCTQ + FCTQHL;
IF HLR$RESP EQ ERRST"RETRY"
THEN
BEGIN
HLR$RESP[0] = ERRST"NOERR";
HLR$UNLD[0] = TRUE;
GOTO RETRYFILE;
END
IF HLR$RESP[0] NQ ERRST"NOERR"
THEN
BEGIN
GOTO STGERR;
END
HLR$FVOL[0] = FALSE;
#
* STEP 4 - END.
#
CONTROL EJECT;
#
* STEP 5 - FINISH COPYING FILE TO DISK.
* - ALL DONE IF CHAIN CONTROL = ONLY OR LAST.
* - PREPARE TO DO NEXT VOLUME.
* - REPEAT STEP 4, COPY VOLUME, IF NO OVERFLOW.
* - REPEAT STEPS 2-4, IF OVERFLOW.
#
IF HLR$RESP[0] EQ ERRST"NOERR" ##
AND NOT HLR$EOI[0]
THEN # COPY NEXT VOLUME #
BEGIN # STEP 5 #
SETFCTX(HLR$VOLAU[0]);
HLR$VOLAUP[0] = HLR$VOLAU[0];
HLR$VOLLNP[0] = HLR$VOLLN[0];
HLR$VOLAU[0] = FCT$LINK(FWD,FPS);
TEMP = FCT$CLKOCL(FWD,FPS);
IF TEMP EQ 0
THEN # NO OVERFLOW #
BEGIN
GOTO NEXTVOL;
END
TEMP = FCT$OCLNK(TEMP);
HLR$FCTXN[0] = (HLR$FCTX[0]/MAXGRT)*MAXGRT + TEMP;
GOTO UNLOAD;
END # STEP 5 #
CONTROL EJECT;
#
* STEP 6 - RESTORE DISK IMAGE.
* - VERIFY FILE LENGTH IS OK.
* - IF NO ERRRORS, USE *SETDA* OR *UREPLAC* TO
* UPDATE THE *PFC* ENTRY FOR THIS FILE
* TO INDICATE THE STAGE WAS SUCCESSFUL.
* - IF THE FREE FILE FLAG IS SET, USE *SETAF* (*AFOBS* )
* TO CLEAR THE *ASA* VALUE FOR THE FILE.
#
TEMP = TDAMFLN[0] - HLR$PRU[0];
IF NOT TDAMIA[0]
THEN
BEGIN
TEMP = TEMP - 1;
END
IF TDAMFLN[0] EQ 1 ##
AND TDAMAFVER[0]
THEN
BEGIN # FILE RETURNED BY PFDUMP #
TEMP = 0;
END
IF TEMP NQ 0
THEN # FILE LENGTH ERROR #
BEGIN
HLR$RESP[0] = ERRST"PERM";
HLR$PEF[0] = AFPSE;
HLR$ERRC[0] = STGERRC"LENERR";
END
ST6A: # TO RETRY CALL TO *SETDA* OR
*UREPLAC* #
IF HLR$RESP[0] EQ ERRST"NOERR"
THEN # FILE AT EOI #
BEGIN # STEP 6 #
NAMEC[0] = HLR$FLNM[0];
NAMEC[1] = TDAMFAM[0];
NAMEC[2] = TDAMPFN[0];
IF NOT TDAMIA[0]
THEN # DIRECT ACCESS FILE #
BEGIN
SETDA(NAME[0],PFMSTAT,6,TDAMUI[0],NAME[1], ##
TDAMPFID[0],TDAMASI[0],TDAMCDT[0],LOC(PFMRET));
END
ELSE # INDIRECT ACCESS FILE #
BEGIN
ZSETFET(LOC(SCR$FET[0]),NAMEC[0],0,0,SFETL);
FET$DT[0] = "MS";
FET$SP[0] = TRUE;
FET$AL[0] = TDAMAL[0];
FET$EP[0] = TRUE;
FET$UP[0] = TRUE;
FET$LFN[0] = NAMEC[0];
REQWEST(FETSET[0],TMSG); # REQUEST EQUIPMENT #
IF FET$AT[0] EQ LNV # LEVEL NOT VALID #
OR FET$AT[0] EQ WEQ # EQUIPMENT UNAVAILABLE #
THEN
BEGIN
HLR$RESP[0] = ERRST"PERM";
HLR$PEF[0] = AFTMP;
HLR$ERRC[0] = STGERRC"NOLVL";
GOTO STGERR;
END
UREPLAC(NAME[0],PFMSTAT,6,NAME[2],TDAMUI[0], ##
NAME[1],TDAMPFID[0],TDAMASI[0],TDAMCDT[0],LOC(PFMRET));
PFMSTAT = -1;
HLR$HPS[0] = STLBL"ST6B"; # RETURN *UREPLACE* COMPLETE #
GLPFMFL = TRUE;
ADD$LNK(HLRQADR,LCHN"HL$PFMWAIT",0);
RETURN;
END
ST6B:
IF PFMSTAT NQ 0
THEN
BEGIN
HLR$HPS[0] = STLBL"ST6A"; # IF WAIT FOR INTERLOCK #
HLR$ERRC[0] = STGERRC"RESTORE";
STERPFM(HLRQADR,PFMSTAT);
END
IF HLR$RESP[0] EQ ERRST"NOERR" ##
AND HLR$FFF[0]
THEN
BEGIN
#
* USE THE PERMANENT ERROR STATUS TO CLEAR THE *ASA* FIELD
* BY "SETTING" THE *AFOBS* FLAG.
#
HLR$RESP[0] = ERRST"PERM";
HLR$PEF[0] = AFOBS;
HLR$ERRC[0] = STGERRC"CLRASA";
PASS = TRUE; # CLEAR LOCATION *HLR$ERRC* AFTER MESSAGE #
END
END # STEP 6 #
CONTROL EJECT;
#
* STEP 7 - PROCESS ERRORS.
* - IF K-DISPLAY MESSAGE OUTSTANDING, WAIT FOR IT.
* - IF NEED TO WAIT FOR INTERLOCK, RETURN.
* - IF PERMANENT ERROR, DO XX.
#
STGERR: # ENTRY VIA *GOTO STGERR*
STATEMENTS #
IF HLR$RESP[0] EQ ERRST"WAIT"
THEN
BEGIN
HLR$RESP[0] = ERRST"NOERR";
DELAY(PFM$INTV,HLRQADR,HLRQIND);
RETURN;
END
IF HLR$RESP[0] EQ ERRST"NOERR"
THEN
BEGIN
HLR$ERRC[0] = STGERRC"NOERR";
END
STGCNT = STGCNT + 1;
MSGAFDF("E","ES",HLR$ERRC[0],HLRQADR);
IF PASS
THEN # FREE FLAG SET - CLEAR *HLR$ERRC*#
BEGIN
HLR$ERRC[0] = 0;
END
ST7A: # ENTRY IF WAITING FOR K-DISPLAY
TO BE COMPLETE #
IF HLR$RESP[0] NQ ERRST"NOERR"
THEN
BEGIN # STEP 7 #
P<KWORD> = LOC(HLR$KREQ[0]);
IF (KW$WORD[0] NQ 0) AND NOT KW$COMP[0]
THEN
BEGIN
DELAY(KDIS$INTV,HLRQADR,HLRQIND);
HLR$HPS[0] = STLBL"ST7A";
RETURN;
END
IF HLR$RESP[0] EQ ERRST"PERM"
THEN # SET FLAG FROM *HLR$PEF* IN *PFC*
ENTRY #
BEGIN
ST7B: # TO RETRY *SETAF* CALL #
NAMEC[0] = HLR$FLNM[0];
NAMEC[1] = TDAMFAM[0];
SETAF(NAME[0],STAT,6,TDAMUI[0],NAME[1], ##
TDAMPFID[0],TDAMASI[0],TDAMCDT[0],HLR$PEF[0],LOC(PFMRET));
IF STAT NQ 0
THEN
BEGIN
STERPFM(HLRQADR,STAT);
IF HLR$RESP[0] EQ ERRST"WAIT"
THEN
BEGIN
HLR$HPS[0] = STLBL"ST7B";
DELAY(PFM$INTV,HLRQADR,HLRQIND);
RETURN;
END
ELSE
BEGIN
HLR$ERRC[0] = STGERRC"SETAF";
MSGAFDF("E","ES",HLR$ERRC[0],HLRQADR);
END
END
HLR$RESP[0] = ERRST"PERM";
END
END # STEP 7 #
CONTROL EJECT;
#
* STEP 8 - COMPLETE STAGING PROCESS.
* - RETURN STAGING FILE.
* - NOTIFY REQUESTOR.
* - GET NEXT STAGING REQUEST, IF ANY, AND RETURN
* TO *HLRQMTR*.
#
ZSETFET(LOC(SCR$FET[0]),HLR$FLNM[0],0,0,SFETL);
RETERN(SCR$FET[0],RCL);
IF HLR$RESP[0] EQ ERRST"NOERR" ##
OR HLR$RESP[0] EQ ERRST"PERM"
THEN # *PFC* WAS UPDATED TO SHOW STATUS
#
BEGIN
TEMP = 0;
END
ELSE # *PFC* NOT UPDATED, *PFM* WILL
KEEP ISSUING *TDAM*S #
BEGIN
TEMP = 1;
END
IF TDAMOSLV[0]
THEN
BEGIN
TELLSLV(TDAMSSN[0],TEMP);
END
IF TDAMOMAST[0] ##
AND TDAMEVENT[0] NQ 0 ##
AND TEMP EQ 0
THEN
BEGIN
EESET(TDAMEVENT[0]);
END
STNTDAM(HLRQADR);
RETURN;
#
* END OF STEP 8.
#
END # STAGER #
TERM
PROC STERCAT((HLRQADR),(ERRSTAT));
# TITLE STERCAT - PROCESS STAGE CATALOG ACCESS ERRORS. #
BEGIN # STERCAT #
#
** STERCAT - PROCESS STAGE CATALOG ACCESS ERRORS.
*
* *STERCAT* PROCESSES ERROR RESPONSES RETURNED TO *STAGER* FROM A
* CATALOG ACCESS REQUEST AND RETURNS A STATUS IN THE *HLRQ*
* ENTRY OF THE STAGE REQUEST.
*
* PROC STERCAT((HLRQADR),(ERRSTAT))
*
* ENTRY (HLRQADR) - ADDRESS OF *HLRQ* FOR THE STAGE REQUEST.
* (ERRSTAT) - CATALOG ACCESS ERROR CODE.
*
* EXIT (HLR$RESP[0]) - ERROR STATE.
* (VALUES DEFINED IN *COMEMSC*).
* = ERRST"WAIT".
* = ERRST"ABANDON".
#
ITEM HLRQADR U; # *HLRQ* ENTRY ADDRESS #
ITEM ERRSTAT I; # CATALOG ACCESS ERROR CODE #
#
**** PROC STERCAT - XREF LIST BEGIN.
#
XREF
BEGIN
PROC ABORT; # ABORT #
PROC MESSAGE; # ISSUE MESSAGE #
END
#
**** PROC STERCAT - XREF LIST END.
#
DEF LISTCON #0#; # DO NOT LIST COMMON DECKS #
*CALL,COMBFAS
*CALL,COMBCMS
*CALL COMSPFM
*CALL,COMXEMC
*CALL,COMXHLR
*CALL,COMXMSC
CONTROL EJECT;
P<HLRQ> = HLRQADR;
IF ERRSTAT EQ CMASTAT"INTLK"
THEN # MSF CATALOG INTERLOCKED #
BEGIN
HLR$RESP[0] = ERRST"WAIT";
RETURN;
END
IF ERRSTAT EQ CMASTAT"NOTOPEN" ##
THEN # MSF CATALOG NOT ONLINE #
BEGIN
HLR$RESP[0] = ERRST"ABANDON";
HLR$ERRC[0] = STGERRC"CATOFFLN";
RETURN;
END
IF ERRSTAT EQ CMASTAT"CIOERR" ##
THEN # MSF CATALOG NOT ONLINE #
BEGIN
HLR$RESP[0] = ERRST"ABANDON";
HLR$ERRC[0] = STGERRC"CATIOER";
RETURN;
END
IF ERRSTAT EQ CMASTAT"NOSUBCAT" ##
OR ERRSTAT EQ CMASTAT"ORDERR"
THEN # OBSOLETE MSF CATALOG ONLINE #
BEGIN
HLR$RESP[0] = ERRST"PERM";
HLR$ERRC[0] = STGERRC"PFCOBS";
HLR$PEF[0] = AFPSE;
RETURN;
END
FE$RTN[0] = "STERCAT.";
MESSAGE(FEMSG,UDFL1);
ABORT;
END # STERCAT #
TERM
PROC STERPFM((HLRQADR),(ERRSTAT));
# TITLE STERPFM - PROCESS STAGE *PFM* ERRORS. #
BEGIN # STERPFM #
#
** STERPFM - PROCESS STAGE *PFM* ERRORS.
*
* *STERPFM* PROCESSES ERROR RESPONSES RETURNED TO CALLERS FROM A
* *PFM* REQUEST AND RETURNS A STATUS IN THE *HLRQ* ENTRY OF THE
* STAGE REQUEST.
*
* PROC STERPFM((HLRQADR),(ERRSTAT))
*
* ENTRY (HLRQADR) - ADDRESS OF *HLRQ* FOR THE STAGE REQUEST.
* (ERRSTAT) - *PFM* ERROR CODE.
*
* EXIT (HLR$RESP[0]) - ERROR STATE.
* (VALUES DEFINED IN *COMEMSC*).
* = ERRST"NOERR".
* = ERRST"WAIT".
* = ERRST"ABANDON".
* IF THE ERROR STATE INDICATES A DELAY CONDITION
* (*ERRST"WAIT"*) THEN THE STAGE REQUEST HAS BEEN ADDED
* TO THE *HLRQ* DELAY CHAIN AND WILL BE PUT BACK ON THE
* *HLRQ* READY CHAIN AFTER A DELAY TIME HAS EXPIRED.
* PROCESSING WILL CONTINUE IN THE ROUTINE INDICATED
* BY *HLR$PN[0]* AND AT THE PROCESS STATE *HLR$PS[0]*.
#
ITEM HLRQADR U; # *HLRQ* ENTRY ADDRESS #
ITEM ERRSTAT I; # *PFM* ERROR CODE #
#
**** PROC STERPFM - XREF LIST BEGIN.
#
XREF
BEGIN
PROC ABORT; # ABORT #
PROC MESSAGE; # ISSUE MESSAGE #
PROC PFMEC; # CONVERT *PFM* ERROR RESPONSE #
END
#
**** PROC STERPFM - XREF - XREF LIST END.
#
DEF LISTCON #0#; # DO NOT LIST COMMON DECKS #
*CALL,COMBFAS
*CALL COMXEMC
*CALL,COMXHLR
*CALL,COMXIPR
*CALL,COMXMSC
*CALL,COMSPFM
ITEM ACTION I; # ERROR PROCESSING ACTION #
SWITCH SPFMER:ERRST # *PFM* ERROR STATES #
SPNOERR:NOERR, # NO ERROR #
SPDELAY:WAIT, # DELAY CONDITION #
SPFATAL:FATAL, # FATAL ERROR #
SPFATAL:RESTART, # RESPONSE INVALID FROM *PFMEC* #
SPFATAL:PERM, # RESPONSE INVALID FROM *PFMEC* #
SPABAN:ABANDON, # ABANDON CONDITION #
SPSPEC:SPECIAL; # SPECIAL CONDITION #
CONTROL EJECT;
P<HLRQ> = HLRQADR;
PFMEC(ERRSTAT,ACTION);
GOTO SPFMER[ACTION];
SPNOERR: # NO ERROR #
HLR$RESP[0] = ACTION;
RETURN;
SPABAN: # ABANDON STAGE REQUEST #
IF ERRSTAT EQ FBS OR ERRSTAT EQ FDA OR ERRSTAT EQ FIA
THEN # RESPONSES INVALID FOR STAGE #
BEGIN
GOTO SPFATAL;
END
HLR$RESP[0] = ACTION;
RETURN;
SPDELAY: # DELAY STAGE REQUEST #
HLR$RESP[0] = ACTION;
RETURN;
SPSPEC: # SPECIAL PROCESSING #
HLR$RESP[0] = ERRST"ABANDON";
HLR$ERRC[0] = STGERRC"DSKFULL";
RETURN;
SPFATAL: # FATAL STAGE ERROR #
FE$RTN[0] = "STERPFM.";
MESSAGE(FEMSG,UDFL1);
ABORT;
END # STERPFM #
TERM
PROC STNTDAM((HLRQADR));
# TITLE STNTDAM - GET NEXT STAGING REQUEST #
BEGIN # STNTDAM #
#
** STNTDAM - GET NEXT STAGING REQUEST.
*
* THIS PROCEDURE SCANS THE *RTRQ* TO LOCATE A FILE STAGE
* REQUEST WHICH CAN BE INITIATED USING THE CARTRIDGE
* CURRENTLY MOUNTED FOR THE *HLRQ* ENTRY. IF SEVERAL
* SUCH FILES ARE FOUND, THE ONE SELECTED IS THE ONE
* WHICH BEGINS CLOSEST TO THE START OF THE CARTRIDGE.
*
* PROC STNTDAM((HLRQADR))
*
* ENTRY (HLRQADR) - ADDRESS OF THE *HLRQ* ENTRY.
*
* THE FOLLOWING FIELDS IN THE *HLRQ* ENTRY AND
* THE *TDAM* PORTION IDENTIFY THE CARTRIDGE
* CURRENTLY MOUNTED.
* - *TDAMFAM*, *TDAMSBF* = SUBFAMILY,
* *HLR$SM*, *HLR$FCTX* = CARTRIDGE IN SUBFAMILY.
*
* EXIT THE *TDAM* PORTION OF THE *HLRQ* ENTRY IS UPDATED
* TO IDENTIFY THE NEXT ACTION.
* IF *TDAMFC* = "NOREQ", NO FILE WAS FOUND.
* OTHERWISE, THE *TDAM* ENTRY FOR THE NEW FILE
* WAS MOVED TO THE *HLRQ*.
#
ITEM HLRQADR U; # *HLRQ* ADDRESS #
#
**** PROC STNTDAM - XREF LIST BEGIN.
#
XREF
BEGIN
PROC ADD$LNK; # ADD ENTRY TO CHAIN #
PROC DEL$LNK; # DELETE ENTRY FROM CHAIN #
PROC ZFILL; # ZERO FILL ARRAY #
END
#
**** PROC STNTDAM - XREF LIST END.
#
DEF LISTCON #0#; # DO NOT LIST COMMON DECKS #
*CALL,COMBFAS
*CALL,COMBCHN
*CALL,COMBTDM
*CALL COMXCTF
*CALL COMBUDT
*CALL,COMXHLR
*CALL COMXMFD
*CALL,COMXMSC
ITEM BESTAU U; # STARTING AU OF BEST FILE #
ITEM BESTQ U; # ADDRESS OF BEST ENTRY #
ITEM CANDIDATE U; # TEMPORARY #
ITEM FAM C(7); # FAMILY #
ITEM I I; # LOOP INDEX #
ITEM SF U; # SUBFAMILY INDEX #
ITEM QADDR U; # ADDRESS OF NEXT *RTRQ* ENTRY #
CONTROL EJECT;
P<HLRQ> = HLRQADR;
P<TDAM> = LOC(HLR$TDAM[0]);
FAM = TDAMFAM[0];
SF = TDAMSBF[0];
BESTQ = 0;
BESTAU = 99999999;
QADDR = CHN$BOC[LCHN"RTD$ACT"];
FOR DUMMY = 0 WHILE QADDR NQ 0
DO
BEGIN # SEARCH LOOP #
CANDIDATE = QADDR;
P<LINKWRD> = QADDR;
P<TDAM> = QADDR+1;
QADDR = LINK$ADR[0]; # SET UP FOR NEXT LOOP #
#
* EXAMINE THE CURRENT *RTRQ* ENTRY AND LOOP IF ITS NOT
* - FOR THE SAME SUBFAMILY,
* - FOR THE SAME CARTRIDGE,
* - THE FIRST ONE ON THE CARTRIDGE.
#
IF TDAMFC[0] NQ TDAMFCODE"STAGE" ##
OR TDAMFAM[0] NQ FAM ##
OR TDAMSBF[0] NQ SF
THEN # NOT STAGE, OR IN THE SAME
SUBFAMILY #
BEGIN
TEST DUMMY;
END
P<ASA> =
LOC(TDAMASA
[0]);
IF ASASM[0] NQ HLR$SM[0] ##
OR ASAFCT[0] NQ HLR$FCTX[0]
THEN # NOT ON THE SAME CARTRIDGE #
BEGIN
TEST DUMMY;
END
IF ASAAU[0] LS BESTAU
THEN # SELECT THIS ONE #
BEGIN
BESTQ = CANDIDATE;
BESTAU = ASAAU[0];
TEST DUMMY;
END
END # SEARCH LOOP #
IF (BESTQ EQ 0) ##
OR (HLR$ERRC[0] NQ 0) ##
OR (HLR$RESP[0] EQ ERRST"RSFULL")
THEN # NO MORE FILES TO STAGE FROM
CARTRIDGE #
BEGIN
P<TDAM> = LOC(HLR$TDAM[0]);
TDAMFC[0] = TDAMFCODE"NOREQ";
HLR$UNLD[0] = TRUE;
END
ELSE # MOVE NEW *TDAM* INTO *HLRQ* #
BEGIN
P<TDAM> = BESTQ + 1;
HLR$TDAM[0] = TDAMREQST[0];
RTRQ$CT = RTRQ$CT - 1;
DEL$LNK(BESTQ,LCHN"RTD$ACT",0);
ZFILL(TDAM[0],TDAMLEN);
ADD$LNK(BESTQ,LCHN"RTD$FRSPC",0);
END
ADD$LNK(HLRQADR,LCHN"HL$READY",0);
HLR$RETRY[0] = FALSE;
HLR$HPN[0] = HLRPN"STAGE";
HLR$HPS[0] = PROCST"INITIAL";
RETURN;
END # STNTDAM #
TERM
PROC TDAM$RP;
# TITLE TDAM$RP - *TDAM* REQUEST PROCESSOR. #
BEGIN # TDAM$RP #
#
** TDAM$RP - *TDAM* REQUEST PROCESSOR.
*
* *TDAM$RP* DOES THE PROCESSING OF REQUESTS RESIDING IN THE *RTRQ*.
* IN THE *RTRQ*.
*
* PROC TDAM$RP.
*
* EXIT *HLR$DOSTG* IS SET TO INTERRUPT DESTAGING IF A
* STAGE REQUEST IS WAITING TO BE PROCESSED.
* THE MASK *STG$MSK* IS SET UP.
*
* MESSAGES * INVALID TDAM REQUEST.*.
*
* NOTES *TDAM$RP* PROCESSES *TDAM* REQUESTS AS FOLLOWS -
*
* STEP 1 - THE STATUS OF EACH *SM* IS DETERMINED.
* THE COUNT OF AVAILABLE *DRD-S* IS DECREMENTED IF
* THE *SM* OR ONE OF THE *DRD-S* IS NOT AVAILABLE.
*
* STEP 2 - IF EITHER *DRD* ON A *SM* IS DESTAGING
* THEN THE *ID* OF THAT CARTRIDGE IS SAVED. IF
* DESTAGING IS NOT OCCURRING ON EITHER *DRD* THEN
* THE *ID* OF A CARTRIDGE ON EITHER *DRD* IS SAVED.
*
* STEP 3 - THE *RTRQ* IS SEARCHED FOR *TDAM* STAGE
* REQUESTS. ANY VALID NON-STAGE REQUESTS ARE
* PROCESSED AS THEY COME IN.
* STAGE REQUESTS ARE PROCESSED UNLESS
* 1) NO *DRD-S* ARE FREE.
* 2) ONE *DRD* IS FREE AND THE CARTRIDGE NEEDED
* IS IN USE.
* IN EITHER OF THESE TWO CASES, IF THE *SM* IS
* DESTAGING THE *HLR$DOSTG* FLAG IS SET TO INTERRUPT
* THE DESTAGE.
*
* STEP 4 - THE MASK *STG$MSK* IS SET UP WITH ONE BIT
* PER *SM* SET IF A STAGE REQUEST FROM A *SM* CANNOT
* BE PROCESSED BECAUSE THE FOLLOWING CONDITIONS ARE
* PRESENT -
* 1) NO SPACE IS AVAILABLE FOR NEW *HLRQ* REQUESTS.
* 2) THERE ARE NO *DRD-S* AVAILABLE.
* 3) THE *SM* IS NOT DESTAGING AND THEREFORE CANNOT
* BE INTERRUPTED BY SETTING THE *HLR$DOSTG* FLAG.
#
#
**** PROC TDAM$RP - XREF LIST BEGIN.
#
XREF
BEGIN
PROC ADD$LNK; # ADD ENTRY TO LINK #
PROC CRELSLK; # RELEASE CATALOG INTERLOCK #
PROC CRELSMM; # RELEASE CATALOG IN MODIFY MODE #
PROC DEL$LNK; # DELETE ENTRY FROM LINK #
PROC HLRQENQ; # *HLRQ* ENQUEUER #
PROC SSOVL; # LOAD *MSAS* OVERLAYS #
PROC MSG; # ISSUE MESSAGE #
PROC MSGAFDF; # MESSAGE HANDLER #
PROC ZFILL; # ZERO FILL BUFFER #
END
#
**** PROC TDAM$RP - XREF LIST END.
#
DEF LISTCON #0#; # DO NOT LIST COMMON DECKS #
*CALL,COMBFAS
*CALL,COMBCHN
*CALL,COMBOVL
*CALL,COMBTDM
*CALL,COMBUDT
*CALL,COMXCTF
*CALL COMXEMC
*CALL,COMXHLR
*CALL,COMXMFD
*CALL,COMXMSC
ITEM DRDCOUNT I; # DRD COUNT #
ITEM FCT U; # CURRENT *FCT* ORDINAL #
ITEM FULL B; # *DRD* FULL #
ITEM HLRADR U; # *HLRQ* ENTRY ADDRESS #
ITEM HLRDEST U; # ADDRESS OF DESTAGE *HLRQ* ENTRY
#
ITEM I I; # LOOP INDEX #
ITEM LINK I; # ADDRESS OF NEW CHAIN ENTRY #
ITEM OFFSET I; # INCREMENT FROM LINK ADDRESS TO
GET *TDAM* ENTRY #
ITEM RTDADR U; # *RTRQ* ENTRY ADDRESS #
ITEM REMOVE B; # REMOVE ENTRY FROM *RTRQ* #
ITEM SM I; # SM-ID #
ITEM STAT I; # STATUS #
ITEM STDRDCT I; # STAGE DRD COUNT #
ITEM TYPE C(1); # MESSAGE TYPE S #
#
* STEP 1 - SEARCH THE *RTRQ* FOR *TDAM* STAGE REQUESTS
* IF NON-STAGE REQUESTS ARE FOUND PROCESS THEM ACCORDINGLY.
#
RTRQ$CT = 0; # CLEAR *RTRQ* COUNTER #
LINK = CHN$BOC[LCHN"RTD$ACT"];
REPEAT WHILE LINK NQ 0
DO
BEGIN # SCAN *RTRQ* #
RTDADR = LINK;
P<TDAM> = LINK + 1;
P<LINKWRD> = LINK;
LINK = LINK$ADR[0];
REMOVE = FALSE;
#
* CHECK FOR INVALID *TDAM* REQUEST.
#
IF TDAMFC[0] LQ TDAMFCODE"NOREQ" ##
OR TDAMFC[0] GQ TDAMFCODE"FCEND" ##
OR TDAMFC[0] EQ TDAMFCODE"DESTAGE" ##
OR TDAMFC[0] EQ TDAMFCODE"DESTRLS"
THEN
BEGIN
MSG(INVRQC,UDFL1); # INVALID *TDAM* REQUEST #
REMOVE = TRUE;
END
#
* PROCESS *TDAM* REQUEST.
#
IF TDAMFC[0] EQ TDAMFCODE"RCLMCINT" ##
OR TDAMFC[0] EQ TDAMFCODE"RCLMUMI"
THEN # RECLAIM INTERLOCKS #
BEGIN
RCLMCAT = TRUE;
SSOVL(LRCLMLK,0);
REMOVE = TRUE;
END
IF TDAMFC[0] EQ TDAMFCODE"RLSCINT"
THEN # RELEASE CATALOG INTERLOCKS #
BEGIN
REMOVE = TRUE;
IF DSC$FAM NQ TDAMPFUFAM[0]
THEN # DESTAGE REQUESTS NOT ACTIVE ON
FAMILY #
BEGIN
CRELSLK(TDAMPFUFAM[0],TDAMMASK[0],0,STAT);
END
ELSE # RELEASE INTERLOCKS LATER #
BEGIN
DSC$LKTYP = 0;
DSC$LKMSK = DSC$LKMSK LOR TDAMMASK[0];
END
END
IF TDAMFC[0] EQ TDAMFCODE"RLSUMI"
THEN # RELEASE UPDATE MODE INTERLOCK #
BEGIN
REMOVE = TRUE;
IF DSC$FAM NQ TDAMPFUFAM[0]
THEN # DESTAGE REQUESTS NOT ACTIVE ON
FAMILY #
BEGIN
CRELSMM(TDAMPFUFAM[0],TDAMMASK[0],0,STAT);
END
ELSE # RELEASE INTERLOCK LATER #
BEGIN
DSC$LKTYP = 1;
DSC$LKMSK = DSC$LKMSK LOR TDAMMASK[0];
END
END
#
* PROCESS STAGE REQUEST.
#
IF TDAMFC[0] EQ TDAMFCODE"STAGE"
THEN
BEGIN # PROCESS STAGE REQUEST #
#
* SET *SM* INDEX.
#
P<ASA> =
LOC(TDAMASA
[0]); SM = ASASM[0];
RTRQ$CT = RTRQ$CT + 1;
#
* IF NO *DRD-S* ARE FREE - DO NOT PROCESS THE REQUEST.
* IF DESTAGING IS BEING DONE, SET BIT IN *HLRQ* FOR
* DESTAGER TO PROCESS STAGE REQUESTS WHEN DONE DESTAGING.
*
* IF ONE *DRD* IS FREE - PROCESS THE REQUEST UNLESS THE
* CARTRIDGE IS IN USE.
* IF DESTAGER IS USING THIS CARTRIDGE, SET THE *DOSTG*
* FLAG IN THE *HLRQ*.
#
SLOWFOR I=1 STEP 1 UNTIL MAXSMUNIT
DO
BEGIN # UNTIL SM FOUND #
IF SM EQ SM$ID[I]
THEN
BEGIN # CHECK *FCT* IN USE #
DRDCOUNT = 0;
FULL = FALSE;
IF D0$ON[I]
THEN
BEGIN
DRDCOUNT = 1;
END
IF D1$ON[I]
THEN
BEGIN
DRDCOUNT = DRDCOUNT + 1;
END
IF SM$STNUM[I] EQ 0
THEN
BEGIN
GOTO TDAM$CONT;
END
STDRDCT = SM$STNUM[I];
IF SM$REQRES1[I] NQ 0
AND SM$REQRES2[I] NQ 0
THEN
BEGIN
FULL = TRUE;
END
IF DRDCOUNT EQ 1
THEN
BEGIN
IF (SM$REQRES1[I] NQ 0)
OR (SM$REQRES2[I] NQ 0)
THEN
BEGIN
FULL = TRUE;
END
END
IF SM$REQRES1[I] NQ 0
THEN
BEGIN # CHECK FIRST RESERVE AREA #
IF NOT SM$LLRQ1[I]
THEN
BEGIN # RESERVED BY *HLRQ* #
P<HLRQ> = SM$REQRES1[I];
IF HLR$HPN[0] EQ HLRPN"STAGE"
THEN
BEGIN
STDRDCT = STDRDCT - 1;
END
IF STDRDCT EQ 0
THEN
BEGIN
FULL = TRUE;
END
IF HLR$FCTX[0] NQ 0
THEN
BEGIN
FCT = HLR$FCTX[0];
END
ELSE
BEGIN
FCT = HLR$ASAFCT[0];
END
IF ASAFCT[0] EQ FCT ##
AND TDAMFAM[0] EQ HLR$FAM[0] ##
AND TDAMSBF[0] EQ HLR$SBF[0]
THEN
BEGIN # DUPLICATE REQUEST #
IF SM$DSFLAG1[I]
THEN
BEGIN # DESTAGING *HLRQ* #
HLR$DOSTG[0] = TRUE;
TEST DUMMY;
END
ELSE
BEGIN # STAGE *HLRQ* #
TEST DUMMY;
END
END # END DUPLICATE REQUEST #
IF FULL AND SM$DSFLAG1[I]
THEN # CLEAR *DRD* ON END OF SUB FAMILY #
BEGIN
HLR$DOSTG[0] = TRUE;
END
END # RESERVED *HLRQ* #
END # END CHECK FOR FIRST RESERVATION #
IF SM$REQRES2[I] NQ 0
THEN
BEGIN # CHECK SECOND RESERVE AREA #
IF NOT SM$LLRQ2[I]
THEN
BEGIN # RESERVED BY *HLRQ* #
P<HLRQ> = SM$REQRES2[I];
IF HLR$HPN[0] EQ HLRPN"STAGE"
THEN
BEGIN
IF STDRDCT NQ 0
THEN
BEGIN
STDRDCT = STDRDCT - 1;
END
END
IF STDRDCT EQ 0
THEN
BEGIN
FULL = TRUE;
END
IF HLR$FCTX[0] NQ 0
THEN
BEGIN
FCT = HLR$FCTX[0];
END
ELSE
BEGIN
FCT = HLR$ASAFCT[0];
END
IF ASAFCT EQ FCT ##
AND TDAMFAM[0] EQ HLR$FAM[0] ##
AND TDAMSBF[0] EQ HLR$SBF[0]
THEN
BEGIN # DUPLICATE REQUEST #
IF SM$DSFLAG2[I]
THEN
BEGIN # DESTAGING *HLRQ* #
HLR$DOSTG[0] = TRUE;
TEST DUMMY;
END
ELSE
BEGIN # STAGE *HLRQ* #
TEST DUMMY;
END
END # END DUPLICATE REQUEST #
IF FULL AND SM$DSFLAG2[I]
THEN # CLEAR *DRD* ON END OF SUB FAMILY #
BEGIN
HLR$DOSTG[0] = TRUE;
END
END # RESERVED *HLRQ* #
END # END CHECK FOR SECOND RESERVATION #
GOTO TDAM$CONT; # *SM* FOUND #
END # END *FCT* IN USE #
END # END *SM* SEARCH #
TDAM$CONT:
IF(SM$HWOFF[I] OR NOT SM$ON[I]) ##
OR (NOT D0$ON[I] AND NOT D1$ON[I]) ##
OR (SM$STNUM[I] EQ 0)
THEN # *SM* /*DRD* NOT USABLE #
BEGIN
STAT = STGERRC"SMOFF";
TYPE = "S"; # SET MESSAGE TYPE #
MSGAFDF(TYPE,"ES",STAT,RTDADR + 1);
REMOVE = TRUE;
GOTO TDAM$CONT1;
END
IF FULL
THEN # NO *DRD* AVAILABLE #
BEGIN
TEST DUMMY;
END
#
* IF SPACE IS AVAILABLE, PUT ENTRY INTO *HLRQ* AND UPDATE THE
* *SM* STATUS LIST.
#
HLRADR = CHN$BOC[LCHN"HL$FRSPC"];
IF HLRADR NQ 0
THEN
BEGIN # BUILD *HLRQ* ENTRY #
RTRQ$CT = RTRQ$CT - 1;
HLRQENQ(HLRADR);
P<HLRQ> = HLRADR;
IF SM$REQRES1[I] EQ 0
THEN
BEGIN
SM$REQRES1[I] = HLRADR;
HLR$DRDRA[0] = LOC(SM$REQRES1[I]);
END
ELSE
BEGIN
SM$REQRES2[I] = HLRADR;
HLR$DRDRA[0] = LOC(SM$REQRES2[I]);
END
HLR$HPN[0] = HLRPN"STAGE";
HLR$TDAM[0] = TDAMREQST[0];
HLR$SM[0] = SM;
REMOVE = TRUE;
END # BUILD *HLRQ* ENTRY #
END
TDAM$CONT1:
IF REMOVE
THEN # REMOVE ENTRY FROM *RTRQ* #
BEGIN
DEL$LNK(RTDADR,LCHN"RTD$ACT",0);
ZFILL(TDAM,TDAMLEN);
ADD$LNK(RTDADR,LCHN"RTD$FRSPC",0);
END
#
* GET NEXT *TDAM* ENTRY.
#
END # SCAN *RTRQ* #
STG$MSK = 1; # STOP NEWWORK REQUESTS #
END # TDAM$RP #
TERM