SXDEST
PROC DS$$DOC; 
  
# TITLE DS$$DOC - DESIGN DOCUMENTATION FOR THE DESTAGE PROCESS.       # 
  
      BEGIN  # DS$$DOC #
  
# 
*                   D E S T A G I N G    O V E R V I E W
* 
*     *SSMOVE* CREATES A FILE CALLED *MVOCOM* (UI = 377760B) WHICH HAS
*     AN ENTRY FOR EACH FILE TO BE DESTAGED OR DESTAGED AND RELEASED. 
*     *SSMOVE* ISSUES A *UCP* CALL TO *SSEXEC* TO INDICATE THAT 
*     DESTAGING IS TO BE DONE.  THE *UCP* REQUEST PROCESSOR *TYP2RP*
*     CALLS *DSSETUP* TO PREPARE FOR FILE DESTAGING.
* 
*     *DSSETUP* COPIES THE DESTAGING ENTRIES (*TDAM* ENTRIES) FROM THE
*     FILE PREPARED BY *SSMOVE* TO EIGHT SCRATCH FILES, ONE PER 
*     SUBFAMILY.  WHILE DOING THIS COPY, IT CALCULATES THE NUMBER OF AU 
*     REQUIRED TO HOLD THE FILES TO BE DESTAGED.  THESE REQUIREMENTS
*     ARE USED BY THE ALLOCATOR (*DSALLO*) TO SELECT THE BEST STORAGE 
*     MODULE AND CARTRIDGE FOR THE SET OF FILES IN ATTEMPTING TO
*     SATISFY THE DUAL OBJECTIVES OF AVOIDING CARTRIDGE OVERFLOW AND
*     REDUCING CARTRIDGE ACCESS TIME BY PLACING MANY FILES ON THE SAME
*     CARTRIDGE.
* 
*     WHEN THE EIGHT SCRATCH FILES ARE PREPARED, THE FILE FROM *SSMOVE* 
*     IS REWOUND AND IS READY TO BE USED TO REPORT BACK TO *SSMOVE* THE 
*     IDENTITY OF ALL FILES WHICH COULD NOT BE DESTAGED.  THE REASON
*     FOR EACH SUCH FAILURE IS ALSO SUPPLIED.  THE VARIABLE *DSC$INIT*
*     IS SET NON-ZERO TO SIGNAL THE MAIN LOOP THAT DESTAGING IS TO BE 
*     INITIATED.  *MAINLP* CALLS *NEWWORK* WHICH GETS AN *HLRQ* ENTRY 
*     AND THEN CALLS *DSNTDAM* TO SELECT A SUBFAMILY AND FILE TO START
*     DESTAGING.
* 
*     IT SHOULD BE NOTED THAT THE STAGING PROCESS CAN PRE-EMPT THE
*     CARTRIDGE OR *HLRQ* ENTRY USED FOR DESTAGING BY SETTING THE 
*     *DOSTG* FLAG IN THE *HLRQ* ENTRY.  WHEN DESTAGER IS DONE WITH THE 
*     CURRENT CARTRIDGE (EXCEPT IN A CARTRIDGE OVERFLOW CONDITION), IT
*     WILL CALL *STNTDAM* TO SELECT A FILE TO BE STAGED FROM THE
*     CURRENT CARTRIDGE USING THE CURRENT *HLRQ* ENTRY.  WHEN THIS
*     OCCURS, THE *DSC$INIT* FLAG IS AGAIN SET NON-ZERO TO CAUSE THE
*     DESTAGING PROCESS TO BE RE-INITIATED. 
# 
  
                                               CONTROL EJECT; 
  
# 
*           M A J O R   R O U T I N E S   I N   D E S T A G I N G 
* 
*     1)   DSSETUP   IS CALLED BY *TYP2RP* WHEN *SSMOVE* MAKES A *UCP*
*     REQUEST TO *SSEXEC*.  IT COPIES THE *TDAM* ENTRIES FOR FILES TO 
*     BE DESTAGED FROM THE *MVOCOM* FILE TO EIGHT SCRATCH FILES, ONE
*     PER SUBFAMILY.
* 
*     2)  DESTAGR   IS CALLED BY THE *HLRQ* MONITOR TO DESTAGE A FILE.
*     IT CALLS PROCEDURES 3 AND 5-8 BELOW TO ASSIST IT IN THIS PROCESS. 
*     WHEN A FILE HAS BEEN DESTAGED, IT CALLS *DSNTDAM* TO UPDATE THE 
*     *HLRQ* ENTRY TO REFLECT THE NEXT FILE TO BE DESTAGED. 
* 
*     3)  DSALLO    IS CALLED BY *DESTAGR* TO SELECT A STORAGE MODULE 
*     AND CARTRIDGE FOR A FILE AND ALSO ASSIGN SOME UNUSED SPACE TO THE 
*     FILE BEING DESTAGED.
* 
*     4)  ANLZAST   IS A HELPER ROUTINE TO *DSALLO* TO IDENTIFY THE 
*     BEST CARTRIDGE FOR A SHORT FILE AND THE BEST CARTRIDGE OR 
*     CARTRIDGE GROUP FOR A LONG FILE.
* 
*     5)  HLLOAD    IS CALLED BY *DESTAGR* TO INTERFACE WITH THE DRIVER 
*     TO CAUSE A CARTRIDGE TO BE MADE AVAILABLE FOR I/O.
* 
*     6)  HLCPYDC   IS CALLED BY *DESTAGR* TO COPY SOME FILE DATA FROM
*     DISK TO THE CURRENTLY ASSIGNED M860 VOLUME. 
* 
*     7)  HLUNLD    IS CALLED BY *DESTAGR* TO INTERFACE WITH THE DRIVER 
*     TO UNLOAD A CARTRIDGE WHICH IS NO LONGER NEEDED.
* 
*     8)  RLSVOL    IS CALLED BY *DESTAGR* AND *HLCPYDC* (AND OTHER 
*     PROCEDURES) TO RELEASE ANY UNUSED AU BY RETURNING THEM TO THE 
*     CHAIN OF AVAILABLE AU ON THE CURRENT CARTRIDGE. 
* 
*     9)  DSNTDAM   IS CALLED BY *DESTAGR* AND *NEWWORK* WHEN AN *HLRQ* 
*     ENTRY IS AVAILABLE FOR USE IN DESTAGING A FILE.  *DSNTDAM* ISSUES 
*     ANY APPROPRIATE MESSAGES ABOUT THE STATUS OF THE FILE JUST
*     DESTAGED AND SELECTS THE NEXT FILE TO BE DESTAGED, TRYING TO PICK 
*     ONE WHICH WILL FIT ON THE CURRENTLY LOADED CARTRIDGE. 
* 
*     10) LLRQXXX   REPRESENT SEVERAL LOW LEVEL REQUEST MODULES WHICH 
*     ARE CALLED BY THE *HLXXXXX* ROUTINES AS NEEDED TO PERFORM 
*     CARTRIDGE LOADS, UNLOADS, AND COPIES FROM DISK TO CARTRIDGE.
# 
  
                                               CONTROL EJECT; 
  
# 
*     D E S T A G E   O V E R V I E W  ( D E T A I L E D )
* 
*     INPUT TO THE TOTAL DESTAGE PROCESS IS PREPARED BY THE *SSMOVE*
*     UTILITY AND CONSISTS OF ONE FILE WHICH CONTAINS AN ENTRY FOR EACH 
*     FILE WHICH IS TO BE DESTAGED.  THESE ENTRIES HAVE BEEN ORDERED BY 
*     *SSMOVE* TO ASSIST IN REDUCING THE NUMBER OF CARTRIDGE ACCESSES 
*     NEEDED TO DESTAGE ALL THE FILES.  THE FIRST SET OF ENTRIES IS FOR 
*     SUBFAMILY 0, SUBFAMILY 1, ... THROUGH SUBFAMILY 7.  WITHIN EACH 
*     SUBFAMILY, ENTRIES ARE ORDERED SUCH THAT ALL SHORT FILES OCCUR
*     FIRST AND ALL LONG FILES OCCUR AFTERWARDS.  WITHIN THE LIST OF
*     SHORT FILES AND LONG FILES, INDIVIDUAL FILES ARE ORDERED BY 
*     DECREASING FILE LENGTH.  THE *SSMOVE* UTILITY DECLARES A FILE TO
*     BE SHORT IF ITS LENGTH IS LESS THAN A SITE SPECIFIED VALUE. 
* 
*     BY DEFINITION, SHORT FILES ONLY RESIDE ON ONE CARTRIDGE.  IF A
*     SHORT FILE IS ENCOUNTERED WHICH DOES NOT FIT ON ONE CARTRIDGE,
*     THE ATTEMPT TO DESTAGE IT IS ABANDONED DUE TO LACK OF SPACE AND 
*     DESTAGING CONTINUES WITH THE NEXT FILE.  TO REDUCE STAGING DELAYS 
*     DUE TO CARTRIDGE POSITIONING TIME, SHORT FILES ARE STORED AT THE
*     FRONT OF A CARTRIDGE.  A CARTRIDGE DIVISION POINT PARAMETER TO
*     *SSLABEL* DETERMINES THE END OF THE SHORT FILE AREA.
* 
*     LONG FILES ARE ALLOWED TO OVERFLOW FROM ONE CARTRIDGE TO ANOTHER
*     WITHIN A GROUP OF UP TO 16 CARTRIDGES, ALTHOUGH THE DESTAGER
*     ATTEMPTS TO AVOID OR REDUCE CARTRIDGE OVERFLOW AS MUCH AS 
*     POSSIBLE.  IF A LONG FILE DOES NOT FIT ON ANY GROUP OF
*     CARTRIDGES, THE ATTEMPT TO DESTAGE IT IS ABANDONED DUE TO LACK OF 
*     AVAILABLE SPACE.
* 
*     IF THE FIRST FILE OF THE SEQUENCE OF FILES FOR A SUBFAMILY IS A 
*     SHORT FILE, THE ALLOCATOR SELECTS A CARTRIDGE WHICH WILL
*     DEFINITELY HOLD THE FIRST SHORT FILE AND HOPEFULLY WILL HOLD ALL
*     THE SHORT FILES.  IF THIS IS POSSIBLE, THE ALLOCATOR WILL FURTHER 
*     PICK THE CARTRIDGE WHICH IS ABLE TO HOLD THE MOST LONG FILES. 
*     AFTER A CARTRIDGE HAS BEEN SELECTED AND THE FIRST SHORT FILE HAS
*     BEEN DESTAGED, AS MANY OTHER SHORT FILES AS WILL FIT ON THAT
*     CARTRIDGE ARE DESTAGED, AND THEN AS MANY LONG FILES AS WILL FIT 
*     ON THAT CARTRIDGE ARE ALSO DESTAGED.  ALL FILES WHICH DO NOT FIT
*     ON THE CURRENT CARTRIDGE ARE DEFERRED FOR SUBSEQUENT DESTAGING TO 
*     A DIFFERENT CARTRIDGE.  THIS IS DONE BY WRITING THE FILES'S 
*     *TDAM* ENTRY TO A SCRATCH FILE.  WHEN DESTAGING TO THIS FIRST 
*     CARTRIDGE HAS BEEN COMPLETED, THE ABOVE PROCESS IS REPEATED USING 
*     THE LIST OF DEFERRED FILES AS INPUT INSTEAD OF THE ORIGINAL LIST
*     OF FILES FROM *SSMOVE*.  THIS PROCESS CONTINUES ONE CARTRIDGE AT
*     A TIME UNTIL ALL THE SHORT FILES AND AS MANY LONG FILES AS
*     POSSIBLE HAVE BEEN DESTAGED.
* 
*     WHEN ONLY LONG FILES REMAIN TO BE DESTAGED, THE PROCESS CONTINUES 
*     AS DESCRIBED ABOVE.  HOWEVER, IF AT ANY TIME, THE FIRST FILE ON 
*     THE SEQUENCE OF REMAINING FILES WILL NOT FIT ON ONE CARTRIDGE,
*     THEN A GROUP OF CARTRIDGES IS SELECTED AND CARTRIDGES WITHIN THIS 
*     GROUP ARE SELECTED ONE AT A TIME UNTIL THE FIRST FILE HAS BEEN
*     COMPLETELY DESTAGED.  THE DESTAGE PROCESS THEN CONTINUES BY 
*     DESTAGING AS MANY OF THE REMAINING LONG FILES AS POSSIBLE TO THE
*     FINAL CONTINUATION CARTRIDGE AS LONG AS NO FILE HAS TO OVERFLOW 
*     TO ANOTHER CARTRIDGE.  AGAIN, ANY FILES WHICH DO NOT FIT IN THEIR 
*     ENTIRETY ARE DEFERRED FOR DESTAGING TO A SUBSEQUENT CARTRIDGE OR
*     CARTRIDGES BY WRITING THE DESTAGE *TDAM* ENTRY TO A SCRATCH FILE. 
# 
  
                                               CONTROL EJECT; 
  
# 
*                 D E S T A G E   D E T A I L E D   F L O W 
* 
*                         ( N O R M A L   C A S E ) 
* 
*     THE FOLLOWING SEQUENCE OCCURS WHEN A FILE IS DESTAGED.
* 
*     CASE A) NO CARTRIDGE OVERFLOW.
* 
*     PROCEDURE *DSNTDAM* SELECTS THE SUBFAMILY FOR WHICH FILE
*     DESTAGING IS TO OCCUR.  IT THEN SELECTS THE FIRST FILE ON THE 
*     LIST OF FILES SUBMITTED BY *SSMOVE*.  IF SHORT FILES ARE TO BE
*     DESTAGED, THIS FIRST FILE IS THE LONGEST OF THE SHORT FILES.  IF
*     ONLY LONG FILES ARE TO BE DESTAGED, THIS FILE IS THE LONGEST OF 
*     THE LONG FILES. 
* 
*     PROCEDURE *DSALLO* IS CALLED BY *DESTAGR* TO ALLOCATE SOME
*     CARTRIDGE SPACE FOR THE FILE DATA.  SINCE THIS IS THE INITIAL 
*     ALLOCATION CALL, IT FIRST SELECTS A STORAGE MODULE THAT CAN BE
*     USED, READS IN THE *AST* FOR THIS STORAGE MODULE, PICKS A 
*     CARTRIDGE (OR, IF OVERFLOW IS ANTICIPATED, A GROUP OF CARTRIDGES
*     AND THE INITIAL CARTRIDGE TO BE USED WITHIN THIS GROUP), READS IN 
*     THE *FCT* ENTRY FOR THIS CARTRIDGE AND FINALLY ALLOCATES A
*     SEQUENCE OF ALLOCATION UNITS TO BE USED FOR THE FILE DATA.  THIS
*     SEQUENCE IS CALLED A VOLUME.
* 
*     THE DESTAGER THEN CALLS *HLLOAD* TO LOAD THE CARTRIDGE SO IT CAN
*     BE ACCESSED AND MAKES A CALL TO *PFM* TO OBTAIN ACCESS TO THE 
*     FILE DATA.  IT THEN CALLS *HLCPYDC* TO COPY SOME FILE DATA FROM 
*     DISK TO THE CARTRIDGE.  IF THE ENTIRE FILE IS NOT YET COPIED TO 
*     THE CARTRIDGE, CALLS TO ALLOCATE MORE SPACE AND COPY MORE DATA
*     ARE MADE UNTIL THE FILE IS COPIED TO THE CARTRIDGE.  AS EACH
*     VOLUME IS COPIED TO THE CARTRIDGE, THE *FCT* ENTRY IS UPDATED IN
*     MEMORY TO REFLECT THE SEQUENCE OF ALLOCATION UNITS THAT ARE USED
*     TO STORE THE FILE DATA.  UPON COMPLETION OF THIS ALLOCATE/COPY
*     SEQUENCE, *PFM* IS AGAIN CALLED TO UPDATE THE FILE'S *PFC* ENTRY
*     TO REFLECT THE LOCATION OF THE FILE DATA ON THE ALLOCATED 
*     CARTRIDGE.  IF DISK SPACE IS TO BE RELEASED, ANOTHER CALL TO
*     *PFM* IS MADE TO ACHIEVE THIS.
* 
*     CASE B)  ADDITIONAL FILES ON THE SAME CARTRIDGE.
* 
*     UPON COMPLETION OF THE DESTAGE PROCESS FOR THE FIRST FILE,
*     PROCEDURE *DSNTDAM* IS AGAIN CALLED TO SELECT THE NEXT FILE TO BE 
*     DESTAGED.  IT SELECTS ONE WHICH WILL FIT ON THE CURRENT 
*     CARTRIDGE.  IF LONGER FILES EXIST, THEIR DESTAGE ENTRIES ARE
*     STORED ON A SCRATCH FILE TO BE PROCESSED LATER WHEN IT BECOMES
*     NECESSARY TO SWITCH TO A DIFFERENT CARTRIDGE.  THE DESTAGER 
*     ALLOCATES SPACE VIA *DSALLO*, OBTAINS ACCESS TO THE FILE DATA VIA 
*     *PFM* AND COPIES THE FILE TO THE CARTRIDGE USING THE
*     ALLOCATE/COPY SEQUENCE DESCRIBED ABOVE.  THE FILE'S *PFC* ENTRY 
*     IS UPDATED AND THE DISK SPACE RELEASED AS DESCRIBED ABOVE.
* 
*     CASE C)  CARTRIDGE OVERFLOW.
* 
*     THIS DESTAGE PROCESS IS SIMILAR TO CASE A), EXCEPT THAT WHEN THE
*     FIRST CARTRIDGE NO LONGER HAS AVAILABLE SPACE, THE ALLOCATOR
*     SELECTS A CONTINUATION CARTRIDGE.  THIS SECOND CARTRIDGE MUST BE
*     IN THE SAME GROUP AS THE FIRST.  THE LINKAGE INFORMATION FOR THE
*     FIRST CARTRIDGE IS UPDATED TO POINT TO ANOTHER CARTRIDGE WITHOUT
*     IDENTIFYING A SPECIFIC CARTRIDGE OR INITIAL ALLOCATION UNIT.  THE 
*     *FCT* ENTRY FOR THE FIRST CARTRIDGE IS THEN WRITTEN TO DISK, AND
*     THE *FCT* ENTRY FOR THE SECOND CARTRIDGE IS THEN READ TO MEMORY.
*     AFTER THE FIRST VOLUME ON THE SECOND CARTRIDGE HAS BEEN WRITTEN,
*     THE *FCT* ENTRY FOR THE SECOND CARTRIDGE IS UPDATED TO REFLECT
*     THE NEW VOLUME AND WRITTEN TO DISK.  THE *FCT* ENTRY FOR THE
*     FIRST CARTRIDGE IS READ INTO MEMORY, UPDATED TO LINK TO THE 
*     INITIAL ALLOCATION UNIT OF THE FIRST VOLUME ON THE SECOND 
*     CARTRIDGE AND THEN WRITTEN BACK TO DISK.  THE *FCT* ENTRY FOR THE 
*     SECOND CARTRIDGE IS THEN READ BACK TO MEMORY.  UPON COMPLETION OF 
*     THE ALLOCATE/COPY SEQUENCE, THE FILE'S *PFC* ENTRY IS UPDATED AS
*     BEFORE, AND THE DISK SPACE RELEASED IF APPROPRIATE. 
# 
  
                                               CONTROL EJECT; 
  
