Retro1.org codex

PRGM SSMOVE; 
# TITLE SSMOVE - INITIALIZES *SSMOVE* UTILITY.                        #
 
      BEGIN  # SSMOVE #
 
#
***   SSMOVE - INITIALIZES *SSMOVE* UTILITY.
*
*     THIS PRGM INITIALIZES THE *SSMOVE* UTILITY BY CRACKING
*     THE CONTROL CARD AND SYNTAX CHECKING THE PARAMETERS.
*
*     SSMOVE,I,L,FM,LO,DN,NW,UI,PX,SB.
*
*     PRGM SSMOVE.
*
*     ENTRY.    INPUTS TO *SSMOVE* ARE
*
*               I            INPUT DIRECTIVES ON FILE *INPUT*.
*               I = FLNM     INPUT DIRECTIVES ON FILE *FLNM*.
*               I = 0        NO INPUT DIRECTIVES.  DEFAULT PARAMETERS
*                            WILL BE USED.
*               I OMITTED    SAME AS *I*.
*
*               L            LISTABLE OUTPUT IS ON FILE *OUTPUT*.
*               L = LFN      LISTABLE OUTPUT IS ON FILE *LFN*.
*               L = 0        NO OUTPUT FILE GENERATED.
*               L OMITTED    SAME AS *L*.
*
*
*               NW           NO WAIT - DO NOT WAIT FOR EXEC TO PROCESS
*                            THE *SSMOVE* REQUEST FILE.
*               NW OMITTED   WAIT FOR COMPLETION OF *SSMOVE* REQUEST
*                            PROCESSING BY EXEC.
*
*               FM           USE DEFAULT FAMILY.
*               FM = FAMILY  FAMILY TO BE PROCESSED.
*               FM OMITTED   SAME AS *FM*.
*
*               LO           INDIVIDUAL FILES ARE NOT TO BE LISTED IN
*                            THE REPORT FILE.
*               LO = F       ALL FILES SELECTED FOR STAGING, DESTAGING,
*                            OR RELEASING ARE LISTED IN THE REPORT FILE.
*               LO = P       LIST ONLY FILES ACTUALLY PROCESSED IN
*                            REPORT FILE (PER *PX* PARAMETER).
*               LO OMITTED   SAME AS *LO*.
*
*               DN           FILES FROM ALL DEVICES IN A SPECIFIED
*                            FAMILY ARE ELIGIBLE FOR DESTAGE AND
*                            RELEASE.
*               DN = DEVICE  DEVICE NUMBER OF THE ONLY DISK FROM
*                            WHICH FILES ARE ELIGIBLE FOR DESTAGE AND
*                            RELEASE.
*               DN OMITTED   SAME AS *DN*.
*
*               LB = N       LARGE FILE BOUNDARY, USED WHEN
*                            SORTING FILES FOR DESTAGING.  ALL FILES
*                            SMALLER THAN *N* PRU-S ARE CONSIDERED
*                            SMALL FILES.
*               LB           DEFAULT LARGE FILE BOUNDARY IS USED.
*               LB OMITTED   SAME AS *LB*.
*
*               UI           ALL USER INDICES ARE PROCESSED.
*               UI = N       RESTRICT PROCESSING TO FILES HAVING
*                            USER INDEX *N*.
*               UI OMITTED   SAME AS *UI*.
*
*               PX           ALL SELECTED PROCESSING WILL BE DONE.
*               PX = XXX     *XXX* IS A CHARACTER STRING IDENTIFYING
*                            WHICH TYPES OF PROCESSING ARE TO BE
*                            EXCLUDED.  EACH CHARACTER OF *XXX* CAN BE
*                            ONE OF THE LETTERS *ABDFIS*.
*                            *I* INHIBITS PROCESSING OF INDIRECT ACCESS
*                            FILES.
*                            *D* INHIBITS PROCESSING OF DIRECT ACCESS
*                            FILES.
*                            *A* CONTROLS RELEASING OF DISK SPACE
*                            (ARCHIVING).
*                            *B* CONTROLS DESTAGING A FILE FROM DISK TO
*                            M860 (BACK-UP).
*                            *S* CONTROLS STAGING A FILE TO DISK.
*                            *F* CONTROLS FREEING A FILE FROM M860 BY
*                            CLEARING ITS ASA VALUE FROM THE FILES
*                            *PFC* ENTRY.
*                            (E.G. PX = ABFS REPORTS THE RESULTS OF A
*                            *SSMOVE* RUN WITHOUT ACTUALLY PERFORMING
*                            THE SELECTED ACTIONS.)
*               PX OMITTED   SAME AS *PX*.
*
*     EXIT.     *SSMOVE* PROCESSED OR AN ERROR CONDITION
*               ENCOUNTERED.
*
*     MESSAGES. SSMOVE - MUST BE SYSTEM ORIGIN.
*               SSMOVE COMPLETE.
*               SSMOVE ABNORMAL, SSMOVE.
*               UNABLE TO CONNECT WITH EXEC.
*
*     NOTES.    PRGM *SSMOVE* INITIALIZES *SSMOVE* UTILITY BY
*               CRACKING AND SYNTAX CHECKING THE CONTROL CARD
*               PARAMETERS.  ANY ERROR IN THE CONTROL CARD OR
*               IN *SSMOVE* PROCESSING CAUSES THE UTILITY TO
*               ABORT.  PRGM *SSMOVE* IS THE MAIN MODULE FROM
*               WHICH ALL THE OTHER ROUTINES ARE CALLED.  THE LIVE
*               PFC IS READ AND THE ENTRIES FOR THE FILES CANDIDATE
*               FOR *DESTAGE AND RELEASE* OR *DESTAGE ONLY* ARE
*               WRITTEN TO TEMPORARY FILES.  THE FILES CANDIDATE
*               FOR *RELEASE ONLY* ARE RELEASED DIRECTLY.  THE
*               TEMPORARY FILES ARE THEN USED TO GENERATE THE
*               COMMUNICATION FILE FOR EXEC.  IF THE *REPORT
*               ONLY* OPTION HAS NOT BEEN SELECTED, THE COMM-
*               UNICATION FILE IS SENT TO EXEC VIA A UCP TYPE 2
*               REQUEST.  A SUMMARY OF ALL THE FILES SELECTED
*               FOR *RELEASE ONLY*, *DESTAGE AND RELEASE* AND
*               FOR *DESTAGE ONLY* IS WRITTEN TO THE REPORT FILE.
*
*     COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
#
 
#
****  PRGM SSMOVE - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # CALLS *ABORT* MACRO #
        PROC BZFILL;                 # BLANK/ZERO FILL CHARACTER ITEM #
        PROC GETSPS;                 # GET SYSTEM ORIGIN STATUS #
        PROC MESSAGE;                # DISPLAYS A MESSAGE IN DAYFILE #
        PROC MVABDS;                 # PROCESS DESTAGE ABANDONMENT #
        PROC MVCALL;                 # ISSUES TYPE 1, 2 UCP REQUEST #
        PROC MVINIT;                 # DECODES *SSMOVE* CONTROL
                                       STATEMENT #
        PROC MVPASS3;                # SETS UP "DESTAGE AND RELEASE"
                                       AND "DESTAGE" TEMP FILES #
        PROC MVPASS4;                # SETS UP COMMUNICATION FILE #
        PROC MVPFRD;                 # READS PFC #
        PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT
                                       OR RETURN #
        PROC RETERN;                 # RETURN A FILE #
        PROC RPCLOSE;                # CLOSE REPORT FILE #
        PROC ZSETFET;                # INITIALIZE A FET #
        END
 
#
****  PRGM SSMOVE - XREF LIST END.
#
 
#
*     DAYFILE MESSAGES.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
      DEF RSLEN      #1#;            # RETURN STATUS WORD LENGTH L #
      DEF MSG1       #" SSMOVE - MUST BE SYSTEM ORIGIN."#;
      DEF MSG2       #" SSMOVE COMPLETE."#;
      DEF MSG3       #" UNABLE TO CONNECT WITH EXEC."#;
      DEF PROCNAME   #"SSMOVE"#;     # PROC NAME #
 
                                               CONTROL PRESET;
*CALL,COMBFAS
*CALL,COMBBZF
*CALL,COMBCPR
*CALL,COMBUCR
*CALL,COMTMOV
*CALL,COMTMVP
*CALL,COMTOUT
 
      ITEM RESPCODE   I;             # RESPONSE FROM EXEC #
 
      ARRAY CALL$SS [0:0] P(CPRLEN);;  # CALLSS PARAMETER BLOCK #
 
      ARRAY SPSSTAT[0:0]  S(RSLEN);
        BEGIN
        ITEM SPS$STATUS U(00,48,12);  # RETURN STATUS #
        END
 
                                               CONTROL EJECT;
 
      REQID$MV = REQNAME"RQIMOVE";   # SET UP REQUESTOR ID #
 
#
*     CHECK FOR SYSTEM ORIGIN PRIVILEGES.
#
 
      GETSPS(SPSSTAT);               # GET SYSTEM ORIGIN STATUS #
      IF SPS$STATUS NQ 0
      THEN
        BEGIN
        MVMSG$LN[0] = MSG1;
        MESSAGE(MVMSG[0],SYSUDF1);
        ABORT;
        END
 
#
*     INITIALIZE *SSMOVE* BY DECODING RUN-TIME PARAMETERS AND
*     BY DECODING RUN-TIME DIRECTIVES.
*
*     WRITE THE FIRST TWO SECTIONS OF THE *SSMOVE* REPORT
*     TO THE REPORT FILE - DIRECTIVES, AND RUN-TIME WEIGHTS.
#
 
      MVINIT;
 
#
*     READ THE PFC AND GENERATE TEMPORARY DECISION FILE.
#
 
      MVPFRD;
 
#
*     GENERATE *DESTAGE AND RELEASE* AND *DESTAGE* TEMP FILES
*     AND RELEASE THE FILES CANDIDATE FOR RELEASE ONLY.
#
 
      MVPASS3;
 
#
*     GENERATE COMMUNICATION FILE.
*     THE REPORT PRODUCED BY THIS STEP IS A LISTING OF THE FILES
*     SELECTED FOR PROCESSING AND THE EXPECTED STATUS OF EACH
*     DEVICE AND SUBFAMILY UPON COMPLETION OF THE SELECTED.
*     PROCESSING.
#
 
      MVPASS4;
 
