SSMOVE
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