# 
*                               D E S T A G E 
* 
*       E R R O R   C O N D I T I O N S   A N D   P R O C E S S I N G 
* 
*     THE RESULT OF ANY ERROR ENCOUNTERED IN DESTAGING A FILE IS THAT 
*     THE ERROR CAN BE OVERCOME (SUCH AS A DELAY CONDITION), OR THE 
*     ERROR WILL CAUSE THE DESTAGE TO BE RETRIED, OR THE ERROR WILL 
*     CAUSE THE DESTAGE TO BE ABANDONED.  FILE DESTAGES WHICH ARE 
*     ABANDONED RESULT IN A DAYFILE AND ACCOUNT FILE MESSAGE WITH AN
*     ERROR CODE.  IN ADDITION, *SSMOVE* WILL PRODUCE A NON-CODED 
*     DESCRIPTION OF THE REASON FOR THE DESTAGE FAILING IF THE *NW* 
*     PARAMETER WAS NOT SELECTED. IF A DESTAGE IS TO BE RETRIED, THE
*     DESTAGE REQUEST IS WRITTEN (BY *DSNTDAM*) TO A SCRATCH FILE.
*     AFTER THE CARTRIDGE CURRENTLY IN USE IS SCHEDULED TO BE UNLOADED, 
*     THE ENTRIES ON THE SCRATCH FILE ARE RESCHEDULED FOR ANOTHER 
*     DESTAGE ATTEMPT.
* 
*     CASE A) NO CARTRIDGE OVERFLOW.
* 
*     1)  *DSALLO* MAKES AN INITIAL ACCESS TO THE SUBFAMILY CATALOG TO
*     DETERMINE WHICH STORAGE MODULE TO USE.  IF THE SUBFAMILY CATALOG
*     IS TEMPORARILY NOT AVAILABLE (BECAUSE *PFDUMP* IS DOING A CATALOG 
*     BACKUP DUMP) THE DESTAGE ATTEMPT IS DELAYED BY PLACING THE *HLRQ* 
*     ENTRY ON THE DELAY CHAIN FOR A FEW SECONDS.  THE CATALOG ACCESS 
*     REQUEST IS THEN REPEATED UNTIL THE CATALOG CAN BE ACCESSED.  THIS 
*     TYPE OF CATALOG ACCESS DELAY SHOULD NEVER OCCUR WITH ANY OTHER
*     CATALOG ACCESS REQUEST ISSUED BY THE REST OF THE DESTAGE PROCESS. 
*     IF IT DOES, A FATAL ERROR WILL OCCUR. 
* 
*     2)  *DSALLO* LOOKS AT THE SUBFAMILY CATALOG PREAMBLE AND THE UNIT 
*     DEVICE TABLE (*UDT*) TO IDENTIFY A STORAGE MODULE WHICH IS USABLE 
*     AND WHICH ALSO HAS ENOUGH SPACE FOR THE FILE TO BE DESTAGED.  IF
*     NO SUCH STORAGE MODULE CAN BE FOUND, THE DESTAGE REQUEST IS 
*     ABANDONED.
* 
*     3)  *DSALLO* THEN READS THE *AST* FOR THE SELECTED STORAGE MODULE 
*     SO THE BEST CARTRIDGE OR CARTRIDGE GROUP CAN BE IDENTIFIED.  IF A 
*     READ ERROR OCCURS WHEN READING THE SUBFAMILY CATALOG, THE DESTAGE 
*     IS ABANDONED.  ANY OTHER CATALOG ACCESS ERROR CONDITION IS FATAL. 
* 
*     4)  *DSALLO* THEN EXAMINES THE *AST*.  IF THE FILE IS TOO LONG TO 
*     FIT ON ANY CARTRIDGE OR GROUP OF CARTRIDGES, THE DESTAGE IS 
*     ABANDONED.
* 
*     5)  *DSALLO* THEN READS IN THE *FCT* ENTRY FOR THE SELECTED 
*     CARTRIDGE.  A CATALOG ACCESS ERROR RESULTS IN THE DESTAGE BEING 
*     ABANDONED.  ALSO, IF THE *FCT* ENTRY SAYS THAT THE CARTRIDGE IS 
*     NOT TO BE USED FOR ANY MORE FILES, THE *AST* AND PREAMBLE ARE 
*     UPDATED, AND A NEW CARTRIDGE IS SELECTED. 
* 
*     6)  *DSALLO* THEN ALLOCATES A VOLUME CONSISTING OF A SEQUENCE OF
*     AVAILABLE ALLOCATION UNITS.  IF NONE EXIST AND THE CARTRIDGE OR 
*     GROUP OF CARTRIDGES WAS CHOSEN FOR THIS FILE, THE DESTAGE IS
*     ABANDONED.  IF THIS FILE IS BEING DESTAGED BECAUSE IT SHOULD HAVE 
*     BEEN ABLE TO FIT ON A PREVIOUSLY SELECTED CARTRIDGE, THE DESTAGE
*     IS RETRIED.  THIS ERROR TYPICALLY OCCURS IF A GREATER THAN
*     EXPECTED NUMBER OF STRIPES ARE DEMARKED WHILE PREVIOUS VOLUMES OF 
*     THE FILE WERE BEING WRITTEN.
* 
*     7)  *DSTAGR* CALLS *HLLOAD* TO LOAD THE CARTRIDGE SO DATA CAN BE
*     WRITTEN TO IT.  IF ANY PROBLEMS OCCUR, THE DESTAGE ATTEMPT IS 
*     RETRIED.  ALSO, IF THE CARTRIDGE IS LOST OR IS UNUSABLE DUE TO A
*     LABEL PROBLEM, THE APPROPRIATE FLAGS ARE SET IN THE *FCT* AND 
*     EVENTUALLY IN THE *AST* AND PREAMBLE FOR THE SUBFAMILY CATALOG. 
* 
*     8)  *DSTAGR* THEN CALLS *PFM* TO ACQUIRE ACCESS TO THE FILE DATA. 
*     IF THE REQUEST CAN NOT BE PROCESSED IMMEDIATELY BECAUSE THE 
*     CATALOG TRACK IS INTERLOCKED, *DESTAGR* PLACES THE *HLRQ* ENTRY 
*     ON A DELAY CHAIN FOR A FEW SECONDS AND RETRIES THE CALL UNTIL IT
*     CAN BE PROCESSED.  IF A USER OR SYSTEM ACTION SUCH AS A FILE
*     PURGE OR UPDATE HAS OCCURED SUCH THAT THE REASON FOR SELECTING
*     THE FILE TO BE DESTAGED HAS BEEN INVALIDATED, THE DESTAGE REQUEST 
*     IS ABANDONED. 
* 
*     9)  *DESTAGR* CALLS *HLCPYDC* TO COPY FILE DATA FROM DISK TO THE
*     CARTRIDGE.  A DISK READ ERROR RESULTS IN THE DESTAGE BEING
*     ABANDONED.  ANY OTHER ERROR CAUSES THE DESTAGE TO BE RETRIED.  IF 
*     THE ERROR WAS DUE TO AN UNRECOVERABLE WRITE ERROR (STRIPE DEMARK
*     FAILURE) OR DUE TO EXCESSIVE RECOVERED WRITE ERROS (SUCCESSFUL
*     STRIPE DEMARKS) THE AFFECTED AU(S) ARE MARKED AS FLAWED IN THE
*     *FCT* ENTRY AND WILL NO LONGER BE AVAILABLE FOR ALLOCATION.  IF A 
*     GENERAL HARDWARE PROBLEM OCCURED, THE CARTRIDGE IS ALSO FORCED TO 
*     BE UNLOADED SO ANY FURTHER DESTAGES WILL BEGIN WITH THE SELECTION 
*     OF A STORAGE MODULE AND THEN A CARTRIDGE. 
* 
*     10) UPON COMPLETION OF THE COPY SEQUENCE, *DESTAGR* MAKES A 
*     CATALOG ACCESS REQUEST TO WRITE THE *FCT* ENTRY TO DISK TO
*     PRESERVE THE STATUS OF THE CARTRIDGE SPACE ALLOCATED TO THE FILE. 
*     IT THEN CALLS *PFM* TO UPDATE THE FILE'S *PFC* ENTRY TO REFLECT 
*     THE LOCATION OF THE DATA ON THE CARTRIDGE AND MAY CALL *PFM* TO 
*     RELEASE THE FILE'S DISK SPACE.  A CATALOG ACCESS ERROR RESULTS IN 
*     THE DESTAGE BEING ABANDONED.  A *PFM* ERROR RESPONSE CAN RESULT 
*     IN A DELAY OR MAY RESULT IN THE DESTAGE BEING ABANDONED OR THE
*     DISK SPACE RELEASE NOT BEING DONE.
* 
* 
*             C A R T R I D G E   O V E R F L O W   E R R O R S 
* 
*     11) *DSALLO* CAN ENCOUNTER A CASE WHERE MORE SPACE IS NEEDED, BUT 
*     NONE IS AVAILABLE ON THE CARTRIDGE IN USE.  THE DESTAGE IS
*     ABANDONED IF THIS CARTRIDGE DOES NOT HAVE AN OFF CARTRIDGE LINK 
*     AVAILABLE OR IF NO OTHER CARTRIDGE IN THE GROUP HAS ANY AVAILABLE 
*     SPACE.
* 
*                      A D D I T I O N A L   N O T E S
* 
*     1)  THE ABILITY OF THE M860 CONTROLLER TO DO WRITE ERROR RECOVERY 
*     BY DEMARKING A STRIPE MEANS THAT LESS DATA CAN BE STORED ON AN AU 
*     THAN EXPECTED.  THEREFORE, A FILE MAY REQUIRE ONE OR POSSIBLY 
*     MORE AU THAN ANTICIPATED.  BECAUSE OF THIS, *DSALLO* CALCULATES 
*     AN AMOUNT OF CONTINGENCY SPACE WHICH IT TRIES TO ALLOCATE IN
*     ADDITION TO THE SPACE NEEDED FOR FILE DATA IF NO STRIPES ARE
*     DEMARKED. 
* 
*     2)  IF A FILE DESTAGE IS ABANDONED OR RETRIED, THE DESTAGE
*     PROCESS WILL ATTEMPT TO RELEASE ANY AU ALLOCATED TO THE FILE.  IF 
*     CARTRIDGE OVERFLOW HAS OCCURED, THIS IS NOT DONE. 
* 
*     3)  ANY ERRORS ENCOUNTERED BY THE DRIVER AS IT ATTEMPTS TO UNLOAD 
*     A CARTRIDGE ARE IGNORED BY THE DESTAGE PROCESS. 
* 
# 
  
      END  # DS$$DOC #
  
    TERM
PROC DESTAGR((HLRQADR));
  
# TITLE DESTAGR - DESTAGE FILE FROM DISK TO M860 CARTRIDGE.           # 
  
      BEGIN  # DESTAGR #
  
# 
*     DESTAGR - DESTAGE FILE FROM DISK TO M860 CARTRIDGE. 
* 
*     *DESTAGR* COPIES A PERMANENT FILE FROM DISK TO AN M860
*     CARTRIDGE.  IT SELECTS THE BEST CARTRIDGE(S) FOR THE FILE,
*     ALLOCATES AVAILABLE AU AS NEEDED TO HOLD THE FILE DATA, 
*     ORGANIZES CONSECUTIVE AU INTO VOLUMES AND LINKS THESE 
*     VOLUMES INTO A CHAIN THAT DEFINES THE LOCATION OF THE FILE
*     DATA ON THE CARTRIDGE.  UPON COMPLETION OF THE COPY, THE
*     *FCT* ON DISK IS UPDATED TO REFLECT THE CHAIN OF AU/VOLUMES AND 
*     THE *PFC* ENTRY FOR THE FILE IS UPDATED TO REFLECT THE
*     NEW *ASA* VALUE FOR THE M860 COPY OF THE FILE.  DEPENDING UPON
*     AN INPUT PARAMETER FROM *SSMOVE*, THE DISK SPACE FOR THE FILE 
*     IS RELEASED UPON SUCCESSFUL COMPLETION OF THE DESTAGE.
*     PERFORMANCE MESSAGES ARE WRITTEN TO THE ACCOUNT FILE IF 
*     EXEC WAS CALLED WITH THE TRACE MODE (*TM*) RUN-TIME PARAMETER.
* 
*     PROC DESTAGR((HLRQADR)) 
* 
*     ENTRY      (HLRQADR) - ADDRESS OF THE *HLRQ* ENTRY CONTAINING 
*                            THE DESTAGE REQUEST. 
*                THE PROCESS STATE FIELD (HLR$HPS) INDICATES THE TYPE 
*                OF PROCESSING TO BE DONE ON THIS CALL TO *DESTAGR*.
*                POSSIBLE ACTIONS ARE AS FOLLOWS..
*                 - INITIATE THE DESTAGE PROCESS. 
*                 - RESUME PROCESSING AFTER INTERFACING WITH THE DRIVER,
*                   (TO DO A CARTRIDGE LOAD OR UNLOAD, OR A COPY FROM 
*                    DISK TO CARTRIDGE.)
*                 - RETRY A FUNCTION WHICH COULD NOT BE DONE PREVIOUSLY 
*                   BECAUSE OF AN INTERLOCK CONDITION.
*                    - ACCESS A SUBFAMILY CATALOG 
*                    - INTERFACE TO *PFM* (ACQUIRE THE FILE TO BE 
*                      DESTAGED, ENTER A NEW *ASA* VALUE IN THE *PFC*,
*                      SET AN ERROR FLAG IN THE *PFC*, OR DROP THE
*                      FILES DISK SPACE). 
*     EXIT       THE PROCESS NAME AND STATE FIELDS ARE SET UP TO
*                IDENTIFY THE NEXT PROCESSING ACTION - WHETHER
*                BY *DESTAGR* OR BY ONE OF ITS HELPER 
*                ROUTINES (*HLXXXX*). 
* 
*                PROCESSING LOGIC FOR *DESTAGR* HAS BEEN
*                ORGANIZED INTO THE FOLLOWING STEPS.
* 
*                  1. INITIALIZATION. 
* 
*                  2. ALLOCATE NEXT VOLUME. 
* 
*                  3. UNLOAD CARTRIDGE (IF CARTRIDGE OVERFLOW). 
* 
*                  4. LOAD CARTRIDGE (IF NECESSARY).
* 
*                  5. ACQUIRE ACCESS TO THE PERMANENT FILE (VIA *PFM*). 
* 
*                  6. COPY DATA TO THE ALLOCATED VOLUME.
* 
*                  7. UPDATE THE *FCT* TO REFLECT A SUCCESSFUL COPY.
* 
*                  8. COMPLETE DESTAGING AND UPDATE THE *FCT* ON
*                     DISK, AND THE *PFC* ENTRY FOR THE FILE. 
* 
*                  9. RELEASE DISK SPACE (IF REQUESTED).
* 
*                 10. ERROR PROCESSING. 
* 
*                 11. PREPARE TO DESTAGE NEXT FILE, OR TERMINATE. 
# 
  
      ITEM HLRQADR    U;             # *HLRQ* ENTRY ADDRESS # 
  
# 
****  PROC DESTAGR - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC ADD$LNK;                # ADD ENTRY TO CHAIN # 
        PROC ACQ$FCT;                # ACQUIRE *FCT* ENTRY #
        PROC CKPFETC;                # CHECK *UGET* STATUS #
        PROC CFLUSH;                 # FLUSH SM CATALOG BUFFER #
        PROC CPUTFCT;                # UPDATE *FCT* ENTRY # 
        PROC CRELSLK;                # RELEASE CATALOG INTERLOCKS # 
        PROC DELAY;                  # TIMED DELAY #
        PROC DROPDS;                 # DROP DIRECT FILE DISK SPACE #
        PROC DROPIDS;                # DROP INDIRECT FILE DISK SPACE #
        PROC DSALLO;                 # ALLOCATE SPACE ON SM # 
        PROC DSERCAT;                # DESTAGE ERROR PROCESSOR #
        PROC DSERPFM;                # DESTAGE ERROR PROCESSOR #
        PROC DSNTDAM;                # GET NEXT DESTAGE REQUEST # 
        PROC HLCPYDC;                # CHECK COPY RETURN CODES #
        PROC HLLOAD;                 # CHECK LOAD RETURN CODES #
        PROC HLLDSET;                # SET *HLRQ* INTO *LLRQ* # 
        PROC MSG;                    # ISSUE DAYFILE MESSAGE #
        PROC MSGAFDF;                # ISSUE ACCOUNT-DAYFILE MESSAGE #
        PROC RECALL;                 # GIVE UP CPU FOR A MOMENT # 
        PROC RETERN;                 # RETURN FILE #
        PROC RLSVOL;                 # RELEASE UNUSED VOLUME #
        PROC RLS$FCT;                # RELEASE *FCT* ENTRY #
        PROC SETASA;                 # SET ALTERNATE STORAGE ADDRESS #
        PROC UASTPRM;                # UPDATE *AST* AND PREAMBLE #
        PROC UATTACH;                # UTILITY ATTACH OF FILE # 
        PROC UGET;                   # UTILITY GET OF FILE #
        PROC UPUSAGE;                # UPDATE USAGE INFO #
        PROC ZFILL;                  # ZERO FILL BUFFER # 
        PROC ZSETFET;                # INITIALIZE A FET # 
        END 
  
# 
****  PROC DESTAGR - XREF LIST END. 
# 
  
      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBCHN 