#
*     IF *REPORT ONLY* OPTION IS NOT SELECTED-
*     AND COMMUNICATION FILE NOT EMPTY-
*       1.  CONNECT WITH EXEC.
*       2.  INFORM EXEC THAT COMMUNICATION FILE IS READY.
*       3.  DISCONNECT.
#
 
      IF NOT (PX$A[0] AND PX$B[0] AND PX$S[0] AND PX$F[0])  ##
        AND NFILES NQ 0
      THEN
        BEGIN  # SEND COMMUNICATION FILE TO EXEC #
        P<CPR> = LOC(CALL$SS[0]);
        MVCALL(TYP"TYP1",REQTYP1"CONNECT",RESPCODE);
        IF RESPCODE NQ RESPTYP1"OK1"
        THEN                         # CONNECT NOT DONE #
          BEGIN
          MVMSG$LN[0] = MSG3;
          MESSAGE(MVMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT #
          END
 
        MVCALL(TYP"TYP2",REQTYP2"FILE$READY",RESPCODE);
 
        IF RESPCODE NQ RESPTYP2"OK2"
        THEN                         # ABNORMAL TERMINATION #
          BEGIN
          MVMSG$PROC[0] = PROCNAME;
          MESSAGE(MVMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT #
          END
 
        MVCALL(TYP"TYP1",REQTYP1"DISCONNECT",RESPCODE);
        IF RESPCODE NQ RESPTYP1"OK1"
        THEN                         # ABNORMAL TERMINATION #
          BEGIN
          MVMSG$PROC[0] = PROCNAME;
          MESSAGE(MVMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT #
          END
 
#
*     PRODUCE REPORT OF ANY DESTAGES WHICH WERE ABANDONED.
#
 
        IF NOT MVARG$NW[0]
        THEN
          BEGIN
          MVABDS;
          END
 
        END  # SEND COMMUNICATION FILE TO EXEC #
 
#
*     CLOSE REPORT FILE.
#
 
      RPCLOSE(OUT$FETP);
 
#
*     RETURN *MVOCOM* FILE AND *CATS* FILE.
#
 
      RETERN(MV$FET[FILEMO],RCL);
      FETP = LOC(MV$FET[FILEMO]);
      BUFP = LOC(MV$BUF[FILEMO]);
      COMNAME = CATS;
      BZFILL(COMNAME,TYPFILL"ZFILL",7);
      ZSETFET(FETP,COMNAME,BUFP,MVBUFL,SFETL);
      RETERN(MV$FET[FILEMO],RCL);
 
#
*     ISSUE FINAL DAYFILE MESSAGE.
#
 
      MVMSG$LN[0] = MSG2;            # STOP WITH DAYFILE MESSAGE #
      MESSAGE(MVMSG[0],SYSUDF1);
      RESTPFP(PFP$END);              # RESTORE USER-S *PFP* #
 
      END  # SSMOVE #
 
    TERM
PROC GETPFC(PEO,FLAG);
# TITLE GETPFC - GET NEXT PFC ENTRY.                                  #
 
      BEGIN  # GETPFC #
 
#
**    GETPFC - GET NEXT PFC ENTRY.
*
*     PROC GETPFC(PEO,FLAG).
*
*     ENTRY.    (PEO) = ORDINAL OF PREVIOUS PFC ENTRY.
*
*     EXIT.     (PEO)       = ORDINAL OF CURRENT PFC ENTRY.
*               P<CNTRWORD> = FWA OF CONTROL WORD.
*               P<PFC>      = FWA OF CURRENT PFC ENTRY.
*               (FLAG)      = ERROR STATUS.
*                             0, MORE PFC ENTRIES TO GO.
*                             1, END OF PFC.
*
*     MESSAGES. NO DEVICES IN THE FAMILY.
*               SSMOVE ABNORMAL, GETPFC.
*
*     NOTES.    A CATALOG SECTOR IS READ IN ALONG WITH THE CONTROL
*               WORD.  THE ORDINAL OF THE NON ZERO PFC ENTRY IN THE
*               SECTOR IS RETURNED TO THE CALLING PROCEDURE.
#
 
      ITEM PEO        I;             # PFC ENTRY ORDINAL #
      ITEM FLAG       I;             # ERROR STATUS #
 
#
****  PROC GETPFC - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC MESSAGE;                # DISPLAYS MESSAGE IN DAYFILE #
        PROC RDPFC;                  # READ *PFC* ENTRY #
        PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT
                                       OR RETURN #
        END
 
#
****  PROC GETPFC - XREF LIST END.
#
 
      DEF MSF$NODEV  #"NO DEVICES IN THE FAMILY."#;  # MESSAGE TEST #
      DEF PROCNAME   #"GETPFC."#;    # PROC NAME #
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL,COMBFAS
*CALL COMBSIT
*CALL,COMTCTW
*CALL,COMSPFM
*CALL,COMTMOV
*CALL,COMTMVP
 
      ITEM FIRST      B = TRUE;      # FIRST CALL TO PROCEDURE #
      ITEM I          I;             # LOOP INDUCTION VARIABLE #
      ITEM LIMIT      I;             # LIMIT ON PFC ORDINAL #
      ITEM WRDCNT     I;             # WORD COUNT #
 
                                               CONTROL EJECT;
 
      SLOWFOR DUMMY = DUMMY
      DO
        BEGIN  # GET NON ZERO PFC ENTRY #
        IF PEO GQ LIMIT OR FIRST
        THEN
          BEGIN  # READ NEXT SECTOR #
          RDPFC(MVARG$FM[0],0,PFC$SEC[0],WRDCNT,FLAG);
          IF FLAG NQ OK
          THEN
            BEGIN  # PROCESS ERROR STATUS #
            IF FLAG EQ 1
            THEN                     # END OF PFC #
              BEGIN
              RETURN;
              END
 
            IF FLAG EQ 2
            THEN                     # NO DEVICES IN THE FAMILY #
              BEGIN
              MVMSG$LN[0] = MSF$NODEV;
              MESSAGE(MVMSG[0],UDFL1);
              RESTPFP(PFP$ABORT);    # RESTORE USER-S *PFP* AND ABORT #
              END
 
            IF FLAG EQ 3 OR FLAG EQ 4
            THEN                     # IGNORE BAD SECTOR OR ERROR IDLE
                                       OR PF UTILITY ACTIVE ON DEVICE #
              BEGIN
              TEST DUMMY;
              END
 
            MVMSG$PROC[0] = PROCNAME;  # ABNORMAL TERMINATION #
            MESSAGE(MVMSG[0],UDFL1);
            RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT #
            END  # PROCESS ERROR STATUS #
 
          IF FIRST
          THEN
            BEGIN
            FIRST = FALSE;
            END
 
          P<CNTRWORD> = LOC(PFC$SEC[0]) + WRDCNT;
 
#
*     CALCULATE LIMIT ON PFC ENTRY ORDINAL.
#
 
          LIMIT = WRDCNT/PFCENTL;
          LIMIT = LIMIT - 1;
          PEO = -1;
          END  # READ NEXT SECTOR #
 
#
*     SEARCH FOR NON ZERO PFC ENTRY.
#
 
        PEO = PEO + 1;
        SLOWFOR I = PEO STEP 1 WHILE I LQ LIMIT
        DO
          BEGIN
          PEO = I;
          P<PFC> = LOC(PFC$SEC[0]) + PEO*PFCENTL;
          IF PFC$UI[0] NQ 0
          THEN
            BEGIN
            RETURN;
            END
 
          END
 
        END  # GET NON ZERO PFC ENTRY #
 
      END  # GETPFC #
 
    TERM
PROC MVABDS;
# TITLE MVABDS - PROCESS DESTAGE ABANDONMENT.                         #
 
      BEGIN  # MVABDS #
 
#
**    MVABDS - PROCESS DESTAGE ABANDONMENT INFORMATION.
*
*     PROC MVABDS.
*
*     MESSAGES   1) UNABLE TO ATTACH COMMUNICATION FILE.
*                2) UNABLE TO READ COMMUNICATION FILE.
*
*     NOTES      PROC *MVABDS* PRODUCES A REPORT PAGE LISTING EACH
*                DESTAGE ABANDONMENT CODE, THE REASON FOR ABANDONMENT,
*                AND THE NUMBER OF FILES ABANDONED FOR THAT REASON.
*                IF *LO=F* IS SPECIFIED EACH ABANDONED FILE AND THE
*                CORRESPONDING ABANDONMENT CODE IS LISTED.  *MVRPTDS*
*                IS CALLED TO REPRODUCE THE DEVICE STATUS REPORT AND
*                THE SUBFAMILY REPORT REFLECTING ONLY THE DESTAGES
*                WHICH ACTUALLY OCCURRED.
#
 
#
****  PROC MVABDS - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC BZFILL;                 # BLANK/ZERO FILL CHARACTER ITEM #
        PROC MESSAGE;                # ISSUE MESSAGE TO DAYFILE #
        PROC MVRPTDS;                # REPORT DEVICE STATUS #
        PROC PF;                     # *PFM* REQUEST INTERFACE #
        PROC READ;                   # INITIATE INPUT TO A BUFFER #
        PROC READW;                  # READ DATA TO WORKING BUFFER #
        PROC RESTPFP;                # RESTORE USER-S FAMILY AND UI. #
        PROC RPEJECT;                # PAGE EJECTS REPORT FILE #
        PROC RPLINE;                 # WRITE LINE TO REPORT FILE #
        PROC RPSPACE;                # PUTS BLANK LINE ON REPORT FILE #
        PROC ZFILL;                  # ZERO FILL ARRAY #
        PROC ZSETFET;                # INITIALIZE A FET #
        FUNC XCDD  C(10);            # CONVERT DECIMAL TO DISPLAY #
        FUNC XCOD C(10);             # BINARY TO DECIMAL DISPLAY #
        END
 
#
****  PROC MVABDS - XREF LIST END.
#
 
      DEF MSG1       #" UNABLE TO ATTACH COMMUNICATION FILE."#;
      DEF MSG2       #" UNABLE TO READ COMMUNICATION FILE."#;
      DEF MSG3       #"NO SPACE"#;
      DEF MSG4       #"NO STORAGE MODULE AVAILABLE"#;
      DEF MSG5       #"NO CARTRIDGE OR GROUP AVAILABLE"#;
      DEF MSG6       #"FILE ALREADY DESTAGED"#;
      DEF MSG7       #"FILE BUSY / PFM PROBLEM"#;
      DEF MSG8       #"CATALOG ACCESS ERROR"#;
      DEF MSG9       #"OVERFLOW NOT LEGAL"#;
      DEF MSG10      #"GROUP FULL"#;
      DEF MSG11      #"DISK READ ERROR"#;
      DEF MSG12      #"CARTRIDGE LOST"#;
      DEF MS613      #"CLOSED DESTAGE"#;
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBBZF
*CALL COMBFET
*CALL COMBTDM
*CALL COMTMOV
*CALL COMTOUT
*CALL COMXMFD
 
      ITEM ABR        S:ABANDON;     # ABANDONMENT CODE #
      ITEM ABNDN      B=TRUE;        # PRODUCE ABANDONMENT REPORT #
      ITEM IX         I;             # FILE TYPE INDEX #
      ITEM J          I;             # FET ADDRESS #
      ITEM STAT       I;             # STATUS #
      ITEM SUBFAM     I;             # SUBFAMILY INDEX #
      ITEM TMPC       C(10);         # TEMPORARY CHARACTER #
 
      ARRAY ABNDNF   [1:11]  S(1);
        BEGIN
        ITEM ABND$NF    I(00,00,60);  # FILE COUNT #
        END
 
                                               CONTROL EJECT;
 
#
*     ATTACH COMMUNICATION FILE.
#
 
      COMNAME = MVOCOM;
      BZFILL(COMNAME,TYPFILL"ZFILL",7);
 
      PF("ATTACH",COMNAME,0,"M","W","RC",STAT,"NA",0,0);
 
      IF STAT NQ OK
      THEN
        BEGIN
        MVMSG$LN[0] = MSG1;
        MESSAGE(MVMSG[0],UDFL1);
        RESTPFP(PFP$ABORT);
        END
 
#
*     DETERMINE WHETHER TO LIST EACH FILE.
#
 
      IF LO$F[0] OR LO$P[0]
      THEN
        BEGIN
        LISTFETP = OUT$FETP;
        END
 
#
*     CLEAR DESTAGE INFORMATION FROM SUBFAMILY STATUS ARRAY.
#
 
      SLOWFOR IX = IXDA STEP 1 UNTIL IXIA
      DO
        BEGIN
        SLOWFOR SUBFAM = 0 STEP 1 UNTIL MAXSF
        DO
          BEGIN
          SFDS$NF[IX,SUBFAM] = 0;
          SFDS$PRU[IX,SUBFAM] = 0;
          END
 
        END
 
#
*     READ PREAMBLE OF COMMUNICATION FILE.
#
 
      J = LOC(MCF$FET[0]);
      ZSETFET(J,COMNAME,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
        MVMSG$LN[0] = MSG2;
        MESSAGE(MVMSG[0],UDFL1);
        RESTPFP(PFP$ABORT);
        END
 
                                               CONTROL EJECT;
 
#
*     WRITE HEADER TO REPORT FILE.
#
 
      RPEJECT(OUT$FETP);
      RPLINE(OUT$FETP,"DESTAGE ABANDONMENT REPORT",5,26,0);
      RPSPACE(OUT$FETP,SP"SPACE",1);
      RPLINE(LISTFETP,"FILENAME           UI     CODE",9,30,0);
      RPSPACE(LISTFETP,SP"SPACE",1);
 
#
*     PROCESS EACH *TDAM* ENTRY.
#
 
      REPEAT WHILE STAT EQ 0
      DO
        BEGIN  # PROCESS EACH *TDAM* #
 
        READW(MCF$FET[0],MCF$REQ[0],TDAMLEN,STAT);
 
        IF STAT EQ CIOERR
        THEN
          BEGIN
          MVMSG$LN[0] = MSG2;
          MESSAGE(MVMSG[0],UDFL1);
          RESTPFP(PFP$ABORT);
          END
 
        IF STAT NQ OK
        THEN
          BEGIN
          TEST DUMMY;
          END
 
        P<TDAM> = LOC(MCF$REQ[0]);
        DNX = DN$TO$DNX[TDAMDN[0]];
        SFX = TDAMSBF[0];
 
#
*     CHECK FOR VALID ABANDONMENT CODE.
#
 
        IF TDAMABR[0] LQ ABANDON"OK"  ##
          OR TDAMABR[0] GQ ABANDON"ENDAB"
        THEN                         # INVALID ABANDON CODE #
          BEGIN
          TEST DUMMY;
          END
 
#
*     DETERMINE FILE TYPE.
#
 
        IF TDAMIA[0]
        THEN
          BEGIN
          FTYPE = IXIA;
          END
 
        ELSE
          BEGIN
          FTYPE = IXDA;
          END
 
#
*     UPDATE COUNTS FOR *MVRPTDS* REPORT.
#
 
        IF TDAMFC[0] EQ TDAMFCODE"DESTRLS"
        THEN                         # FILE WAS NOT RELEASED #
          BEGIN
          DEV$RELF[FTYPE,DNX] = DEV$RELF[FTYPE,DNX] - 1;
          DEV$TRPRU[FTYPE,DNX] = DEV$TRPRU[FTYPE,DNX] + TDAMFLN[0];
          IF FTYPE EQ IXIA
          THEN
            BEGIN
            DEV$RELP[FTYPE,DNX] = DEV$RELP[FTYPE,DNX] - TDAMFLN[0];
            END
 
          ELSE
            BEGIN
            PRUTRK = DEV$SECTR[IXDA,DNX];
            TRUPRU = (((TDAMFLN[0]+1) / PRUTRK) + 1) * PRUTRK;
            DEV$RELP[FTYPE,DNX] = DEV$RELP[FTYPE,DNX] - TRUPRU;
            END
 
          END
 
        SFDS$NF[FTYPE,SFX] = SFDS$NF[FTYPE,SFX] + 1;
        SFDS$PRU[FTYPE,SFX] = SFDS$PRU[FTYPE,SFX] + TDAMFLN[0];
        SFRL$NF[FTYPE,SFX] = SFRL$NF[FTYPE,SFX] - 1;
        SFRL$PRU[FTYPE,SFX] = SFRL$PRU[FTYPE,SFX] - TDAMFLN[0];
        SFDM$NF[FTYPE,SFX] = SFDM$NF[FTYPE,SFX] - 1;
        SFDM$PRU[FTYPE,SFX] = SFDM$PRU[FTYPE,SFX] - TDAMFLN[0];
 
#
*     INCREMENT FILE COUNT.
#
 
        ABR = TDAMABR[0];
        ABND$NF[ABR] = ABND$NF[ABR] + 1;
 
#
*     WRITE EACH FILE TO REPORT FILE.
#
 
        TMPC = TDAMPFN[0];
        BZFILL(TMPC,TYPFILL"BFILL",7);
        RPLINE(LISTFETP,TMPC,10,7,1);
        TMPC = XCOD(TDAMUI[0]);
        RPLINE(LISTFETP,TMPC,20,10,1);
        CHR$10[0] = XCDD(TDAMABR[0]);
        RPLINE(LISTFETP,CHR$R2[0],37,2,0);
 
        END  # PROCESS EACH *TDAM* #
 
#
*     LIST CODE, NUMBER OF FILES, AND EXPLANATION.
#
 
      RPSPACE(OUT$FETP,SP"SPACE",2);
      RPLINE(OUT$FETP,"CODE       FILES       REASON",9,29,0);
      RPSPACE(OUT$FETP,SP"SPACE",1);
 
      ABR = ABANDON"NOSPACE";
      CHR$10[0] = XCDD(ABR);
      RPLINE(OUT$FETP,CHR$R2[0],11,2,1);
      CHR$10[0] = XCDD(ABND$NF[ABR]);
      RPLINE(OUT$FETP,CHR$R8[0],17,8,1);
      RPLINE(OUT$FETP,MSG3,30,8,0);
 
      ABR = ABANDON"NOSM";
      CHR$10[0] = XCDD(ABR);
      RPLINE(OUT$FETP,CHR$R2[0],11,2,1);
      CHR$10[0] = XCDD(ABND$NF[ABR]);
      RPLINE(OUT$FETP,CHR$R8[0],17,8,1);
      RPLINE(OUT$FETP,MSG4,30,27,0);
 
      ABR = ABANDON"NOCARGP";
      CHR$10[0] = XCDD(ABR);
      RPLINE(OUT$FETP,CHR$R2[0],11,2,1);
      CHR$10[0] = XCDD(ABND$NF[ABR]);
      RPLINE(OUT$FETP,CHR$R8[0],17,8,1);
      RPLINE(OUT$FETP,MSG5,30,31,0);
 
      ABR = ABANDON"NEWASA";
      CHR$10[0] = XCDD(ABR);
      RPLINE(OUT$FETP,CHR$R2[0],11,2,1);
      CHR$10[0] = XCDD(ABND$NF[ABR]);
      RPLINE(OUT$FETP,CHR$R8[0],17,8,1);
      RPLINE(OUT$FETP,MSG6,30,21,0);
 
      ABR = ABANDON"PFMERR";
      CHR$10[0] = XCDD(ABR);
      RPLINE(OUT$FETP,CHR$R2[0],11,2,1);
      CHR$10[0] = XCDD(ABND$NF[ABR]);
      RPLINE(OUT$FETP,CHR$R8[0],17,8,1);
      RPLINE(OUT$FETP,MSG7,30,23,0);
 
      ABR = ABANDON"CATIOERR";
      CHR$10[0] = XCDD(ABR);
      RPLINE(OUT$FETP,CHR$R2[0],11,2,1);
      CHR$10[0] = XCDD(ABND$NF[ABR]);
      RPLINE(OUT$FETP,CHR$R8[0],17,8,1);
      RPLINE(OUT$FETP,MSG8,30,20,0);
 
      ABR = ABANDON"NOOVERF";
      CHR$10[0] = XCDD(ABR);
      RPLINE(OUT$FETP,CHR$R2[0],11,2,1);
      CHR$10[0] = XCDD(ABND$NF[ABR]);
      RPLINE(OUT$FETP,CHR$R8[0],17,8,1);
      RPLINE(OUT$FETP,MSG9,30,18,0);
 
      ABR = ABANDON"GRFULL";
      CHR$10[0] = XCDD(ABR);
      RPLINE(OUT$FETP,CHR$R2[0],11,2,1);
      CHR$10[0] = XCDD(ABND$NF[ABR]);
      RPLINE(OUT$FETP,CHR$R8[0],17,8,1);
      RPLINE(OUT$FETP,MSG10,30,10,0);
 
      ABR = ABANDON"DSKRDERR";
      CHR$10[0] = XCDD(ABR);
      RPLINE(OUT$FETP,CHR$R2[0],11,2,1);
      CHR$10[0] = XCDD(ABND$NF[ABR]);
      RPLINE(OUT$FETP,CHR$R8[0],17,8,1);
      RPLINE(OUT$FETP,MSG11,30,15,0);
 
      ABR = ABANDON"LOST";
      CHR$10[0] = XCDD(ABR);
      RPLINE(OUT$FETP,CHR$R2[0],11,2,1);
      CHR$10[0] = XCDD(ABND$NF[ABR]);
      RPLINE(OUT$FETP,CHR$R8[0],17,8,1);
      RPLINE(OUT$FETP,MSG12,30,14,0);
 
      ABR = ABANDON"CLOSEDS";
      CHR$10[0] = XCDD(ABR);
      RPLINE(OUT$FETP,CHR$R2[0],11,2,1);
      CHR$10[0] = XCDD(ABND$NF[ABR]);
      RPLINE(OUT$FETP,CHR$R8[0],17,8,1);
      RPLINE(OUT$FETP,MS613,30,14,0);
 
#
*     GENERATE AN UPDATED *DEVICE REPORT* AND *SUBFAMILY REPORT*.
#
 
      MVRPTDS(ABNDN);
 
 
      END  # MVABDS #
 
    TERM
PROC MVALCS(CS,VCS,NBS,KEY,FLAG);
# TITLE MVALCS - ANALYZES CHARACTER STRING.                           #
 
      BEGIN  # MVALCS #
 
#
**    MVALCS - ANALYZES CHARACTER STRING.
*
*     THIS PROCEDURE ANALYZES AN INPUT CHARACTER STRING (CS)
*     TO VERIFY THAT EACH CHARACTER IS IN THE STRING
*     SPECIFIED BY *VCS*.  EACH VALID CHARACTER RESULTS IN THE
*     CORRESPONDING BIT IN *NBS* BEING SET TO 1 (TRUE).  THESE BITS
*     IN *NBS* MAY THEN BE TESTED AS BOOLEAN ITEMS TO DETERMINE
*     IF THE ASSOCIATED CHARACTER WAS SUPPLIED OR NOT.
*
*     PROC MVALCS(CS,VCS,NBS,KEY,FLAG).
*
#
 
      ITEM CS         C(10);         # INPUT CHARACTER STRING #
      ITEM VCS        C(10);         # VALID CHARACTERS #
      ITEM NBS        I;             # OUTPUT BIT STRING #
      ITEM KEY        C(2);          # OPTION BEING TESTED #
      ITEM FLAG       I;             # NON-ZERO FOR ERRORS #
 
 
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS #
 
*CALL,COMBFAS
*CALL COMBSIT
 
 
      ITEM C          C(1);          # CHARACTER BEING ANALYZED #
      ITEM I          I;             # LOOP INDEX #
      ITEM J          I;             # LOOP INDEX #
 
                                               CONTROL EJECT;
 
      NBS = 0;
      FLAG = 0;
      SLOWFOR I = 0 STEP 1 UNTIL 9
      DO
        BEGIN  # CS LOOP #
        C = C<I,1>CS;
        IF C EQ " " OR C EQ 0
        THEN
          RETURN;
        SLOWFOR J = 0 STEP 1 UNTIL 9
        DO
          BEGIN  # SEARCH FOR MATCH #
          IF C<J,1>VCS EQ C
          THEN
            BEGIN
            B<J,1>NBS = 1;
            TEST I;
            END
 
          END  # SEARCH FOR MATCH #
 
        FLAG = I+1;
        RETURN;
        END  # CS LOOP #
 
      END  # MVALCS #
 
    TERM
PROC MVCALL((REQTYPE),(REQCODE),RESPCODE);
# TITLE MVCALL - ISSUES TYPE 1 OR 2 UCP REQUEST TO EXEC.              #
 
      BEGIN  # MVCALL #
 
#
**    MVCALL - ISSUES A TYPE 1 OR 2 UCP REQUEST TO EXEC.
*
*     PROC MVCALL((REQTYPE),(REQCODE),RESPCODE).
*
*     ENTRY.    (REQTYPE)   = REQUEST TYPE.
*               (REQCODE)   = REQUEST CODE.
*               (MVARG$FM)  = FAMILY NAME.
*               (REQID$MV)  = REQUESTOR ID.
*               (SSID$MV)   = SUBSYSTEM ID.
*               P<CPR>      = FWA OF CALLSS PARAMETER BLOCK.
*
*     EXIT.     (RESPCODE) = RESPONSE FROM EXEC.
*
*     MESSAGES. SSMOVE ABNORMAL, MVCALL.
*
*     NOTES.    THE CALLSS PARAMETER REQUEST BLOCK IS SET
*               UP FOR A TYPE 1 OR TYPE 2 UCP REQUEST AND
*               THE REQUEST IS ISSUED TO EXEC.
#
 
      ITEM REQTYPE    I;             # REQUEST TYPE #
      ITEM REQCODE    I;             # REQUEST CODE #
      ITEM RESPCODE   I;             # RESPONSE FROM EXEC #
 
#
****  PROC MVCALL - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # STOPS PROCESSING #
        PROC CALLSS;                 # ISSUES A UCP/SCP REQUEST #
        PROC MESSAGE;                # DISPLAYS MESSAGE IN DAYFILE #
        PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT
                                       OR RETURN #
        END
 
#
****  PROC MVCALL - XREF LIST END.
#
 
      DEF PROCNAME   #"MVCALL."#;    # PROC NAME #
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL,COMBFAS
*CALL,COMBCPR
*CALL,COMTMOV
*CALL,COMTMVP
 
      ITEM I          I;             # LOOP INDUCTION VARIABLE #
 
                                               CONTROL EJECT;
 
#
*     ZERO FILL CALLSS PARAMETER BLOCK.
#
 
      FASTFOR I = 0 STEP 1 UNTIL CPRLEN-1
      DO
        BEGIN
        CPR1[I] = 0;
        END
 
      CPR$RQT[0] = REQTYPE;          # SET UP PARAMETER BLOCK #
      CPR$RQC[0] = REQCODE;
      CPR$RQI[0] = REQID$MV;
      CPR$SSPFLG[0] = TRUE;
      CPR$FAM[0] = MVARG$FM[0];
 
      IF REQTYPE EQ TYP"TYP1"
      THEN                           # TYPE 1 REQUEST #
        BEGIN
        CPR$WC[0] = TYP1$WC;
        END
 
      ELSE
        BEGIN  # TYPE 2 OR ILLEGAL REQUEST #
        IF REQTYPE EQ TYP"TYP2"
        THEN                         # TYPE 2 REQUEST #
          BEGIN
          CPR$WC[0] = TYP2$WC;
          CPR$NW[0] = MVARG$NW[0];
          END
 
        ELSE                         # ILLEGAL REQUEST TYPE #
          BEGIN
          MVMSG$PROC[0] = PROCNAME;
          MESSAGE(MVMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);        # RESTORE USER-S *PFP* AND ABORT #
          END
 
        END  # TYPE 2 OR ILLEGAL REQUEST #
 
      CALLSS(SSID$MV,CPR[0],RCL);
      IF REQTYPE EQ TYP"TYP2"
      THEN
        BEGIN
        RESPCODE = CPR$RQR[0];       # RETURN RESPONSE FROM EXEC #
        END
 
      ELSE
        BEGIN
        RESPCODE = CPR$ES[0];        # RETURN RESPONSE FROM SYSTEM #
        END
 
      RETURN;
 
      END  # MVCALL #
 
    TERM
PROC MVCKSF((FN),(UI),PO);
# TITLE MVCKSF - CHECK IF SPECIAL FILE.                               #
 
      BEGIN  # MVCKSF #
 
#
**    MVCKSF - CHECK IF SPECIAL FILE.
*
*     THIS PROCEDURE DETERMINES WHETHER THE FILE SPECIFIED BY
*     THE *FN* AND *UI* PARAMETERS WAS SPECIFIED VIA THE
*     *SF,FN=...* DIRECTIVE.
*
*     PROC MVCKSF( (FN), (UI), PO).
*
*     ENTRY.    (FN) = NAME OF A PERMANENT FILE
*               (UI) = USER INDEX OF THIS FILE
*
*     EXIT.     (PO) = 0, IF THE FILE WAS NOT SPECIFIED BY A
*                         *SF,FN=...* DIRECTIVE.
*                    = Q, IF IT WAS SPECIFIED BY THE DIRECTIVE
*                         *SF,FN,...PO=Q.*.
#
 
      ITEM FN         C(7);          # FILE NAME #
      ITEM UI         I;             # USER INDEX #
      ITEM PO         C(1);          # PROCESSING OPTION #
 
      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
*CALL,COMBFAS
*CALL,COMTMOV
 
      ITEM I          I;             # LOOP INDEX #
 
      ARRAY CKSFILES  [0:0]  S(3);   # CHECK FOR SPECIAL FILES #
        BEGIN
        ITEM CK$WRD1    U(00,00,60);  # WORD 1 #
        ITEM CK$FN      C(00,00,07);  # FILE NAME #
        ITEM CK$WRD2    U(01,00,60);  # WORD 2 #
        ITEM CK$FNC     C(01,00,07);  # SELECTED FILE NAME #
        ITEM CK$WRD3    U(02,00,60);  # WORD 3 #
        ITEM CK$MASK    U(02,00,42);  # MASK FOR FILE NAME #
        END
 
                                               CONTROL EJECT;
      PO = 0;
 
      SLOWFOR I = 1 STEP 1 UNTIL IDXFN
      DO
        BEGIN  # SEARCH FOR FILE MATCH #
        IF UI LS SF$UI[I]
        THEN                         # NO MATCH #
          BEGIN
          RETURN;
          END
 
        IF UI GR SF$UI[I]
        THEN
          BEGIN
          TEST I;
          END
 
        CK$FN[0] = FN;
        CK$FNC[0] = SF$FNC[I];
        CK$MASK[0] = SF$MASK[I];
        IF ( (CK$FN[0] LXR CK$FNC[0])  # COMPARE FILE NAMES #
          LAN CK$WRD3[0] )           # EXCLUDE WILD-CARD CHARACTERS #
          EQ 0
        THEN                         # FOUND A MATCH #
          BEGIN
          PO = SF$PO[I];
          RETURN;
          END
 
        END  # SEARCH FOR FILE MATCH #
 
      END  # MVCKSF #
 
    TERM
PROC MVDIR;
# TITLE MVDIR - PROCESS DIRECTIVES .                                  #
 
      BEGIN  # MVDIR #
 
#
**    THIS PROCEDURE PROCESSES THE DIRECTIVES.
*
*     PROC MVDIR.
*
*     MESSAGES. DIRECTIVE ERROR - REPORT ONLY.
*
*     NOTES.    THIS PROCEDURE READS EACH DIRECTIVE AND CHECKS
*               THAT IT IS VALID.  IF IT IS NOT A VALID DIRECTIVE
*               A MESSAGE IS ISSUED TO THE DAYFILE AND THE REPORT
*               FILE.  *SSMOVE* THEN CONTINUES IN REPORT ONLY
*               MODE.  FOR THE *FR*,*WM*,*WA*,*PR*,*BR*,
*               AND *SM* DIRECTIVES THE DEFAULT VALUES ARE REPLACED
*               WITH THE SPECIFIED VALUES.  THE DIRECTIVES AND
*               RUN-TIME PARAMETER VALUES ARE WRITTEN TO THE REPORT
*               FILE.
#
 
#
****  PROC MVDIR - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC BZFILL;                 # BLANK/ZERO FILL CHARACTER ITEM #
        PROC MESSAGE;                # DISPLAYS A MESSAGE IN DAYFILE #
        PROC READ;                   # INITIATE INPUT TO A BUFFER #
        PROC READC;                  # COPY LINE TO WORKING BUFFER #
        PROC RPEJECT;                # PAGE EJECT #
        PROC RPLINE;                 # WRITE LINE TO REPORT FILE #
        PROC RPSPACE;                # WRITE BLANK LINE TO REPORT FILE
                                     #
        PROC XARG;                   # DECODE PARAMETERS PER *ARG*
                                       TABLE #
        PROC ZFILL;                  # ZERO OUT AN ARRAY #
        PROC ZSETFET;                # INITIALIZE A FET #
        FUNC XCDD C(10);             # CONVERT BINARY TO DECIMAL #
        FUNC XDXB I;                 # CONVERT DISPLAY TO BINARY #
        END
 
#
****  PROC MVDIR - XREF LIST END.
#
 
      DEF MSK77   #O"77"#;           # MASK #
      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS #
 
                                               CONTROL PRESET;
*CALL,COMBFAS
*CALL COMBSIT
*CALL,COMBBZF
*CALL,COMSPFM
*CALL,COMTMOV
*CALL,COMTMVD
*CALL,COMTMVP
*CALL,COMTOUT
 
      ITEM ARGLIST    I;             # ARGUMENT LIST ADDRESS #
      ITEM COL        I;             # COLUMN NUMBER #
      ITEM DIRLINE    C(90);         # DIRECTIVE TEXT LINE #
      ITEM DIRNUM     I;             # DIRECTIVE NUMBER #
      ITEM EOR        B;             # END-OF-RECORD FLAG #
      ITEM FATALERR   B;             # FATAL ERROR, IF TRUE #
      ITEM FOUND      B;             # LOOP EXIT CONTROL #
      ITEM I          I;             # LOOP INDEX #
      ITEM J          I;             # LOOP INDEX #
      ITEM K          I;             # LOOP INDEX #
      ITEM KEY        C(2);          # DIRECTIVE KEYWORD #
      ITEM KEYOK      B;             # CONTROL VARIABLE #
      ITEM L          I;             # LOOP INDEX #
      ITEM LFN        C(7);          # FILE NAME #
      ITEM MASK       I;             # MASK FOR SPECIAL FILE NAMES #
      ITEM MAXARG     I;             # MAXIMUM NUMBER OF ARGUMENTS #
      ITEM STAT       I;             # STATUS OF PROCEDURE CALL #
      ITEM TMPI       I;             # TEMPORARY INTEGER #
 
 
      ARRAY SFDEF [1:SFMX] S(1);
        BEGIN
        ITEM SFD$I      I(00,00,60);  # DEFAULT VALUES FOR *SF*
                                        DIRECTIVE #
        END
 
      BASED
      ARRAY PARM [1:2,1:2,1:1] S(1);
        BEGIN
        ITEM PARM$V     U(00,00,60);  # PARAMETER VALUE #
        END
 
      BASED
      ARRAY XXARG[1:1] S(1);
        BEGIN
        ITEM XX$KEY     C(00,00,02);  # PARAMETER KEY #
        ITEM XX$C2      C(00,06,01);  # SECOND CHARACTER OF KEY #
        END
 
      BASED
      ARRAY SFPARM [1:1] S(1);
        BEGIN
        ITEM SF$C       C(00,00,10);  # *SF* PARAMETER (CHARACTER) #
        ITEM SF$I       I(00,00,60);  # *SF* PARAMETER (INTEGER) #
        END
 
      ARRAY SFTMP [0:0] S(1);
        BEGIN
        ITEM SFT$VAL    U(00,00,60);  # ENTIRE WORD #
        ITEM SFT$UI     U(00,00,18);  # USER INDEX #
        ITEM SFT$FNC    C(00,18,07);  # FILE NAME #
        ITEM SFT$FNI    I(00,18,42);  # FILE NAME #
        END
 
      BASED
      ARRAY ZR [0:0];;               # ARRAY TO BE ZEROED #
 
 
      ITEM ADDR       U;             # PARAMETER LIST ADDRESS #
 
 
      ARRAY LU [1:2] P(2);
        BEGIN
        ITEM LL         I(00,00,60);  # LOWER LIMIT #
        ITEM UL         I(01,00,60);  # UPPER LIMIT #
        END
 
      BASED
      ARRAY TQ[1:1] S(1);
        BEGIN
        ITEM TQ$VAL     I(00,00,60);  # DIRECTIVE PARAMETERS #
        END
 
      BASED
      ARRAY KWTEXT[1:1] S(2);
        BEGIN
        ITEM KW$TEXT    C(00,00,20);  # TEXT FOR DIRECTIVE KEYWORD #
        END
 
 
 
                                               CONTROL EJECT;
      P<TQ> = ARG$TAB[0];
 
#
*     INITIALIZE TO READ THE DIRECTIVE FILE.
#
 
      IF MVARG$I[0] NQ 0
      THEN
        BEGIN
        IDXFN = 0;
        LFN = MVARG$I[0];
        FETP = LOC(MV$FET[FILEMI]);
        BUFP = LOC(MV$BUF[FILEMI]);
        ZSETFET(FETP,LFN,BUFP,MVBUFL,SFETL);
        READ(MV$FET[FILEMI],NRCL);
        EOR = FALSE;
        END
 
      ELSE                           # NO DIRECTIVE FILE #
        BEGIN
        EOR = TRUE;
        END
 
#
*     READ AND PROCESS EACH DIRECTIVE.  ISSUE A NON-FATAL
*     ERROR MESSAGE FOR ANY DIRECTIVE ERRORS.
#
 
      FOR DIRNUM = 1 STEP 1 WHILE NOT EOR
      DO
        BEGIN  # PROCESS NEXT DIRECTIVE #
        DIRLINE = " ";               # ERASE PREVIOUS DIRECTIVE #
        READC(MV$FET[FILEMI],DIRLINE,9,STAT);
        BZFILL(DIRLINE,TYPFILL"BFILL",90);
        C<89,1>DIRLINE = ".";        # FORCE DIRECTIVE TERMINATOR #
        IF STAT NQ 0
        THEN
          BEGIN
          EOR = TRUE;
          TEST DIRNUM;
          END
 
        CHR$10[0] = XCDD(DIRNUM);
        RPLINE(OUT$FETP,CHR$R3[0],3,3,1);  # PRINT DIRECTIVE NUMBER #
        RPLINE(OUT$FETP,DIRLINE,8,80,0);  # PRINT DIRECTIVE #
 
        IF C<0,1>DIRLINE EQ "*"
        THEN                         # FOUND COMMENT #
          BEGIN
          TEST DIRNUM;
          END
 
 
#
*     VERIFY DIRECTIVE KEYWORD IS OK.
*     LOCATE *ARGLIST* FOR THIS DIRECTIVE.
#
 
        KEY = C<0,2>DIRLINE;
        KEYOK = FALSE;
        FOR I = 1 STEP 1 WHILE (NOT KEYOK) AND (I LQ NUMDIR)
        DO
          BEGIN
          IF ARG$KEY[I] NQ KEY
          THEN
            BEGIN
            TEST I;
            END
 
          KEYOK = TRUE;
          MAXARG = ARG$MX[I];
          ADDR = ARG$VAL[I];
          ARGLIST = ARG$TAB[I];
          END
 
#
*     IF A DIRECTIVE ERROR OR DIRECTIVE PARAMETER ERROR EXISTS
*     IGNORE THIS DIRECTIVE.
#
 
        IF NOT KEYOK
        THEN                         # DIRECTIVE ERROR #
          BEGIN
          RPLINE(OUT$FETP,"** UNRECOGNIZED DIRECTIVE - IGNORED.",8,36
            ,0);
          RPSPACE(OUT$FETP,SP"SPACE",1);
          FATALERR = TRUE;
          TEST DIRNUM;
          END
 
#
*     CRACK PARAMETERS FOR THE DIRECTIVE AND SAVE THEM APPROPRIATELY.
#
 
        P<ZR> = ARG$TAB[0];
        ZFILL(ZR[0],ARG$MX[0]);
        XARG(ARGLIST,DIRLINE,STAT);
        IF STAT NQ 0
        THEN                         # DIRECTIVE PARAMETER ERROR #
          BEGIN
          RPLINE(OUT$FETP,"PARAM ERROR - DIRECTIVE IGNORED",12,31,0);
          RPSPACE(OUT$FETP,SP"SPACE",1);
          FATALERR = TRUE;
          TEST DIRNUM;
          END
 
                                               CONTROL EJECT;
 
#
**    PROCESS THE *PR*, *BR*, *FR*, *WA*, *WM*, *SM* DIRECTIVES
*     BY REPLACING DEFAULT VALUES WITH SPECIFIED VALUES.
#
 
        IF KEY NQ "SF"
        THEN
          BEGIN
          FOR I = 1 STEP 1 UNTIL 2
          DO
            BEGIN  # ESTABLISH LIMITS PER *TQ* #
            LL[I] = 1;
            UL[I] = 2;
            IF TQ$VAL[2*I-1] NQ TQ$VAL[2*I]
            THEN
              BEGIN  # NOT 1,2 #
              IF TQ$VAL[2*I-1] NQ 0
              THEN
                BEGIN
                LL[I] = 2;
                END
 
              ELSE
                BEGIN
                UL[I] = 1;
                END
 
              END  # NOT 1,2 #
 
            END  # ESTABLISH LIMITS PER *TQ* #
 
          STAT = 0;
          P<PARM> = ADDR;
          FOR I = 1 STEP 1 UNTIL MAXARG
          DO
            BEGIN
            IF TQ$VAL[I+5] EQ 0
            THEN
              BEGIN
              TEST I;
              END
 
            STAT = XDXB(TQ$VAL[I+5],1,TMPI);
            IF STAT NQ 0
            THEN
              BEGIN
              RPLINE(OUT$FETP,"INCORRECT VALUE - DIRECTIVE IGNORED."
                ,8,35,0);
              FATALERR = TRUE;
              TEST I;
              END
 
            FOR J = LL[1] STEP 1 UNTIL UL[1]
            DO
              BEGIN  # J #
              FOR K = LL[2] STEP 1 UNTIL UL[2]
              DO
                BEGIN  # K #
                PARM$V[J,K,I] = TMPI;
                END
 
              END  # J #
 
            END  # I #
 
          TEST DIRNUM;
          END
 
#
**    PROCESS THE *SF* DIRECTIVE WITHOUT THE *FN* PARAMETER
*     BY SAVING THE OTHER PARAMETERS AS DEFAULTS FOR USE WHEN
*     THE *FN* PARAMETER IS PROVIDED.
#
 
        P<SFPARM> = ARG$VAL[0];
        IF SF$I[SFFN] EQ 0
        THEN
          BEGIN  # ESTABLISH *SF* DEFAULTS #
          FOR I = 1 STEP 1 UNTIL SFMX
          DO
            BEGIN
            IF SF$I[I] NQ 0
            THEN
              BEGIN
              SFD$I[I] = SF$I[I];
              END
 
            END
 
          TEST DIRNUM;
          END  # ESTABLISH *SF* DEFAULTS #
 
#
**    PROCESS THE *SF* DIRECTIVE HAVING THE *FN* PARAMETER AS FOLLOWS..
*       1)  SUBSTITUTE THE DEFAULT PARAMETERS FOR ANY MISSING
*           PARAMETER.  DECLARE AN ERROR IF EITHER THE *UI* OR
*           *PO* PARAMETER IS MISSING.
*
*       2)  IGNORE DIRECTIVE IF THE *UI* OR *PO* PARAMETER IS INVALID.
*
*       3)  SAVE THE *FN*, *UI*, *PO* VALUES AND THE FILE MASK IN THE
*           ARRAY OF SELECTED FILES.
#
 
        KEYOK = TRUE;
        FOR I = SFUI STEP 1 UNTIL SFPO
        DO
          BEGIN  # STEP 1 #
          IF SF$I[I] EQ 0
          THEN
            BEGIN
            SF$I[I] = SFD$I[I];
            END
 
          IF SF$I[I] EQ 0
          THEN
            BEGIN
            KEYOK = FALSE;
            END
 
          END  # STEP 1 #
 
        STAT = XDXB(SF$C[SFUI],0,TMPI);
        KEYOK = KEYOK AND (STAT EQ 0) AND  ##
          (TMPI GR 0) AND (TMPI LQ SYS$UI);
        SFT$UI[0] = TMPI;
        KEY = C<0,1>SF$C[SFPO];
        IF KEY NQ "A" AND KEY NQ "B" AND KEY NQ "S"  ##
          AND KEY NQ "F" AND KEY NQ "X"
        THEN
          BEGIN
          KEYOK = FALSE;
          END
 
        IF NOT KEYOK
        THEN
          BEGIN
          RPLINE(OUT$FETP,"*PO* OR *UI* PARAMETER MISSING OR INVALID"
            ,8,41,0);
          FATALERR = TRUE;
          TEST DIRNUM;
          END
 
        IF IDXFN EQ MXSPF
        THEN
          BEGIN
          RPLINE(OUT$FETP,"TOO MANY FILES SPECIFIED - EXCESS IGNORED."
            ,8,42,0);
          RPSPACE(OUT$FETP,SP"SPACE",1);
          END
 
        IDXFN = IDXFN+1;
        IF IDXFN GR MXSPF
        THEN
          BEGIN
          TEST DIRNUM;
          END
 
        SFT$FNC[0] = SF$C[SFFN];
        MASK = -1;
        FOR I = 0 STEP 1 UNTIL 6
        DO
          BEGIN  # FIND ASTERISKS IN FILE NAME #
          IF C<I,1>SFT$FNC[0] NQ "*"
          THEN
            BEGIN
            TEST I;
            END
 
          C<I,1>SFT$FNC[0] = MSK77;
          C<I,1>MASK = 0;
          END  # FIND ASTERISKS #
 
