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 = 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 = FWA OF CONTROL WORD. * P = 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 = 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 = 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 = 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 = CCS; IF C EQ " " OR C EQ 0 THEN RETURN; SLOWFOR J = 0 STEP 1 UNTIL 9 DO BEGIN # SEARCH FOR MATCH # IF CVCS EQ C THEN BEGIN BNBS = 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 = 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 = 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 = 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 = 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 = 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 CSFT$FNC[0] NQ "*" THEN BEGIN TEST I; END CSFT$FNC[0] = MSK77; CMASK = 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 = ARG$TEXT[I]; RPLINE(OUT$FETP,KWTEXT[1],3,20,0); KEY = ARG$KEY[I]; P = ARG$TAB[I]+5; P = 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 = LOC(MV$WBUF[0]); P = 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 = 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 = 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 = LOC(MV$WBUF[0]); P = 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 = 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 = 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 = LOC(MV$WBUF[0]); P = 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