*CALL,COMBCMD 
*CALL,COMBCMS 
*CALL COMBCPR 
*CALL COMBLRQ 
*CALL,COMBMCT 
*CALL,COMBTDM 
*CALL COMBUDT 
*CALL,COMXCTF 
*CALL,COMXEMC 
*CALL,COMXFCQ 
*CALL,COMXHLR 
*CALL COMXIPR 
*CALL,COMXMSC 
*CALL,COMSPFM 
  
      ITEM ATEOI      B;             # END OF INFORMATION # 
      ITEM CC         U;             # CHAIN CONTROL VALUE #
        ITEM CURFCT          U;      # *FCT* OF A PARALLEL *HLRQ* # 
      ITEM DRDCOUNT   I;             # NUMBER OF DRD-S AVAILABLE #
      ITEM DSTGCOUNT  I;             # DRD AVAILABLE TO DESTAGER #
      ITEM FLAG       B;             # BOOLEAN STATUS # 
      ITEM I          I;             # LOOP COUNTER # 
      ITEM QADDR      U;             # *FCT* ENTRY ADDRESS #
      ITEM START      I;             # STARTING AU #
      ITEM STAT       I;             # STATUS # 
      ITEM TEMP       U;             # TEMPORARY #
      ITEM TEMP1      U;             # TEMPORARY #
      ITEM TFAM       C(7);        # TERMPORARY FAMILY #
      ITEM TFCT       U;           # ASAFCT # 
      ITEM TTDAMSBF   U;           # SUBFAMILY NUMBER # 
      ITEM T1         I;             # TEMPORARY #
      ITEM T2         I;             # TEMPORARY #
      ITEM USED       I;             # AU USED #
  
      ARRAY SCR$FET [0:0] P(SFETL); ;  # SCRATCH FET #
  
      STATUS DSLABEL
        DS1A,                        # INITIALIZATION # 
        DS2A,                        # RETRY *DSALLO* CALL #
        DS3A,                        # RE-ENTER AFTER "NORMAL" UNLOAD # 
        DS3B,                        # RE-ENTER AFTER "FORCED" LOAD # 
        DS3C,                        # RE-ENTER AFTER "UNLOAD"  # 
        DS4A,                        # RE-ENTER AFTER *HLLOAD* #
        DS5A,                        # RETRY *UATTACH*/*UGET* CALL #
        DS5B,                        # WAIT *UGET* COMPLETE # 
        DS6A,                        # RE-ENTER AFTER *HLCPYDC* # 
        DS8A,                        # RETRY *SETASA* CALL #
        DS9A,                        # RETRY *DROP(I)DS* CALL # 
        DS11A,                       # RE-ENTER AFTER "NORMAL" UNLOAD # 
        DS11B,                       # RE-ENTER AFTER "FORCED" LOAD # 
        DS11C,                       # RE-ENTER AFTER "UNLOAD"  # 
        DSEND;                       # END OF LIST #
  
  
      SWITCH DSENTR:DSLABEL 
               DS1A:DS1A, 
               DS2A:DS2A, 
               DS3A:DS3A, 
               DS3B:DS3B, 
               DS3C:DS3C, 
               DS4A:DS4A, 
               DS5A:DS5A, 
               DS5B:DS5B, 
               DS6A:DS6A, 
               DS8A:DS8A, 
               DS9A:DS9A, 
              DS11A:DS11A,
              DS11B:DS11B,
              DS11C:DS11C;
  
  
      ARRAY MSGMB    [0:0]  S(5); 
        BEGIN     # MESSAGE BUFFER #
        ITEM MSG$LINE  C(00,00,28) = [" CATALOG *FCT* PROBLEM.     "];
        ITEM MSG$ZERO  U(03,48,12) = [0];   # ZERO-BYTE TERMINATOR #
        END 
  
  
      BASED 
      ARRAY   CLEAR   [0:0]  S(1);
        BEGIN 
        ITEM CLN      U(00,36,24);      # CLEAR *DRD* ASSIGNMENT #
        ITEM RESETDRD U(00,36,24);      # NEW *HLRQ* ADDRESS #
        END 
                                               CONTROL EJECT; 
  
# 
*     STEP 1 - INITIALIZE.
# 
  
      P<HLRQ> = HLRQADR;
      P<TDAM> = LOC(HLR$TDAM[0]); 
  
      GOTO DSENTR[HLR$HPS[0]];
  
DS1A:                                # BEGIN DESTAGE #
  
# 
*     INITIALIZE *HLRQ* FIELDS.  NOTE THAT *HLR$VOLAUP* IS
*     INITIALIZED IN STEP 5 SINCE IT HAS INPUT TO *DSALLO*. 
# 
  
      HLR$RESP[0] = ERRST"NOERR"; 
      HLR$PRU[0] = 0; 
      HLR$1STVOL[0] = 0;
      HLR$NEWASA[0] = 0;
  
      IF TDAMFC[0] EQ TDAMFCODE"STAGE"
      THEN
        BEGIN   # NO RESOURCES - END #
        GOTO ENDALL;
        END 
  
  
# 
*     STEP 1 - END. 
# 
  
                                               CONTROL EJECT; 
  
# 
*     STEP 2 - ALLOCATE CARTRIDGE SPACE.
*            - THE ALLOCATED AU ARE USED IN STEP 6 TO STORE 
*              FILE DATA.  ANY UNUSED AU ARE MADE AVAILABLE 
*              FOR RE-USE IN STEP 7 IF NO ERRORS OCCUR. 
*              IF ERRORS OCCUR IN STEP 6, THE PROCEDURE 
*              *HLCPYDC* WILL MAKE ANY UNFLAWED AU AVAILABLE
*              FOR RE-USE.  IF ERRORS OCCUR ELSEWHERE,
*              STEP 10 WILL MAKE THESE AU AVAILABLE.
# 
  
NEXTVOL:                             # CHOOSE CARTRIDGE AND AUS # 
DS2A:                                # RETRY *DSALLO* CALL #
      HLR$HPS[0] = DSLABEL"DS2A";        # IF WAIT FOR INITERLOCK # 
  
  
      DSALLO(HLRQADR);
  
          HLR$AUUD [0] = HLR$VOLAU [0] ;    # IN CASE OF ERROR #
      IF HLR$RESP[0] EQ ERRST"WAIT" 
      THEN     # *HLRQ* IS ON CATALOG WAIT #
        BEGIN 
        HLR$RESP[0] = 0;
        RETURN; 
        END 
  
      IF HLR$RESP[0] EQ ERRST"SPECIAL"
      THEN
        BEGIN 
        ADD$LNK(HLRQADR,LCHN"HL$DRDRESW",0);
        HLR$RESP[0] = ERRST"NOERR"; 
        RETURN; 
        END 
  
      IF (HLR$RESP[0] EQ ERRST"NOERR" )  ## 
        AND (HLR$VOLLN[0] EQ 0) 
      THEN                           # NO SPACE # 
        BEGIN 
        IF HLR$FFILE[0] 
        THEN                         # ABANDON FIRST FILE # 
          BEGIN 
          HLR$RESP[0] = ERRST"ABANDON"; 
          HLR$ERRC[0] = ABANDON"NOSPACE"; 
          END 
  
        ELSE                         # RETRY OTHER FILES #
          BEGIN 
          HLR$RESP[0] = ERRST"RETRY"; 
          END 
  
        END 
  
      IF HLR$RESP[0] NQ ERRST"NOERR"
      THEN
        BEGIN 
        HLR$HPS[0] = DSLABEL"DS2A";  # IF WAIT FOR INTERLOCK #
        GOTO DSERR; 
        END 
  
# 
*     STEP 2 - END. 
# 
  
                                               CONTROL EJECT; 
  
# 
*     STEP 3 - UNLOAD PREVIOUS CARTRIDGE, IF APPROPRIATE. 
*              - CALL *HLUNLD* TO DO THE UNLOAD. THE CARTRIDGE
*                USAGE STATISTICS ARE RETURNED IN THE *HLRQ*
*                ENTRY AND USED TO UPDATE THE *FCT* IN STEP 7.
*              - ALL ERROR CONDITIONS ENCOUNTERED IN UNLOADING
*                A CARTRIDGE ARE HANDLED BY *HLUNLD*. 
*                SINCE *DESTAGR* DOES NOT NEED THIS CARTRIDGE 
*                TO COMPLETE DESTAGING IT DOES NOT CONCERN
*                ITSELF WITH WHETHER OR NOT UNLOAD ERRORS OCCURRED. 
# 
  
      IF HLR$UNLD[0]
      THEN
        BEGIN  # UNLOAD OLD CARTRIDGE # 
        HLR$UNLD[0] = FALSE;
        IF HLR$HLRQW[0] NQ 0
        THEN
          BEGIN      # SWITCH CONTROL OF *DRD* TO WAITTING *HLRQ* # 
          TEMP = HLR$DRDRA[0];
          TEMP1 = HLR$LRQADR[0];
          P<HLRQ> = HLR$HLRQW[0]; 
          HLR$DRDRA[0] = TEMP;
          HLR$LRQADR[0] = TEMP1;
          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];
          RESETDRD = HLR$HLRQW[0];
          HLR$HLRQW[0] = 0; 
          HLR$DRDRA[0] = 0; 
          HLR$LRQADR[0] = 0;
          END 
  
        ELSE
          BEGIN       # DO UNLOAD OF CARTRIDGE #
          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] = DSLABEL"DS3A"; 
          ADD$LNK(HLR$LRQADR[0],LCHN"LL$READY",0);
          RETURN; 
  
DS3A:     # 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 # 
            HLR$HPS[0] = DSLABEL"DS3B"; 
            RETURN; 
  
DS3B:                                # 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] = DSLABEL"DS3C"; 
                ADD$LNK(HLR$LRQADR[0],LCHN"LL$READY",0);
                RETURN; 
  
DS3C: 
                END      # UNLOAD OF 2ND REQUEST #
              END        # LOAD OF 2ND REQUEST #
            P<CLEAR> = HLR$DRDRA[0];
            CLN = 0;
            HLR$DRDRA[0] = 0; 
  
            END          # PHYSICAL CARTRIDGE UNLOAD #
            END          # ORIGINAL UNLOAD REQUEST #
  
# 
*     STEP 3 END. 
# 
  
                                               CONTROL EJECT; 
  
# 
*     STEP 4 - LOAD CARTRIDGE, IF APPROPRIATE.
*              - CALL *HLLOAD* TO DO THE LOAD AND OBTAIN
*                THE LARGE BUFFER.  *HLLOAD* WILL UPDATE
*                THE *FCT* IF THE CARTRIDGE IS LOST OR HAS
*                AN IMPROPER LABEL. 
*              - IF ERRORS OCCUR, STEP 11 WILL EVENTUALLY CAUSE 
*                THE CARTRIDGE TO BE UNLOADED AND THE 
*                ASSOCIATED LARGE BUFFER TO BE RELEASED.
# 
  
      IF HLR$LOAD[0]
      THEN
        BEGIN  # STEP 4 # 
        SLOWFOR I=1 STEP 1 UNTIL MAXSMUNIT
        DO
          BEGIN     # FIND *SM* # 
          IF HLR$SM[0] EQ SM$ID[I]
          THEN
            BEGIN 
            GOTO SMFOUND; 
            END       # *SM* FOUND #
          END       # *SM* SEARCH COMPLETE #
  