#
*     INSERT THE FILE PARAMETERS AND MASK INTO THE ARRAY
*     SUCH THAT THE USER INDEX AND FILE NAME ARE IN ASCENDING ORDER.
#
 
        FOUND = FALSE;
        SLOWFOR I = IDXFN STEP -1 WHILE (NOT FOUND)
        DO
          BEGIN
          IF (SFT$VAL[0] LS SF$W1[I-1]) AND (I GR 1)
          THEN
            BEGIN
            SF$W1[I] = SF$W1[I-1];
            SF$W2[I] = SF$W2[I-1];
            TEST I;
            END
 
          ELSE
            BEGIN
            FOUND = TRUE;
            SF$W1[I] = SFT$VAL[0];
            SF$PO[I] = KEY;
            SF$MASK[I] = B<0,42>MASK;
            END
 
          END
 
        TEST DIRNUM;
        END  # DIRECTIVE PROCESSING #
 
#
*     IF A FATAL DIRECTIVE ERROR OR DIRECTIVE PARAMETER ERROR
*     HAS OCCURRED THEN ISSUE A DAYFILE MESSAGE AND CONTINUE
*     IN REPORT ONLY MODE.
#
 
      IF FATALERR
      THEN
        BEGIN
        MVMSG$LN[0] = " DIRECTIVE ERROR - REPORT ONLY.";
        MESSAGE(MVMSG[0],UDFL1);
        PX$A[0] = TRUE;
        PX$B[0] = TRUE;
        PX$F[0] = TRUE;
        PX$S[0] = TRUE;
        END
 
#
*     WRITE RESULTANT VALUES OF RUN-TIME PARAMETERS.
#
 
 
#
*      WRITE HEADER.
#
 
      RPEJECT(OUT$FETP);
 
      RPLINE(OUT$FETP,               ##
        "RUN-TIME PARAMETER VALUES    ",  ##
        17,27,0);
 
      RPSPACE(OUT$FETP,SP"SPACE",1);
 
      RPLINE(OUT$FETP,               ##
        "   * D E S T A G E *     * R E L E A S E *",  ##
        15,42,0);
 
      RPLINE(OUT$FETP,               ##
        "   DIRECT   INDIRECT     DIRECT   INDIRECT",  ##
        15,42,0);
 
 
#
*     WRITE PARAMETER VALUES
#
 
      FOR I = 2 STEP 1 UNTIL NUMDIR
      DO
        BEGIN  # I #
        RPSPACE(OUT$FETP,SP"SPACE",2);
        P<KWTEXT> = ARG$TEXT[I];
        RPLINE(OUT$FETP,KWTEXT[1],3,20,0);
 
        KEY = ARG$KEY[I];
        P<XXARG> = ARG$TAB[I]+5;
        P<PARM> = ARG$VAL[I];
        RPSPACE(OUT$FETP,SP"SPACE",1);
        RPLINE(OUT$FETP,KEY,8,2,1);  # PRINT DIRECTIVE KEY #
 
        FOR J = 1 STEP 1 UNTIL ARG$MX[I]
        DO
          BEGIN  # J #
          KEY = XX$KEY[J];
          IF XX$C2[J] EQ 0
          THEN                       # SPACE FILL KEY #
            BEGIN
            C<1,1>KEY = " ";
            END
 
          COL = 16;                  # STARTING COLUMN FOR PARAMETER
                                       VALUES #
          FOR K = 1 STEP 1 UNTIL 2
          DO
            BEGIN  # K #
            FOR L = 1 STEP 1 UNTIL 2
            DO
              BEGIN  # L #
              TMPI = PARM$V[L,K,J];
              CHR$10[0] = XCDD(TMPI);  # CONVERT VALUE TO DECIMAL #
              RPLINE(OUT$FETP,CHR$R8[0],COL,8,1);  # PRINT VALUE #
              COL = COL + 11;        # MOVE TO NEXT COLUMN #
              END  # L #
 
            END  # K #
 
          RPLINE(OUT$FETP,KEY,12,2,0);  # PRINT PARAM KEY AND VALUES #
          END  # J #
 
        END  # I #
 
      END  # MVDIR #
 
    TERM
PROC MVDOIT;
# TITLE MVDOIT - PERFORM SELECTED PROCESSING.                         #
 
      BEGIN  # MVDOIT #
 
#
**    MVDOIT - PERFORM SELECTED PROCESSING.
*
*     THIS PROCEDURE ISSUES THE CALLS TO STAGE A FILE, CLEAR
*     AN *ASA*, AND DROP DISK SPACE.
*
*     PROC MVDOIT.
*
*     ENTRY.    PROCESSING ACTION FLAGS ARE SET IN ARRAY
*               *EXT$TDAM*.
*
*     EXIT.     SELECTED PROCESSING OCCURS OR ERRORS ARE
*               PROCESSED.
*
*     NOTES.    1) IF THE FILE IS TO BE STAGED, A CALL IS MADE TO
*                  *CALPFU* TO STAGE THE FILE.
*
*               2) IF THE FILE-S *ASA* IS TO BE CLEARED, A CALL IS
*                  MADE TO *SETAF* TO CLEAR THE *ASA* IN THE FILE-S
*                  *PFC* ENTRY.
*
*               3) IF THE FILE IS TO BE RELEASED *DROPDS* (FOR
*                  DIRECT ACCESS FILES) OR *DROPIDS* ( FOR
*                  INDIRECT ACCESS FILES) IS CALLED TO RELEASE
*                  THE DISK SPACE FOR THE FILE.
#
 
