SXSTGE
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