SMFOUND:  
        DRDCOUNT = 0; 
        IF D0$ON[I] 
        THEN
          BEGIN 
          DRDCOUNT = 1; 
          END 
  
        IF D1$ON[I] 
        THEN
          BEGIN 
          DRDCOUNT = DRDCOUNT + 1;
          END 
  
        IF SM$DSNUM[I] EQ 0 
        THEN     # DESTAGE DISABLED ON THIS SM #
          BEGIN 
          HLR$RESP[0] = ERRST"SMDSTAGEOFF"; 
          GOTO DSINERR; 
          END 
  
        DSTGCOUNT = SM$DSNUM[I];
  
        TTDAMSBF = HLR$SBF[0];
        TFCT = HLR$FCTX[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$HPN[0] EQ HLRPN"DESTAGE" 
            THEN
              BEGIN 
              DSTGCOUNT = DSTGCOUNT - 1;
  
              IF DSTGCOUNT EQ 0 
              THEN    # DO NOT LET A NEW DESTAGE START #
                BEGIN 
                P<HLRQ> = HLRQADR;     # SET ERROR TO ORGINIAL HLRQ # 
                HLR$RESP[0] = ERRST"RSFULL";
                GOTO DSINERR; 
                END 
              END 
  
  
            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;
                  HLR$HPS[0] = DSLABEL"DS5A"; 
                  HLR$LOAD[0] = FALSE;
                  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$HPN[0] EQ HLRPN"DESTAGE" 
            THEN
              BEGIN 
              DSTGCOUNT = DSTGCOUNT - 1;
  
              IF DSTGCOUNT EQ 0 
              THEN    # DO NOT LET A NEW DESTAGE START #
                BEGIN 
                P<HLRQ> = HLRQADR;   # SET ERROR TO ORGINIAL HLRQ # 
                HLR$RESP[0] = ERRST"RSFULL";
                GOTO DSINERR; 
                END 
              END 
  
  
            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;
                  HLR$HPS[0] = DSLABEL"DS5A"; 
                  HLR$LOAD[0] = FALSE;
                  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;
        IF (SM$REQRES1[I] NQ 0)         ##
          AND (SM$REQRES2[I] NQ 0)
        THEN
          BEGIN 
          HLR$RESP[0] = ERRST"RSFULL";
          GOTO DSINERR; 
          END 
  
          IF DRDCOUNT EQ 1
          THEN
            BEGIN 
            IF(SM$REQRES1[I] NQ 0)         ## 
              OR (SM$REQRES2[I] NQ 0) 
            THEN
              BEGIN 
              HLR$RESP[0] = ERRST"RSFULL";
              GOTO DSINERR; 
              END 
            END       # END OF ONE *DRD* #
  
        IF SM$REQRES1[I] EQ 0 
        THEN       # RESERVE *DRD* #
          BEGIN 
          SM$REQRES1[I] = HLRQADR;
          SM$DSFLAG1[I] = TRUE; 
          HLR$DRDRA[0] = LOC(SM$REQRES1[I]);
          END 
  
        ELSE
          BEGIN 
          SM$REQRES2[I] = HLRQADR;
          SM$DSFLAG2[I] = TRUE; 
          HLR$DRDRA[0] = LOC(SM$REQRES2[I]);
          END 
  
        HLR$HPS[0] = DSLABEL"DS4A"; 
        HLLDSET((HLRQADR));     # MOVE *HLRQ* DATA TO *LLRQ* #
        MSGAFDF("I","LD",0,HLRQADR);
        RETURN;         # WAIT LOAD OF CARTRIDGE #
  
DS4A: 
        HLLOAD((HLRQADR));     # CHECK RETURN CODES # 
DSINERR:                             # IF *DRD* NOT ASSIGNED #
      P<HLRQ> = HLRQADR;
        HLR$LOAD[0] = FALSE;
        IF HLR$RESP[0] NQ ERRST"NOERR"
        THEN
          BEGIN 
          HLR$ERRC[0] = ERRST"SPECIAL"; 
          GOTO DSERR; 
          END 
  
        END  # STEP 4 # 
  
                                               CONTROL EJECT; 
  
# 
*     STEP 5 - ACQUIRE FILE FROM *PFM*, IF APPROPRIATE. 
*              - ISSUE A *UATTACH* IF DIRECT ACCESS, OTHERWISE, 
*                ISSUE A *UGET*.
*              - CAUSE THE *PFC* ENTRY TO BE STORED AT *HLR$PFC*. 
*              - RELOOP IF THE *UATTACH* OR *UGET* REQUEST
*                CAN NOT BE PROCESSED DUE TO SOME DELAY CONDITION.
*              - ABANDON DESTAGE IF THE FILE HAS BEEN DESTAGED. 
*              - CLEAR THE *HLR$VOLAUP* FIELD.
# 
  
DS5A:                                # RETRY *UATTACH*/*UGET* CALL #
      IF HLR$FVOL[0]
      THEN
        BEGIN  # STEP 5 # 
        NAMEC[0] = HLR$FLNM[0]; 
        NAMEC[2] = TDAMPFN[0];
        NAMEC[1] = TDAMFAM[0];
  
        P<PFC> = LOC(HLR$PFC[0]); 
  
        IF NOT TDAMIA[0]
        THEN
          BEGIN  # DIRECT ACCESS FILE # 
          UATTACH(NAME[0],PFMSTAT,6,NAME[2],PTRD,TDAMUI[0],NAME[1],  ## 
            TDAMPFID[0],PFC[0],TDAMCDT[0],LOC(PFMRET)); 
          HLR$PRU[0] = 0;            # START WITH SYSTEM SECTOR # 
          END  # DIRECT ACCESS FILE # 
  
        ELSE
          BEGIN  # INDIRECT ACCESS FILE # 
          UGET(NAME[0],PFMSTAT,6,NAME[2],TDAMUI[0],NAME[1],    ## 
            TDAMPFID[0],PFC[0],TDAMCDT[0],LOC(PFMRET)); 
  
          HLR$PRU[0] = 1;            # START WITH 1ST DATA SECTOR # 
          PFMSTAT = -1; 
          HLR$HPS[0] = DSLABEL"DS5B"; 
          GLPFMFL = TRUE; 
          ADD$LNK(HLRQADR,LCHN"HL$PFMWAIT",0);
          RETURN; 
  
          END  # INDIRECT ACCESS FILE # 
DS5B: 
          P<PFC> = LOC(HLR$PFC[0]); 
  
# 
*     CHECK FOR ERROR ON UGET OR UATTACH. 
# 
  
        IF PFMSTAT NQ 0 
        THEN
          BEGIN 
          DSERPFM(HLRQADR,PFMSTAT); 
          IF HLR$RESP[0] NQ ERRST"NOERR"
          THEN
            BEGIN 
            HLR$HPS[0] = DSLABEL"DS5A"; 
            GOTO DSERR; 
            END 
  
          END 
  
        IF TDAMASA[0] NQ PFC$AA[0]
        THEN                         # IF FILE ALREADY DESTAGED # 
          BEGIN 
          HLR$RESP[0] = ERRST"ABANDON"; 
          HLR$ERRC[0] = ABANDON"NEWASA";; 
          GOTO DSERR; 
          END 
  
        HLR$VOLAUP[0] = 0;
        HLR$CSNDP[0] = "";
        HLR$CCODP[0] = "";
        HLR$VOLLNP[0] = 0;
  
        MSGAFDF("B", "BD",0,HLRQADR); 
  
        END  # STEP 5 # 
  
                                               CONTROL EJECT; 
  
# 
*     STEP 6 - COPY DATA TO THE NEXT VOLUME.
*              - CALL *HLCPYDC* TO EFFECT THE COPY. 
*              - IF NO ERROR, *HLR$AUUD* IDENTIFIES THE 
*                LAST AU WRITTEN.  *HLR$EOI* IS SET IF
*                THE DESTAGE IS COMPLETE. 
# 
  
      P<LLRQ> = HLR$LRQADR[0];
      HLR$HPS[0] = DSLABEL"DS6A"; 
      LLR$PRCNME[0] = REQTYP4"CPY$DA";
      LLR$PRCST[0] = PROCST"INITIAL"; 
      LLR$DR[0] = 0;
      ADD$LNK(HLR$LRQADR[0],LCHN"LL$READY",0);
      RETURN;        # START COPY # 
  
DS6A:                   # RE-ENTER AFTER COPY COMPLETE #
  
      HLCPYDC((HLRQADR));      # CHECK RETURN CODES # 
      IF HLR$RESP[0] NQ ERRST"NOERR"
      THEN
        BEGIN 
        GOTO DSERR; 
        END 
  
# 
*     STEP 6 - END. 
# 
  
                                               CONTROL EJECT; 
  
# 
*     STEP 7 - UPDATE *FCT* ENTRY TO REFLECT NEW VOLUME.
# 
  
# 
*     STEP 7.1 - RELEASE UNUSED AU. 
# 
  
      USED = HLR$AUUD[0]+1-HLR$VOLAU[0];
      RLSVOL(HLRQADR,HLR$FCTQ[0],HLR$AUUD[0]+1,HLR$VOLLN[0]-USED);
  
  
      P<PFC> = LOC(HLR$PFC[0]); 
  
      IF TDAMIA[0]
      THEN
        BEGIN 
        ATEOI = (HLR$PRU[0] - 1) GQ HLR$PFC$LN[0];
        END 
  
      ELSE
        BEGIN             # DIRECT FILE # 
        ATEOI = HLR$PRU[0] GQ HLR$PFC$LN[0];
        END 
  
  
# 
*     STEP 7.2 - ORGANIZED USED AU INTO ONE VOLUME. 
*                (CC=LAST, LINK=0, LENGTH=WHATEVER).
*              - THE LINK FIELD IS SET TO ZERO TO FACILITATE
*                ERROR CORRECTION WHEN A PARTIAL CHAIN EXISTS.
*                *SSVAL* WILL TREAT A CHAIN WHICH HAS NO *PFC*
*                ENTRY AND HAS CC=FIRST OR MIDDLE AND A 
*                LINK=0 AS IF IT WERE A NORMAL ORPHAN.  THIS
*                PERMITS THE NORMAL M860 SPACE MANAGEMENT 
*                PROCESS TO MAKE THIS SPACE AVAILABLE WITHOUT 
*                HUMAN INTERVENTION.
# 
  
      P<FCT> = HLR$FCTQ[0] + FCTQHL;
      T1 = 0; 
      T2 = 0; 
      START = HLR$VOLAU[0]; 
  
      FOR I = 0 STEP 1 UNTIL USED-1 
      DO
        BEGIN 
        SETFCTX(START+I);            # SET *FWD* AND *FPS* VALUES # 
  
        FCT$CLFG(FWD,FPS) = 0;
        FCT$FBF(FWD,FPS) = 1; 
        FCT$CAUF(FWD,FPS) = T1; 
        FCT$CC(FWD,FPS) = CHAINCON"LAST"; 
        FCT$LEN(FWD,FPS) = USED - 1 - I;
        FCT$LINK(FWD,FPS) = T2; 
  
        T1 = 1;                      # ALL BUT THE FIRST AU ARE 
                                       CONTINUATION AU #
        T2 = START; 
  
        END 
  
# 
*     SAVE THE ID OF THE FIRST ALLOCATED VOLUME ON THE
*     CARTRIDGE IN CASE THE DESTAGE IS ABANDONED.  THEN THE 
*     ALLOCATED SPACE CAN BE RELEASED AND REUSED. 
# 
  
      IF HLR$1STVOL[0] EQ 0 
      THEN
        BEGIN 
        HLR$1STVOL[0] = START;
        END 
  
      HLR$VOLLN[0] = 0;              # PREVENT RE-RELEASING IF FUTURE 
                                       ERROR RECOVERY # 
                                               CONTROL EJECT; 
  
# 
*     STEP 7.3 - SAVE NEW *FCT* ENTRY, AND GET OLD *FCT* ENTRY. 
# 
  
      IF HLR$JOF[0] 
      THEN
        BEGIN  # GET *FCT* ENTRY FOR PREVIOUS CARTRIDGE # 
        RLS$FCT(HLR$FCTQ[0],0,STAT);
        HLR$FCTQ[0] = 0;             # PREVENT A 2ND RELEASE #
        IF STAT EQ CMASTAT"NOERR" 
        THEN
          BEGIN 
          ACQ$FCT(TDAMFAM[0],TDAMSBF[0],HLR$SM[0],  ##
            HLR$FCTXP[0],QADDR,0,STAT); 
          END 
  
        IF STAT NQ CMASTAT"NOERR" 
        THEN
          BEGIN 
          DSERCAT(HLRQADR,STAT);
          GOTO DSERR; 
          END 
  
        P<FCT> = QADDR + FCTQHL;
  
# 
*     UPDATE CARTRIDGE USAGE STATISTICS.
*     UPDATE *AST* AND THE PREAMBLE TO REFLECT THE SPACE NOW AVAILABLE. 
# 
  
        UPUSAGE(HLRQADR,QADDR); 
  
        UASTPRM(TDAMFAM[0],TDAMSBF[0],HLR$SM[0],QADDR,STAT);
  
        IF STAT NQ CMASTAT"NOERR" 
        THEN
          BEGIN 
          DSERCAT(HLRQADR,STAT);
          RLS$FCT(QADDR,0,STAT);
          GOTO DSERR; 
          END 
  
        END  # GET *FCT* ENTRY FOR PREVIOUS CARTRIDGE # 
  
                                               CONTROL EJECT; 
  
# 
*     STEP 7.4 - UPDATE LINK TO THIS VOLUME.
# 
  
      IF HLR$FVOL[0]
      THEN                           # SET LINKAGE IN *HLRQ* #
        BEGIN 
        P<ASA> = LOC(HLR$NEWASA[0]);
        ASASM[0] = HLR$SM[0]; 
        ASAFCT[0] = HLR$FCTX[0];
        ASAAU[0] = HLR$VOLAU[0];
  
        END 
  
      ELSE                           # SET LINKAGE IN PREVIOUS VOLUME # 
        BEGIN 
        SETFCTX(HLR$VOLAUP[0]);      # SET *FWD* AND *FPS* VALUES # 
  
        FCT$LINK(FWD,FPS) = HLR$VOLAU[0]; 
  
        IF HLR$JOF[0] 
        THEN
          BEGIN 
          T1 = FCT$CLKOCL(FWD,FPS); 
          FCT$OCLNK(T1) = HLR$FCTX[0];
          END 
  
        END 
  
                                               CONTROL EJECT; 
  
# 
*     STEP 7.5 - UPDATE BACKLINK INFORMATION. 
# 
  
      HLR$VOLAUP[0] = HLR$VOLAU[0]; 
      HLR$VOLLNP[0] = USED; 
  
# 
*     STEP 7.6 - RESTORE NEW *FCT* ENTRY, IF APPROPRIATE. 
# 
  
      IF HLR$JOF[0] 
      THEN
        BEGIN 
        RLS$FCT(QADDR,0,STAT);
        IF STAT EQ CMASTAT"NOERR" 
        THEN
          BEGIN 
          ACQ$FCT(TDAMFAM[0],TDAMSBF[0],HLR$SM[0],  ##
            HLR$FCTX[0],QADDR,0,STAT);
          END 
  
        IF STAT NQ CMASTAT"NOERR" 
        THEN
          BEGIN 
          DSERCAT(HLRQADR,STAT);
          GOTO DSERR; 
          END 
  
        P<FCT> = QADDR + FCTQHL;
        HLR$FCTQ[0] = QADDR;
        END 
  
                                               CONTROL EJECT; 
  
# 
*     STEP 7.7 - SET CORRECT VALUE IN *CC* FIELD. 
# 
  
      IF HLR$FVOL[0]
      THEN
        BEGIN  # FIRST OR ONLY VOLUME # 
        IF ATEOI
        THEN
          BEGIN 
          CC = CHAINCON"ONLY";
          END 
  
        ELSE
          BEGIN 
          CC = CHAINCON"FIRST"; 
          END 
  
        END  # FIRST OR ONLY VOLUME # 
  
      ELSE
        BEGIN  # MIDDLE OR LAST # 
        IF ATEOI
        THEN
          BEGIN 
          CC = CHAINCON"LAST";
          END 
  
        ELSE
          BEGIN 
          CC = CHAINCON"MIDDLE";
          END 
  
        END  # MIDDLE OR LAST # 
  
      SETFCTX(HLR$VOLAU[0]);         # SET *FWD* AND *FPS* VALUES # 
  
      FCT$CC(FWD,FPS) = CC; 
  
# 
*     STEP 7 - END. 
# 
  
                                               CONTROL EJECT; 
  
# 
*     STEP 8 - COMPLETE DESTAGING OF THIS FILE. 
# 
  
      HLR$FVOL[0] = FALSE;
  
      IF NOT ATEOI
      THEN
        BEGIN 
        GOTO NEXTVOL; 
        END 
  
# 
*     STEP 8.2 - WRITE *FCT* ENTRY TO DISK. 
# 
  
      CPUTFCT(TDAMFAM[0],TDAMSBF[0],HLR$SM[0],  ##
        HLR$FCTX[0],P<FCT>,HLRQADR,STAT); 
  
      IF STAT EQ 0
      THEN
        BEGIN 
        CFLUSH(TDAMFAM[0],TDAMSBF[0],HLRQADR,STAT); 
        END 
  
      IF STAT NQ 0
      THEN
        BEGIN 
        DSERCAT(HLRQADR,STAT);
        GOTO DSERR; 
        END 
  
# 
*     STEP 8.4 - ISSUE *SETASA* TO COMPLETE DESTAGE.
# 
  
DS8A:                                # RETRY *SETASA* CALL #
  
      HLR$HPS[0] = DSLABEL"DS8A";    # IF WAIT CONDITION #
      NAMEC[0] = HLR$FLNM[0]; 
      NAMEC[1] = TDAMFAM[0];
  
  
      TDAMASA[0] = HLR$NEWASA[0]; 
      TDAMAT[0] = ATAS; 
  
      SETASA(NAME[0],STAT,6,TDAMUI[0],NAME[1],TDAMPFID[0],  ##
        TDAMASI[0],TDAMCDT[0],LOC(PFMRET)); 
  
      IF STAT NQ 0
      THEN
        BEGIN 
        DSERPFM(HLRQADR,STAT);
        IF HLR$RESP[0] NQ ERRST"NOERR"
        THEN
          BEGIN 
          GOTO DSERR; 
          END 
  
        HLR$NEWASA[0] = 0;   # CLEAR FOR NO FURTHER *FCT* RELEASE # 
        END 
  
# 
*     STEP 8 - END. 
# 
  
                                               CONTROL EJECT; 
  
# 
*     STEP 9 - RELEASE DISK SPACE, IF REQUESTED.
# 
  
      IF TDAMFC[0] EQ TDAMFCODE"DESTRLS"
      THEN
        BEGIN  # DO RELEASE PROCESSING #
DS9A:                                # RETRY *DROP(I)DS* CALL # 
        HLR$HPS[0] = DSLABEL"DS9A";  # IF NEED TO RETRY *PFM* CALL #
        NAMEC[0] = HLR$FLNM[0]; 
        NAMEC[1] = TDAMFAM[0];
        IF TDAMIA[0]
        THEN                         # INDIRECT ACCESS FILE # 
          BEGIN 
          DROPIDS(NAME[0],STAT,6,TDAMUI[0],NAME[1],  ## 
            TDAMPFID[0],TDAMASI[0],TDAMCDT[0],LOC(PFMRET)); 
          END 
  
        ELSE                         # DIRECT ACCESS FILE # 
          BEGIN 
          DROPDS(NAME[0],STAT,6,TDAMUI[0],NAME[1],  ##
            TDAMPFID[0],TDAMASI[0],TDAMCDT[0],LOC(PFMRET)); 
          END 
  
        IF STAT NQ 0
        THEN
          BEGIN 
          DSERPFM(HLRQADR,STAT);
          IF HLR$RESP[0] NQ ERRST"NOERR"
          THEN
            BEGIN 
# 
       THE *ASA* IS SET, THE *FCT* SPACE MUST NOT BE RELEASED.
# 
  
  
           IF HLR$RESP[0] EQ ERRST"WAIT"
           THEN 
             BEGIN
             HLR$RESP[0] = ERRST"NOERR";
             DELAY(PFM$INTV,HLRQADR,HLRQIND); 
             RETURN;
             END
  
           ELSE      # REPORT ERROR, BUT DON-T RELEASE *FCT* SPACE. # 
             BEGIN
# 
  
       SET *ASA* WORKED - LEAVE *FCT* IN TACK.
# 
             HLR$RESP[0] = ERRST"ABANDON";
             GOTO STARTSTEP11;
             END
  
            END 
  
          END 
  
        END  # DO RELEASE PROCESSING #
  
       HLR$TDAMFL[0] = HLR$PFC$LN[0];        # SET DAYFILE MESSAGE #
# 
*     STEP 9 - END. 
# 
  
                                               CONTROL EJECT; 
  
# 
*     STEP 10 - HANDLE ERRORS SPECIFIC TO THIS FILE.
# 
  
DSERR:                               # ERROR CLEANUP #
  
      STAT = HLR$RESP[0]; 
      IF STAT NQ ERRST"NOERR" 
      THEN
        BEGIN  # STEP 10 #
        IF STAT EQ ERRST"WAIT"
        THEN
          BEGIN 
          HLR$RESP[0] = ERRST"NOERR"; 
          DELAY(PFM$INTV,HLRQADR,HLRQIND);
          RETURN; 
          END 
  
        IF HLR$FCTQ[0] NQ 0 
        THEN                         # RELEASE ALLOCATED AU, IF ANY # 
          BEGIN 
  
          P<FCT> = HLR$FCTQ[0] + FCTQHL;
  
# 
        RELEASE SPACE ON CURRENT CARTRIDGE. 
# 
  
  
            START = HLR$1STVOL[0];
            REPEAT WHILE START NQ 0 
            DO
              BEGIN 
              SETFCTX(START); 
              T1 = FCT$LINK(FWD,FPS); 
              T2 = FCT$LEN(FWD,FPS) + 1;
  
              RLSVOL(HLRQADR,HLR$FCTQ,START,T2);
              P<FCT> = HLR$FCTQ[0] + FCTQHL;
              START = T1; 
              END 
  
          P<FCT> = HLR$FCTQ[0] + FCTQHL;
          RLSVOL(HLRQADR,HLR$FCTQ[0],HLR$VOLAU[0],HLR$VOLLN[0]);
  
          END 
  
  
# 
        RELEASE PREVIOUS CARTRIDGE SPACE ON CURRENT FILE. 
# 
  
          P<ASA> = LOC(HLR$NEWASA[0]);
  
# 
          RECOVER FROM *ASA* IN *HLRQ*. 
# 
  
          I = 0;       # CLEAR FOR ERROR CHECK #
          IF ASAFCT[0] NQ HLR$FCTX[0]      ## 
            AND ASAFCT[0] NQ 0
          THEN
            BEGIN      # RELEASE THE FIRST SET OF CARTRIDGE SPACE # 
            RLS$FCT(HLR$FCTQ[0],0,STAT);
            TEMP = ASAFCT[0]; 
            START = ASAAU[0]; 
            USED = ASAGP[0];
  
            IF STAT NQ CMASTAT"NOERR" 
            THEN
              BEGIN 
              DSERCAT(HLRQADR,STAT);
              GOTO DSERREND;
              END 
  
            HLR$FCTQ[0] = 0;
  
RLSTART:  
  
            IF TEMP NQ HLR$FCTX[0]       ## 
              AND TEMP NQ 0 
            THEN
              BEGIN    # START NEW FCT LOCATION # 
              ACQ$FCT(TDAMFAM[0],TDAMSBF[0],HLR$SM[0],TEMP,     ##
                QADDR,0,STAT);
  
              IF STAT NQ CMASTAT"NOERR" 
              THEN
                BEGIN 
                DSERCAT(HLRQADR,STAT);
                I = 1;
                GOTO DSERREND;
                END 
  
            P<FCT> = QADDR + FCTQHL;
            UASTPRM(TDAMFAM[0],TDAMSBF[0],HLR$SM[0],QADDR,STAT);
  
            REPEAT WHILE START NQ 0 
            DO
              BEGIN 
              TEMP1 = 0;
              SETFCTX(START); 
              T1 = FCT$LINK(FWD,FPS); 
              T2 = FCT$LEN(FWD,FPS) + 1;
  
# 
        CHECK FOR OFF-CARTRIDGE LINK
# 
  
              IF FCT$CLKOCL(FWD,FPS) NQ 0 
              THEN
                BEGIN  # OFF-CARTRIDGE LINK # 
                IF FCT$CLKOCL(FWD,FPS) EQ 1 
                THEN
                  BEGIN 
                  B<0,1>FCT$OCLF[0] = 0;
                  TEMP1 = USED * 16 + FCT$OCL[0]; 
                  END 
  
                ELSE
                  BEGIN 
                  IF FCT$CLKOCL(FWD,FPS) EQ 2 
                  THEN
                    BEGIN 
                    B<1,1>FCT$OCLF[0] = 0;
                    TEMP1 = USED * 16 + FCT$OCL1[0];
                    END 
  
                  ELSE
                    BEGIN 
                    B<2,1>FCT$OCLF[0] = 0;
                    TEMP1 = USED * 16 + FCT$OCL2[0];
                    END 
                  END 
  
                  IF TEMP1 GR (PRM$ENTRC[HLR$SM[0]] + 15)   ##
                    OR TEMP1 LS 16
                  THEN
                    BEGIN 
                    I = 1;
                    GOTO DSERREND;
                    END 
  
                END 
  
                RLSVOL(HLRQADR,QADDR,START,T2); 
                P<FCT> = QADDR + FCTQHL;
                START = T1; 
  
                IF TEMP1 NQ 0 
                THEN
                  BEGIN 
                  TEMP = TEMP1; 
                  P<FCT> = QADDR + FCTQHL;
                  UASTPRM(TDAMFAM[0],TDAMSBF[0],HLR$SM[0],QADDR,STAT);
                  RLS$FCT(QADDR,0,STAT);
                    IF STAT NQ CMASTAT"NOERR" 
                    THEN
                      BEGIN 
                      DSERCAT(HLRQADR,STAT);
                      I = 1;
                      GOTO DSERREND;
                      END 
                  GOTO RLSTART; 
                  END 
  
                END   # END OF DO LOOP #
  
                P<FCT> = QADDR + FCTQHL;
                UASTPRM(TDAMFAM[0],TDAMSBF[0],HLR$SM[0],QADDR,STAT);
                RLS$FCT(QADDR,0,STAT);
                  IF STAT NQ CMASTAT"NOERR" 
                  THEN
                    BEGIN 
                    DSERCAT(HLRQADR,STAT);
                    I = 1;
                    GOTO DSERREND;
                    END 
               END     # END OF NEW *FCT* LOACTION FIND # 
  
# 
        RESET THE ORGINAL CURRENT CARTRIDGE FCT.
# 
  
  
DSERREND: 
  
                IF I NQ 0    # CHECK FOR AN ERROR IN ERROR CLEAN UP # 
                THEN
                  BEGIN 
                  MSG(MSGMB,UDFL1); 
                  IF HLR$FCTQ[0] EQ 0   # IF NO CARTRIDGE # 
                  THEN
                    BEGIN 
                    GOTO CKSPECIAL; 
                    END 
                  END 
  
                HLR$NEWASA[0] = 0;      # CLEAR FOR FURTHER RECOVERY #
  
                IF HLR$FCTX[0] EQ 0 
                THEN
                  BEGIN 
                  GOTO CKSPECIAL; 
                  END 
  
                ACQ$FCT(TDAMFAM[0],TDAMSBF[0],HLR$SM[0],HLR$FCTX[0], ## 
                    QADDR,0,STAT);
  
                IF STAT NQ CMASTAT"NOERR" 
                THEN
                  BEGIN 
                  DSERCAT(HLRQADR,STAT);
                  HLR$AUSF[0] = 0;
                  HLR$AULF[0] = 0;
                  GOTO STARTSTEP11; 
                  END 
  
                P<FCT> = QADDR + FCTQHL;
                UASTPRM(TDAMFAM[0],TDAMSBF[0],HLR$SM[0],QADDR,STAT);
                HLR$FCTQ[0] = QADDR;
           END
  
  
CKSPECIAL:  
           IF HLR$ERRC[0] EQ ERRST"SPECIAL" 
           THEN 
             BEGIN      # NO CARTRIDGE LOADED # 
             HLR$AUSF[0] = 0; 
             HLR$AULF[0] = 0; 
             END        # CARTRIDGE NO LOAD # 
  
        END  # STEP 10 #
  
                                               CONTROL EJECT; 
  
# 
*     STEP 11 - COMPLETE THIS FILE AND PROCEED WITH NEXT ONE. 
*               - RETURN FILE USED FOR DESTAGING. 
*               - CALL *DSNTDAM* TO OBTAIN NEXT FILE TO DESTAGE.
*               - UPDATE *AST* TO REFLECT AVAILABLE AU, IF APPROPRIATE. 
*               - SWITCH TO STAGING, IF APPROPRIATE.
*               - UNLOAD CARTRIDGE, IF NO MORE FILES FOR IT.
*               - UPDATE *FCT* TO REFLECT USAGE COUNTS. 
*               - RELEASE INTERLOCKS ON SUBFAMILY CATALOGS. 
# 
  
STARTSTEP11:  
      ZSETFET(LOC(SCR$FET[0]),HLR$FLNM[0],0,0,SFETL);  # RETURN FILE #
      RETERN(SCR$FET[0],RCL); 
  
      HLR$FFILE[0] = FALSE; 
  
      DSNTDAM(HLRQADR); 
  
# 
*     UPDATE THE *AST* IF DONE DESTAGING TO THIS CARTRIDGE. 
# 
  
      FLAG = (HLR$UNLD[0])
        OR (TDAMFC[0] EQ TDAMFCODE"NOREQ")
        OR (TDAMFC[0] EQ TDAMFCODE"STAGE"); 
  
      IF (HLR$FCTQ[0] NQ 0) AND      ## 
        (FLAG OR (HLR$HPN[0] EQ HLRPN"STAGE" ) )
      THEN                           # UPDATE THE *AST* # 
        BEGIN 
        P<FCTQ> = HLR$FCTQ[0];
        UASTPRM(FCTQFAMILY[0],FCTQSUBF[0],HLR$SM[0],  ##
          HLR$FCTQ[0],STAT);
  
        IF STAT NQ CMASTAT"NOERR" 
        THEN
          BEGIN 
          DSERCAT(HLRQADR,STAT);
          END 
  
        END 
  
# 
*     IF THIS *HLRQ* IS TO BE USED TO DO STAGING FROM THIS CARTRIDGE, 
*     TRANSFER CONTROL TO *STAGER*. 
# 
  
      IF HLR$HPN[0] EQ HLRPN"STAGE" 
      THEN
        BEGIN 
        IF DSC$LKMSK NQ 0 
        THEN
          BEGIN 
          CRELSLK(DSC$FAM,DSC$LKMSK,0,STAT);
          DSC$LKMSK = 0;
          END 
  
        RETURN; 
        END 
  
# 
*     EXIT IF NEXT FILE IS TO GO TO THIS CARTRIDGE. 
# 
  
      IF NOT FLAG 
      THEN                           # DESTAGE NEXT FILE TO SAME
                                       CARTRIDGE #
        BEGIN 
        ADD$LNK(HLRQADR,LCHN"HL$READY",0);
        RETURN; 
        END 
      IF HLR$FCTQ[0] NQ 0 
      THEN                           # RELEASE *FCT* ENTRY #
        BEGIN 
        P<FCTQ> = HLR$FCTQ[0];
  
        UPUSAGE(HLRQADR,HLR$FCTQ[0]); 
  
  
        RLS$FCT(HLR$FCTQ[0],0,STAT);
        IF STAT NQ CMASTAT"NOERR" 
        THEN
          BEGIN 
          DSERCAT(HLRQADR,STAT);
          END 
  
        HLR$FCTQ[0] = 0;
        HLR$FCTX[0] = 0;
  
        END 
  
  
# 
*     UNLOAD CARTRIDGE IF ONE WAS SUCCESSFULLY LOADED.
# 
  
  
        IF HLR$HLRQW[0] NQ 0
        THEN
          BEGIN      # SWITCH CONTROL OF *DRD* TO WAITTING *HLRQ* # 
          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];
          RESETDRD = HLR$HLRQW[0];
          HLR$HLRQW[0] = 0; 
          HLR$DRDRA[0] = 0; 
          HLR$LRQADR[0] = 0;
          END 
  
        IF HLR$LRQADR[0] NQ 0 
        THEN
          BEGIN       # DO UNLOAD OF CARTRIDGE #
          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] = DSLABEL"DS11A";
          ADD$LNK(HLR$LRQADR[0],LCHN"LL$READY",0);
          RETURN; 
  