#
****  PROC MVDOIT - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC BZFILL;                 # BLANK/ZERO FILL CHARACTER ITEM #
        PROC CALPFU;                 # CALL *PFU* TO STAGE FILE #
        PROC DROPDS;                 # DROP DIRECT FILE DISK SPACE #
        PROC DROPIDS;                # DROP INDIRECT FILE DISK SPACE #
        PROC MESSAGE;                # ISSUE DAYFILE MESSAGE #
        PROC MVERRP;                 # PROCESS *SSMOVE* ERRORS #
        PROC RECALL;                 # RECALL #
        PROC RETERN;                 # RETURN FILE #
        PROC SETAF;                  # SET ALTERNATE STORAGE ADDRESS #
        PROC UATTACH;                # UTILITY ATTACH #
        PROC UGET;                   # UTILITY GET #
        PROC ZFILL;                  # ZERO FILL ARRAY #
        END
 
#
****  PROC MVDOIT - XREF LIST END.
#
 
      DEF LISTCON   #0#;             # DO NOT LIST COMDECKS #
 
*CALL COMBFAS
*CALL COMBBZF
*CALL COMBTDM
*CALL COMSPFM
*CALL COMTMOV
 
      DEF ZEROASA     #0#;           # ZERO *ASA* #
 
      ITEM CTSR       U;             # STAGE REQUEST #
      ITEM FAMILY     C(10);         # FAMILY NAME #
      ITEM FILENAME   C(10);         # FILE NAME #
      ITEM FLAG       I;             # ERROR FLAG #
      ITEM I          I;             # LOOP VARIABLE #
      ITEM J          I;             # LOOP VARIABLE #
      ITEM LFN        C(10);         # LOCAL FILE NAME #
      ITEM MORE       B;             # ISSUE STAGE REQUEST AGAIN #
      ITEM UFLAG      I;             # UTILITY ERROR FLAG #
 
      ARRAY DOIT$PFC[0:0]S(PFCENTL);;  # PFC INFORMATION FOR *PFU* #
 
      ARRAY STG$REQ [0:0] S(5);      # STAGE REQUEST INFORMATION #
        BEGIN
        ITEM STG$FAM    C(00,00,07);  # FAMILY NAME #
        ITEM STG$DN     U(01,54,06);  # DEVICE NUMBER #
        ITEM STG$TN     U(02,48,12);  # TRACK NUMBER #
        ITEM STG$SN     U(03,48,12);  # SECTOR NUMBER #
        ITEM STG$PEO    U(04,58,02);  # PFC ENTRY ORDINAL #
        END
 
      ARRAY SG$CW   [0:0] S(1);      # STAGE REQUEST CONTROL WORD #
        BEGIN
        ITEM SG$WORD    U(00,00,60);  # STAGE CONTROL WORD #
        ITEM SG$PE      U(00,00,18);  # PFC ENTRY IMAGE #
        ITEM SG$REQ     U(00,18,18);  # INFORMATION LIST #
        ITEM SG$STAT    U(00,36,24);  # STATUS #
        ITEM SG$ERR     U(00,36,12);  # ERROR STATUS #
        ITEM SG$COMP    U(00,59,01);  # REQUEST COMPLETE #
        END
 
      ARRAY ERRMSG [0:0] P(3);;      # *PFM* ERROR MESSAGE #
 
                                               CONTROL EJECT;
 
#
*     IF THE FILE IS TO BE STAGED, SET UP THE STAGE REQUEST
*     ARRAYS.  CALL *CALPFU* TO STAGE THE FILE.
#
 
      P<TDAM> = LOC(MV$WBUF[0]);
      P<PFC> = LOC(DOIT$PFC[0]);
      ZFILL(SG$CW,1);
      MORE = TRUE;
 
      IF EXT$STG[0]
      THEN
        BEGIN  # STAGE FILE #
        IF EXT$CLR[0]
        THEN                         # HAVE *STAGER* CLEAR *ASA* #
          BEGIN
          TDAMFFF[0] = TRUE;
          END
 
        STG$FAM[0] = TDAMFAM[0];
        STG$DN[0] = TDAMDN[0];
        STG$TN[0] = TDAMTRACK[0];
        STG$SN[0] = TDAMSECTOR[0];
        STG$PEO[0] = TDAMPEO[0];
        SG$WORD = 1;
        PFC$AFFRE[0] = TDAMFFF[0];
        PFC$AA[0] = TDAMASA[0];
        PFC$AT[0] = TDAMAT[0];
        PFC$FN[0] = TDAMPFN[0];
        PFC$UI[0] = TDAMUI[0];
        PFC$CD[0] = TDAMCDT[0];
        PFC$DA[0] = NOT TDAMIA[0];
 
        IF PFC$DA[0]
        THEN
          BEGIN
          PFC$LF[0] = TDAMFLN[0] + 1;
          END
 
        ELSE
          BEGIN
          PFC$LF[0] = TDAMFLN[0];
          END
 
        SG$PE[0] = LOC(PFC[0]);
        SG$REQ[0] = LOC(STG$REQ[0]);
MVDOIT1:
 
        REPEAT WHILE SG$COMP EQ 0
        DO
          BEGIN
          RECALL;                    # WAIT FOR REQUEST TO COMPLETE #
          END
 
        CALPFU(SG$CW,CTSR);
        IF SG$ERR[0] EQ 0
        THEN
          BEGIN
          GOTO MVDOIT2;
          END
 
        ELSE
          BEGIN
          SG$STAT[0] = 1;
          GOTO MVDOIT1;
          END
 
        END  # STAGE FILE #
 
MVDOIT2:
 
#
*     CLEAR THE *ASA* BY "SETTING" THE *AFOBS* FLAG.
#
 
      IF EXT$CLR[0] AND NOT EXT$STG[0]
      THEN
        BEGIN
        FILENAME = TDAMPFN[0];
        BZFILL(FILENAME,TYPFILL"ZFILL",10);
 
        LFN = MVULFN;
        BZFILL(LFN,TYPFILL"ZFILL",10);
 
        FAMILY = TDAMFAM[0];
        BZFILL(FAMILY,TYPFILL"ZFILL",10);
 
        SETAF(LFN,FLAG,6,TDAMUI[0],FAMILY,TDAMPFID[0],
          TDAMASI[0],TDAMCDT[0],AFOBS,LOC(ERRMSG));
 
        RETERN(MVULFN,RCL);
        END  # CLEAR ASA #
 
#
*     IF THE FILE IS TO BE RELEASED FROM DISK,
*     CALL *DROPDS* FOR DIRECT ACCESS FILES OR *DROPIDS* FOR
*     INDIRECT ACCESS FILES TO RELEASE THE DISK SPACE FOR THE FILE.
#
 
      IF EXT$REL[0]
      THEN
        BEGIN  # RELEASE DISK SPACE #
        FILENAME = TDAMPFN[0];
        BZFILL(FILENAME,TYPFILL"ZFILL",10);
        FAMILY = TDAMFAM[0];
        BZFILL(FAMILY,TYPFILL"ZFILL",10);
 
        IF NOT TDAMIA[0]
        THEN                         # RELEASE DIRECT FILE DISK SPACE #
          BEGIN
          DROPDS(FILENAME,FLAG,6,TDAMUI[0],FAMILY,TDAMPFID[0],  ##
          TDAMASI[0],TDAMCDT[0],LOC(ERRMSG));
          END
 
        ELSE                         # RELEASE INDIRECT FILE DISK SPACE
                                     #
          BEGIN
          DROPIDS(FILENAME,FLAG,6,TDAMUI[0],FAMILY,TDAMPFID[0],
          TDAMASI[0],TDAMCDT[0],LOC(ERRMSG));
          END
 
        END  # RELEASE DISK SPACE #
 
#
*     IF *SETAF*, *DROPDS*, OR *DROPIDS* RETURNED A NON-ZERO
*     STATUS, CALL PROCEDURE *MVERRP* TO WRITE THE TDAM TO THE
*     LOCAL PROBLEM FILE.
#
 
      IF FLAG NQ 0
      THEN
        BEGIN
        MVERRP;
        END
 
      END  # MVDOIT #
 
    TERM
PROC MVERRP;
# TITLE MVERRP - PROCESS ERRORS.                                      #
 
      BEGIN  # MVERRP #
 
#
**    MVERRP - *SSMOVE* ERROR PROCESSOR.
*
*     THIS PROCEDURE PROCESSES ANY ERRORS RESULTING FROM A
*     CLEAR ASA, OR RELEASE REQUEST BY WRITING THE TDAM TO A FILE
*     OF PROBLEMS.
*
*     PROC MVERRP.
#
 
#
****  PROC MVERRP - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC WRITEW;                 # WRITE RECORD TO FILE BUFFER #
        END
 
#
****  PROC MVERRP - XREF LIST END.
#
 
      DEF LISTCON   #0#;             # DO NOT LIST COMDECKS #
 
*CALL COMBFAS
*CALL COMBTDM
*CALL COMTMOV
 
      ITEM FLAG       I;             # ERROR FLAG #
 
                                               CONTROL EJECT;
 
      P<TDAM> = LOC(MV$WBUF[0]);
      WRITEW(MV$FET[FILEAUX],MV$WBUF[0],TDAMLEN,FLAG);
 
      RETURN;
 
      END  # MVERRP #
 
    TERM
PROC MVHEAD((FETP));
# TITLE MVHEAD - PRINTS HEADER ON *SSMOVE* REPORT FILE.               #
 
      BEGIN  # MVHEAD #
 
#
**    MVHEAD - PRINTS HEADER ON *SSMOVE* REPORT FILE.
*
*     PROC MVHEAD((FETP)).
*
*     ENTRY.    (FETP) = FWA OF FET.
*
*     EXIT.     HEADER PRINTED.
*
*     NOTES.    REPORT FORMATTER IS USED TO PRINT THE HEADER LINE.
*               THE CONTROL CARD IMAGE IS WRITTEN TO THE
*               REPORT FILE ON THE FIRST EXECUTION OF THE PROC.
#
 
      ITEM FETP       I;             # FWA OF FET #
 
#
****  PROC MVHEAD - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC BZFILL;                 # BLANK OR ZERO FILLS A BUFFER #
        PROC RPLINEX;                # WRITES A REPORT LINE #
        END
 
#
****  PROC MVHEAD - XREF LIST END.
#
 
      DEF LISTCON   #0#;             # DO NOT LIST COMDECKS #
*CALL,COMBFAS
*CALL COMBSIT
*CALL,COMBBZF
 
      ITEM FIRST      B = TRUE;      # FIRST EXECUTION OF PROC #
 
      BASED
      ARRAY RA [0:0];;               # TO ACCESS RA AREA #
 
                                               CONTROL EJECT;
 
#
*     PRINT THE HEADER.
#
 
      RPLINEX(FETP,"SSMOVE REPORT.",2,14,0);
      RPLINEX(FETP," ",1,1,0);
 
      IF FIRST
      THEN                           # WRITE CONTROL CARD IMAGE #
        BEGIN
        FIRST = FALSE;
        P<RA> = 0;
        BZFILL(RA[O"70"],TYPFILL"BFILL",80);
        RPLINEX(FETP,RA[O"70"],2,80,0);
        RPLINEX(FETP," ",1,1,0);
        END
 
      RETURN;
 
      END  # MVHEAD #
 
    TERM
PROC MVINDEV;
# TITLE MVINDEV - INITIALIZE *DEVSTAT* ARRAY.                         #
      BEGIN  # MVINDEV #
 
#
**    MVINDEV - INITIALIZE *DEVSTAT* ARRAY.
*
*     *MVINDEV* INITIALIZES TABLE ENTRIES FOR EACH PERMANENT FILE
*     DEVICE BELONGING TO THE FAMILY BEING ANALYZED.
*
*     ARRAYS *DNTODNX*, *SFSTAT* AND *DEVSTAT* ARE ALL ZEROED.
*
*     ARRAY *DNTODNX* IS INITIALIZED SO THAT *DNX = DN$TO$DNX[DN]*
*     CAN BE USED TO DETERMINE THE INDEX FOR A DEVICE GIVEN ITS
*     DEVICE NUMBER.
*
*     ARRAY *DEVSTAT* IS INITIALIZED TO CONTAIN INFORMATION
*     OBTAINED FROM THE *EST* AND *MST* ENTRIES FOR EACH DEVICE.
*
*     PROC MVINDEV.
*
*     ENTRY.     MVARG$FM[0] IDENTIFIES THE FAMILY TO BE ANALYZED
*                BY THIS *SSMOVE* RUN.
*
*     EXIT.      ARRAYS *DNTODNX, *SFSTAT* AND *DEVSTAT* ARE
*                INITIALIZED.
*
*     MESSAGES.  *MAXDEV* TOO SMALL.
#
 
#
****  PROC MVINDEV - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC GETMST;                 # GETS DATA FROM *EST* AND *MST*
                                       ENTRIES #
        PROC MESSAGE;                # DISPLAYS MESSAGE IN DAYFILE #
        PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT
                                       OR RETURN #
        PROC ZFILL;                  # ZERO FILL ARRAY #
        END
 
#
****  PROC MVINDEV - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
*CALL,COMBFAS
*CALL,COMTMOV
*CALL,COMTMVP
 
      ITEM DEVERR     B;             # INVALID DEVICE SPECIFIED #
      ITEM DN         I;             # DEVICE NUMBER #
      ITEM ESTX       I;             # INDEX TO NEXT *EST* ENTRY #
      ITEM FAM        C(7);          # FAMILY FROM *MST* #
      ITEM MASKP      I;             # PRIMARY MASK FROM *MST* #
      ITEM MASKS      I;             # SECONDARY MASK FROM *MST* #
      ITEM NUM        I;             # NUMBER OF DRIVES FOR THIS DEVICE
                                     #
      ITEM SECT       I;             # PRUS PER TRACK #
      ITEM STAT       I;             # STATUS FROM *GETMST* #
      ITEM TPRU       I;             # TOTAL PRU FOR A DEVICE #
      ITEM TYPE       C(2);          # DEVICE TYPE #
 
                                               CONTROL EJECT;
 
#
*     INITIALIZE THE VARIOUS ARRAYS TO ZERO.
#
 
      ZFILL(DEVSTAT,8*MAXDEV);
      ZFILL(SF$STAT,10*MAXSF);
      ZFILL(DNTODNX,64);
 
      DNX = 1;
      DEVERR = TRUE;
 
#
*     LOOK AT EACH *EST* AND CORRESPONDING *MST* ENTRY TO
*     FIND DEVICES BELONGING TO THE FAMILY BEING ANALYZED.
#
 
      SLOWFOR ESTX = 1 STEP 1 WHILE STAT GQ 0
      DO
        BEGIN  # ANALYZE EACH *EST* AND *MST* ENTRY #
        GETMST(ESTX,STAT,TYPE,FAM,DN,NUM,TPRU,SECT,MASKP,MASKS);
 
        IF STAT NQ 0 OR              ##
          FAM NQ MVARG$FM[0]
        THEN
          BEGIN
          TEST ESTX;
          END
 
        IF DNX GR MAXDEV
        THEN
          BEGIN
          MESSAGE(" *MAXDEV* TOO SMALL ");
          TEST ESTX;
          END
 
        IF MVARG$DN[0] NQ 0   ##
          AND MVARG$DN[0] EQ DN
        THEN                         # SPECIFIED DEVICE FOUND #
          BEGIN
          DEVERR = FALSE;
          END
 
#
*     FOR EACH DEVICE, ESTABLISH THE INDEX (*DN$TO$DNX[DN]*) FOR
*     THE DISKS DEVICE NUMBER FIELD IN THE CORRESPONDING *DEVSTAT*
*     ENTRY.
#
 
        DN$TO$DNX[DN] = DNX;
        DEV$EO[IXIA,DNX] = ESTX;
        DEV$TPRU[IXIA,DNX] = TPRU;
        DEV$TYPE[IXIA,DNX] = TYPE;
        DEV$NUM[IXIA,DNX] = NUM;
        DEV$MAST[IXIA,DNX] = MASKP NQ 0;
        DEV$SEC[IXIA,DNX] = MASKS NQ 0;
        DEV$DN[IXIA,DNX] = DN;
        DEV$SECTR[IXDA,DNX] = SECT;
        DEV$EXIST[IXIA,DNX] = TRUE;
        DNX = DNX+1;
        TEST ESTX;
        END  # ANALYZE EACH *EST* AND *MST* ENTRY #
 
#
*     ABORT WITH MESSAGE IF INVALID DEVICE SPECIFIED.
#
 
      IF MVARG$DN[0] NQ 0   ##
        AND DEVERR
      THEN
        BEGIN
        MVMSG$LN[0] = " INVALID DEVICE SPECIFIED.";
        MESSAGE(MVMSG[0],SYSUDF1);
        RESTPFP(PFP$ABORT);
        END
 
      END  # MVINDEV #
 
    TERM
PROC MVINIT;
# TITLE MVINIT - DECODES *SSMOVE* CONTROL STATEMENT.                  #
 
      BEGIN  # MVINIT #
 
#
**    MVINIT - DECODES *SSMOVE* CONTROL STATEMENT.
*
*     *MVINIT* DECODES THE PARAMETERS ON THE *SSMOVE* CONTROL
*     STATEMENT.  INVALID PARAMETERS ARE REPORTED VIA DAYFILE MESSAGES.
*     PROCEDURE *MVDIR* IS CALLED TO PROCESS THE DIRECTIVE FILE.
*
*     PROC MVINIT.
*
*     ENTRY.    CONTROL CARD IMAGE IN RA+70B.
*
*     EXIT.     PARAMETERS IN THE *MVARG* ARRAY.
*               THE *OPTLO* AND *OPTPX* ARRAYS ARE UPDATED
*               TO REFLECT ANY RUN-TIME PARAMETERS.
*
*     MESSAGES. 1) SSMOVE - PARAMETER ERROR.
*               2) COMMUNICATION FILE BUSY.
*               3) UNABLE TO DEFINE COMMUNICATION FILE.
*               4) FAMILY NOT FOUND.
#
 
#
****  PROC MVINIT - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC BZFILL;                 # BLANK/ZERO FILL CHARACTER ITEM #
        PROC GETFAM;                 # GET DEFAULT FAMILY #
        PROC GETPFP;                 # GET USER-S FAMILY AND UI. #
        PROC MESSAGE;                # ISSUE DAYFILE MESSAGE #
        PROC MVALCS;                 # ANALYZE CHARACTER STRING #
        PROC MVDIR;                  # PROCESS DIRECTIVES #
        PROC MVHEAD;                 # WRITES HEADER ON OUTPUT FILE #
        PROC MVINDEV;                # INITIALIZE DEVICE STATUS ARRAYS
                                     #
        PROC MVTAB;                  # PROVIDES ADDRESS OF PARAMETER
                                       DECODING TABLE #
        PROC PDATE;                  # GET CURRENT DATE/TIME #
        PROC PF;                     # *PFM* REQUEST INTERFACE #
        PROC RESTPFP;                # RESTORE USER-S FAMILY AND UI. #
        PROC RPOPEN;                 # OPENS OUTPUT FILE #
        PROC SETPFP;                 # SET FAMILY/USER INDEX #
        PROC XARG;                   # DECODES PARAMETERS PER DECODING
                                       TABLE #
        FUNC MVRELAG U;              # CALCULATE RELATIVE AGE #
        FUNC XDXB I;                 # CONVERTS DISPLAY TO BINARY #
        END
 
#
****  PROC MVINIT - XREF LIST END.
#
 
      DEF MSG1       #" SSMOVE - PARAMETER ERROR."#;
      DEF MSG2       #" COMMUNICATION FILE BUSY."#;
      DEF MSG3       #" UNABLE TO DEFINE COMMUNICATION FILE."#;
      DEF MSG4       #" FAMILY NOT FOUND."#;
 
      DEF PROCNAME   #"SSMOVE."#;    # PROCEDURE NAME #
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL,COMBFAS
*CALL COMBSIT
*CALL,COMBBZF
*CALL,COMBPFP
*CALL,COMBTDM
*CALL,COMSPFM
*CALL,COMTMOV
*CALL,COMTMVP
*CALL,COMTOUT
 
 
      ITEM ARGLIST    I;             # ADDRESS OF ARGUMENT TABLE #
      ITEM CCOK       B=TRUE;        # CONTROL CARD STATUS #
      ITEM DEFORD     I;             # ORDINAL OF DEFAULT FAMILY #
      ITEM LINK       I;             # ORDINAL OF LINK DEVICE #
      ITEM NUM        I;             # NUMBER OF FAMILIES #
      ITEM STAT       I;             # ERROR STATUS #
      ITEM TMPI       I;             # TEMPORARY INTEGER #
                                               CONTROL EJECT;
 
