Retro1.org codex

SXDEST

[00001] PROC DS$$DOC
[00003] DS$$DOC - DESIGN DOCUMENTATION FOR THE DESTAGE PROCESS.
[00360] PROC DESTAGR¹⁾
[00362] DESTAGR - DESTAGE FILE FROM DISK TO M860 CARTRIDGE.
[00441] PROC ADD$LNK
[00442] PROC ACQ$FCT
[00443] PROC CKPFETC
[00444] PROC CFLUSH
[00445] PROC CPUTFCT
[00446] PROC CRELSLK
[00447] PROC DELAY
[00448] PROC DROPDS
[00449] PROC DROPIDS
[00450] PROC DSALLO
[00451] PROC DSERCAT
[00452] PROC DSERPFM
[00453] PROC DSNTDAM
[00454] PROC HLCPYDC
[00455] PROC HLLOAD
[00456] PROC HLLDSET
[00457] PROC MSG
[00458] PROC MSGAFDF
[00459] PROC RECALL
[00460] PROC RETERN
[00461] PROC RLSVOL
[00462] PROC RLS$FCT
[00463] PROC SETASA
[00464] PROC UASTPRM
[00465] PROC UATTACH
[00466] PROC UGET
[00467] PROC UPUSAGE
[00468] PROC ZFILL
[00469] PROC ZSETFET
[01923] PROC DSALLO²⁾
[01925] DSALLO - ALLOCATE A VOLUME ON A M860 CARTRIDGE.
[01930] DSALLO - ALLOCATE A VOLUME ON A M860 CARTRIDGE.
[02074] PROC ACQ$FCT
[02075] PROC ANLZAST
[02077] PROC CRDAST
[02078] PROC DSERCAT
[02079] PROC OCTSRCH
[02080] PROC RLSVOL
[02081] PROC RLS$FCT
[02082] PROC UASTPRM
[02731] PROC DSERCAT³⁾
[02733] DSERCAT - PROCESS DESTAGE CATALOG ACCESS ERRORS.
[02738] DSERCAT - PROCESS DESTAGE CATALOG ACCESS ERRORS.
[02767] PROC ABORT
[02768] PROC MESSAGE
[02802] PROC DSERPFM⁴⁾
[02804] DSERPFM - PROCESS DESTAGE *PFM* ERRORS.
[02809] DSERPFM - PROCESS DESTAGE *PFM* ERRORS.
[02845] PROC ABORT
[02846] PROC DELAY
[02847] PROC MESSAGE
[02848] PROC PFMEC
[02909] PROC DSNTDAM⁵⁾
[02911] DSNTDAM - SELECT NEXT FILE TO DESTAGE.
[02916] DSNTDAM - SELECT NEXT FILE TO DESTAGE.
[02943] FUNC XCOD C(10)
[02944] PROC BLOWUP
[02945] PROC CRELSLK
[02946] PROC MESSAGE
[02947] PROC MSGAFDF
[02948] PROC READ
[02949] PROC READW
[02950] PROC RENAME
[02951] PROC RETERN
[02952] PROC REWIND
[02953] PROC STNTDAM
[02954] PROC WRITER
[02955] PROC WRITEW
[02956] PROC ZSETFET
[03407] PROC DSSETUP(FAM,ERRSTAT)
[03409] DSSETUP - DESTAGING INITIALIZATION PROCESSOR.
[03414] DSSETUP - DESTAGING INITIALIZATION PROCESSOR.
[03446] PROC ABORT
[03447] PROC BLOWUP
[03448] PROC BZFILL
[03449] PROC HLRQENQ
[03450] PROC MESSAGE
[03451] PROC MSG
[03452] PROC PFD
[03453] PROC READ
[03454] PROC READW
[03455] PROC RETERN
[03456] PROC REWIND
[03457] PROC RMVBLNK
[03458] PROC SETPFP
[03459] PROC WRITER
[03460] PROC WRITEW
[03461] PROC ZSETFET
Source Code

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
¹⁾ , ²⁾ , ⁵⁾
HLRQADR
³⁾ , ⁴⁾
HLRQADR),(ERRSTAT
Retro1.org codex

Table of Contents

SXDEST

Table Of Contents

Source Code