DS11A:     # 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 # 
            HLR$HPS[0] = DSLABEL"DS11B";
            RETURN; 
  
DS11B:                                # 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] = DSLABEL"DS11C";
                ADD$LNK(HLR$LRQADR[0],LCHN"LL$READY",0);
                RETURN; 
  
DS11C:  
                END      # UNLOAD OF 2ND REQUEST #
              END        # LOAD OF 2ND REQUEST #
            P<CLEAR> = HLR$DRDRA[0];
            CLN = 0;
            HLR$DRDRA[0] = 0; 
  
            END          # PHYSICAL CARTRIDGE UNLOAD #
  
      HLR$UNLD[0] = FALSE;
      IF DSC$LKMSK NQ 0 
      THEN                           # TIME TO RELEASE INTERLOCKS # 
        BEGIN 
        CRELSLK(DSC$FAM,DSC$LKMSK,0,STAT);
        DSC$LKMSK = 0;
        END 
  
ENDALL: 
  
      IF TDAMFC[0] EQ TDAMFCODE"STAGE"
      THEN
        BEGIN    # *DSNTDAM* PROC FOUND NO ROOM - DO NOT
                   RECALL DESTAGE ROUTINE # 
        DSC$INIT = 0; 
        DSC$WRESRS = 1; 
        HLR$HPS[0] = PROCST"COMPLETE";
        RETURN; 
        END 
  
      IF TDAMFC[0] NQ TDAMFCODE"NOREQ"
      THEN
        BEGIN 
        HLR$HPS[0] = PROCST"INITIAL"; 
        ADD$LNK(HLRQADR,LCHN"HL$READY",0);
        END 
  
      ELSE
        BEGIN 
        HLR$HPS[0] = PROCST"COMPLETE";
        DSC$INIT = 1; 
        END 
  
# 
*     END STEP 11.
# 
  
      RETURN; 
      END  # DESTAGR #
  
    TERM
PROC DSALLO((HLRQADR)); 
  
# TITLE DSALLO - ALLOCATE A VOLUME ON A M860 CARTRIDGE.               # 
  
      BEGIN  # DSALLO # 
  
# 
**    DSALLO - ALLOCATE A VOLUME ON A M860 CARTRIDGE. 
* 
*     AN INITIAL CALL TO *DSALLO* SELECTS THE STORAGE MODULE
*     (*SM*), CARTRIDGE GROUP, SPECIFIC CARTRIDGE, AND FIRST
*     VOLUME TO USE ON THAT CARTRIDGE.
*     ON SUBSEQUENT CALLS, *DSALLO* WILL ASSIGN ADDITIONAL
*     VOLUMES ON THE SAME CARTRIDGE.  IN A CARTRIDGE OVERFLOW 
*     SITUATION, NEW CARTRIDGES IN THE SAME GROUP AS THE FIRST
*     CARTRIDGE WILL BE ASSIGNED IN ORDER TO ACQUIRE THE M860 
*     SPACE NECESSARY TO DESTAGE A LONG FILE. 
* 
*     PROC DSALLO((HLRQADR))
* 
*     ENTRY      (HLRQADR)   - ADDRESS OF THE *HLRQ* ENTRY FOR A
*                              DESTAGE REQUEST. 
*                (HLR$FFILE) - IF FIRST FILE OF A SEQUENCE OF FILES.
*                (HLR$FVOL)  - IF FIRST VOLUME OF A FILE. 
*                (HLR$PRU)   - NUMBER OF PRU DESTAGED SO FAR. 
*                (HLR$SH)    - TRUE IF SHORT FILE.
*                (HLR$TDAM)  - HAS FAMILY, SUBFAMILY, FILE LENGTH.
*                (HLR$XXX)   - WHERE XXX REFERS TO THE FIELDS SET BY
*                              THE INITIAL CALL TO *DSALLO* WHICH 
*                              SELECTED A CARTRIDGE.
*               (HLR$VOLAUP) - ID OF PREVIOUS VOLUME IF *FVOL* IS FALSE.
*                              TOTAL AU NEEDED FOR SHORT FILES IF 
*                              *FFILE* AND *FVOL* ARE TRUE. 
* 
*     EXIT       (HLR$CCOD)  - IDENTIFIES SELECTED CARTRIDGE. 
*                (HLR$CSND)  - IDENTIFIES SELECTED CARTRIDGE. 
*                (HLR$SM)    - IDENTIFIES *SM* CONTAINING CARTRIDGE.
*                (HLR$FCTQ)  - *FCT* QUEUE ENTRY FOR CARTRIDGE. 
*                (HLR$Y/Z)   - CUBICLE LOCATION OF SELECTED CARTRIDGE.
*                (HLR$FCTX)  - *FCT* INDEX OF CARTRIDGE.
*                (HLR$VOLAU) - FIRST *AU* OF ALLOCATED VOLUME.
*                (HLR$VOLLN) - NUMBER OF *AU* IN ALLOCATED VOLUME.
*                (HLR$LOAD)  - SAYS TO LOAD A NEW CARTRIDGE.
*                (HLR$UNLD)  - SAYS TO UNLOAD AN OLD CARTRIDGE. 
*                (HLR$JOF)   - SAYS A CARTRIDGE OVERFLOW JUST OCCURRED. 
*                (HLR$RESP)  - =0, REQUEST SATISFIED WITHOUT ERROR. 
*                              =N, N IDENTIFIES THE ERROR ACTION. 
*                (HLR$ERRC)  - REASON FOR ABANDONING A DESTAGE. 
# 
  
  
# 
**    NOTES ABOUT THE LOGIC USED IN *DSALLO*. 
* 
*     THE SPECIFIC PROCESSING DONE BY *DSALLO* ON A GIVEN CALL
*     DEPENDS UPON WHICH OF FOUR (4) CASES EXISTS AT THE TIME OF
*     THE CALL TO *DSALLO*. 
* 
*     CASE A)    INITIAL CALL (FIRST VOLUME OF THE FIRST FILE OF
*                A SEQUENCE OF FILES) IN A CARTRIDGE OVERFLOW SITUATION 
*                (FIRST FILE IS A LONG FILE). 
* 
*                *DSALLO* SELECTS A *SM*, GROUP, INITIAL CARTRIDGE IN 
*                THE GROUP, AND A VOLUME ON THE CARTRIDGE.
* 
* 
*     CASE B)    INITIAL CALL IN A NON-OVERFLOW SITUATION (FIRST
*                FILE IS A SMALL FILE OR A LONG FILE WHICH IS EXPECTED
*                TO FIT ON ONE CARTRIDGE).
* 
*                *DSALLO* SELECTS A *SM*, SPECIFIC CARTRIDGE, AND A 
*                VOLUME ON THAT CARTRIDGE.
* 
* 
*     CASE C)    SUBSEQUENT CALL TO CASE A) - TO SELECT THE NEXT
*                CARTRIDGE IN THE GROUP AND ASSIGN A VOLUME ON THIS 
*                NEW CARTRIDGE. 
* 
* 
*     CASE D)    SUBSEQUENT CALL TO CASES A), B) OR C) FOR THE FIRST
*                FILE OF A SEQUENCE, OR ANY CALL FOR OTHER THAN THE 
*                FIRST FILE OF A SEQUENCE.  IN THIS CASE, *DSALLO*
*                ASSIGNS A VOLUME FROM THE LAST SELECTED CARTRIDGE. 
* 
* 
*     THE FOLLOWING LOGIC STEPS ARE CONDITIONALLY EXECUTED
*     DEPENDING UPON THE CASE WHICH EXISTS FOR THIS CALL. 
* 
*  STEP  IF CASE ACTION 
* 
*     1  (A,B)   SELECT A STORAGE MODULE. 
* 
*     1  (C,D)   DETERMINE WHETHER CASE C OR D EXISTS.
*                ITS CASE C) IF ITS THE FIRST FILE, A LONG FILE,
*                AND NO SPACE IS LEFT.  ITS CASE D) OTHERWISE.
* 
*     2  (A,B,C) READ IN THE *AST* FOR THE *SM* FROM STEP 1.
* 
*     3  (A,B)   PICK A CARTRIDGE IF ONE WILL HOLD THE FIRST
*                FILE (DETERMINES CASE B), OR PICK A CARTRIDGE
*                GROUP (DETEMINES CASE A).
* 
*     4  (A,C)   SELECT A CARTRIDGE IN THE GROUP. 
* 
*     5  (C)     UPDATE OFF-CARTRIDGE LINK. 
*                .1) UPDATE THE *FCT* FOR THE PREVIOUS CARTRIDGE
*                    TO LINK TO THIS NEW CARTRIDGE. 
*                .2) SET THE FLAG TO CAUSE AN UNLOAD OF OLD CARTRIDGE.
*                .3) WRITE THE *FCT* ENTRY FOR THE OLD CARTRIDGE TO 
*                    DISK.
* 
*     6  (A,B,C) DO SETUP FOR NEW CARTRIDGE.
*                .1) GET *FCT* ENTRY FOR NEW CARTRIDGE. 
*                .2) VERIFY THAT THE *FCT* AND *AST* ENTRIES FOR
*                    THIS CARTRIDGE ARE IN SYNC.
*                .3) SET *HLR$FCTQ* FIELD TO POINT TO NEW *FCT* ENTRY.
*                .4) SET THE *HLRQ* FIELDS IDENTIFYING THE AMOUNT OF
*                    SPACE LEFT ON THIS CARTRIDGE FOR 
*                    AND LONG FILES.
*                .5) SET FLAG TO LOAD THIS NEW CARTRIDGE. 
* 
*     7  (ALL)   ALLOCATE A VOLUME OF AVAILABLE SPACE ON THIS CARTRIDGE.
* 
# 
  
# 
*     NOTES ABOUT THE ALLOCATION STRATEGY.
* 
*       1. ONE ALLOCATION OBJECTIVE IS TO ALLOCATE ENOUGH EXTRA 
*          AU TO PROVIDE SOME CONTINGENCY IN CASE SOME STRIPES
*          ARE DEMARKED.  INSTALLATION PARAMETERS *CONTG$ADD* 
*          AND *CONTG$PER* DEFINE THE NUMBER OF EXTRA STRIPES 
*          TO HOPEFULLY BE PROVIDED BY THE ALLOCATION PROCESS.
*          IF THESE EXTRA STRIPES (AU) ARE NOT AVAILABLE, 
*          ALLOCATION WILL PROCEED WITHOUT ANY EXTRA STRIPES. 
* 
*       2. IF A CARTRIDGE IS SELECTED BASED ON ITS *AST* ENTRY, BUT 
*          ITS *FCT* ENTRY THEN INDICATES THE CARTRIDGE IS UNUSABLE,
*          THE *AST* AND PREAMBLE ARE UPDATED TO REFLECT THIS 
*          NEW CARTRIDGE STATUS.  THE ALLOCATION PROCESS THEN 
*          REPEATS IN AN EFFORT TO FIND ANOTHER CARTRIDGE.
# 
  
      ITEM HLRQADR    I;             # *HLRQ* ADDRESS # 
  
# 
****  PROC DSALLO - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC ACQ$FCT;                # ACQUIRE *FCT* ENTRY #
        PROC ANLZAST;                # IDENTIFY BEST CARTRIDGE AND
                                       GROUP #
        PROC CRDAST;                 # READ AST TO MEMORY # 
        PROC DSERCAT;                # PROCESS CATALOG ERRORS # 
        PROC OCTSRCH;                # OPEN CATALOG SEARCH #
        PROC RLSVOL;                 # RELEASE UNUSED AU #
        PROC RLS$FCT;                # RELEASE *FCT* ENTRY #
        PROC UASTPRM;                # UPDATE *AST* AND PREAMBLE #
        END 
  
# 
****  PROC DSALLO - XREF LIST END.
# 
  
      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL COMBCHN 
*CALL,COMBCMD 
*CALL,COMBCMS 
*CALL,COMBMCT 
*CALL,COMBSIT 
*CALL,COMBTDM 
*CALL,COMBUDT 
*CALL,COMXFCQ 
*CALL,COMXHLR 
*CALL,COMXMSC 
  
  
      ITEM AU$FILE    I;             # AU NEEDED FOR REST OF CURRENT
                                       FILE # 
      ITEM AU$MAX     I;             # AU NEEDED FOR ALL SHORT FILES #
      ITEM CASE$A     B;             # IDENTIFIES CASE A #
      ITEM CASE$B     B;             # IDENTIFIES CASE B #
      ITEM CASE$C     B;             # IDENTIFIES CASE C #
      ITEM CASE$D     B;             # IDENTIFIES CASE D #
      ITEM DELTAAU    I;             # LOOP INDEX # 
      ITEM EXTRAAU    U;             # NUMBER OF CONTINGENCY AU # 
      ITEM FCTQADDR   U;             # FCTQ ADDRESS # 
      ITEM FCTX       I;             # *FCT* INDEX OF BEST CANDIDATE #
      ITEM GRX        I;             # GROUP INDEX OF BEST CANDIDATE #
      ITEM GRSZ       I;             # SIZE OF BEST GROUP # 
      ITEM I          I;             # LOOP INDEX # 
      ITEM MAXC       I;             # CAPACITY OF BEST CARTRIDGE # 
      ITEM MAXGR      I;             # CAPACITY OF BEST GROUP # 
      ITEM MAXVOLLN   U = 128;       # REM (SB 128) MAXIMUM VOLUME
                                       LENGTH # 
      ITEM NOTDONE    B;             # LOOP TERMINATOR #
      ITEM QADDR      I;             # ADDRESS OF *FCT* ENTRY # 
      ITEM STAT       I;             # STATUS # 
      ITEM SM         I;             # INDEX OF BEST STORAGE MODULE # 
      ITEM SMGR       I;             # INDEX OF *SM* WITH BEST GROUP #
      ITEM SMOFF      B;             # STATUS INDICATOR # 
      ITEM TMP1       I;             # TEMPORARY VARIABLE # 
                                               CONTROL EJECT; 
  