#
*     SAVE ORIGINAL FAMILY AND USER INDEX FOR RESTORING.
#
 
      GETPFP(PFP[0]);
      USER$FAM[0] = PFP$FAM[0];
      USER$UI[0] = PFP$UI[0];
 
#
*     CRACK PARAMETERS ON *SSMOVE* PROGRAM CALL.
#
 
      MVTAB(ARGLIST);
      XARG(ARGLIST,0,STAT);
      CCOK = STAT EQ 0;
 
      MVALCS(MVARG$LO[0],VCSLO,LOOPT[0],"LO",STAT);
      CCOK = CCOK AND (STAT EQ 0);
 
      MVALCS(MVARG$PX[0],VCSPX,PXOPT[0],"PX",STAT);
      CCOK = CCOK AND (STAT EQ 0);
 
#
*     CRACK NW, UI, DN, LB AND SET UP REPORT FILE.
#
 
      IF MVARG$ZNW[0] NQ 0
      THEN
        BEGIN
        MVARG$ZNW[0] = 0;
        MVARG$NW[0] = TRUE;
        END
 
      ELSE
        BEGIN
        MVARG$NW[0] = FALSE;
        END
 
      IF MVARG$ZUI[0] NQ 0
      THEN
        BEGIN
        STAT = XDXB(MVARG$UI[0],0,TMPI);
        MVARG$ZUI[0] = TMPI;
        CCOK = CCOK AND (STAT EQ 0)  ##
          AND (TMPI GR 0) AND (TMPI LQ SYS$UI);
        END
 
      IF MVARG$DN[0] NQ 0
      THEN
        BEGIN
        STAT = XDXB(MVARG$DN[0],0,TMPI);
        MVARG$DN[0] = TMPI;
        CCOK = CCOK AND (STAT EQ 0);
        END
 
      IF MVARG$LB[0] EQ LBNS
      THEN                           # *LB* NOT SPECIFIED #
        BEGIN
        MVARG$LB[0] = DEFLB;
        END
 
      ELSE
        BEGIN
        STAT = XDXB(MVARG$LB[0],1,TMPI);
        MVARG$LB[0] = TMPI;
        IF STAT NQ 0
        THEN
          BEGIN
          CCOK = FALSE;
          MVARG$LB[0] = DEFLB;
          END
 
        END
 
      IF MVARG$L[0] EQ 0
      THEN
        BEGIN
        OUT$FETP = 0;
        END
 
      ELSE
        BEGIN
        OUT$FETP = LOC(OUT$FET[0]);
        END
 
      IF NOT CCOK
      THEN
        BEGIN
        MVMSG$LN[0] = MSG1;
        MESSAGE(MVMSG[0],SYSUDF1);
        RESTPFP(PFP$ABORT);
        END
 
      RPOPEN(MVARG$L[0],OUT$FETP,MVHEAD);  # OPEN REPORT FILE #
 
#
*     GET DEFAULT FAMILY AND SUBSYSTEM ID.
#
 
      SSID$MV = ATAS;
      GETFAM(FAMT,NUM,LINK,DEFORD,SSID$MV);
 
      IF MVARG$FM[0] EQ 0
      THEN                           # FAMILY NOT SPECIFIED #
        BEGIN
        MVARG$FM[0] = FAM$NAME[DEFORD];
        END
 
      PFP$WRD0[0] = 0;               # SET FAMILY AND USER INDEX #
      PFP$FAM[0] = MVARG$FM[0];
      PFP$UI[0] = DEF$UI;
      PFP$FG1[0] = TRUE;
      PFP$FG4[0] = TRUE;
      SETPFP(PFP[0]);
      IF PFP$STAT[0] NQ 0
      THEN                           # FAMILY NOT FOUND #
        BEGIN
        MVMSG$LN[0] = MSG4;
        MESSAGE(MVMSG[0],SYSUDF1);
        RESTPFP(PFP$ABORT);          # RESTORE USER-S *PFP* AND ABORT #
        END
 
#
*     CALL PROCEDURE *MVDIR* TO PROCESS DIRECTIVES.
#
 
      MVDIR;
 
#
*     CALL *MVINDEV* TO INITIALIZE DEVICE STATUS ARRAYS.
#
 
      MVINDEV;
 
#
*     ATTACH COMMUNICATION FILE.
#
 
      COMNAME = MVOCOM;              # ZERO FILL FILE NAME #
      NFILES = 0;
      BZFILL(COMNAME,TYPFILL"ZFILL",7);
      IF NOT (PX$A[0] AND PX$B[0] AND PX$S[0] AND PX$F[0])
      THEN
        BEGIN
        PF("ATTACH",COMNAME,0,"M","W","RC",STAT,"NA",0,0);
        IF STAT NQ OK
        THEN
          BEGIN  # PROCESS ATTACH ERROR FLAG #
          IF STAT EQ FBS
          THEN                       # COMMUNICATION FILE BUSY #
            BEGIN
            MVMSG$LN[0] = MSG2;      # ABORT WITH DAYFILE MESSAGE #
            MESSAGE(MVMSG[0],SYSUDF1);
            RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT #
            END
 
          IF STAT EQ FNF
          THEN                       # FILE DOES NOT EXIST #
            BEGIN
            PF("DEFINE",COMNAME,0,"BR","N","RC",STAT,0);
            IF STAT NQ OK
            THEN                     # PROCESS DEFINE ERROR #
              BEGIN
              MVMSG$LN[0] = MSG3;    # ABORT WITH DAYFILE MESSAGE #
              MESSAGE(MVMSG[0],SYSUDF1);
              RESTPFP(PFP$ABORT);    # RESTORE USER-S *PFP* AND ABORT #
              END
 
            END
 
          ELSE                       # ABNORMAL TERMINATION #
            BEGIN
            MVMSG$PROC[0] = PROCNAME;
            MESSAGE(MVMSG[0],SYSUDF1);
            RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT #
            END
 
          END  # PROCESS ATTACH ERROR FLAG #
 
        END
 
      PDATE(CURDT$MV);               # GET CURRENT DATE AND TIME #
      TMPI = B<24,18>CURDT$MV;
      CURAGE = MVRELAG(TMPI);        # ESTABLISH AGE OF TODAY #
      CURTIME = B<42,18>CURDT$MV;    # ESTABLISH CURRENT TIME #
 
      END  # MVINIT #
 
    TERM
PROC MVPASS3;
# TITLE MVPASS3 - FINAL SELECTION OF FILES TO BE RELEASED.            #
 
      BEGIN  # MVPASS3 #
                                               CONTROL FTNCALL;
 
#
**    MVPASS3 - FINAL SELECTION OF FILES TO BE RELEASED.
*
*     THIS PROCEDURE DOES THE FINAL SELECTION OF THE FILES TO BE
*     RELEASED FROM DISK AND PRODUCES A PASS 3 OUTPUT FILE FOR
*     USE IN DOING OR DIRECTING *SSEXEC* TO DO THE SELECTED ACTIONS.
*     THIS PASS 3 OUTPUT FILE IS SORTED SUCH THAT FILES TO BE
*     DESTAGED ARE ORDERED BY SUBFAMILY AND THEN BY SIZE (SMALL,
*     THEN LARGE).
*
*     PROC MVPASS3.
*
*     ENTRY.    1) THE PASS 1 OUTPUT FILE IS AVAILABLE ON DISK.
*
*               2) THE AMOUNT OF DISK SPACE NEEDED PER DEVICE AND
*                  FILE TYPE IS IN THE *DEV$NEED* FIELD OF *DEV$STAT*.
*
*     EXIT.     1) THE PASS 3 OUTPUT FILE CONTAINS ALL FILES TO BE
*                  DESTAGED, RELEASED, STAGED, OR FREED.  FILES TO BE
*                  DESTAGED ARE SORTED BY SUBFAMILY AND THEN FILE SIZE.
*
*               2) THE NUMBER OF FILES AND AMOUNT OF MSAS SPACE NEEDED
*                  IS PROVIDED IN THE *SFDS$NF* AND *SFDS$PRU* FIELDS
*                  OF THE ARRAY *SF$STAT*.
*
*     NOTES.    THE PROCESSING LOGIC FOR THIS ROUTINE IS AS FOLLOWS..
*
*               1) SORT THE ENTRIES OF THE PASS 1 OUTPUT FILE BY
*                  RELEASE VALUE.
*
*               2) DETERMINE WHICH OF THE FILES CONDITIONALLY SELECTED
*                  TO BE RELEASED WILL ACTUALLY BE RELEASED.  SELECT
*                  THOSE HAVING THE LARGEST RELEASE VALUE UNTIL THE
*                  NEEDED AMOUNT OF SPACE FOR EACH FILE TYPE ON EACH
*                  DEVICE IS OBTAINED.
*
*               3) WRITE THE ENTRY FOR ALL FILES THUS SELECTED TO THE
*                  PASS 3 OUTPUT FILE.  ALSO, COPY THE ENTRIES FOR ALL
*                  FILES PREVIOUSLY SELECTED FOR PROCESSING.
#
 
#
****  PROC MVPASS3 - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC CLOSEM;                 # CLOSE FILE #
        PROC FILESQ;                 # ESTABLISH SEQUENTIAL FILE
                                       ORGANIZATION #
        PROC OPENM;                  # OPEN FILE #
        PROC READ;                   # INITIATE FILE INPUT #
        PROC RETERN;                 # RETURN FILE #
        PROC READW;                  # READ NEXT RECORD #
        PROC REWIND;                 # REWIND FILE #
        PROC SM5END;                 # S/M TERMINATION #
        PROC SM5FROM;                # S/M INPUT FILE DEFINITION #
        PROC SM5KEY;                 # S/M KEY DEFINITION #
        PROC SM5SORT;                # S/M INITIALIZATION #
        PROC SM5TO;                  # S/M OUTPUT FILE DEFINITION #
        PROC WRITER;                 # FLUSH FILE BUFFER #
        PROC WRITEW;                 # WRITE RECORD #
        PROC ZSETFET;                # INITIALIZE FET #
        END
 
#
****  PROC MVPASS3 - XREF LIST END.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS #
      DEF SFITL      #35#;           # *FIT* BUFFER SIZE #
 
*CALL,COMBFAS
*CALL,COMBTDM
*CALL,COMTMOV
*CALL,COMTMVP
 
      ITEM EOTDAM     B;             # SIGNAL EOF #
      ITEM FLAG       I;             # STATUS FROM I/O CALLS #
      ITEM IXLN       I;             # LARGE/SMALL INDEX #
      ITEM NXTDAM     I;             # LOOP INDEX #
 
      ARRAY FIT [1:2] S(SFITL);;     # USED TO SORT FILES #
                                               CONTROL EJECT;
      FILESQ(FIT[1],"LFN","SCR1","RT","F","BT","C","FL",90);
      OPENM(FIT[1],"INPUT", "R");
 
      FILESQ(FIT[2],"LFN","SCR2","RT","F","BT","C","FL",90);
      OPENM(FIT[2],"OUTPUT","R");
 
      SM5SORT(0);                    # NO STATISTICS RETURNED #
 
      SM5FROM("SCR1");               # DEFINE INPUT FILE #
 
      SM5TO("SCR2");                 # DEFINE OUTPUT FILE #
 
      SM5KEY(61,10,"BINARY","D");    # SORT BY DECREASING RELEASE VALUE
                                     #
 
      SM5END;                        # INITIATE SORT USING ONE KEY #
 
      CLOSEM(FIT[1]);
      CLOSEM(FIT[2]);
 
      RETERN(MV$FET[FILEMO],RCL);
      FETP = LOC(MV$FET[FILEMI]);
      BUFP = LOC(MV$BUF[FILEMI]);
      ZSETFET(FETP,"SCR2",BUFP,MVBUFL,SFETL);
 
      FETP = LOC(MV$FET[FILEMO]);
      BUFP = LOC(MV$BUF[FILEMO]);
      ZSETFET(FETP,"SCR3",BUFP,MVBUFL,SFETL);
      REWIND(MV$FET[FILEMI],RCL);    # REWIND SCR2 #
 
      READ(MV$FET[FILEMI],NRCL);     # PREPARE TO READ SORTED PASS 1
                                       OUTPUT FILE #
      EOTDAM = FALSE;
 
      P<TDAM> = LOC(MV$WBUF[0]);
      P<EXT$TDAM> = LOC(MV$WBUF[0]) + TDAMLEN;
 
      SLOWFOR NXTDAM = 0 STEP 1 WHILE NOT EOTDAM
      DO
        BEGIN  # NEXT TDAM #
        READW(MV$FET[FILEMI],MV$WBUF[0],MVWBUFL,FLAG);
 
        IF FLAG NQ 0
        THEN
          BEGIN
          EOTDAM = TRUE;
          TEST NXTDAM;
          END
 
#
*     INITIALIZE FILE INDICES.
#
 
        DNX = EXT$DNX[0];
        FTYPE = EXT$FTYPE[0];
        SFX = TDAMSBF[0];
 
#
*     IF THE FILE IS TO BE RELEASED, UPDATE DEVICE STATISTICS
*     AND PROCESSING ACTION FLAGS.
#
 
        IF ( EXT$CREL[0]             # CANDIDATE TO BE RELEASED #
          AND (DEV$NEED[FTYPE,DNX] GR 0) )  # AND SPACE NEEDED #
 
        THEN                         # FILE IS TO BE RELEASED #
          BEGIN
          EXT$REL[0] = TRUE;
          DEV$NEED[FTYPE,DNX] = DEV$NEED[FTYPE,DNX] - TDAMFLN[0];
          DEV$RELF[FTYPE,DNX] = DEV$RELF[FTYPE,DNX] + 1;
          DEV$TRPRU[FTYPE,DNX] = DEV$TRPRU[FTYPE,DNX] - TDAMFLN[0];
          IF FTYPE EQ IXIA
          THEN
            BEGIN
            DEV$RELP[FTYPE,DNX] = DEV$RELP[FTYPE,DNX] + TDAMFLN[0];
            END
 
          ELSE
            BEGIN
            PRUTRK = DEV$SECTR[IXDA,DNX];
            TRUPRU = (((TDAMFLN[0]+1) / PRUTRK) + 1) * PRUTRK;
            DEV$RELP[FTYPE,DNX] = DEV$RELP[FTYPE,DNX] + TRUPRU;
            END
 
          END
 
#
*     FOR FILES WHICH ARE TO BE DESTAGED, COUNT THE FILES AND
*     ALLOCATION UNIT REQUIREMENTS PER SUBFAMILY AND FILE SIZE.
#
 
        IF EXT$DES[0]                # DESTAGE SELECTED UNCONDITIONALLY
                                     #
          OR (EXT$CDES[0] AND EXT$REL[0])
 
        THEN                         # UPDATE DATA NEEDED BY *SSEXEC*
                                       TO DESTAGE FILES #
          BEGIN
          IF TDAMFLN[0] LS MVARG$LB[0]
          THEN                       # SMALL FILE #
            BEGIN
            IXLN = IXSM;
            END
 
          ELSE                       # LARGE FILE #
            BEGIN
            IXLN = IXLG;
            END
 
          EXT$DES[0] = TRUE;
          EXT$IXLN[0] = IXLN;
          SFDS$NF[FTYPE,SFX] = SFDS$NF[FTYPE,SFX] + 1;
          SFDS$PRU[FTYPE,SFX] = SFDS$PRU[FTYPE,SFX] + TDAMFLN[0];
          SFDM$NF[FTYPE,SFX] = SFDM$NF[FTYPE,SFX] + 1;
          SFDM$PRU[FTYPE,SFX] = SFDM$PRU[FTYPE,SFX] + TDAMFLN[0];
          END
 
#
*     COUNT THE NUMBER OF AND TOTAL LENGTH OF FILES TO BE STAGED.
#
 
        IF EXT$STG[0]
        THEN
          BEGIN
          SFSG$NF[FTYPE,SFX] = SFSG$NF[FTYPE,SFX] + 1;
          SFSG$PRU[FTYPE,SFX] = SFSG$PRU[FTYPE,SFX] + TDAMFLN[0];
          SFRL$NF[FTYPE,SFX] = SFRL$NF[FTYPE,SFX] - 1;
          SFRL$PRU[FTYPE,SFX] = SFRL$PRU[FTYPE,SFX] - TDAMFLN[0];
          END
 
        IF EXT$CLR[0] OR TDAMFFF[0]
        THEN
          BEGIN
          SFDM$NF[FTYPE,SFX] = SFDM$NF[FTYPE,SFX] - 1;
          SFDM$PRU[FTYPE,SFX] = SFDM$PRU[FTYPE,SFX] - TDAMFLN[0];
          END
 
        ELSE
          BEGIN
          IF EXT$REL[0]
          THEN
            BEGIN
            SFRL$NF[FTYPE,SFX] = SFRL$NF[FTYPE,SFX] + 1;
            SFRL$PRU[FTYPE,SFX] = SFRL$PRU[FTYPE,SFX] + TDAMFLN[0];
            END
 
          END
 
#
*     FOR FILES SELECTED FOR FURTHER PROCESSING
*     (EXT$STG/REL/DES/CLR BIT SET), WRITE THE FILE-S ENTRY
*     TO THE PASS 3 OUTPUT FILE.
#
 
        IF EXT$PA3[0] NQ 0
        THEN
          BEGIN
          WRITEW(MV$FET[FILEMO],MV$WBUF[0],MVWBUFL,FLAG);
          END
 
        END  # NEXT TDAM #
 
      WRITER(MV$FET[FILEMO],RCL);
 
#
*     SORT THE ABOVE FILE BY SUBFAMILY, FILE SIZE (SMALL/LARGE),
*     AND FILE LENGTH SO IT CAN BE PROCESSED BY THE NEXT ROUTINE.
#
 
      FILESQ(FIT[1],"LFN","SCR3","RT","F","BT","C","FL",90);
      OPENM(FIT[1],"INPUT","R");
 
      FILESQ(FIT[2],"LFN","SCR4","RT","F","BT","C","FL",90);
      OPENM(FIT[2],"OUTPUT","R");
 
      SM5SORT(0);                    # NO STATISTICS RETURNED #
 
      SM5FROM("SCR3");               # DEFINE INPUT FILE #
 
      SM5TO("SCR4");                 # DEFINE OUTPUT FILE #
 
      SM5KEY(178,3,"BINARY_BITS");   # KEY1 = SUBFAMILY #
 
      SM5KEY(73,1,"BINARY");         # KEY2 = FILE SIZE *IXLN* #
 
      SM5KEY(302,23,"BINARY_BITS","D");  # KEY3 = FILE LENGTH #
 
      SM5END;                        # INITIATE SORTING ON THE THREE
                                       KEYS #
 
      CLOSEM(FIT[1]);
      CLOSEM(FIT[2]);
      RETERN(MV$FET[FILEMI],RCL);
      RETERN(MV$FET[FILEMO],RCL);
      END  # MVPASS3 #
 
    TERM
PROC MVPASS4;
# TITLE MVPASS4 - SETS UP THE COMMUNICATION FILE.                     #
 
      BEGIN  # MVPASS4 #
 
#
**    MVPASS4 - SETS UP THE COMMUNICATION FILE.
*
*     THIS PROCEDURE READS THE FILE CONTAINING AN ENTRY FOR
*     EACH FILE SELECTED FOR PROCESSING AND EITHER DOES IT DIRECTLY,
*     OR WRITES AN ENTRY ON THE *SSEXEC* COMMUNICATION FILE SO
*     *SSEXEC* CAN DESTAGE THE FILE AND OPTIONALLY RELEASE IT FROM
*     DISK.  FILES WHICH ARE PROCESSED DIRECTLY ARE PASSED TO
*     PROCEDURE *MVDOIT* WHICH CALLS *PFM* TO PERFORM THE ACTION.
*     THIS PROCEDURE ALSO WRITES A LINE ON THE OUTPUT FILE FOR EACH
*     FILE SELECTED FOR PROCESSING, IF THE *LO=F* OPTION IS ON.
*
*     PROC MVPASS4.
*
*     ENTRY.   FILE *SCR4* CONTAINS ENTRIES FOR ALL FILES TO BE
*              PROCESSED.  IT IS SORTED BY SUBFAMILY, FILE LENGTH
*              (SHORT/LONG), AND FILE SIZE (BY PRU LENGTH, LARGEST
*              FIRST).
*
*     EXIT.    1) CALLS TO *MVDOIT* ARE DONE TO CAUSE PROCESSING FOR
*                 FILES TO BE STAGED, RELEASED OR FREED FROM A
*                 CARTRIDGE.
*
*              2) ENTRIES FOR FILES TO BE DESTAGED OR DESTAGED AND
*                 RELEASED ARE WRITTEN TO THE COMMUNICATION FILE.
*
*              3) THE OUTPUT FILE CONTAINS AN ENTRY FOR EACH FILE
*                 SELECTED FOR PROCESSING.
#
 
