Retro1.org codex

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