# 
*     INITIALIZE FIELDS.
# 
  
      P<HLRQ> = HLRQADR;
      P<TDAM> = LOC(HLR$TDAM[0]); 
      P<FCT> = HLR$FCTQ[0] + FCTQHL;
  
      HLR$JOF[0] = FALSE; 
      HLR$VOLAU[0] = 0; 
      HLR$VOLLN[0] = 0; 
  
# 
*     CALCULATE NECESSARY AU AND A CONTINGENCY AMOUNT.
# 
  
      TMP1 = 1 + (TDAMFLN[0] - HLR$PRU[0]-1)/INPRUS;
      AU$FILE = 1 + (TMP1-1)/INSPAU;  # NECESSARY AU #
  
      TMP1 = TMP1 + CONTG$ADD + (TMP1*CONTG$PER -1)/100 + 1;
      EXTRAAU = 1 + (TMP1-1)/INSPAU - AU$FILE;
  
TRYAGAIN:                            # USED IF SELECTED CARTRIDGE IS
                                       UNUSABLE # 
      CASE$A = FALSE; 
      CASE$B = FALSE; 
      CASE$C = FALSE; 
      CASE$D = FALSE; 
  
# 
*     STEP 1 (CASE A OR B) - SELECT A STORAGE MODULE. 
*            (CASE C OR D) - DETERMINE WHETHER CASE C OR D. 
# 
  
      IF NOT (HLR$FFILE[0] AND HLR$FVOL[0]) 
  
      THEN                           # CASE C OR D #
  
        BEGIN  # STEP 1CD # 
  
        CASE$C = HLR$JOF[0] OR       ## 
          ( NOT HLR$SH[0]            ## 
          AND (FCT$FAULF[0] EQ 0)    ## 
          AND HLR$FFILE[0]           ## 
          );
        CASE$D = NOT CASE$C;
        FCTX = HLR$FCTX[0]; 
  
        END  # STEP 1CD # 
  
      ELSE                           # CASE A OR B #
  
                                               CONTROL EJECT; 
        BEGIN  # STEP 1AB # 
        CASE$A = TRUE;               # DECIDE A OR B IN STEP 3 #
        HLR$AUSF[0] = 0;
        HLR$AULF[0] = 0;
  
        OCTSRCH(TDAMFAM[0],TDAMSBF[0],TMP1,HLRQADR,STAT); 
  
        IF STAT NQ CMASTAT"NOERR" 
        THEN
          BEGIN  # *OCTSRCH* ERROR #
          IF STAT EQ CMASTAT"INTLK" 
          THEN
            BEGIN 
            HLR$RESP[0] = ERRST"WAIT";
            RETURN; 
  
            END 
  
          ELSE
            BEGIN 
            DSERCAT(HLRQADR,STAT);
            RETURN; 
  
            END 
  
          END  # *OCTSRCH* ERROR #
  
        P<PREAMBLE> = OCT$PRMA[TMP1]; 
  
# 
*     STEP 1.2 - CALCULATE AU NEEDED AND PREPARE TO SEARCH
*                FOR THE BEST *SM*. 
# 
  
        AU$MAX = HLR$VOLAUP[0];      # FROM *NXTDEST* # 
        SM = 0; 
        SMGR = 0; 
        P<UDT$SMA> = UDTSADR; 
                                               CONTROL EJECT; 
  
# 
*     STEP 1.3 - SEARCH PREAMBLE TO FIND STORAGE MODULE.
# 
  
        FOR DELTAAU = EXTRAAU STEP -1 WHILE SM EQ 0 
        DO
          BEGIN  # *SM* CONTINGENCY LOOP #
          IF DELTAAU LS 0 
          THEN                       # NOT ENOUGH SPACE # 
            BEGIN 
            HLR$RESP[0] = ERRST"ABANDON"; 
            HLR$ERRC[0] = ABANDON"NOSPACE"; 
            RETURN; 
            END 
  
          MAXC = AU$FILE + DELTAAU -1;
          MAXGR = MAXC; 
          SMOFF = TRUE; 
  
          FOR I = 1 STEP 1 UNTIL MAXSMUNIT
          DO
            BEGIN  # *SM* SEARCH #
            TMP1 = SM$ID[I];
  
            IF PRM$SCW1[TMP1] EQ 0
            THEN                     # *SM* NOT ASSIGNED TO SUBFAMILY # 
              BEGIN 
              TEST I; 
              END 
  
            IF (SM$HWOFF[I] OR NOT SM$ON[I])     ## 
              OR (SM$DSNUM[I] EQ 0)             ##
              OR (NOT D0$ON[I] AND NOT D1$ON[I])
            THEN                     # *SM*/*DRD* NOT USABLE #
              BEGIN 
              TEST I; 
              END 
  
            ELSE                     # *SM* ASSIGNED AND USABLE # 
              BEGIN 
              SMOFF = FALSE;
              END 
  
            IF HLR$SH[0] AND (PRM$MXAUS[TMP1] GR MAXC)
            THEN                     # FOUND *SM* WITH BETTER CARTRIDGE 
                                       FOR SHORT FILES #
              BEGIN 
              SM = TMP1;
              MAXC = PRM$MXAUS[TMP1]; 
              TEST I; 
              END 
  
            IF NOT HLR$SH[0] AND (PRM$MXAUGR[TMP1] GR MAXC) 
            THEN
              BEGIN  # CONSIDER CARTRIDGE OR GROUP SIZE # 
              IF PRM$MXAUL[TMP1] GR MAXC
              THEN                   # CONSIDER INDIVIDUAL CARTRIDGE #
                BEGIN 
                MAXC = PRM$MXAUL[TMP1]; 
                SM = TMP1;
                END 
  
              ELSE                   # CONSIDER GROUP SIZE #
                BEGIN 
                IF PRM$MXAUGR[TMP1] GR MAXGR
                THEN
                  BEGIN 
                  MAXGR = PRM$MXAUGR[TMP1]; 
                  SMGR = TMP1;
                  END 
  
                END 
  
              END  # CONSIDER CARTRIDGE OR GROUP SIZE # 
  
            END  # *SM* SEARCH #
  
          IF SMOFF
          THEN                       # NO *SM* AVAILABLE #
            BEGIN 
            HLR$RESP[0] = ERRST"ABANDON"; 
            HLR$ERRC[0] = ABANDON"NOSM";
            RETURN; 
            END 
  
# 
*     MAKE FINAL *SM* DECISION. 
# 
  
          IF SM EQ 0
          THEN                       # TRY *SM* WITH BEST GROUP # 
            BEGIN 
            SM = SMGR;
            END 
  
          END  # *SM* CONTINGENCY LOOP #
  
        HLR$SM[0] = SM; 
        END  # STEP 1AB # 
  
                                               CONTROL EJECT; 
  
# 
*     STEP 2 ( CASE A, B OR C) - READ IN *AST*. 
# 
  
      IF NOT CASE$D 
      THEN                           # CASE A, B OR C # 
        BEGIN  # STEP 2 # 
        CRDAST(TDAMFAM[0],TDAMSBF[0],HLR$SM[0],ASTBADR,HLRQADR,STAT); 
  
        IF STAT NQ CMASTAT"NOERR" 
        THEN
          BEGIN 
          DSERCAT(HLRQADR,STAT);
          RETURN; 
          END 
  
        P<AST> = ASTBADR; 
  
        END  # STEP 2 # 
  
                                               CONTROL EJECT; 
  
# 
*     STEP 3 (CASE A OR B) - PICK CARTRIDGE (CASE B) OR 
*                            PICK GROUP (CASE A). 
# 
  
      IF CASE$A 
      THEN
        BEGIN  # STEP 3 # 
  
        FCTX = 0; 
        FOR DELTAAU = EXTRAAU STEP -1 WHILE FCTX EQ 0 
        DO
          BEGIN  # *AST* CONTINGENCY LOOP # 
          IF DELTAAU LS 0 
          THEN                       # NO SPACE # 
            BEGIN 
            HLR$RESP[0] = ERRST"ABANDON"; 
            HLR$ERRC[0] = ABANDON"NOCARGP"; 
            RETURN; 
            END 
  
          IF HLR$SH[0]
          THEN                       # FIND CARTRIDGE FOR SHORT FILES # 
            BEGIN 
            GRX = 0;
  
            ANLZAST(HLR$SM[0],AU$MAX,0,FCTX,DUMMY,DUMMY,DUMMY); 
  
            IF FCTX NQ 0             ## 
              AND (AST$AUSF[FCTX] LS AU$FILE) 
            THEN                     # FILE DOES NOT FIT #
              BEGIN 
              FCTX = 0; 
              END 
  
            END 
  
          ELSE                       # FIND CARTRIDGE OR GROUP FOR LONG 
                                       FILES #
            BEGIN 
  
            ANLZAST(HLR$SM[0],0,AU$FILE+DELTAAU,DUMMY,FCTX,GRX,GRSZ); 
  
            END 
  
          IF FCTX NQ 0
          THEN                       # CASE B # 
            BEGIN 
            CASE$B = TRUE;
            CASE$A = FALSE; 
            END 
  
          ELSE                       # CASE A OR NO SPACE # 
            BEGIN 
            IF GRX NQ 0 
            THEN                     # CASE A # 
              BEGIN 
              CASE$A = TRUE;
              FCTX = GRX*MAXGRT;
              END 
  
            END 
  
          END  # *AST* CONTINGENCY LOOP # 
  
        END  # STEP 3 # 
  
                                               CONTROL EJECT; 
  
# 
*     STEP 4 (CASE A OR C) - PICK CARTRIDGE IN GROUP. 
# 
  
      IF CASE$A OR CASE$C 
      THEN
        BEGIN  # STEP 4 # 
        GRX = (FCTX/MAXGRT)*MAXGRT; 
        FCTX = 0; 
        MAXC = 0; 
        FOR DELTAAU = EXTRAAU STEP -1 WHILE FCTX EQ 0 
        DO
          BEGIN  # CARTRIDGE CONTINGENCY LOOP # 
          IF DELTAAU LS 0 
          THEN                       # NO SPACE # 
            BEGIN 
            HLR$RESP[0] = ERRST"ABANDON"; 
            HLR$ERRC[0] = ABANDON"GRFULL";
            RETURN; 
            END 
  
          FOR I = 0 STEP 1 UNTIL MAXGRT-1 
          DO
            BEGIN  # SEARCH GROUP FOR BEST CARTRIDGE #
            IF (GRX+I EQ HLR$FCTX[0]) 
            THEN                     # DO NOT PICK THIS CARTRIDGE # 
              BEGIN 
              TEST I; 
              END 
  
            TMP1 = AST$AULF[GRX+I]; 
            IF ((TMP1 LS AU$FILE+DELTAAU)  ## 
              AND AST$NOCLF[GRX+I])  ## 
              OR NOT AST$AAF[GRX+I] 
            THEN                     # CARTRIDGE NOT USABLE # 
              BEGIN 
              TEST I; 
              END 
  
            IF TMP1 GR MAXC 
            THEN                     # PICK THIS CARTRIDGE #
              BEGIN 
              FCTX = GRX+I; 
              MAXC = TMP1;
              END 
  
            END  # SEARCH FOR BEST CARTRIDGE #
  
          END  # CARTRIDGE CONTINGENCY LOOP # 
  
        END  # STEP 4 # 
  
                                               CONTROL EJECT; 
  
# 
*     STEP 5 (CASE C) - PREPARE FOR CARTRIDGE OVERFLOW. 
*             .1 SET FLAG TO UNLOAD OLD CARTRIDGE.
*             .2 FORCE *FCT* FOR PREVIOUS CARTRIDGE TO DISK.
*             .3 SET JUST OVERFLOWED FLAG IN *HLRQ* ENTRY.
# 
  
  
      IF CASE$C AND (NOT HLR$JOF[0])
      THEN
        BEGIN  # STEP 5 # 
  
        HLR$FCTXP[0] = HLR$FCTX[0]; 
        HLR$CSNTPS[0] = HLR$CSNTCU[0];
  
# 
*     SELECT AN AVAILABLE *OCL* FIELD IN THE *FCT* HEADER 
*     AND UPDATE THE PREVIOUS VOLUME TO LINK TO THE NEW 
*     CARTRIDGE VIA THIS *OCL* FIELD. 
# 
  
        NOTDONE = TRUE; 
        FOR I = 0 STEP 1 WHILE NOTDONE
        DO
          BEGIN  # SET LINK TO NEW CARTRIDGE #
          IF I EQ 3 
          THEN                       # NO OFF-CARTRIDGE LINK AVAILABLE
                                     #
            BEGIN 
            HLR$RESP[0] = ERRST"ABANDON"; 
            HLR$ERRC[0] = ABANDON"NOOVERF"; 
            RETURN; 
            END 
  
          IF B<I,1>FCT$OCLF[0] EQ 1 
          THEN                       # THIS LINK FIELD IN USE # 
            BEGIN 
            TEST I; 
            END 
  
# 
*     HAVING FOUND AN AVAILABLE LINK, UPDATE THE
*     LINKAGE TO THE NEW CARTRIDGE. 
# 
  
          B<I,1>FCT$OCLF[0] = 1;
  
          SETFCTX(HLR$VOLAUP[0]); 
          FCT$CLKOCL(FWD,FPS) = I+1;
          NOTDONE = FALSE;
          END  # SET LINK TO NEW CARTRIDGE #
  
# 
*     COMPLETE REST OF STEP 5.
# 
  
        HLR$UNLD[0] = TRUE; 
        HLR$JOF[0] = TRUE;
        HLR$1STVOL[0] = 0;           # INDICATE O VOLUMES TO RELEASE #
  
        RLS$FCT(HLR$FCTQ[0],0,STAT);
  
        IF STAT NQ CMASTAT"NOERR" 
        THEN
          BEGIN 
          DSERCAT(HLRQADR,STAT);
          RETURN; 
          END 
  
        END  # STEP 5 # 
  
                                               CONTROL EJECT; 
  
# 
*     STEP 6 (CASE A, B OR C) - DO NEW CARTRIDGE SETUP. 
* 
*             .1 GET *FCT* ENTRY. 
*             .2 VERIFY *FCT* AND *AST* ENTRIES AGREE.
*             .3 COMPLETE SETUP.
# 
  
      IF NOT CASE$D 
      THEN
        BEGIN  # STEP 6 # 
  
        FCTQADDR = CHN$BOC[LCHN"FCT$FRSPC"];
  
        IF FCTQADDR EQ 0
        THEN
          BEGIN 
          HLR$RESP[0] = ERRST"SPECIAL"; 
          RETURN; 
          END 
  
  
        ACQ$FCT(TDAMFAM[0],TDAMSBF[0],HLR$SM[0],FCTX,QADDR,0, STAT);
  
        IF STAT NQ CMASTAT"NOERR" 
        THEN
          BEGIN 
          DSERCAT(HLRQADR,STAT);
          RETURN; 
  
          END 
  
        P<FCT> = QADDR + FCTQHL;
  
        IF FCT$LCF[0] OR FCT$EEF[0] OR FCT$IAF[0] 
        THEN                         # CLEAR ALLOCATION AUTHORIZED FLAG 
                                       IN *AST* ENTRY # 
          BEGIN 
          AST$AAF[FCTX] = FALSE;
          UASTPRM(TDAMFAM[0],TDAMSBF[0],HLR$SM[0],0,STAT);
  
          RLS$FCT(QADDR,0,TMP1);
  
          IF STAT NQ CMASTAT"NOERR" 
          THEN
            BEGIN 
            DSERCAT(HLRQADR,STAT);
            RETURN; 
            END 
  
          IF TMP1 NQ CMASTAT"NOERR" 
          THEN
            BEGIN 
            DSERCAT(HLRQADR,TMP1);
            RETURN; 
            END 
  
          GOTO TRYAGAIN;             # TRY FOR ANOTHER
                                       CARTRIDGE/GROUP/SM # 
          END 
  
        HLR$FCTQ[0] = QADDR;
                                               CONTROL EJECT; 
  
# 
*     STEP 6.3 - COMPLETE SETUP.
# 
  
        HLR$FCTX[0] = FCTX; 
        HLR$AUSF[0] = AST$AUSF[FCTX]; 
        HLR$AULF[0] = AST$AULF[FCTX]; 
        HLR$LOAD[0] = TRUE; 
        HLR$CSND[0] = FCT$CSND[0];
        HLR$CCOD[0] = FCT$CCOD[0];
        HLR$Z[0] = FCT$Z[0];
        HLR$Y[0] = FCT$Y[0];
  
        END  # STEP 6 # 
  
                                               CONTROL EJECT; 
  
# 
*     STEP 7 (ALL CASE$S) - ALLOCATE A VOLUME.
# 
  
      IF HLR$SH[0]
      THEN                           # USE *AU* FOR SHORT FILES # 
        BEGIN 
        TMP1 = FCT$FAUSF[0];
        END 
  
      ELSE                           # USE *AU* FOR LONG FILES #
        BEGIN 
        TMP1 = FCT$FAULF[0];
        END 
  
      IF TMP1 EQ 0
      THEN                           # NO SPACE LEFT #
        BEGIN 
        RETURN; 
        END 
  
      SETFCTX(TMP1);
  
      HLR$VOLAU[0] = TMP1;
  
# 
*     CALCULATE AU NEEDED IN THIS VOLUME (MAX OF MAXVOLLN). 
# 
  
      AU$FILE = AU$FILE + EXTRAAU;
      IF AU$FILE GR MAXVOLLN
      THEN
        BEGIN 
        AU$FILE = MAXVOLLN; 
        END 
  
# 
*     CONCATENATE ADJACENT FREE VOLUMES INTO ONE LARGER 
*     VOLUME.  IF THE TOTAL EXCEEDS MAXVOLLN AU, RELEASE THE
*     EXTRA AU SO THE FINAL VOLUME IS MAXVOLLN AU.
# 
  
      NOTDONE = TRUE; 
      FOR I = 0 WHILE NOTDONE 
      DO
        BEGIN 
        HLR$VOLLN[0] = HLR$VOLLN[0] + FCT$LEN(FWD,FPS) + 1; 
        TMP1 = FCT$LINK(FWD,FPS); 
  
        IF (HLR$VOLLN[0] GQ AU$FILE )  ## 
          OR ( HLR$VOLAU[0] + HLR$VOLLN[0] NQ TMP1 )
        THEN                         # NO MORE CONCATENATION
                                       POSSIBLE/NEEDED #
          BEGIN 
          NOTDONE = FALSE;
          TEST I; 
          END 
  