#
****  PROC MVPASS4 - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC BZFILL;                 # BLANK/ZERO FILL CHARACTER ITEM #
        PROC MVDOIT;                 # PERFORM PROCESSING, EXCEPT
                                       DESTAGES #
        PROC MVPRNDT;                # PRINT DATE AND ACCESS COUNT #
        PROC MVRPTDS;                # REPORT DEVICE STATUS #
        PROC READ;                   # INITIATE DATA TRANSFER INTO A
                                       BUFFER #
        PROC READW;                  # READ A RECORD INTO WORKING
                                       BUFFER #
        PROC RETERN;                 # RETURN FILE #
        PROC REWIND;                 # REWIND FILE #
        PROC RPEJECT;                # ISSUE PAGE EJECT #
        PROC RPLINE;                 # WRITE LINE ON OUTPUT FILE #
        PROC WRITER;                 # FLUSH BUFFER TO FILE #
        PROC WRITEW;                 # WRITE RECORD TO FILE BUFFER #
        PROC ZFILL;                  # ZERO FILL ARRAY #
        PROC ZSETFET;                # INITIALIZE *FET* #
        FUNC XCDD C(10);             # CONVERT BINARY TO DECIMAL
                                       DISPLAY #
        FUNC XCOD C(10);             # CONVERT BINARY TO OCTAL DISPLAY
                                     #
        END
 
#
****  PROC MVPASS4 - XREF LIST END.
#
 
 
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS #
 
*CALL,COMBFAS
*CALL,COMBBZF
*CALL,COMBTDM
*CALL,COMTMOV
*CALL COMTMVP
*CALL,COMTOUT
 
 
      DEF FILEHDR1   #"NAME    TYPE     UI    LENGTH     DATE"#;
      DEF FILEHDR2   #"  ACC-CT  ACTION(* = NOT DONE PER *PX* OPTION)"
        #;
      DEF FILEHDR3   #"DES-VAL   REL-VAL"#;
      DEF MSGCLR     #"CLEAR *ASA* FIELD.   "#;
      DEF MSGDES     #"DESTAGE FILE.        "#;
      DEF MSGDSR     #"DESTAGE AND RELEASE. "#;
      DEF MSGREL     #"RELEASE FROM DISK.   "#;
      DEF MSGSCLR    #"STAGE, CLEAR *ASA*.  "#;
      DEF MSGSTG     #"STAGE FILE TO DISK.  "#;
 
      ITEM EOTDAM     B;             # SIGNALS END-OF-FILE #
      ITEM FLAG       I;             # READ STATUS #
      ITEM NXTDAM     U;             # LOOP INDEX #
      ITEM PREVSF     I;             # PREVIOUS SUBFAMILY #
      ITEM SKIP       B;             # CCNTROLS DOING SELECTED ACTION #
      ITEM TMPC       C(10);         # TEMPORARY CELL #
 
 
      ARRAY DTDAM [0:0] S(TDAMLEN);;  # DESTAGE HEADER FOR A SUBFAMILY
                                      #
                                               CONTROL EJECT;
#
*     DETERMINE WHETHER TO LIST EACH FILE FOR PROCESSING.
#
 
 
        IF LO$F[0]
        THEN                         # FULL LISTING #
          BEGIN
          LISTFETP = OUT$FETP;
          PX$FETP = OUT$FETP;
          END
 
        ELSE
          BEGIN
          IF LO$P[0]
          THEN                       # PARTIAL LISTING #
            BEGIN
            LISTFETP = OUT$FETP;
            PX$FETP = 0;
            END
 
          ELSE
            BEGIN
            LISTFETP = 0;
            PX$FETP = 0;
            END
 
          END
 
#
*     INITIALIZE *FET* FOR THE FILES USED BY THIS PROCEDURE.
#
 
      FETP = LOC(MV$FET[FILEMI]);
      BUFP = LOC(MV$BUF[FILEMI]);
      ZSETFET(FETP,SCR4,BUFP,MVBUFL,SFETL);
      REWIND(MV$FET[FILEMI],RCL);    # REWIND SCR4 #
      READ(MV$FET[FILEMI],NRCL);
 
      FETP = LOC(MV$FET[FILEMO]);
      BUFP = LOC(MV$BUF[FILEMO]);
      ZSETFET(FETP,MVOCOM,BUFP,MVBUFL,SFETL);
 
      FETP = LOC(MV$FET[FILEAUX]);
      BUFP = LOC(MV$BUF[FILEAUX]);
      ZSETFET(FETP,MVLPROB,BUFP,MVBUFL,SFETL);
 
#
*     WRITE HEADER TO COMMUNICATION FILE.
#
 
      P<MVPREAM> = LOC(MV$WBUF[0]);
      ZFILL(MVPREAM,MVPRML);
      MVPR$FLNM[0] = MVOCOM;
      BZFILL(MVPR$FLNM[0],TYPFILL"BFILL",6);
      MVPR$DT[0] = CURDT$MV;
      MVPR$LB[0] = MVARG$LB[0];
 
      WRITEW(MV$FET[FILEMO],MVPREAM[0],MVPRML,FLAG);
 
      PREVSF = 8;
      EOTDAM = FALSE;
      P<TDAM> = LOC(MV$WBUF[0]);
 
      RPEJECT(LISTFETP);
      RPLINE(LISTFETP,FILEHDR1,2,38,1);
      RPLINE(LISTFETP,FILEHDR2,42,46,1);
      RPLINE(LISTFETP,FILEHDR3,90,17,0);
      RPLINE(LISTFETP," ",1,1,0);
 
      SLOWFOR NXTDAM = 0 STEP 1 WHILE NOT EOTDAM
      DO
        BEGIN  # NEXT TDAM REQUEST #
        READW(MV$FET[FILEMI],MV$WBUF,MVWBUFL,FLAG);
        IF FLAG NQ 0
        THEN
          BEGIN
          EOTDAM = TRUE;
          TEST NXTDAM;
          END
#
*     SET OUTPUT FILE.
#
 
        IF LO$P[0]
        THEN
          BEGIN
          LISTFETP = OUT$FETP;
          END
 
#
*     SEND ALL REQUESTS WITH A DESTAGE TO *SSEXEC*.
*     CALL *MVDOIT* TO PERFORM ALL OTHER REQUESTS.
#
 
        IF EXT$DES[0]
        THEN                         # SEND TO *SSEXEC* #
          BEGIN  # DESTAGE FILE #
 
#
*     WRITE SELECTED PROCESSING MESSAGE TO OUTPUT FILE FOR
*     FILES TO BE DESTAGED OR DESTAGED AND RELEASED.
#
 
          IF EXT$REL[0]
          THEN                       # DESTAGE AND RELEASE #
            BEGIN
            TDAMFC[0] = TDAMFCODE"DESTRLS";
            SKIP = PX$A[0] OR PX$B[0];
            IF SKIP
            THEN
              BEGIN
              LISTFETP = PX$FETP;
              END
 
            RPLINE(LISTFETP,MSGDSR,54,20,1);
            MVPRNDT(TDAMLAD[0],TDAMACC[0],EXT$DESV[0],EXT$RELV[0]);
            END
 
          ELSE                       # DESTAGE ONLY #
            BEGIN
            TDAMFC[0] = TDAMFCODE"DESTAGE";
            SKIP = PX$B[0];
            IF SKIP
            THEN
              BEGIN
              LISTFETP = PX$FETP;
              END
 
            RPLINE(LISTFETP,MSGDES,54,20,1);
            MVPRNDT(TDAMLMD[0],TDAMACC[0],EXT$DESV[0],EXT$RELV[0]);
            END
 
#
*     WRITE OUTPUT LINE IDENTIFYING FILE.
#
 
          TMPC = TDAMPFN[0];
          BZFILL(TMPC,TYPFILL"BFILL",7);
          RPLINE(LISTFETP,TMPC,2,7,1);   # PFN #
 
          TMPC = XCOD(TDAMUI[0]);
          RPLINE(LISTFETP,TMPC,11,10,1); # UI #
 
          TMPC = XCDD(TDAMFLN[0]);
          RPLINE(LISTFETP,TMPC,21,10,1); # LENGTH IN PRU #
 
          IF EXT$FTYPE[0] EQ IXIA
          THEN
            BEGIN
            TMPC = "IND.";
            END
 
          ELSE
            BEGIN
            TMPC = "DIR.";
            END
 
          RPLINE(LISTFETP,TMPC,11,4,1);
 
          IF SKIP
          THEN
            BEGIN
            TMPC = "*";
            END
 
          ELSE
            BEGIN
            TMPC = " ";
            WRITEW(MV$FET[FILEMO],MV$WBUF[0], TDAMLEN,FLAG);
            NFILES = NFILES + 1;
            END
 
          RPLINE(LISTFETP,TMPC,53,1,0);
          TEST NXTDAM;
          END  # DESTAGE FILE #
 
#
*     ISSUE CORRECT PROCESSING ACTION TEXT TO THE REPORT LINE.
*     CALL *MVDOIT* IF IT IS OK TO PERFORM THE SELECTED ACTION.
#
 
        IF EXT$STG[0]
        THEN
          BEGIN
          IF EXT$CLR[0]
          THEN
            BEGIN
            SKIP = PX$F[0] OR PX$S[0];
            IF SKIP
            THEN
              BEGIN
              LISTFETP = PX$FETP;
              END
 
            RPLINE(LISTFETP,MSGSCLR,54,20,1);
            END
 
          ELSE                       # STAGE ONLY #
            BEGIN
            SKIP = PX$S[0];
            IF SKIP
            THEN
              BEGIN
              LISTFETP = PX$FETP;
              END
 
            RPLINE(LISTFETP,MSGSTG,54,20,1);
            END
 
          END
 
        ELSE                         # NO STAGE INVOLVED #
          BEGIN
          IF EXT$CLR[0]
          THEN                       # CLEAR ASA DIRECTLY #
            BEGIN
            SKIP = PX$F[0];
            IF SKIP
            THEN
              BEGIN
              LISTFETP = PX$FETP;
              END
 
            RPLINE(LISTFETP,MSGCLR,54,20,1);
            END
 
          ELSE                       # MUST BE RELEASE #
            BEGIN
            SKIP = PX$A[0];
            IF SKIP
            THEN
              BEGIN
              LISTFETP = PX$FETP;
              END
 
            RPLINE(LISTFETP,MSGREL,54,20,1);
            MVPRNDT(TDAMLAD[0],TDAMACC[0],EXT$DESV[0],EXT$RELV[0]);
            END
 
          END
 
#
*     WRITE OUTPUT LINE IDENTIFYING FILE.
#
 
          TMPC = TDAMPFN[0];
          BZFILL(TMPC,TYPFILL"BFILL",7);
          RPLINE(LISTFETP,TMPC,2,7,1);   # PFN #
 
          TMPC = XCOD(TDAMUI[0]);
          RPLINE(LISTFETP,TMPC,11,10,1); # UI #
 
          TMPC = XCDD(TDAMFLN[0]);
          RPLINE(LISTFETP,TMPC,21,10,1); # LENGTH IN PRU #
 
          IF EXT$FTYPE[0] EQ IXIA
          THEN
            BEGIN
            TMPC = "IND.";
            END
 
          ELSE
            BEGIN
            TMPC = "DIR.";
            END
 
          RPLINE(LISTFETP,TMPC,11,4,1);
 
        IF SKIP
        THEN
          BEGIN
          TMPC = "*";
          END
 
        ELSE
          BEGIN
          TMPC = " ";
          MVDOIT;
          END
 
        RPLINE(LISTFETP,TMPC,53,1,0);
 
        TEST NXTDAM;
        END  # NEXT TDAM REQUEST #
 
      WRITER(MV$FET[FILEMO],RCL);
      WRITER(MV$FET[FILEAUX],RCL);
      RETERN(MV$FET[FILEMO],RCL);
      RETERN(MV$FET[FILEMI],RCL);
      RETERN(MV$FET[FILEAUX],RCL);
 
#
*     ISSUE FIRST CALL TO *MVRPTDS* TO PRODUCE THE REPORT PAGE
*     SUMMARIZING THE STATUS OF EACH DEVICE AND SUBFAMILY.
#
 
      MVRPTDS(0);
 
      END
 
    TERM
PROC MVPFRD;
# TITLE MVPFRD - READ PFC.                                            #
 
      BEGIN  # MVPFRD #
 
#
**    MVPFRD - READ PFC.
*
*     THIS PROCEDURE READS THE PFC, CREATES THE PASS 1 OUTPUT
*     FILE AND DETERMINES THE AMOUNT OF DISK SPACE TO BE
*     RELEASED ON EACH DEVICE.
*
*     PROC MVPFRD.
*
*     EXIT.      PASS 1 OUTPUT FILE SET UP.
*
*     MESSAGES.  INCORRECT DEVICE INDEX.
*
*     NOTES.     PERMANENT FILES ARE INCLUDED IN THE PASS 1
*                OUTPUT FILE IF THEY MEET ANY OF THE FOLLOWING..
*
*                1) ARE SELECTED BY THE *SF* DIRECTIVE AND
*                   THE SPECIFIED PROCESSING IS VALID TO DO.
*
*                2) HAVE THE FREE-FILE (AFFRE) FLAG SET IN THE
*                   *PFC* ENTRY FOR THE FILE WHEN THE FILE HAS
*                   A NON-ZERO *ASA* VALUE.
*
*                3) IF THE FILE SATISFIES THE DESTAGE CRITERIA.
*
*                4) IF THE FILE IS A CANDIDATE TO BE RELEASED.
#
 
#
****  PROC MVPFRD - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC BZFILL;                 # BLANK/ZERO FILL CHARACTER ITEM #
        PROC GETDI;                  # GET DEVICE INHIBIT DATE/TIME #
        PROC GETPFC;                 # GET NEXT PFC ENTRY #
        PROC MESSAGE;                # ISSUE DAYFILE MESSAGE #
        PROC MVCKSF;                 # SEARCH FOR SELECTED FILES #
        PROC MVVALDS;                # CALCULATE DESTAGE VALUE #
        PROC MVVALRL;                # CALCULATE RELEASE VALUE #
        PROC RETERN;                 # RETURNS A FILE #
        PROC REWIND;                 # REWINDS A FILE #
        PROC UATTACH;                # UTILITY ATTACH #
        PROC WRITER;                 # WRITES EOR ON A FILE #
        PROC WRITEW;                 # DATA TRANSFER ROUTINE #
        PROC XWOD;                   # CONVERT OCTAL TO DISPLAY #
        PROC ZFILL;                  # ZERO FILL ARRAY #
        PROC ZSETFET;                # SETS UP A FET #
        END
 
#
****  PROC MVPFRD - XREF LIST END.
#
 
      DEF LISTCON   #0#;             # DO NOT LIST COMDECKS #
*CALL,COMBFAS
*CALL COMBSIT
*CALL,COMBBZF
*CALL,COMBTDM
*CALL,COMSPFM
*CALL,COMTCTW
*CALL,COMTMOV
*CALL,COMTMVD
*CALL,COMTMVP
 
      ITEM DISKIMAGE  B;             # TRUE IF DISK IMAGE EXISTS #
      ITEM EOPFC      B;             # END OF PFC INDICATOR #
      ITEM FAM        C(10);         # FAMILY NAME #
      ITEM FLAG       I;             # ERROR STATUS #
      ITEM GOAL       I;             # DESIRED PRU ON DISK #
      ITEM I          I;             # LOOP INDUCTION VARIABLE #
      ITEM INHBDT     U;             # DEVICE INHIBIT DATE/TIME #
      ITEM LFNAME     C(10);         # LOCAL FILE NAME #
      ITEM MV$DNX     I;             # SPECIFIED DEVICE INDEX #
      ITEM NOREL      B;             # LEGALITY OF RELEASING FILE #
      ITEM NUMMSS     I;             # NUMBER OF MSS IMAGES #
      ITEM NXTPFC     I;             # FILE COUNTER #
      ITEM PEOCNT     I;             # PFC ORDINAL #
      ITEM PFNAME     C(10);         # PERMANENT FILE NAME #
      ITEM PO         C(1);          # PROCESSING OPTION #
      ITEM RES        I;             # FILE RESIDENCE CODE #
      ITEM TMPI       I;             # TEMPORARY #
 
      ARRAY SCR$FET [0:0] S(SFETL);;  # SCRATCH FET #
 
      ARRAY ERRMSG [0:0] P(3); ;     # *PFM* ERROR MESSAGES #
 
      ARRAY DISASA  [0:0]  S(2);
        BEGIN
        ITEM DIS$ASA  C(00,48,12);   # ASA IN DISPLAY CODE #
        END
 
      ARRAY MSG1 [0:0]  S(3);       # *PFC* ERROR INFORMATION #
        BEGIN
        ITEM MSG1$SP   C(00,00,03) = ["   "];
        ITEM MSG1$FN   C(00,18,07);   # FILE NAME #
        ITEM MSG1$TXT  C(01,00,08) = ["  ASA = "];
        ITEM MSG1$ASA  C(01,48,12);   # ALTERNATE STORAGE ADDRESS #
        END
                                               CONTROL EJECT;
 
#
*     SET UP FET FOR PASS 1 OUTPUT FILE.
#
 
      FETP = LOC(MV$FET[FILEMO]);
      BUFP = LOC(MV$BUF[FILEMO]);
      ZSETFET(FETP,SCR1,BUFP,MVBUFL,SFETL);
      RETERN(MV$FET[FILEMO],RCL);
 
      FAM = MVARG$FM[0];
      LFNAME = "SCR";                # LOCAL FILE NAME #
      BZFILL(LFNAME,TYPFILL"ZFILL",10);
      BZFILL(FAM,TYPFILL"ZFILL",10);
 
#
*     READ PFC.
#
 
      P<TDAM> = LOC(MV$WBUF[0]);
      P<EXT$TDAM> = LOC(MV$WBUF[0]) + TDAMLEN;
      EOPFC = FALSE;
      EXT$PAZ[0] = 0;
 
#
*     DETERMINE THE INDEX OF THE SPECIFIED DEVICE.
#
 
      IF MVARG$DN[0] EQ 0
      THEN                           # NO DEVICE SPECIFIED #
        BEGIN
        MV$DNX = 0;
        END
 
      ELSE
        BEGIN
        MV$DNX = DN$TO$DNX[MVARG$DN[0]];
        END
 
#
*     THE MAIN LOGIC OF THIS ROUTINE IS IN THE FOLLOWING LOOP.
*     PROCESSING FOR EACH FILE OCCURS DURING TWO TRIPS THROUGH
*     THIS LOOP.  THE TOP OF THE LOOP COMPLETES PROCESSING FOR
*     A FILE.  THE BOTTOM OF THE LOOP INITIATES FILE PROCESSING.
*     THE FOLLOWING STEPS COMPRISE THE LOGIC OF THIS MAIN LOOP.
*
*     1) (TOP OF THE LOOP).. WRITE THE FILE ENTRY TO THE PASS 1
*        OUTPUT FILE IF ANY PROCESSING ACTION FLAGS WERE SET
*        WHEN THE FILE WAS ANALYZED DURING THE BOTTOM PART
*        OF THE PREVIOUS EXECUTION OF THIS LOOP.
*
*     2) GET THE PFC ENTRY FOR THE NEXT FILE TO BE ANALYZED BY
*        THE REST OF THIS LOOP.  ESTABLISH THE FILE TYPE, SUBFAMILY
*        AND DEVICE NUMBER INDICES.
*
*     3) GET THE FILE LENGTH, IF NECESSARY.
*
*     4) DETERMINE THE RESIDENCE OF THE FILE AND UPDATE DEVICE
*        AND SUBFAMILY STATISTICS ACCORDINGLY.
*
*     5) IGNORE THE FILE IF IT IS EXCLUDED FROM PROCESSING DUE
*        TO RUN-TIME PARAMETERS OR IF IT HAS A SPECIAL USER INDEX.
*
*     6) SELECT PROCESSING ACTIONS AS CONTROLLED BY THE *SF,FN=..*
*        DIRECTIVE OR THE *AFFREE* FLAG IN THE PFC ENTRY.
*
*     7) EVALUATE THE DESTAGE AND RELEASE FORMULAS AND SET
*        THE APPROPRIATE PROCESSING ACTION FLAGS.
#
 
      SLOWFOR NXTPFC = 0 STEP 1 WHILE NOT EOPFC
      DO                             # FINISH PROCESSING OLD PFC ENTRY,
                                       THEN START NEW ONE #
        BEGIN  # NEXT PFC #
        IF EXT$PA[0] NQ 0
        THEN                         # SAVE ENTRY FOR NEXT STEP OF
                                       ANALYSIS #
          BEGIN
          TDAMFLN[0] = PFC$LF[0];
          TDAMASA[0] = PFC$AA[0];
          TDAMAT[0] = PFC$AT[0];
          TDAMPFN[0] = PFC$FN[0];
          TDAMUI[0] = PFC$UI[0];
          TDAMSBF[0] = PFC$SF[0];
          TDAMFAM[0] = MVARG$FM[0];
          TDAMCDT[0] = PFC$CD[0];
          TDAMAL[0] = PFC$AL[0];
          TDAMFFF[0] = PFC$AFFRE[0];
          TDAMFFF[0] = PFC$AFFRE[0];
          EXT$AFOBS[0] = PFC$AFOBS[0];
          EXT$RES[0] = RES;
          EXT$FTYPE[0] = FTYPE;
 
#
*     SAVE DATES AND ACCESS COUNT FOR THE REPORT FILE.
#
 
          TDAMLMD[0] = PFC$MDD[0];
          TDAMLAD[0] = PFC$ADD[0];
          TDAMACC[0] = PFC$AC[0];
 
          WRITEW(MV$FET[FILEMO],MV$WBUF[0],MVWBUFL,FLAG);
          END
 
        ZFILL(EXT$TDAM,3);           # CLEAR FOR NEXT FILE #
        FLAG = 0;
        GETPFC(PEOCNT, FLAG);
        IF FLAG NQ OK
        THEN
          BEGIN
          EOPFC = TRUE;
          TEST NXTPFC;
          END
 
#
*     ESTABLISH FILE TYPE, SUBFAMILY AND DEVICE NUMBER INDICES.
#
 
        IF PFC$DA[0]
        THEN
          BEGIN
          FTYPE = IXDA;
          END
 
        ELSE
          BEGIN
          FTYPE = IXIA;
          END
 
        TDAMIA[0] = NOT PFC$DA[0];
        SFX = PFC$SF[0];
 
        IF PFC$EO[0] EQ 0
        THEN
          BEGIN
          DNX = DN$TO$DNX[CNTR$DN[0]];
          END
 
        ELSE
          BEGIN
          DNX = DN$TO$DNX[PFC$EO[0]];
          END
 
        EXT$DNX[0] = DNX;
        TDAMDN[0] = CNTR$DN[0];
 
#
*     ISSUE DAYFILE MESSAGE IF ILLEGAL DEVICE INDEX.
#
 
        IF DNX EQ 0
        THEN                         # IGNORE FILE #
          BEGIN
          MVMSG$LN[0] = " INCORRECT DEVICE INDEX.";
          MESSAGE(MVMSG[0],UDFL1);
          TEST NXTPFC;
          END
 
#
*     SET UP PFID AND GET FILE LENGTH, IF NECESSARY.
#
 
        TDAMPEO[0] = PEOCNT;
        TDAMTRACK[0] = CNTR$TRK[0];
        TDAMSECTOR[0] = CNTR$SEC[0];
 
        IF PFC$LF[0] EQ 0 AND PFC$DA[0]  ##
          AND(PFC$UI[0] LS DEF$UI OR PFC$UI[0] GR DEF$UI+7)
        THEN                         # GET FILE LENGTH #
          BEGIN
          PFNAME = PFC$FN[0];
          BZFILL(PFNAME,TYPFILL"ZFILL",10);
          UATTACH(LFNAME,FLAG,6,PFNAME,PTRD,PFC$UI[0],FAM,  ##
            TDAMPFID[0],PFC[0],PFC$CD[0],LOC(ERRMSG));
          FETP = LOC(SCR$FET[0]);
          ZSETFET(FETP,LFNAME,0,0,SFETL);
          RETERN(SCR$FET[0],RCL);    # RETURN THE FILE #
          END
 
#
*     CALCULATE RESIDENCE OF THE FILE AND UPDATE
*     DEVICE OR SUBFAMILY STATISTICS ACCORDINGLY.
*
*     DO NOT EXCLUDE ANY FILE HAVING *AFFRE* FLAG SET
*     INCLUDING FILES LOCKED TO DISK AND FILES WITH AN
*     OBSOLETE MSAS COPY.
#
 
        DISKIMAGE = (PFC$BT[0] NQ 0);
        NUMMSS = 0;
        IF PFC$AA[0] NQ 0
        THEN                         # OBSOLETE COPY #
          BEGIN
          IF (PFC$AFOBS[0] AND NOT PFC$AFFRE[0])
          THEN
            BEGIN
            NUMMSS = 0;
            END
 
          ELSE
            BEGIN
            NUMMSS = 1;
            END
 
          END
 
        IF NUMMSS NQ 0 AND NOT DISKIMAGE
        THEN                         # FILE RELEASED #
          BEGIN
          RES = RESIDENCE"RES$M86";
          SFRL$NF[FTYPE,SFX] = SFRL$NF[FTYPE,SFX] + 1;
          SFRL$PRU[FTYPE,SFX] = SFRL$PRU[FTYPE,SFX] + PFC$LF[0];
          SFDM$NF[FTYPE,SFX] = SFDM$NF[FTYPE,SFX] + 1;
          SFDM$PRU[FTYPE,SFX] = SFDM$PRU[FTYPE,SFX] + PFC$LF[0];
          END
 
        IF DISKIMAGE
        THEN                         # FILE ON DISK #
          BEGIN
          RES = RESIDENCE"RES$RMS";
          DEV$NF[FTYPE,DNX] = DEV$NF[FTYPE,DNX] + 1;
          DEV$TRPRU[FTYPE,DNX] = DEV$TRPRU[FTYPE,DNX] + PFC$LF[0];
          IF FTYPE EQ IXIA
          THEN
            BEGIN
            DEV$PRU[FTYPE,DNX] = DEV$PRU[FTYPE,DNX] + PFC$LF[0];
            END
 
          ELSE
            BEGIN
            PRUTRK = DEV$SECTR[IXDA,DNX];
            TRUPRU = (((PFC$LF[0] + 1) / PRUTRK) + 1) * PRUTRK;
            DEV$PRU[FTYPE,DNX] = DEV$PRU[FTYPE,DNX] + TRUPRU;
            END
 
          IF NUMMSS NQ 0
          THEN                       # FILE ALSO ON MSAS #
            BEGIN
            RES = RESIDENCE"RES$RMS$MF";
            SFDM$NF[FTYPE,SFX] = SFDM$NF[FTYPE,SFX] + 1;
            SFDM$PRU[FTYPE,SFX] = SFDM$PRU[FTYPE,SFX] + PFC$LF[0];
            END
 
          END
 
        IF FTYPE EQ IXDA
          AND PFC$LF[0] NQ 0
        THEN                         # IGNORE SYSTEM SECTOR #
          BEGIN
          PFC$LF[0] = PFC$LF[0] - 1;
          END
 
#
*     SEE IF THE FILE IS TO BE EXCLUDED DUE TO RUN-TIME PARAMETERS
*     (PX, UI OPTIONS), IF THE FILE IS IN A RESERVED USER INDEX,
*     OR IF IT IS LOCKED TO DISK.
#
 
        IF (PFC$DA[0] AND PX$D[0] )  # DIRECT ACCESS FILE #
          OR ( NOT PFC$DA[0] AND PX$I[0] )  # INDIRECT ACCESS FILE #
 
          OR ( MVARG$UI[0] NQ 0      # NOT THE SELECTED #
          AND PFC$UI[0] NQ MVARG$UI[0] )  # USER INDEX #
 
          OR ( PFC$UI[0] GQ DEF$UI   # MSS USER INDICES #
          AND PFC$UI[0] LQ DEF$UI+7 )  ##
 
          OR ( PFC$UI[0] EQ SYS$UI )  # SYSTEM USER INDEX #
 
          OR (PFC$UI[0] EQ FPF$UI)     # FLAWPF USER INDEX #
 
          OR ( PFC$RS[0] EQ RSLK     # FILE LOCKED TO DISK #
            AND NOT PFC$AFFRE[0])
 
        THEN                         # DO NOT CONSIDER THIS FILE FOR
                                       FURTHER PROCESSING #
          BEGIN
          TEST NXTPFC;
          END
 
#
*     PROCESS THE SPECIAL FLAGS (*PO* OR FREE-UP FLAG IN *PFC*)
*     AS FOLLOWS..
*
*     1)  PO=F  (FREE FILE FROM CARTRIDGE)
*              IF THE ASA NQ 0 THEN SET *CLR*.  ALLOW FILE TO
*              BE SELECTED TO BE STAGED.
*
*     2)  PO=A (ARCHIVE OR RELEASE FROM DISK)
*              FORCE RELEASE BY SETTING *REL* UNLESS THE FILE
*              IS ALREADY ARCHIVED.  THE CHECK TO VERIFY THAT
*              THE *BR=Y* REQUIREMENT IS MET IS MADE FURTHER ON.
*
*     3)  PO=S OR *CLR* OR PFC$AFFRE SET (STAGE TO DISK)
*              FORCE THE FILE TO BE STAGED TO DISK BY SETTING
*              *STG* UNLESS THE FILE IS ALREADY ON DISK.  SET
*              *NOREL* TO PROHIBIT THE FILE FROM BEING RELEASED
*              FROM DISK.  IF THE FREE FILE FLAG IS SET IN THE
*              *PFC* STAGER WILL CLEAR THE *ASA* AFTER STAGING
*              THE FILE TO DISK.
*
*     4)  PO=B (BACKUP OR DESTAGE TO MSAS)
*              SET THE *DES* FLAG IF THE FILE RESIDES ON DISK ONLY.
#
 
        MVCKSF(PFC$FN[0],PFC$UI[0],PO);  # SEE IF FILE SELECTED #
 
        EXT$CLR[0] = (PFC$AA[0] NQ 0)  # CASE 1 #
        AND ((RES EQ RESIDENCE"RES$RMS$MF" AND PFC$AFFRE[0])
        OR (PO EQ "F"));
 
        EXT$REL[0] = (PO EQ "A")     # CASE 2 #
          AND (RES NQ RESIDENCE"RES$M86");
 
        EXT$STG[0] = (PO EQ "S" OR EXT$CLR[0] OR PFC$AFFRE[0])  ##
          AND (RES EQ RESIDENCE"RES$M86");
        NOREL = EXT$STG[0] OR EXT$CLR[0];
 
#
*     IF ERROR FLAGS ARE SET IN THE *PFC* DO NOT ALLOW THE FILE
*     TO BE STAGED.
#
 
        IF EXT$STG[0]
        THEN
          BEGIN  # CHECK *PFC* FOR ERRORS #
          IF PFC$AFPDE[0]            # DATA ERROR #
            OR PFC$AFPSE[0]          # SYSTEM ERROR #
            OR PFC$AFTMP[0]          # TEMPORARY ERROR #
          THEN
            BEGIN
            MSG1$FN[0] = PFC$FN[0];
            XWOD(PFC$AA[0],DISASA);
            MSG1$ASA[0] = DIS$ASA[0];
            MVMSG$LN[0] = " PFC ERROR FLAGS SET";
            MESSAGE(MVMSG[0],UDFL1);
            MESSAGE(MSG1[0],UDFL1);
            EXT$STG[0] = FALSE;      # PROHIBIT STAGING #
            EXT$CLR[0] = FALSE;
            TEST NXTPFC;
            END
          END   # CHECK *PFC* FOR ERRORS #
 
#
*     IF THE FILE RESIDES ON DISK, SELECT IT TO BE DESTAGED IF
*     SPECIFIED BY THE FILE-S *PO* ATTRIBUTE, OR IF ITS DESTAGE
*     VALUE EXCEEDS THE THRESHOLD.
#
 
        IF RES EQ RESIDENCE"RES$RMS"
        THEN                         # SELECT DESTAGE IF APPROPRIATE #
          BEGIN
          IF PO EQ "B"
          THEN                       # CASE 4 #
            BEGIN
            EXT$DES[0] = TRUE;
            END
 
          ELSE                       # CALCULATE DESTAGE VALUE AND
                                       COMPARE TO THRESHOLD #
            BEGIN
            MVVALDS(TMPI,PO);        # CALCULATE DESTAGE VALUE #
            EXT$DES[0] = TMPI GQ FR$VAL[FTYPE,IXDS,FRTH];
            EXT$CDES[0] = NOT EXT$DES[0];  # IN CASE FILE IS RELEASED #
            EXT$DESV[0] = TMPI;
            END
 
          END
 
#
*     CHECK TO SEE IF THE FILE CAN BE RELEASED.
*       - VERIFY *BR=Y* REQUIREMENT SATISFIED.
*       - VERIFY *DN* PARAMETER SATISFIED.
*       - VERIFY FILE NOT ALREADY SELECTED FOR RELEASE.
*       - CALCULATE RELEASE VALUE AND IF GREATER THAN
*         THE THRESHOLD, SAVE IT FOR FUTURE USE IN
*         SELECTING AMONG THE CANDIDATE FILES.
#
 
#
*     IF A DUMP TAPE BACKUP IS REQUIRED, PROHIBIT
*     RELEASING THE FILE.
#
 
        GETDI(CNTR$EQ[0],INHBDT);    # GET DEVICE INHIBIT DATE/TIME #
        IF PFC$BR[0] EQ BRAL AND INHBDT LQ PFC$UD[0]
        THEN                         # PROHIBIT RELEASING THE FILE #
          BEGIN
          EXT$REL[0] = FALSE;
          NOREL = TRUE;
          END
 
        IF EXT$REL[0]
        THEN                         # COUNT PRU TO BE RELEASED #
          BEGIN
          DEV$RELF[FTYPE,DNX] = DEV$RELF[FTYPE,DNX] + 1;
          DEV$TRPRU[FTYPE,DNX] = DEV$TRPRU[FTYPE,DNX] - PFC$LF[0];
          IF FTYPE EQ IXIA
          THEN
            BEGIN
            DEV$RELP[FTYPE,DNX] = DEV$RELP[FTYPE,DNX] + PFC$LF[0];
            END
 
          ELSE
            BEGIN
            PRUTRK = DEV$SECTR[IXDA,DNX];
            TRUPRU = (((PFC$LF[0]+1) / PRUTRK) + 1) * PRUTRK;
            DEV$RELP[FTYPE,DNX] = DEV$RELP[FTYPE,DNX] + TRUPRU;
            END
 
          TEST NXTPFC;
          END
 
        IF MV$DNX NQ 0               ##
          AND MV$DNX NQ DNX          # FAILS *DN* PARAMETER #
        THEN                         # DO NOT CONSIDER FILE FOR
                                       DESTAGING OR RELEASING #
          BEGIN
          EXT$DES[0] = FALSE;        # DO NOT DESTAGE #
          TEST NXTPFC;
          END
 
        IF NOREL
        THEN                         # DO NOT RELEASE #
          BEGIN
          TEST NXTPFC;
          END
 
        IF RES NQ RESIDENCE"RES$M86"
        THEN
          BEGIN
          MVVALRL(TMPI,PO);          # CALCULATE RELEASE VALUE #
          EXT$CREL[0] = TMPI GQ FR$VAL[FTYPE,IXRL,FRTH];
          EXT$RELV[0] = TMPI;
          TEST NXTPFC;
          END
 
        END  # NEXT PFC #
 
#
*     AFTER PROCESSING ALL FILES,
*       - FLUSH THE PASS 1 OUTPUT BUFFER TO DISK.
*       - CALCULATE THE AMOUNT OF DISK SPACE NEEDED
*         TO BE RELEASED ON EACH DEVICE.
#
 
      WRITER(MV$FET[FILEMO],RCL);
      REWIND(MV$FET[FILEMO],RCL);
 
#
*     CALCULATE THE NUMBER OF PRU TO BE RELEASED ON EACH DEVICE.
#
 
      SLOWFOR I = 1 STEP 1 UNTIL MAXDEV
      DO
        BEGIN  # EACH DEVICE #
        IF DEV$MAST[IXIA,I]
        THEN                         # USE MASTER DEVICE GOALS #
          BEGIN
          TMPI = SMMG;
          END
 
        ELSE                         # USE SECONDARY DEVICE GOALS #
          BEGIN
          TMPI = SMSG;
          END
 
        SLOWFOR FTYPE = IXDA STEP IXIA-IXDA UNTIL IXIA
        DO
          BEGIN
 
          GOAL = SM$VAL[FTYPE,IXRL,TMPI]*DEV$TPRU[IXIA,I]/100;
          DEV$NEED[FTYPE,I] =        ##
            DEV$PRU[FTYPE,I] - GOAL - DEV$RELP[FTYPE,I];
          END
 
        END  # EACH DEVICE #
 
      RETURN;
 
      END  # MVPFRD #
 
    TERM
PROC MVPRNDT(PDATE,ACC$CT,DVAL,RVAL);
# TITLE MVPRNDT - PRINT DATE AND ACCESS COUNTS.                       #
 
      BEGIN  # MVPRNDT #
 
#
**    MVPRNDT - PRINT DATE AND ACCESS COUNTS.
*
*     THIS PROCEDURE PRINTS THE DATE AND THE ACCESS COUNT FOR
*     A FILE ON THE REPORT FILE.
*
*     PROC MVPRNDT.
*
*     ENTRY.     PDATE = *YYMMDD*.
*                ACC$CT = ACCESS COUNT.
*
*     EXIT.      COL. 33-40 CONTAIN *YY.MM.DD*.
*                COL. 42-48 CONTAIN ACCESS COUNT.
#
 
      ITEM PDATE      C(10);         # PACKED DATE #
      ITEM ACC$CT     I;             # ACCESS COUNT #
      ITEM DVAL       U;             # CALCULATED DESTAGE VALUE #
      ITEM RVAL       U;             # CALCULATED RELEASE VALUE #
 
#
****  PROC MVPRNDT - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC RPLINE;                 # WRITE LINE #
        FUNC XCDD C(10);             # BINARY TO DECIMAL DISPLAY #
        END
 
#
****  PROC MVPRNDT - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
 
*CALL,COMBFAS
*CALL,COMTMOV
 
      ITEM TMPC       C(10);         # TEMPORARY CHARACTER #
                                               CONTROL EJECT;
      TMPC = XCDD(ACC$CT);
      RPLINE(LISTFETP,TMPC,40,10,1);  # WRITE ACCESS COUNT #
 
      RPLINE(LISTFETP,"YY.MM.DD",34,8,1);
 
      CHR$10[0] = XCDD(70+B<42,6>PDATE);  # YEAR #
      RPLINE(LISTFETP,CHR$R2[0],34,2,1);
 
#
*     FORCE LEADING ZERO ON DAY AND MONTH BY ADDING 100.
#
 
      CHR$10[0] = XCDD(100+B<48,6>PDATE);  # MONTH #
      RPLINE(LISTFETP,CHR$R2[0],37,2,1);
 
      CHR$10[0] = XCDD(100+B<54,6>PDATE);  # DATE #
      RPLINE(LISTFETP,CHR$R2[0],40,2,1);
 
      IF DVAL GQ 0
      THEN
        BEGIN
        CHR$10[0] = XCDD(DVAL);
        RPLINE(LISTFETP,CHR$10[0],87,10,1);
        END
 
      ELSE                           # NEGATIVE VALUE #
        BEGIN
        RPLINE(LISTFETP,"-1",95,2,1);
        END
 
      IF RVAL GQ 0
      THEN
        BEGIN
        CHR$10[0] = XCDD(RVAL);
        RPLINE(LISTFETP,CHR$10[0],98,10,1);
        END
 
      ELSE                           # NEGATIVE VALUE #
        BEGIN
        RPLINE(LISTFETP,"-1",106,2,1);
        END
 
 
      RETURN;
      END  # MVPRNDT #
 
    TERM
FUNC MVRELAG(RELDATE) U;
# TITLE MVRELAG - CALCULATE RELATIVE AGE.                             #
 
      BEGIN  # MVRELAG #
 