# 
*     ADD NEXT FREE VOLUME INTO THE ONE TO BE USED. 
# 
  
        SETFCTX(TMP1);
        TEST I; 
        END 
  
  
# 
*     UPDATE POINTER TO FREE SPACE TO REFLECT SELECTION 
*     OF THE ABOVE SELECTED *AU*. 
# 
  
      EXTRAAU = 0;
      IF HLR$VOLLN[0] GR MAXVOLLN 
      THEN
        BEGIN 
        EXTRAAU = HLR$VOLLN[0] - MAXVOLLN;
        HLR$VOLLN[0] = MAXVOLLN;
        END 
  
      IF HLR$SH[0]
      THEN
        BEGIN 
        FCT$FAUSF[0] = TMP1;
        HLR$AUSF[0] = HLR$AUSF[0] - HLR$VOLLN[0] - EXTRAAU; 
        END 
  
      ELSE
        BEGIN 
        FCT$FAULF[0] = TMP1;
        HLR$AULF[0] = HLR$AULF[0] - HLR$VOLLN[0] - EXTRAAU; 
        END 
  
# 
*     AFTER DONE WITH CONCATENATION, RELEASE EXTRA AU.
# 
  
      RLSVOL(HLRQADR,HLR$FCTQ[0],HLR$VOLAU[0]+MAXVOLLN,EXTRAAU);
  
# 
*     STEP 7 END. 
# 
  
      RETURN; 
      END  # DSALLO # 
  
    TERM
PROC DSERCAT((HLRQADR),(ERRSTAT));
  
# TITLE DSERCAT - PROCESS DESTAGE CATALOG ACCESS ERRORS.              # 
  
      BEGIN  # DSERCAT #
  
# 
**    DSERCAT - PROCESS DESTAGE CATALOG ACCESS ERRORS.
* 
*     *DSERCAT* VERIFIES THAT THE ERROR RESPONSES FROM CATALOG
*     ACCESS ROUTINES ARE EXPECTED ONES.  IF SO, AN APPROPRIATE 
*     ERROR CODE IS RETURNED TO THE *HLRQ*.  IF NOT, AN ABORT IS DONE.
* 
*     PROC DSERCAT((HLRQADR)) 
* 
*     ENTRY      (HLRQADR) - ADDRESS OF *HLRQ* ENTRY FOR DESTAGE
*                            REQUEST. 
*                (ERRSTAT) - ERROR STATUS RETURNED BY A CATALOG 
*                            ACCESS REQUEST.
* 
*     EXIT       (HLR$RESP) - ERROR STATE.
*                             (VALUES DEFINED IN *COMXMSC*) 
*                             = ERRST"ABANDON". 
* 
*     MESSAGES   * EXEC ABNORMAL, DSERCAT.* 
# 
  
      ITEM HLRQADR    U;             # *HLRQ* ENTRY ADDRESS # 
      ITEM ERRSTAT    I;             # CATALOG ACCESS ERROR CODE #
  
# 
****  PROC DSERCAT - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC ABORT;                  # ABORT #
        PROC MESSAGE;                # ISSUE MESSAGE #
        END 
  
# 
****  PROC DSERCAT - XREF LIST END. 
# 
  
      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBCMS 
*CALL,COMBTDM 
*CALL,COMXHLR 
*CALL,COMXMSC 
  
  
  
  
  
      P<HLRQ> = HLRQADR;
  
      IF ERRSTAT EQ CMASTAT"CIOERR" 
      THEN                           # IF READ/WRITE ERROR #
        BEGIN 
        HLR$RESP[0] = ERRST"ABANDON"; 
        HLR$ERRC[0] = ABANDON"CATIOERR";
        RETURN; 
        END 
  
      FE$RTN[0] = "DSERCAT.";        # ABORT ON FATAL ERROR # 
      MESSAGE(FEMSG,UDFL1); 
      ABORT;
      END 
  
    TERM
PROC DSERPFM((HLRQADR),(ERRSTAT));
  
# TITLE DSERPFM - PROCESS DESTAGE *PFM* ERRORS.                       # 
  
      BEGIN  # DSERPFM #
  
# 
**    DSERPFM - PROCESS DESTAGE *PFM* ERRORS. 
* 
*     *DSERPFM* PROCESSES ERROR RESPONSES RETURNED TO *DESTAGR* FROM
*     *PFM* AND RETURNS A STATUS IN THE *HLRQ* ENTRY OF THE 
*     DESTAGE REQUEST.
* 
*     PROC DSERPFM((HLRQADR),(ERRSTAT)) 
* 
*     ENTRY      (HLRQADR) - ADDRESS OF *HLRQ* ENTRY FOR DESTAGE
*                            REQUEST. 
*                (ERRSTAT) - *PFM* ERROR CODE.
* 
*     EXIT       (HLR$RESP) - ERROR STATE.
*                             (VALUES DEFINED IN *COMXMSC*) 
*                             = ERRST"NOERR". 
*                             = ERRST"WAIT".
*                             = ERRST"ABANDON". 
* 
*                IF THE ERROR STATE INDICATES A DELAY CONDITION 
*                (*ERRST"WAIT"*) THEN THE DESTAGE 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. 
* 
*     MESSAGES   * EXEC ABNORMAL, DSERPFM.* 
# 
  
      ITEM HLRQADR    U;             # *HLRQ* ENTRY ADDRESS # 
      ITEM ERRSTAT    I;             # *PFM* ERROR CODE # 
  
# 
****  PROC DSERPFM - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC ABORT;                  # ABORT #
        PROC DELAY;                  # TIMED DELAY #
        PROC MESSAGE;                # ISSUE MESSAGE #
        PROC PFMEC;                  # CONVERT *PFM* ERROR RESPONSE # 
        END 
  
# 
****  PROC DSERPFM - XREF LIST END. 
# 
  
      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBTDM 
*CALL,COMXHLR 
*CALL,COMXIPR 
*CALL,COMXMSC 
*CALL,COMSPFM 
  
      ITEM ACTION     I;             # ERROR PROCESSING ACTION #
  
      SWITCH DPFMER:ERRST            # DESTAGE ERROR STATES # 
            DPNOERR:NOERR,           # NO ERROR # 
            DPDELAY:WAIT,            # DELAY CONDITION #
            DPFATAL:FATAL,           # FATAL ERROR #
            DPFATAL:RESTART,         # RESPONSE INVALID FROM *PFMEC* #
            DPFATAL:PERM,            # RESPONSE INVALID FROM *PFMEC* #
             DPABAN:ABANDON,         # ABANDON DESTAGE #
             DPSPEC:SPECIAL;         # SPECIAL CONDITION #
  
                                               CONTROL EJECT; 
  
      P<HLRQ> = HLRQADR;
  
      PFMEC(ERRSTAT,ACTION);
      HLR$RESP[0] = ACTION; 
      GOTO DPFMER[ACTION];
  
DPABAN:                              # ABANDON DESTAGE REQUEST #
      IF ERRSTAT EQ FTL 
      THEN                           # RESPONSE INVALID FOR DESTAGE # 
        BEGIN 
        GOTO DPFATAL; 
        END 
  
      HLR$ERRC[0] = ABANDON"PFMERR";
      RETURN; 
  
DPDELAY:                             # DELAY DESTAGE REQUEST #
      HLR$RESP[0] = ERRST"WAIT";
      RETURN; 
  
DPSPEC:                              # RESPONSE INVALID FOR DESTAGE # 
  
DPFATAL:                             # FATAL DESTAGE ERROR #
      FE$RTN[0] = "DSERPFM.";        # ABORT ON FATAL ERROR # 
      MESSAGE(FEMSG,UDFL1); 
      ABORT;
  
DPNOERR:                             # NO ERRORS #
  
      RETURN; 
      END  # DSERPFM #
  
    TERM
PROC DSNTDAM((HLRQADR));
  
# TITLE DSNTDAM - SELECT NEXT FILE TO DESTAGE.                        # 
  
      BEGIN  # DSNTDAM #
  
# 
**    DSNTDAM - SELECT NEXT FILE TO DESTAGE.
* 
*     *DSNTDAM* ANALYZES THE RESULTS OF THE PREVIOUS DESTAGE
*     AND ADVANCES TO THE NEXT FILE TO BE DESTAGED.  *DSNTDAM*
*     ADVANCES TO THE NEXT SUBFAMILY IF A SUBFAMILY RUNS OUT
*     OF FILES. 
* 
*     PROC DSNTDAM
* 
*     ENTRY      HLRQADR - ADRRESS OF *HLRQ* ENTRY. 
*                FET/BUFFER  FOR SCRATC"I" SET UP FOR READ. 
*                FET/BUFFER FOR SCRATCH SET UP FOR WRITE. 
*                FET/BUFFER FOR *MVOCOM* SET UP FOR WRITE.
* 
*     EXIT       (HLR$TDAM) HAS *TDAM* REQUEST FOR NEXT FILE. 
*                 THE FOLLOWING *HLRQ* FIELDS ARE INITIALIZED.
*                   - SH/FFILE/FVOL(TRUE)/VOLAUP. 
# 
  
      ITEM HLRQADR    U;             # ADDRESS OF *HLRQ* ENTRY #
  
# 
***** PROC DSNTDAM - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        FUNC XCOD C(10);             # BINARY TO OCTAL DISPLAY #
        PROC BLOWUP;
        PROC CRELSLK;                # RELEASE CATALOG INTERLOCK #
        PROC MESSAGE;                # ISSUE A DAYFILE MESSAGE #
        PROC MSGAFDF;                # ISSUE ACCOUNT-DAYFILE MESSAGE #
        PROC READ;                   # READ A FILE #
        PROC READW;                  # READ FILE TO WORKING BUFFER #
        PROC RENAME;                 # RENAME A FILE #
        PROC RETERN;                 # RETURN A FILE #
        PROC REWIND;                 # REWIND A FILE #
        PROC STNTDAM;                # GET FILE TO STAGE #
        PROC WRITER;                 # WRITE RECORD MARK #
        PROC WRITEW;                 # WRITE DATA FROM WORKING BUFFER # 
        PROC ZSETFET;                # SET UP A FET # 
        END 
  
# 
****  PROC DSNTDAM - XREF LIST END. 
# 
  
      DEF PRUPAU #(INSPAU*PRUBLK)#; 
  
      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBBZF 
*CALL,COMBCPR 
*CALL,COMBTDM 
*CALL COMBMAT 
*CALL,COMBUDT 
*CALL COMXCTF 
*CALL,COMXHLR 
*CALL,COMXMFD 
*CALL,COMXMSC 
  
  
  
  
      ITEM ACTION     U;             # CONTROLS MAIN LOOP PROCESSING #
      ITEM AU         U;             # FILE SIZE #
      ITEM I          U;             # LOOP COUNTER # 
      ITEM J          U;             # SCRATCH 1 INDEX #
      ITEM K          U;             # SCRATCH 2 INDEX #
      ITEM LOOP       U;             # LOOP INDEX # 
      ITEM SF         U;             # SUBFAMILY INDEX #
      ITEM STAT       U;             # FET STATUS # 
      ITEM STATS      U;             # WRITE FET STATUS # 
      ITEM TAKEIT     B;             # IF 1ST FILE ABANDONED, DO 2ND #
  
  
                                               CONTROL EJECT; 
      P<HLRQ> = HLRQADR;
      P<TDAM> = LOC(HLR$TDAM[0]); 
      P<MVPREAM> = LOC(MCF$PRM[0]); 
  
      SF = TDAMSBF[0];
      ACTION = HLR$RESP[0]; 
      HLR$RESP[0] = ERRST"NOERR"; 
      TAKEIT = FALSE; 
      J = HLR$SCROS1[0];
  
# 
**    PROCESS *ABANDON* STATUS. 
*       - WRITE *TDAM* ENTRY WITH REASON TO *MOVCOM* FILE.
*       - ISSUE DAYFILE MESSAGE WITH FILE ID AND REASON.
# 
  
      IF ACTION EQ ERRST"NOERR"      ## 
        OR ACTION EQ ERRST"ABANDON" 
      THEN                           # ISSUE A MESSAGE #
        BEGIN 
        IF ACTION EQ ERRST"ABANDON" 
        THEN
          BEGIN 
          STAT = HLR$ERRC[0]; 
          ACTION = ERRST"NOERR";
          TDAMABR[0] = HLR$ERRC[0];      # SAVE ABANDON REASON #
          WRITEW(MCF$FET[0],TDAM[0],TDAMLEN,STATS); 
          END 
  
        ELSE
          BEGIN 
          STAT = ABANDON"OK"; 
          DSTCNT = DSTCNT + 1;
          END 
  
        MSGAFDF("E", "ED", STAT,HLRQADR); 
  
        END 
  
      FOR LOOP = LOOP STEP 1
      DO
        BEGIN  # MAIN LOOP #
  
# 
**    PROCESS *TOTAL DESTAGE DISABLE* CASE. 
* 
*       - CLOSE ALL SUB FAMILIES. 
* 
# 
  
  
        IF (NOT GLBDSFL AND ACTION NQ ERRST"NXTSUBF")   # # 
          OR (ACTION EQ ERRST"SMDSTAGEOFF") 
        THEN       # CLOSE OUT SUB FAMILY # 
        BEGIN 
          STATS = 0;
          IF HLR$ERRC[0] NQ ERRST"SPECIAL"
          THEN      # FILE REPORT ALREADY WROTE # 
            BEGIN 
            READW(SCR1$FET[J],TDAM[0],TDAMLEN,STATS); 
            END 
  
          IF STATS NQ 0 
          THEN
            BEGIN 
            WRITER(SCR2$FET[J],RCL);
            RENAME(SCR2$FET[J],SCRNMU[SF]); 
            HLR$ERRC[0] = 0;
            HLR$UNLD[0] = HLR$FCTQ[0] NQ 0; 
            CLEARBUF[J] = 0;
            SCR$HLRQ[SF] = 0; 
  
            SLOWFOR I = 0 STEP 1 UNTIL MAXSF
            DO
              BEGIN       # CLEAR WAIT DRD FLAG ON ALL SUB FAMILYS #
              SCR$WTDRD[I] = FALSE; 
              END 
  
            ACTION = ERRST"NXTSUBF";
            END 
  
          ELSE
            BEGIN 
            STAT = ABANDON"CLOSEDS";
            TDAMABR[0] = ABANDON"CLOSEDS";
            WRITEW(MCF$FET[0],TDAM[0],TDAMLEN,STATS); 
            MSGAFDF("E", "ED", STAT,HLRQADR); 
            ACTION = ERRST"SMDSTAGEOFF";
            END 
  
          HLR$ERRC[0] = 0;
          END 
  
# 
**    PROCESS *NOERR* CASE. 
* 
*       - GET NEXT *TDAM* ENTRY.
*       - IF NEXT FILE OK TO DESTAGE, RETURN. 
*         OTHERWISE, DEFER ITS DESTAGE BY SETTING 
*         ITS STATUS TO "RETRY".
*       - IF NO MORE FILES, CLOSE THE SCRATCH FILE
*         CONTAINING FILES TO BE RETRIED AND
*         RENAME IT TO THE ORIGINAL NAME FOR THAT SF. 
*       - IF *DOSTG* FLAG IS SET, ASSIGN *HLRQ* ENTRY TO STAGE
*         A FILE.  OTHERWISE, GET THE NEXT FILE FROM THE
*         NEXT SUBFAMILY AND CONTINUE DESTAGING.
# 
  
        IF ACTION EQ ERRST"NOERR" 
  
        THEN
          BEGIN  # GET NEXT *TDAM* ENTRY #
          READW(SCR1$FET[J],TDAM[0],TDAMLEN,STAT);
  
          IF STAT EQ OK 
          THEN
            BEGIN  # DESTAGE OR RETRY THIS FILE # 
            AU = 1 + (TDAMFLN[0]-1)/PRUPAU; 
            HLR$SH[0] = TDAMFLN[0] LS MVPR$LB[0]; 
            IF HLR$FFILE[0] OR TAKEIT  # ACCEPT 1ST FILE OF SEQUENCE #
  
              OR (HLR$SH[0]          # SHORT FILE WHICH SHOULD FIT #
              AND (AU LS HLR$AUSF[0]) )  ## 
  
              OR (NOT HLR$SH[0]      # LONG FILE WHICH SHOULD FIT # 
              AND (AU LS HLR$AULF[0]) )  ## 
  
            THEN                     # DESTAGE FILE # 
              BEGIN 
              HLR$HPS[0] = PROCST"INITIAL"; 
              HLR$FVOL[0] = TRUE; 
              RETURN; 
              END 
  
            ELSE                     # RETRY FILE # 
              BEGIN 
              ACTION = ERRST"RETRY";
              TEST LOOP;
              END 
  
            END  # DESTAGE OR RETRY THIS FILE # 
  
          ELSE                       # CLOSE FILE OF TDAM-S TO BE 
                                       RETRIED #
            BEGIN 
            WRITER(SCR2$FET[J],RCL);
            RENAME(SCR2$FET[J],SCRNMU[SF]); 
            CLEARBUF[J] = 0;
            SCR$HLRQ[SF] = 0; 
  
            IF HLR$DOSTG[0]  AND (HLR$LRQADR[0] NQ 0)     ##
              AND (HLR$ERRC[0] NQ ERRST"SPECIAL") 
            THEN                     # GET FILE TO BE STAGED #
              BEGIN 
              DSC$INIT = 1; 
              STNTDAM(HLRQADR); 
              RETURN; 
              END 
  
            HLR$ERRC[0] = 0;
            HLR$UNLD[0] = HLR$FCTQ[0] NQ 0; 
  
            SLOWFOR I = 1 STEP 1 UNTIL MAXSMUNIT
            DO
              BEGIN    # FIND MATCHING *SM* # 
  
              IF HLR$SM[0] EQ SM$ID[I]
              THEN
                BEGIN  # CLEAR FOR THE NEXT SUBFAMILY # 
  
                SLOWFOR K = 0 STEP 1 UNTIL MAXSF
                DO
                  BEGIN  # CHECK FOR PENDING REQUEST #
  
                  IF B<K>SM$DSRFW0[I] NQ 0
                  THEN
                    BEGIN    # CLEAR REQUEST #
                    B<K>SM$DSRFW0[I] = 0; 
                    SCR$WTDRD[K] = FALSE; 
                    GOTO DRDOPEN; 
                    END 
                  END    # CHECK FOR PENDING REQUEST #
                END    # CLEAR OF SUBFAMILY # 
              END      # CLEAR OF DRD # 
  
            IF DSC$WRESRS NQ 0
            THEN    # FORCE A DESTAGE RESTART # 
              BEGIN 
              DSC$INIT = 1; 
              END 
  