#
**    MVRELAG - CALCULATE RELATIVE AGE.
*
*     THIS FUNCTION CALCULATES THE RELATIVE AGE OF AN ITEM
*     GIVEN A DATE IN PACKED FORMAT.  THIS AGE IS THE NUMBER
*     OF DAYS SINCE JAN 01, 1970.
*     THE ABSOLUTE AGE OF AN ITEM IS CALCULATED BY THE CALLING
*     PROGRAMS WHICH SUBTRACT THE RELATIVE AGE OF THE ITEM
*     FROM THE RELATIVE AGE OF THE CURRENT DATE.
*     IF THE DIFFERENCE BETWEEN THE CURRENT DATE AND THE
*     LAST ACCESS DATE OR MODIFY DATE IS LESS THAN 30 DAYS,
*     THEIR DIFFERENCE AS CALCULATED BY THIS FUNCTION WILL
*     BE CALCULATED CORRECTLY.  IF THE DIFFERENCE IS MORE
*     THAN 30 DAYS, THEN A 1 DAY ERROR MAY BE INTRODUCED.
*     IT IS ASSUMED THAT A 3 PERCENT ERROR IS NOT OF CONCERN
*     FOR THE PURPOSES OF *SSMOVE*.
*
*     FUNC MVRELAG( (RELDATE) ).
*
*     ENTRY.    RELDATE = *YYMMDD* OF AN OBJECT.
*
*     EXIT.     MVRELAG = NUMBER OF DAYS SINCE 70/01/01.
#
 
      ITEM RELDATE    C(10);         # *YYMMDD* #
 
 
      ITEM DAY        U;             # *DD* FROM *RELDATE* #
      ITEM MONTH      U;             # *MM* FROM *RELDATE* #
      ITEM TMPI       I;             # TEMPORARY #
      ITEM YEAR       U;             # *YY* FROM *RELDATE* #
 
      ARRAY MONTHS [1:12] S(1);      # TOTAL DAYS IN PREVIOUS MONTHS #
        BEGIN
        ITEM MON$TOT    I(00,00,60) = [  ##
        0,
        31,
        59,
        90,
        120,
        151,
        181,
        212,
        243,
        273,
        304,
        334];
        END
 
                                               CONTROL EJECT;
      YEAR = B<42,6>RELDATE;
      MONTH = B<48,6>RELDATE;
      DAY = B<54,6>RELDATE;
 
      TMPI = YEAR*365 + MON$TOT[MONTH] + DAY;
 
      IF( (YEAR/4)*4 EQ YEAR) AND (MONTH EQ 3)
      THEN
        BEGIN
        TMPI = TMPI + 1;
        END
 
      MVRELAG = TMPI;
      RETURN;
      END
 
    TERM
PROC MVRPTDS((ABNDN));
# TITLE MVRPTDS - REPORT DEVICE STATUS.                               #
 
      BEGIN  # MVRPTDS #
 
#
**    MVRPTDS - REPORT DEVICE STATUS.
*
*     THIS PROCEDURE PRINTS A PAGE SUMMARIZING THE SPACE
*     AVAILABILITY ON EACH DEVICE.
*
*     PROC MVRPTDS( (ABNDN) ).
*
*     ENTRY.     THE ARRAY *DEVSTAT* CONTAINS DATA TO BE PRINTED.
*
*     EXIT.      THE RELEVANT INFORMATION IS PRINTED ON THE OUTPUT FILE.
*
*     MESSAGES.  DEVICE SPACE GOAL NOT MET.
#
 
      ITEM ABNDN      B;             # PROCESS ABANDONMENT REPORT #
 
#
****  PROC MVRPTDS - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC MESSAGE;                # ISSUE DAYFILE MESSAGE #
        PROC RPEJECT;                # PAGE EJECT #
        PROC RPLINE;                 # WRITE LINE #
        PROC RPSPACE;                # PRINT BLANK LINES #
        FUNC XCDD C(10);             # BINARY TO DECIMAL DISPLAY CODE #
        FUNC XCOD C(10);             # BINARY TO OCTAL DISPLAY CODE #
        END
 
#
****  PROC MVRPTDS - XREF LIST END.
#
 
 
      DEF HDR11   #"   (BEFORE)   DEVICE STATUS   "#;
      DEF HDR12      #" (AFTER)   PERCENTS "#;
      DEF HDR21      #"EO  DN  DT-N  TYPE "#;
      DEF HDR22      #"   FILES /     PRU  "#;
      DEF HDR23      #"EXP. GOAL "#;
      DEF HDR24      #"FLAG."#;
 
      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS #
 
*CALL,COMBFAS
*CALL COMBSIT
*CALL,COMSPFM
*CALL,COMTMOV
*CALL,COMTMVD
*CALL,COMTOUT
 
 
      ITEM EXP$PER    I;             # EXPECTED PERCENT SPACE AVAILABLE
                                     #
      ITEM EXP$PRU    I;             # EXPECTED PRU AVAILABLE #
      ITEM GOAL       I;             # PERCENT DESIRED DISK SPACE #
      ITEM I          I;             # LOOP INDEX #
      ITEM IX         I;             # FILE TYPE INDEX #
      ITEM SUBFAM     I;             # LOOP INDEX #
 
 
      ARRAY FILETYPE[IXDA:IXIA] S(1);
        BEGIN
        ITEM FILE$TYPE  C(00,00,04) = [  ##
        "DIR.",
        "IND."];
        END
 
                                               CONTROL EJECT;
 
#
*     PRINT HEADER LINES.
#
 
      RPEJECT(OUT$FETP);
 
      IF ABNDN
      THEN
        BEGIN
        RPLINE(OUT$FETP,"DESTAGE ABANDONMENT REPORT",5,26,0);
        RPSPACE(OUT$FETP,SP"SPACE",1);
        END
 
      RPLINE(OUT$FETP,HDR11,21,30,1);
      RPLINE(OUT$FETP,HDR12,51,20,0);
      RPSPACE(OUT$FETP,SP"SPACE",2);
 
      RPLINE(OUT$FETP,HDR21,2,19,1);
      RPLINE(OUT$FETP,HDR22,21,20,1);
      RPLINE(OUT$FETP,HDR22,41,20,1);
      RPLINE(OUT$FETP,HDR23,61,10,1);
      RPLINE(OUT$FETP,HDR24,72,05,0);
 
#
*     PRINT DATA FOR DEVICES ABLE TO HOLD INDIRECT FILES (MASTER
*     DEVICES), FOLLOWED BY DATA ON DEVICES ABLE TO HOLD DIRECT
*     ACCESS FILES.
#
 
      SLOWFOR I = 1 STEP 1 UNTIL 2
      DO
        BEGIN  # REPORT ON BOTH FILE TYPES #
        RPSPACE(OUT$FETP,SP"SPACE",2);  # 2 BLANK LINES AS A SEPARATOR
                                        #
 
        SLOWFOR DNX = 1 STEP 1 UNTIL MAXDEV
        DO
          BEGIN  # REPORT EACH DEVICE #
 
          IF I EQ 1
          THEN                       # ONLY DO MASTER DEVICES #
            BEGIN
            IX = IXIA;
            GOAL = SM$VAL[IXIA,IXRL,SMMG];
            IF NOT DEV$MAST[IXIA,DNX]
            THEN                     # SKIP THIS DEVICE #
              BEGIN
              TEST DNX;
              END
 
            END
 
          ELSE                       # ONLY DO DEVICES HOLDING DIRECT
                                       ACCESS FILES #
            BEGIN
            IX = IXDA;
            IF DEV$MAST[IXIA,DNX]
            THEN
              BEGIN
              GOAL = SM$VAL[IXDA,IXRL,SMMG];
              END
 
            ELSE
              BEGIN
              GOAL = SM$VAL[IXDA,IXRL,SMSG];
              END
 
            IF NOT DEV$SEC[IXIA,DNX] OR  ##
              DEV$NF[IXDA,DNX] EQ 0
            THEN                     # SKIP THIS DEVICE #
              BEGIN
              TEST DNX;
              END
 
            END
 
#
*     PRINT EO, DN, DT-N, TYPE.
#
 
          CHR$10[0] = XCOD(DEV$EO[IXIA,DNX]);
          RPLINE(OUT$FETP,CHR$R2[0],2,2,1);
 
          CHR$10[0] = XCOD(DEV$DN[IXIA,DNX]);
          RPLINE(OUT$FETP,CHR$R2[0],6,2,1);
 
          CHR$10[0] = XCOD(DEV$NUM[IXIA,DNX]);
          RPLINE(OUT$FETP,DEV$TYPE[IXIA,DNX],10,2,1);
          RPLINE(OUT$FETP,"-",12,1,1);
          RPLINE(OUT$FETP,CHR$R1[0],13,1,1);
 
          RPLINE(OUT$FETP,FILE$TYPE[IX],16,4,1);
 
#
*     ISSUE BEFORE STATISTICS - NUM. FILES, PRU.
#
 
          CHR$10[0] = XCDD(DEV$NF[IX,DNX]);
          RPLINE(OUT$FETP,CHR$R8[0],21,8,1);
 
          CHR$10[0] = XCDD(DEV$PRU[IX,DNX]);
          RPLINE(OUT$FETP,CHR$R8[0],31,8,1);
 
#
*     ISSUE AFTER STATISTICS - FILES, PRU.
#
 
          CHR$10[0] = XCDD(DEV$NF[IX,DNX] - DEV$RELF[IX,DNX]);
          RPLINE(OUT$FETP,CHR$R8[0],41,8,1);
 
          EXP$PRU = DEV$PRU[IX,DNX] - DEV$RELP[IX,DNX];
          EXP$PER = (EXP$PRU*100 + DEV$TPRU[IXIA,DNX]/2)
            /DEV$TPRU[IXIA,DNX];
          CHR$10[0] = XCDD(EXP$PRU);
          RPLINE(OUT$FETP,CHR$R8[0],51,8,1);
 
#
*     ISSUE PERCENTAGES.  IF SPACE GOAL NOT MET ISSUE WARNING
*     FLAG AND DAYFILE MESSAGE.
#
 
          IF EXP$PER GR GOAL
          THEN                       # SPACE GOAL NOT MET #
            BEGIN
            RPLINE(OUT$FETP,"**",72,2,1);
            MVMSG$LN[0] = " DEVICE SPACE GOAL NOT MET.";
            MESSAGE(MVMSG[0],UDFL1);
            END
 
          CHR$10[0] = XCDD(EXP$PER);
          RPLINE(OUT$FETP,CHR$R3[0],61,3,1);
 
          CHR$10[0] = XCDD(GOAL);
          RPLINE(OUT$FETP,CHR$R3[0],66,3,0);  # WRITE LINE #
          END  # REPORT EACH DEVICE #
 
        END  # REPORT BOTH FILE TYPES #
 
#
*     ISSUE SUBFAMILY REPORT.  PRINT HEADER TO REPORT FILE.
#
 
      RPSPACE(OUT$FETP,SP"SPACE",2);
      RPLINE(OUT$FETP,"  ** - DEVICE SPACE GOAL NOT MET",2,32,0);
      RPSPACE(OUT$FETP,SP"SPACE",2);
      RPLINE(OUT$FETP,"SUBFAMILY REPORT",40,16,0);
      RPSPACE(OUT$FETP,SP"SPACE",1);
 
      IF ABNDN
      THEN
        BEGIN
        RPLINE(OUT$FETP,"FILES NOT DESTAGED",22,18,1);
        END
 
      ELSE
        BEGIN
        RPLINE(OUT$FETP,"FILES TO DESTAGE",22,16,1);
        END
 
      RPLINE(OUT$FETP,"FILES ONLY ON 7990",63,18,1);
      RPLINE(OUT$FETP,"FILES ON 7990",108,13,0);
      RPLINE(OUT$FETP,"SUB             DIRECT",2,25,1);
      RPLINE(OUT$FETP,"INDIRECT",37,8,1);
      RPLINE(OUT$FETP,"DIRECT             INDIRECT",60,27,1);
      RPLINE(OUT$FETP,"DIRECT             INDIRECT",102,27,0);
      RPLINE(OUT$FETP,"FAMILY    NUMBER",2,16,1);
      RPLINE(OUT$FETP,"PRU    NUMBER        PRU",26,24,1);
      RPLINE(OUT$FETP,"NUMBER        PRU",54,17,1);
      RPLINE(OUT$FETP,"NUMBER        PRU",75,17,1);
      RPLINE(OUT$FETP,"NUMBER        PRU",96,17,1);
      RPLINE(OUT$FETP,"NUMBER        PRU",117,17,0);
      RPSPACE(OUT$FETP,SP"SPACE",1);
 
#
*     PROCESS EACH SUBFAMILY.
#
 
      SLOWFOR SUBFAM = 0 STEP 1 UNTIL MAXSF
      DO
        BEGIN  # FOR EACH SUBFAMILY #
        SLOWFOR IX = IXDA STEP 1 UNTIL IXIA
        DO
          BEGIN  # REPORT BOTH FILE TYPES #
          CHR$10[0] = XCDD(SUBFAM);
          RPLINE(OUT$FETP,CHR$R1[0],3,1,1);
          IF IX EQ IXDA
          THEN
            BEGIN  # DIRECT ACCESS #
            CHR$10[0] = XCDD(SFDS$NF[IX,SUBFAM]);
            RPLINE(OUT$FETP,CHR$R8[0],10,8,1);
            CHR$10[0] = XCDD(SFDS$PRU[IX,SUBFAM]);
            RPLINE(OUT$FETP,CHR$R8[0],21,8,1);
            CHR$10[0] = XCDD(SFRL$NF[IX,SUBFAM]);
            RPLINE(OUT$FETP,CHR$R8[0],52,8,1);
            CHR$10[0] = XCDD(SFRL$PRU[IX,SUBFAM]);
            RPLINE(OUT$FETP,CHR$R8[0],63,8,1);
            CHR$10[0] = XCDD(SFDM$NF[IX,SUBFAM]);
            RPLINE(OUT$FETP,CHR$R8[0],94,8,1);
            CHR$10[0] = XCDD(SFDM$PRU[IX,SUBFAM]);
            RPLINE(OUT$FETP,CHR$R8[0],105,8,1);
            END  # DIRECT ACCESS #
 
          ELSE
            BEGIN  # INDIRECT ACCESS #
            CHR$10[0] = XCDD(SFDS$NF[IX,SUBFAM]);
            RPLINE(OUT$FETP,CHR$R8[0],31,8,1);
            CHR$10[0] = XCDD(SFDS$PRU[IX,SUBFAM]);
            RPLINE(OUT$FETP,CHR$R8[0],42,8,1);
            CHR$10[0] = XCDD(SFRL$NF[IX,SUBFAM]);
            RPLINE(OUT$FETP,CHR$R8[0],73,8,1);
            CHR$10[0] = XCDD(SFRL$PRU[IX,SUBFAM]);
            RPLINE(OUT$FETP,CHR$R8[0],84,8,1);
            CHR$10[0] = XCDD(SFDM$NF[IX,SUBFAM]);
            RPLINE(OUT$FETP,CHR$R8[0],115,8,1);
            CHR$10[0] = XCDD(SFDM$PRU[IX,SUBFAM]);
            RPLINE(OUT$FETP,CHR$R8[0],126,8,0);
            END  # INDIRECT ACCESS #
 
          END  # REPORT BOTH FILE TYPES #
 
        END  # FOR EACH SUBFAMILY #
 
      END  # MVRPTDS #
 
    TERM
PROC MVVALDS(DVAL,PO);
# TITLE MVVALDS - CALCULATE DESTAGE VALUE.                            #
 
      BEGIN  # MVVALDS #
 
#
**    MVVALDS - CALCULATE DESTAGE VALUE.
*
*     PROC MVVALDS(DVAL,PO).
*
*     ENTRY.    PO = PROCESSING OPTION FROM *SF* DIRECTIVE, OR 0.
*
*     EXIT.     DVAL = DESTAGE VALUE.
#
 
      ITEM DVAL       I;             # DESTAGE VALUE #
      ITEM PO         C(1);          # PROCESSING OPTION #
 
#
****  PROC MVVALDS - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        FUNC MVRELAG U;              # RELATIVE AGE #
        END
 
#
****  PROC MVVALDS - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
*CALL,COMBFAS
*CALL COMBSIT
*CALL,COMSPFM
*CALL,COMTMOV
*CALL,COMTMVD
 
 
      ITEM AGE        I;             # DAYS SINCE LAST ACCESS #
                                               CONTROL EJECT;
      AGE = CURAGE - MVRELAG(PFC$MDD[0]);  # TIME SINCE LAST ACCESS #
      IF PFC$MDT[0] GR CURTIME
      THEN
        BEGIN
        AGE = AGE - 1;
        END
 
#
*     VERIFY FILE MEETS AGE AND SIZE REQUIREMENTS.
#
 
      IF (AGE LS FR$VAL[FTYPE,IXDS,FRDD])  # TEST AGE #
        OR (PFC$LF[0] LS FR$VAL[FTYPE,IXDS,FRMN])  # MINIMUM SIZE #
        OR (PFC$LF[0] GR FR$VAL[FTYPE,IXDS,FRMX])  # MAXIMUM SIZE #
      THEN                           # FILE FAILS REQUIREMENTS #
        BEGIN
        DVAL = -1;
        RETURN;
        END
 
#
*     EVALUATE DESTAGE VALUE FORMULA.
#
 
      DVAL =                         ##
        (WA$VAL[FTYPE,IXDS,WMAG]+WM$VAL[FTYPE,IXDS,WMAG]*AGE)  ##
        *(WA$VAL[FTYPE,IXDS,WMLN]+WM$VAL[FTYPE,IXDS,WMLN]*PFC$LF[0])##
        *(PR$VAL[FTYPE,IXDS,PFC$RS[0]])  # *PR* FACTOR #
        *(BR$VAL[FTYPE,IXDS,PFC$BR[0]])  # *BR* FACTOR #
        /((WA$VAL[FTYPE,IXDS,WAAC]+WM$VAL[FTYPE,IXDS,WMAC]   ##
        *PFC$AC[0])*WA$VAL[FTYPE,IXDS,WADV]);
 
 
 
      RETURN;
      END  # MVVALDS #
 
    TERM
PROC MVVALRL(RVAL,PO);
# TITLE MVVALRL - CALCULATE RELEASE VALUE.                            #
      BEGIN  # MVVALRL #
 
#
**    MVVALRL - CALCULATE RELEASE VALUE.
*
*     PROC MVVALRL(RVAL,PO).
*
*     ENTRY.    PO = PROCESSING OPTION FROM *SF* DIRECTIVE, OR 0.
*
*     EXIT.     RVAL = RELEASE VALUE.
#
 
      ITEM PO         C(1);          # PROCESSING OPTION #
      ITEM RVAL       I;             # RELEASE VALUE #
 
#
****  PROC MVVALRL - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        FUNC MVRELAG U;              # RELATIVE AGE #
        END
 
#
****  PROC MVVALRL - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
*CALL,COMBFAS
*CALL COMBSIT
*CALL,COMSPFM
*CALL,COMTMOV
*CALL,COMTMVD
 
 
      ITEM AGE        I;             # DAYS SINCE LAST ACCESS #
                                               CONTROL EJECT;
      AGE = CURAGE - MVRELAG(PFC$ADD[0]);  # TIME SINCE LAST ACCESS #
      IF PFC$ADT[0] GR CURTIME
      THEN
        BEGIN
        AGE = AGE - 1;
        END
 
#
*     VERIFY FILE MEETS AGE AND SIZE REQUIREMENTS.
#
 
      IF (AGE LS FR$VAL[FTYPE,IXRL,FRDD])  # TEST AGE #
        OR (PFC$LF[0] LS FR$VAL[FTYPE,IXRL,FRMN])  # MINIMUM SIZE #
        OR (PFC$LF[0] GR FR$VAL[FTYPE,IXRL,FRMX])  # MAXIMUM SIZE #
      THEN                           # FILE FAILS REQUIREMENTS #
        BEGIN
        RVAL = -1;
        RETURN;
        END
 
#
*     EVALUATE RELEASE VALUE FORMULA.
#
 
      RVAL =                         ##
        (WA$VAL[FTYPE,IXRL,WAAG]+WM$VAL[FTYPE,IXRL,WMAG]*AGE)  ##
        *(WA$VAL[FTYPE,IXRL,WALN]+WM$VAL[FTYPE,IXRL,WMLN]*PFC$LF[0])##
        *(PR$VAL[FTYPE,IXRL,PFC$RS[0]])  # *PR* FACTOR #
        *(BR$VAL[FTYPE,IXRL,PFC$BR[0]])  # *BR* FACTOR #
        /((WA$VAL[FTYPE,IXRL,WAAC]+WM$VAL[FTYPE,IXRL,WMAC]     ##
        *PFC$AC[0])*WA$VAL[FTYPE,IXRL,WADV]);
 
 
 
      RETURN;
      END  # MVVALRL #
 
    TERM