# 
*         CHECK FOR AN OTHER *SM* WAITING A RESTART.
* 
# 
  
  
            SLOWFOR I = 1 STEP 1 UNTIL MAXSMUNIT
            DO
              BEGIN     # FIND *SM* # 
              IF HLR$SM[0] NQ SM$ID[I]
              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 DRDOPEN; 
                      END 
                    END   # COMPLETED CHECK OF WAITING #
                END     # DESTAGE WAITNG *DRD* #
              END       # FIND *SM* # 
  
DRDOPEN:  
            ACTION = ERRST"NXTSUBF";
            TEST LOOP;
            END 
  
          END  # GET NEXT *TDAM* ENTRY #
  
# 
**    PROCESS *RETRY* STATUS. 
* 
*       - SAVE *TDAM* ENTRY ON SCRATCH FILE.
*       - ADD FILE LENGTH TO REQUIREMENTS.
# 
  
        IF ACTION EQ ERRST"RETRY" 
  
        THEN
          BEGIN  # RETRY CASE # 
          WRITEW(SCR2$FET[J],TDAM[0],TDAMLEN,STAT); 
          AU = 1 + (TDAMFLN[0]-1)/PRUPAU; 
          IF HLR$SH[0]
          THEN
            BEGIN 
            SCR$AUS[SF] = SCR$AUS[SF] + AU; 
            END 
  
          ELSE
            BEGIN 
            SCR$AUL[SF] = SCR$AUL[SF] + AU; 
            END 
  
          ACTION = ERRST"NOERR";     # GET NEXT FILE TO DESTAGE # 
          TEST LOOP;
          END  # RETRY CASE # 
  
# 
* 
*     PROCESS A *RESOURES* BEING CASE.
*       - HOLD UP *DESTAGING* UNTIL RESOURSES 
*           ARE AVAILABLE.
* 
# 
  
  
      IF ACTION EQ ERRST"RSFULL"
      THEN
        BEGIN 
NEXTENTR: 
        WRITEW(SCR2$FET[J],TDAM[0],TDAMLEN,STAT); 
        AU = 1 + (TDAMFLN[0]-1)/PRUPAU; 
        IF HLR$SH[0]
        THEN
          BEGIN 
          SCR$AUS[SF] = SCR$AUS[SF] + AU; 
          END 
  
        ELSE
          BEGIN 
          SCR$AUL[SF] = SCR$AUL[SF] + AU; 
          END 
  
        READW(SCR1$FET[J],TDAM[0],TDAMLEN,STAT);
  
        IF STAT EQ 0
        THEN
          BEGIN 
          GOTO NEXTENTR;
          END 
  
        ELSE
          BEGIN 
          WRITER(SCR2$FET[J],RCL);
          RENAME(SCR2$FET[J],SCRNMU[SF]); 
          CLEARBUF[J] = 0;
          SCR$HLRQ[SF] = 0; 
          END 
        SLOWFOR I=1 STEP 1 UNTIL MAXSMUNIT
        DO
          BEGIN    # SET *SM* FOR DESTAGE RECALL #
          IF HLR$SM EQ SM$ID[I] 
          THEN
            BEGIN 
            B<(SF)>SM$DSRFW0[I] = 1;
            SCR$WTDRD[SF] = TRUE;    # HOLD DESTAGE ON THIS SUBFAMILY # 
            GOTO SMFOUND; 
            END 
          END      # END OF SET *DESTAGE* RECALL #
  
SMFOUND:  
          ACTION = ERRST"NXTSUBF";
          HLR$ERRC[0] = 0;
          HLR$UNLD[0] = HLR$FCTQ[0] NQ 0; 
          TEST LOOP;
          END 
# 
**    PROCESS *NXTSUBF* CASE. 
* 
*       - LOOK FOR NEXT SUBFAMILY WITH FILES TO BE DESTAGED.
*           IF ONE IS FOUND, PREPARE TO PROCESS ITS FILES.
*           IF NONE FOUND, TERMINATE DESTAGING. 
# 
  
        IF ACTION EQ ERRST"NXTSUBF" 
        THEN                         # FIND NEXT SUBFAMILY TO BE
                                       DESTAGED # 
          BEGIN  # NEXT SUBFAMILY CASE #
          SLOWFOR I = 0 STEP 1 UNTIL MAXSF
          DO
            BEGIN  # LOOK FOR NEXT SUBFAMILY #
            IF NOT SCR$WTDRD[I]              ## 
              AND (SCR$AUS[I] NQ 0 OR SCR$AUL[I] NQ 0)
              AND (SCR$HLRQ[I] EQ 0)
            THEN
              BEGIN  # PREPARE SCRATCH FILES #
              SF = I; 
              SBI[SF] = "0" + I;
              SCI[SF] = "0" + I;
  
              SLOWFOR J = 0 STEP SCCBL WHILE J LS MAT$SPACE    ## 
                [MAT$ENTRY"SCR$BUF"]
              DO
                BEGIN      # FIND FREE SET OF SCRATCH BUFFERS # 
                IF CLEARBUF[J] EQ 0 
                THEN
                  BEGIN    # SCRATCH FILES FREE # 
                  HLR$SCROS1[0] = J;
                  K = J + SFETL + MAT$FWA[MAT$ENTRY"SCR$BUF"];
                  ZSETFET(LOC(SCR1$FET[J]),SCRNM[SF],K,MCFBUFL,SFETL);
                  ZSETFET(LOC(SCR2$FET[J]),SCRNMX[SF],K + MCFBUFL 
                      + SFETL, MCFBUFL,RFETL);
                  REWIND(SCR1$FET[J],RCL);
                  REWIND(SCR2$FET[J],RCL);
                  READ(SCR1$FET[J],RCL);
                  HLR$VOLAUP[0] = SCR$AUS[I]; 
                  SCR$HLRQ[SF] = HLRQADR; 
                  SCR$AUS[I] = 0; 
                  SCR$AUL[I] = 0; 
                  HLR$FFILE[0] = TRUE;
  
                  IF NOT GLBDSFL
                  THEN
                    BEGIN    # DESTAGING CLOSED # 
                    ACTION = ERRST"SMDSTAGEOFF";   # TO GIBDSFL CHECK # 
                    END 
  
                  ELSE
                    BEGIN    # CHECK FIRST FILE # 
                    ACTION = ERRST"NOERR";   # GET FIRST FILE # 
                    END 
                  TEST LOOP;
                  END      # SCRATCH BUFFER # 
                END      # FREE SCRATCH BUFFER #
  
  
              END 
  
            END  # LOOK FOR NEXT SUBFAMILY #
  
  
  
# 
*     CHECK IF ALL DESTAGES ARE COMPLETE. 
# 
  
  
      SLOWFOR I = 0 STEP 1 UNTIL MAXSF
      DO
        BEGIN 
           IF SCR$HLRQ[I] NQ 0 OR SCR$WTDRD[I]
           THEN 
             BEGIN     # DESTAGES NOT COMPLETE #
             TDAMFC[0] = TDAMFCODE"STAGE";
             RETURN;
             END
          END 
# 
*     IF NO SUBFAMILY WAS FOUND, TERMINATE DESTAGING. 
# 
  
          TDAMFC[0] = TDAMFCODE"NOREQ"; 
  
          WRITER(MCF$FET[0],RCL); 
  
          REWIND(MCF$FET[0],RCL); 
          RETERN(MCF$FET[0],RCL); 
  
          RETURN; 
          END  # NEXT SUBFAMILY CASE #
  
        END  # MAIN LOOP #
  
      END  # DSNTDAM #
  
    TERM
PROC DSSETUP(FAM,ERRSTAT);
  
# TITLE  DSSETUP - DESTAGING INITIALIZATION PROCESSOR.                # 
  
      BEGIN  # DSSETUP #
  
# 
**    DSSETUP - DESTAGING INITIALIZATION PROCESSOR. 
* 
*     *DSSETUP* READS THE *MVOCOM* FILE CREATED BY *SSMOVE* AND WRITES
*     ( UP TO 8 ) SCRATCH FILES ( ONE FOR EACH SUBFAMILY WITH FILES 
*     TO BE DESTAGED ).  *DSSETUP* THEN CALLS *DSNTDAM* TO PREPARE
*     THE *HLRQ* ENTRY FOR THE FIRST FILE TO BE DESTAGED. 
*     THE *MVOCOM* FILE IS ALSO INITIALIZED BY REWRITING
*     THE PREAMBLE BACK TO IT.
* 
*     PROC DSSETUP(FAM,ERRSTAT) 
* 
*     ENTRY      *MOVCOM* FILE HAS BEEN GENERATED BY *SSMOVE*.
*                (FAM)   = FAMILY TO BE PROCESSED.
* 
*     EXIT       SCRATCH FILES WRITTEN AND REWOUND FOR EACH AFFECTED
*                SUBFAMILY.  *HLRQ* ENTRY ESTABLISHED FOR FIRST FILE. 
*                (ERRSTAT) =0, IF NO PROBLEMS.
* 
*     MESSAGES   * UNABLE TO READ MVOCOM,   FM=FFFFFFF.*. 
*                * UNABLE TO WRITE SCRATCH, FM=FFFFFFF.*. 
* 
# 
  
      ITEM FAM        C(7);          # FAMILY NAME #
      ITEM ERRSTAT    U;             # REPLY STATUS # 
  
# 
****  PROC DSSETUP - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC ABORT;                  # ABNORMAL TERMINATION # 
        PROC BLOWUP;
        PROC BZFILL;                 # BLANK OR ZERO FILL ITEM #
        PROC HLRQENQ;                # *HLRQ* ENQUEUER #
        PROC MESSAGE;                # ISSUE MESSAGE #
        PROC MSG;                    # ISSUE MESSAGE #
        PROC PFD;                    # PERMANENT FILE REQUEST DELAYS #
        PROC READ;                   # READ A FILE #
        PROC READW;                  # READ DATA TO WORKING BUFFER #
        PROC RETERN;                 # RETURN FILE #
        PROC REWIND;                 # REWIND A FILE #
        PROC RMVBLNK;                # REMOVE EXCESS BLANKS # 
        PROC SETPFP;                 # SWITCH TO GIVEN SUBFAMILY #
        PROC WRITER;                 # WRITE END OF RECORD #
        PROC WRITEW;                 # WRITE DATA FROM WORKING BUFFER # 
        PROC ZSETFET;                # INITIALIZES A FET #
        END 
  
# 
****  PROC DSSETUP - XREF LIST END. 
# 
  
      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS # 
*CALL,COMBFAS 
*CALL,COMBBZF 
*CALL,COMBFET 
*CALL COMBMAT 
*CALL,COMXCTF 
*CALL,COMBPFP 
*CALL,COMBPFS 
*CALL,COMBTDM 
*CALL,COMXMFD 
*CALL,COMXMSC 
  
  
      ITEM AU         U;             # FILE SIZE IN AU #
      ITEM I          I;             # LOOP COUNTER # 
      ITEM J          I;             # LOOP COUNTER # 
      ITEM K          I;             # BUFFER POINTER # 
      ITEM MCFCATM    C(40) = " UNKNOWN FAMILY - XXXXXXX.;";
      ITEM MCFUNPR    C(40) = " UNABLE TO PROCESS MOVE REQUEST FILE.;"
        ; 
      ITEM OPEN       B;             # CONTROL OPENING OF NEW SCRATCH 
                                       FILE # 
      ITEM PREVSF     U;             # PREVIOUS SUBFAMILY # 
      ITEM PRUPAU     U;             # NUMBER OF PRU PER AU # 
      ITEM STAT       I;             # STATUS # 
      ITEM STATW      I;             # WRITE STATUS # 
                                               CONTROL EJECT; 
  
# 
*     INITIALIZE SUBFAMILY SCRATCH FILE ENTRIES.
# 
  
      PRUPAU = INSPAU*PRUBLK; 
  
      SLOWFOR I = 0 STEP 1 UNTIL MAXSF
      DO
        BEGIN 
        SCR$AUS[I] = 0; 
        SCR$AUL[I] = 0; 
        END 
  
# 
*     VERIFY *FAM* IS A KNOWN FAMILY. 
# 
  
      OPEN = FALSE; 
      FOR I = 0 STEP 1 WHILE I LS FAMCNT AND NOT OPEN 
      DO
        BEGIN 
        OPEN = MRFTFAM[I] EQ FAM; 
        END 
  
      IF NOT OPEN 
      THEN                           # UNKNOWN FAMILY # 
        BEGIN 
        ERRSTAT = 1;
        BZFILL(FAM,TYPFILL"BFILL",7); 
        C<18,7>MCFCATM = FAM; 
        MSG(MCFCATM,UDFL1); 
        MSG(MCFUNPR,UDFL1); 
        RETURN; 
        END 
  
# 
*     SWITCH TO SPECIFIED FAMILY. 
# 
  
      PFP$WRD0[0] = 0;
      PFP$FAM[0] = FAM; 
      PFP$UI[0] = DEF$UI; 
      PFP$FG1[0] = TRUE;
      PFP$FG4[0] = TRUE;
      SETPFP(PFP);
  
      IF PFP$STAT[0] NQ 0 
      THEN
        BEGIN 
        FE$RTN[0] = "DSSETUP";
        MESSAGE(FEMSG,UDFL1); 
        ABORT;
        END 
  
  
# 
*     ATTACH *MVOCOM* FILE GENERATED BY *SSMOVE*. 
# 
  
      PFD("ATTACH", MVOCOM,0,"M","W","RC",STAT,0);
  
      IF STAT NQ OK 
      THEN
        BEGIN 
        MOVMLINE[0] = MCFATTERR;
        BZFILL(FAM,TYPFILL"BFILL",7); 
        MOVMFAM[0] = FAM; 
        RMVBLNK(MOVMSG[0],38);
        MESSAGE(MOVMSG[0],UDFL1); 
        ERRSTAT = 1;
        RETURN; 
        END 
  
# 
*     READ *MVOCOM* FILE PREAMBLE.
# 
  
      J = LOC(MCF$FET[0]);
      ZSETFET(J,MVOCOM,LOC(MCF$BUF[0]),MCFBUFL,SFETL);
      FET$EP[0] = TRUE; 
  
      READ(MCF$FET[0],NRCL);
      READW(MCF$FET[0],MCF$PRM[0],MVPRML,STAT); 
  
      IF STAT NQ OK 
      THEN
        BEGIN 
        MOVMLINE[0] = MCFRDERR; 
        FAM = MRFTFAM[0]; 
        BZFILL(FAM,TYPFILL"BFILL",7); 
        MOVMFAM[0] = FAM; 
        RMVBLNK(MOVMSG[0],38);
        MESSAGE(MOVMSG[0],UDFL1); 
        RETERN(MCF$FET[0],RCL); 
        ERRSTAT = 1;
        RETURN; 
        END 
  
  
# 
*     SET UP SCRATCH FILE NAMES.
# 
  
  
      SLOWFOR I = 0 STEP 1 UNTIL MAXSF
      DO
        BEGIN     # SET SCRATCH FILE NAMES #
        NAMESCR[I] = "SCRATC";
        SCRNMX[I] = "SCRBBB"; 
        END 
  
  
# 
*     COPY *MVOCOM* TO SCRATCH FILES. 
# 
  
      P<FETSET> = LOC(MCF$FET[0]);
      P<TDAM> = LOC(MCF$REQ[0]);
      P<MVPREAM> = LOC(MCF$PRM[0]); 
      K = MAT$FWA[MAT$ENTRY"SCR$BUF"];
      P<SCR1$FET> = K;
      P<SCR2$FET> = K + SFETL + MCFBUFL + 1;
      PREVSF = 8; 
  
      SLOWFOR I =0 STEP 1 WHILE STAT EQ 0 
      DO
        BEGIN  # TRANSFER TDAM ENTRIES FROM *MVOCOM* TO SCRATCH # 
        READW(MCF$FET[0],MCF$REQ[0],TDAMLEN,STAT);
  
        IF STAT EQ CIOERR 
        THEN
          BEGIN  # TERMINATE PROCESSING *MVOCOM* FILE # 
          IF FET$AT[0] NQ OK
          THEN
            BEGIN  # READ ERROR # 
            MOVMLINE[0] = MCFRDERR; 
            FAM = MRFTFAM[0]; 
            BZFILL(FAM,TYPFILL"BFILL",7); 
            MOVMFAM[0] = FAM; 
            RMVBLNK(MOVMSG[0],38);
            MESSAGE(MOVMSG[0],UDFL1); 
            END  # READ ERROR # 
  
          RETERN(MCF$FET[0],RCL); 
          ERRSTAT = 1;
          RETURN; 
          END  # TERMINATE *MVOCOM* PROCESSING #
  
        J = TDAMSBF[0]; 
  
# 
*     CLOSE OUT PREVIOUS SCRATCH FILE, IF APPROPRIATE.
# 
  
        IF (I NQ 0)                  # NOT 1ST PASS # 
          AND (J NQ PREVSF OR STAT NQ 0)  # FOUND A NEW SUBFAMILY # 
        THEN                         # CLOSE OUT SCRATCH FILE FOR 
                                       PREVIOUS SUBFAMILY # 
          BEGIN 
          OPEN = TRUE;
          WRITER(SCR1$FET[0],RCL);
          END 
  
        IF STAT NQ 0
        THEN
          BEGIN 
          TEST I; 
          END 
  
# 
*     OPEN NEW SCRATCH FILE, IF APPROPRIATE.
# 
  
        IF (I EQ 0) OR (OPEN) 
        THEN
          BEGIN 
          SBI[0] = "0" + J; 
          PREVSF = J; 
          ZSETFET(K,SCRNM[0],K+SFETL,    ## 
              MCFBUFL,SFETL);    ## 
          REWIND(SCR1$FET[0],RCL);
          OPEN = FALSE; 
          END 
  
        AU = 1 + (TDAMFLN[0]-1)/PRUPAU; 
        IF TDAMFLN[0] LS MVPR$LB[0] 
        THEN
          BEGIN 
          SCR$AUS[TDAMSBF[0]] = SCR$AUS[TDAMSBF[0]] + AU; 
          END 
  
        ELSE
          BEGIN 
          SCR$AUL[TDAMSBF[0]] = SCR$AUL[TDAMSBF[0]] + AU; 
          END 
  
        WRITEW(SCR1$FET[0],MCF$REQ[0],TDAMLEN,STATW); 
        END  # TRANSFER TDAM ENTRIES FROM *MVOCOM* TO SCRATCH # 
  
# 
*     COMPLETE SETTING UP FOR DESTAGING OF FILES. 
*       - WRITE PREAMBLE BACK TO *MVOCOM* FILE. 
*       - COMPLETE INITIALIZATION.
# 
  
      REWIND(MCF$FET[0],RCL); 
      WRITEW(MCF$FET[0],MCF$PRM[0],MVPRML,STATW); 
      DSC$INIT = 1; 
      ERRSTAT = 0;
      CLEARBUF[0] = 0;
      DSC$FAM = FAM;
      DSC$LKMSK = 0;
      DSC$LKTYP = 0;
      RETURN; 
  
      END  # DSSETUP #
  
    TERM
