*DECK COLLECT
*IF DEF,CDCNET,1
PRGM CLCDCNT;
*IF -DEF,CDCNET,1
PRGM COLLECT;
#
DUMP COLLECTION PROCESSOR
P R O C E D U R E C O N T E N T S
------------------------------------
ITEM DECLARATIONS
LINK DECLARATIONS
ARRAY DECLARATIONS
COMMON DECLARATIONS
MISC DECLARATIONS
FUNC KEYLINE
PROC READ$CFO
PROC COLECT (MAIN PROCESS)
COLLECT COPYRIGHT CONTROL DATA SYSTEMS INC. 1994.
#
CONTROL EJECT;
#
NETWORK DUMP COLLECTION PROGRAM
THE NETWORK DUMP COLLECTION PROGRAM, COLLECT, IS USED TO
CO-LOCATE THE VARIOUS DUMP, TRACE, STATISTIC AND LIST
FILES WHICH RESULT FROM ANY INVOCATION OF THE NETWORK.
THESE FILES ARE FIRST COPIED TO A LOCAL FILE BY THE
PROGRAM "COLLECT" AND THEN, VIA JOB CONTROL STATEMENTS,
THIS FILE IS COPIED TO A TAPE FILE.
THE CALL STATEMENT FOR THE COLLECTION PROGRAM TAKES THE
FOLLOWING FORM--
COLLECT(NIN=XXX[,NOPURGE][,NOSAVE])
THE NETWORK INVOCATION NUMBER XXX IS A ONE TO THREE CHAR-
ACTER DECIMAL NUMBER WHICH INDICATES THE UPPER LIMIT OF THE
INVOCATION NUMBERS TO BE COLLECTED. ALL FILES WITH AN NIN
FROM 1 THROUGH XXX WILL BE COPIED TO THE LOCAL
FILE. IF THE NIN VALUE IS NOT SPECIFIED, A DEFAULT
VALUE OF 1 (ONE) WILL BE USED.
THE NOPURGE OPTION, IF SPECIFIED, INDICATES THAT THE COLLECTED
FILES ARE NOT TO BE PURGED AFTER THEY ARE SUCCESSFULLY COPIED
TO THE COMMON LOCAL FILE. IF THIS OPTION IS NOT SPEC-
IFIED, EACH FILE COPIED WILL BE IMMEDIATELY PURGED.
THE NOSAVE OPTION, WHEN SPECIFIED, BYPASSES THE FILE COPYING
FUNCTIONS. THAT IS, NO DUMPXXX FILES WILL BE CREATED. THIS
OPTION MAY BE SPECIFIED TO CAUSE THE PURGING (ONLY) OF ALL
NETWORK DUMP FILES.
THE COLLECTION PROCESS IS INITIATED VIA THE NETWORK STARTUP
JOB, NAMI. THE RELEASED NAMI JOB MASTER FILE WILL CAUSE
NAMI TO INITIATE THE COLLECTOR JOB UPON EACH INVOCATION OF THE
NETWORK. THE COLLECTOR JOB WILL BE PASSED AN NIN VALUE OF THE
LAST NETWORK INVOCATION NUMBER-- THE CURRENT NETWORK WILL BE
INITIATED WITH AN INCREMENTAL VALUE OF THE NIN. THE PURGE AND
SAVE OPTIONS WILL BE IN EFFECT. FOR EXAMPLE, ON THE 5TH
INITIATION OF THE NETWORK, THE COLLECTOR JOB WILL HAVE THE
CONTROL STATEMENT CALL OF---
COLLECT(NIN=004)
AND THE NETWORK WILL BE STARTED WITH AN NIN OF 005.
THE COLLECTOR JOB WILL PROCESS ALL FILES WHICH HAVE A NAME OF
THE FORM---
PPTSXXX WHERE PP = PRODUCT PREFIX
CS, NS, NV (FOR NVF),
NI (FOR NIP), TV (FOR TVF)
IA (FOR IAF), RB (FOR RBF),
NP (NPUS), IT (ITF), PR (PSU),
QT (QTF), QS (QTFS), PS (PTFS),
AT (ATF), PI (FTPI), TS (FTPS)
*IF DEF,CDCNET
FS, OS, LS, IN (INITMDI)
DI...DR, DS...D9 (MDI DUMPS)
*ENDIF
T = TYPE OF FILE
L (LIST FILE), T (TRACE FILE)
S (STATISTICS FILE), D (DUMP
FILE)
S = SUB TYPE FOR FILE
0, 1 OR 2
XXX = NETWORK INVOCATION NUMBER
000 THROUGH 999
NOTE - T AND S ARE NOT VALID FOR NP AND
MDI DUMP FILES.
THE FILE PRODUCED BY THE COLLECTOR JOB HAS ONE FILE
AND MANY RECORDS. EACH FILE SELECTED (SEE ABOVE FILE NAME
DESCRIPTION) IS COPIED TO THE COMMON FILE AS ONE OR MORE
RECORDS WHERE THE FIRST RECORD IS PRECEDED BY A 16 (20B) WORD
RECORD WHICH CONTAINS THE FILE NAME. IN THIS WAY, AN ITEMIZE
OR CATALOG OF THE COLLECTOR COMMON FILE WILL EASILY SHOW
WHICH FILES WERE COPIED.
THE LOCAL FILES CREATED BY THE COLLECTION PROGRAM HAVE
THE NAMES---
DUMPXXX WHERE XXX IS THE SPECIFIED OR DEFAULT
NIN FROM THE COLLECTOR CALL
STATEMENT. THIS FILE WILL
CONTAIN ALL OF THE FILES
EXCEPT THOSE WRITTEN TO
DUNPXXX AND/OR DMDIXXX.
DUNPXXX WHERE XXX IS THE SPECIFIED OR DEFAULT
NIN FROM THE COLLECTOR CALL
STATEMENT. THIS FILE WILL
CONTAIN THE NP DUMP FILES, THAT
IS, FILES OF THE NAME NPZZXXX.
*IF DEF,CDCNET
DMDIXXX WHERE XXX IS THE SPECIFIED OR DEFAULT
NIN FROM THE COLLECTOR CALL
STATEMENT. THIS FILE WILL
CONTAIN THE MDI DUMP FILES, THAT
IS, FILES OF THE NAME
DI_AA_NIN ... DI_99_NIN
. .
. .
. .
DR_AA_NIN ... DR_99_NIN
DS_AA_NIN ... DS_99_NIN
. .
. .
. .
D9_AA_NIN ... D9_99_NIN
*ENDIF
THE JOB SKELETON FOR THE COLLECTOR JOB WHICH IS RELEASED
WITH THE MULTI-HOST NETWORK WILL CAUSE THE COMMON (LOCAL)
FILES TO BE COPIED TO MAGNETIC TAPE. WHEN THE FILES HAVE BEEN
SUCCESSFULLY COPIED, COLLECT WILL AGAIN BE EXECUTED TO PURGE
THE INDIVIDUAL FILES WHICH WERE COLLECTED.
TO USE THE COLLECTOR JOB AS A PURGING VEHICLE, THE FOLLOWING
CALL STATEMENT MAY BE USED---
COLLECT(NIN=999,NOSAVE)
WITH THIS INVOCATION OF THE COLLECTOR, ALL FILES WITH THE
NAME FORMAT AS DESCRIBED ABOVE WILL BE PURGED. NO DUMP FILE
WILL BE CREATED.
#
CONTROL EJECT;
#ITEM DECLARATIONS #
BEGIN
ITEM INDX1 I=0;
ITEM NDXPF I=0;
ITEM K I=0, K1 I=0, K2 I=0;
ITEM J1 I=0, J2 I=0, J3 I=0;
ITEM N I=0, N1 I=0, N2 I=0;
ITEM NR1 R=0, NR2 R=0;
ITEM OPTION I=0;
ITEM TOTPRU I=0;
DEF STATEOI #O"1031"#;
ITEM SPACES C(10) = " ";
ITEM EDITX C(10);
ITEM SCANF C(10);
ITEM SCANK C(10);
ITEM SCANV C(10);
ITEM NETINV C(10); #NIN0ZZZ #
ITEM USERNUM C(10);
ITEM INV$LOW I=1;
ITEM INV$HIGH I=999;
ITEM INV$ONE I=0;
ITEM DD60 B=FALSE;
ITEM FL2PURGE B=TRUE;
ITEM FL2TAPE B=FALSE;
ITEM FL2DISK B=TRUE;
ITEM FL2SAVE B=TRUE;
ITEM MORE$2$DO B=TRUE;
ITEM SHORT B=FALSE;
ITEM CHK$RANGE B=TRUE;
*IF DEF,CDCNET
ITEM $DEFAULT C(10)= O"53040506012514240000"; # PN & UN PARAMS #
ITEM $CURRENT C(10)= O"53032522220516240000"; # FOR NETCDA CALL#
*ENDIF
DEF MODE$P #1#;
DEF MODE$T #2#;
DEF MODE$D #4#;
DEF MODE$S #8#;
COMMON IDINFO;
BEGIN
ITEM IDVERSN C(40); # COLLECTOR VERSION IDENT #
ITEM COPYRIGHT C(50); # COLLECTOR COPYRIGHT #
END
CONTROL EJECT;
#LINK DECLARATIONS #
XREF PROC CFOWAIT;
XREF PROC CFOBCLR;
XREF PROC CFOBSET;
XREF PROC CPYOPN;
XREF PROC CPYATT;
XREF PROC CPYGET;
XREF PROC CPYFLS;
XREF PROC CPYPUR;
XREF PROC CPYRET;
XREF PROC CPYSAV;
XREF PROC FINSHIO;
XREF PROC OFLUSH;
XREF PROC PUTLINE;
XREF PROC PUTTERM;
XREF PROC PUTTRMX;
XREF PROC SENDMSG;
XREF PROC SETUPC;
XREF PROC SIERRA;
XREF PROC STARTIO;
XREF PROC TIGRLST;
XREF FUNC XCDD C(10);
XREF FUNC XCOD C(10);
XREF FUNC XSFW C(10);
XREF FUNC XCFD C(10);
*IF DEF,CDCNET
XREF PROC NETCDA;
XREF PROC NETFMA;
XREF PROC NETFMP;
*ENDIF
CONTROL EJECT;
#ARRAY DECLARATIONS #
ARRAY LINE[0:10] S(1);
BEGIN
ITEM LIN6 C(0, 0, 6);
ITEM LINX C(0, 0, 10);
ITEM LIN80 C(0, 0, 80);
ITEM LINX1A C(0, 0, 110);
ITEM LIN4 C(0, 0, 4);
END
ARRAY ENVIRONS [0:0] S(21);
BEGIN
ITEM ENV1 C(0, 0, 10) = [" "];
ITEM ENV2 C(1, 0, 10) = ["CFO=YES "];
ITEM ENV3 C(2, 0, 10) = ["CMU=YES "];
ITEM ENV4 C(3, 0, 10) = ["C/MEJ=YES "];
ITEM ENV5 C(4, 0, 10) = [" "];
ITEM ENV6 C(5, 0, 10) = ["PPUS=00 "];
ITEM ENV7 C(6, 0, 10) = ["CM=000000B"];
ITEM ENV8 C(7, 0, 10) = [" "];
ITEM ENV9 C(8, 0, 20) = ["CONTROL STATEMENT = "];
ITEM ENV10 C(08, 0, 50);
ITEM ENV11 C(11, 0, 10);
ITEM ENV12 C(12, 0, 10);
ITEM ENV13 C(13, 0, 10) = [" "];
ITEM ENV14 C(14, 0, 10) = ["SUNDAY "];
ITEM ENV15 C(15, 0, 20) = [" MM/DD/YY HH.MM.SS "];
ITEM ENV17 C(17, 0, 10) = [" "];
ITEM ENV18 C(18, 0, 10) = ["SAVE=YES "];
ITEM ENV19 C(19, 0, 10) = ["TAPE=YES "];
ITEM ENV20 C(20, 0, 10) = ["PURGE=YES "];
END
CONTROL EJECT;
#COMMON DECLARATIONS #
COMMON PASSIT;
BEGIN
ITEM IOFWA I;
ITEM IOCNT I;
ITEM IOCMP I;
ITEM IOLVL I;
ITEM IOFLG I;
END
COMMON PARAMS;
BEGIN
ITEM CMODE I;
ITEM CSTAT I;
ARRAY CMSG [0:7] S(1);
BEGIN
ITEM CMESS C(0, 0, 10);
ITEM CMSG80 C(0, 0, 80);
END
END
COMMON TIGRCOM;
BEGIN
ITEM TCSTAT I;
ITEM TCLEN I;
ARRAY TBUFFR [0:64] S(1);
BEGIN
ITEM TBUF C(0, 0, 10);
ITEM TBUFNAM C(0, 0, 7);
ITEM TBUFCNT U(0, 0, 24);
ITEM TBUFTYP C(0, 42, 3);
END
END
COMMON COPYCOM;
BEGIN
ITEM PFN1 C(10);
ITEM UN1 C(10);
ITEM PFN2 C(10);
ITEM UN2 C(10);
ITEM PFN3 C(10);
ITEM UN3 C(10);
END
COMMON PFEMSG;
BEGIN
ITEM PFERMSG C(30);
ITEM PFEZBYT I;
END
CONTROL EJECT;
#COMMON DECLARATIONS #
COMMON SIERRAC;
BEGIN
ARRAY SIE [0:0] S(7);
BEGIN
ITEM SIECM U(0, 00, 30);
ITEM SIEDATE C(1, 00, 10);
ITEM SIEJDATE C(2, 00, 10);
ITEM SIEJYR C(2, 30, 02);
ITEM SIEJDAY C(2, 42, 03);
ITEM SIETIME C(3, 00, 10);
ITEM SIECPUS U(4, 24, 24);
ITEM SIECPUMS U(4, 48, 12);
ITEM SIEUSER C(5, 00, 07);
ITEM SIEMID C(6, 00, 10);
END
END
COMMON MSGCOM;
BEGIN
ARRAY MSGCOMA [0:8] S(1);
BEGIN
ITEM OPMSG1 C(0, 00, 10);
ITEM OPMSG C(0, 00, 80);
ITEM OPMSGZB U(0, 00, 60);
END
END
COMMON PFTABLES;
BEGIN
ARRAY PFTABLE [0:99] S(1);
BEGIN
ITEM PFLIST C(0, 00, 9);
ITEM PFTYPE U(0, 54, 6);
END
END
DEF DIR #4#;
DEF IND #9#;
*IF DEF,CDCNET
DEF NFM #3#;
COMMON NFMBLK;
BEGIN
ARRAY NETFMBLOCK [0:30] S(1);
BEGIN
ITEM NFMLFN C(0,0,6);
ITEM NFMNFN C(0,0,10);
ITEM NFMPFN C(0,0,7);
ITEM NFMSTAT U(0,42,18);
ITEM NFMWORD U(0,0,60);
END
END
*ENDIF
CONTROL EJECT;
COMMON PFNLIST;
BEGIN
ARRAY PFNA [0:20] S(1);
BEGIN
ITEM PFNC1C2 C(0, 0, 10);
END
ARRAY PFNB [0:39] S(1);
BEGIN
ITEM PFNC3 C(0, 0, 10);
ITEM PFNC3NP C(20, 0, 10);
END
END
COMMON PACKING;
BEGIN
ITEM PACK80 C(80);
ITEM PACK160 C(100);
ITEM PACKEND C(10);
ARRAY PACK01 [0:79] S(1);
BEGIN
ITEM PACKW C(0, 0, 10);
END
ITEM UPCSTAT U;
ITEM UPCOUNT U;
END
CONTROL EJECT;
XREF
ARRAY RAZERO [0:0] S(64);
BEGIN
ITEM JCACFO B(00, 45, 01);
ITEM JCACMU B(53, 00, 01);
ITEM JCACME B(54, 00, 01);
ITEM JCAPPU U(54, 07, 05);
ITEM JCA70 C(56, 00, 50);
ITEM JCAOPMSG C(56, 00, 80);
END
ARRAY DATALNY [0:0] S(12);
BEGIN
ITEM LNY0 C(0, 0, 20) = [" MODE = 00B"];
ITEM LNY1 C(2, 0, 20) = [" OPTION = 00B"];
ITEM LNY2 C(4, 0, 20) = [" NIN = 000D"];
ITEM LNY3 C(6, 0, 20) = [" NINCR = 000D"];
ITEM LNY4 C(8, 0, 20) = [" NINLO = 000D"];
ITEM LNY5 C(10,0, 20) = [" NINHI = 000D"];
ITEM LNY1A C(1, 42, 2);
ITEM LNY1B C(3, 42, 2);
ITEM LNY1C C(5, 36, 3);
ITEM LNY1D C(7, 36, 3);
ITEM LNY1E C(9, 36, 3);
ITEM LNY1F C(11,36, 3);
END
ARRAY DAY2DAY [0:6] S(1);
BEGIN
ITEM DAY0 C(0, 0, 10) = ["SUNDAY "];
ITEM DAY1 C(1, 0, 20) = ["MONDAY TUESDAY "];
ITEM DAY3 C(3, 0, 20) = ["WEDNESDAY THURSDAY "];
ITEM DAY5 C(5, 0, 20) = ["FRIDAY SATURDAY "];
END
CONTROL EJECT;
# PROC READ$CFO #
PROC READ$CFO;
BEGIN
ITEM SAVEFWA I;
FOR K = 0 STEP 1 UNTIL 7 DO
CMESS[K] = SPACES;
CFOBSET;
# IF NOT DD60 THEN READLN #
CFOWAIT;
CMSG80[0] = JCAOPMSG[0];
SAVEFWA = IOFWA;
IOFWA = LOC(CMSG80[0]);
IOCNT = 7;
PUTLINE;
OPMSG[0] = CMSG80[0];
OPMSGZB[4] = 0;
SENDMSG;
IOFWA = SAVEFWA;
END #READ CFO#
PROC FILL55 (FILET);
BEGIN
ITEM FILET C(10);
FOR N2 = 0 STEP 1 UNTIL 9 DO
IF (C<N2,1>FILET LS "A") OR (C<N2,1>FILET GR "9")
THEN C<N2,1>FILET = " ";
END #FILL55#
PROC STRIP55 (STRIPIT);
BEGIN
ITEM STRIPIT C(10);
FOR N2 = 0 STEP 1 UNTIL 9 DO
IF (C<N2,1>STRIPIT LS "A") OR (C<N2,1>STRIPIT GR "9")
THEN C<N2,1>STRIPIT = 0;
END #STRIP55#
CONTROL EJECT;
# PROC SHOTERM #
PROC SHOTERM (FWA, COUNT, FLUSH);
BEGIN
ITEM FWA I;
ITEM COUNT I;
ITEM FLUSH B;
IF FWA NQ 0 THEN IOFWA = FWA;
IF COUNT NQ 0 THEN IOCNT = COUNT;
PUTTERM;
IF FLUSH THEN PUTTRMX;
END #SHOTERM#
# PROC CLR$OPMSG #
PROC CLR$OPMSG;
BEGIN
ITEM NN I;
FOR NN = 0 STEP 1 UNTIL 7 DO
OPMSG1[NN] = SPACES;
END
# PROC WEEKDAY #
PROC WEEKDAY;
BEGIN
EDITX = SIEJYR;
N1 = C<0,1>EDITX - "0";
N2 = C<1,1>EDITX - "0";
N = (N1 * 10) + N2;
NR1 = 365.25 * N;
EDITX = SIEJDAY;
N1 = (C<0,1>EDITX - "0") * 100;
N1 = N1 + ((C<1,1>EDITX - "0") * 10);
N1 = N1 + (C<2,1>EDITX - "0");
NR1 = NR1 + N1;
N = NR1;
NR2 = N;
IF NR1 EQ NR2 THEN NR1 = NR1 - 1.0;
N = NR1;
FOR K=0 WHILE N GR 6 DO
N = N -7;
ENV14 = DAY0[N];
END #WEEKDAY#
CONTROL EJECT;
FUNC DCODE (CHARS) I;
BEGIN
ITEM CHARS C(10);
ITEM TVAL I;
ITEM J1 I;
DCODE = 0;
TVAL = 0;
FOR J1 = 0 STEP 1 UNTIL 9 DO
BEGIN
IF (C<J1,1>CHARS GQ "0") AND (C<J1,1>CHARS LQ "9")
THEN TVAL = TVAL * 10 + (C<J1,1>CHARS - "0");
END
DCODE = TVAL;
END #DCODE#
CONTROL EJECT;
PROC CRACK$CALL;
BEGIN
PACK80 = SPACES;
PACK80 = JCAOPMSG;
C<79,1>PACK80 = ".";
SETUPC;
USERNUM = SPACES;
NETINV = "NIN0999 ";
SHORT = TRUE;
FOR J2 = 0 STEP 1 WHILE C<0,1>PACKW[J2] NQ 0 DO
BEGIN
SCANF = PACKW[J2];
SCANV = PACKW[J2+1];
FILL55 (SCANF);
FILL55 (SCANV);
SCANK = C<0, 4>SCANF;
IF SCANK EQ "NOPU" THEN FL2PURGE = FALSE;
IF SCANK EQ "NOSA" THEN FL2SAVE = FALSE;
IF SCANK EQ "UN " THEN USERNUM = SCANV;
IF SCANK EQ "NINL" THEN INV$LOW = DCODE (SCANV);
IF SCANK EQ "NINH" THEN INV$HIGH = DCODE (SCANV);
IF SCANK EQ "NIN " THEN INV$HIGH = DCODE (SCANV);
IF SCANK EQ "OIN " THEN INV$HIGH = DCODE (SCANV);
IF SCANK EQ "NINC" THEN INV$ONE = DCODE (SCANV);
IF SCANK EQ "SHOR" THEN SHORT = TRUE;
IF SCANK EQ "FULL" THEN SHORT = FALSE;
END
IF INV$ONE NQ 0 THEN CHK$RANGE = FALSE;
IF INV$ONE EQ 0 THEN INV$ONE = INV$HIGH;
INV$ONE = INV$ONE + 10000;
EDITX = XCDD (INV$ONE);
INV$ONE = INV$ONE - 10000;
C<4,3>NETINV = C<7,3>EDITX;
END #CRACK$CALL#
CONTROL EJECT;
# PROC INITCPA #
PROC INITCPA;
BEGIN
SIERRA;
IF NOT JCACFO THEN C<4,3>ENV2 = "NO ";
IF NOT JCACMU THEN C<4,3>ENV3 = "NO ";
IF NOT JCACME THEN C<6,3>ENV4 = "NO ";
N = JCAPPU;
EDITX = XCDD(N);
C<5,2>ENV6 = C<8,2>EDITX;
N = SIECM;
EDITX = XCOD(N);
C<3,6>ENV7 = C<4,6>EDITX;
C<00,10>ENV15 = SIEDATE;
C<10,10>ENV15 = SIETIME;
WEEKDAY;
IF (NOT FL2PURGE) THEN C<6,3>ENV20 = "NO ";
IF (NOT FL2TAPE) THEN C<5,3>ENV19 = "NO ";
IF (NOT FL2SAVE) THEN C<5,3>ENV18 = "NO ";
SHOTERM (LOC(ENV1), 1, FALSE);
SHOTERM (LOC(ENV1), 4, FALSE);
SHOTERM (LOC(ENV5), 3, FALSE);
SHOTERM (LOC(ENV8), 3, FALSE);
ENV10 = JCA70;
FOR K = 0 STEP 1 UNTIL 49 DO
IF C<K,1>ENV10 EQ 0 THEN C<K,1>ENV10 = " ";
SHOTERM (LOC(ENV8), 6, FALSE);
SHOTERM (LOC(ENV13), 1, FALSE);
SHOTERM (LOC(ENV13), 4, FALSE);
SHOTERM (LOC(ENV17), 1, FALSE);
SHOTERM (LOC(ENV17), 4, FALSE);
SHOTERM (LOC(ENV17), 1, TRUE);
NR1 = SIECPUS * 1000.0;
NR2 = SIECPUMS;
NR1 = NR1 + NR2;
END #INITCPA#
CONTROL EJECT;
# PROC DS$DEFAULT #
PROC DS$DEFAULT;
BEGIN
EDITX = XCOD(CMODE);
LNY1A = C<8,2>EDITX;
EDITX = XCOD(OPTION);
LNY1B = C<8,2>EDITX;
LNY1C = C<4,3>NETINV;
EDITX = XCDD(INV$ONE);
LNY1D = C<7,3>EDITX;
EDITX = XCDD(INV$LOW);
LNY1E = C<7,3>EDITX;
EDITX = XCDD(INV$HIGH);
LNY1F = C<7,3>EDITX;
SHOTERM (LOC(LNY0), 6, FALSE);
SHOTERM (LOC(LNY3), 6, FALSE);
SHOTERM (LOC(LNY0), 1, TRUE);
END #DS$DEFAULT#
FUNC IN$RANGE B;
BEGIN
IN$RANGE = FALSE;
EDITX = C<4,3>PFN1;
IF CHK$RANGE THEN
BEGIN
IF DCODE (EDITX) LS INV$LOW THEN RETURN;
IF DCODE (EDITX) GR INV$HIGH THEN RETURN;
IN$RANGE = TRUE;
RETURN;
END
ELSE
BEGIN
IF DCODE (EDITX) NQ INV$ONE THEN RETURN;
IN$RANGE = TRUE;
RETURN;
END
END #IN$RANGE#
CONTROL EJECT;
# PROC SETUP$CLCT #
PROC SETUP$CLCT;
BEGIN
CLR$OPMSG;
OPMSG[0] = IDVERSN;
SENDMSG;
CRACK$CALL;
CMODE = 0;
IF FL2PURGE THEN CMODE = CMODE + MODE$P;
IF FL2TAPE THEN CMODE = CMODE + MODE$T;
IF FL2DISK THEN CMODE = CMODE + MODE$D;
IF FL2SAVE THEN CMODE = CMODE + MODE$S;
STRIP55(USERNUM);
INITCPA;
DS$DEFAULT;
FOR N = 0 STEP 1 UNTIL 99 DO
BEGIN
PFLIST[N] = SPACES;
PFTYPE[N] = 0;
END
TCSTAT = 0;
MORE$2$DO = TRUE;
END #SETUP$CLCT#
CONTROL EJECT;
PROC SHOW$STAT (SWRD, OP, FTYPE);
BEGIN
ITEM SWRD C(10);
ITEM OP C(10);
ITEM FTYPE I;
LINX[0] = SPACES;
EDITX = SWRD;
EDITX = C<0,7>EDITX;
FILL55 (EDITX);
IF FTYPE EQ DIR THEN LINX[0] = " DIR FILE ";
IF FTYPE EQ IND THEN LINX[0] = " IND FILE ";
*IF DEF,CDCNET
IF FTYPE EQ NFM THEN LINX[0] = " NFM FILE ";
*ENDIF
LINX[1] = EDITX;
LINX[2] = " FCN = ";
C<7,3>LINX[2] = C<0,3>OP;
LINX[3] = " ST = ";
K = SWRD LAN O"77 7777";
EDITX = XCOD(K);
LINX[4] = SPACES;
LINX[4] = C<4,6>EDITX;
SHOTERM (LOC(LINX[0]), 5, TRUE);
END #SHOW$STAT#
FUNC PFERR (NAMPF) B;
BEGIN
ITEM NAMPF C(10);
K = NAMPF / 2**10;
K = K LAN O"377";
IF K EQ 0 THEN PFERR = FALSE;
IF K NQ 0 THEN PFERR = TRUE;
IF K EQ 0 THEN RETURN;
LINX[0] = SPACES;
LINX[1] = "ERROR CODE";
LINX[2] = SPACES;
EDITX = XCOD (K);
LINX[2] = C<6,4>EDITX;
SHOTERM (LOC(LINX[0]), 3, FALSE);
SHOTERM (LOC(PFERMSG), 3, TRUE);
RETURN;
END #PFERR#;
CONTROL EJECT;
PROC CAT$LIST;
BEGIN
UN2 = USERNUM;
FOR TCSTAT = 0 WHILE MORE$2$DO DO
BEGIN
TIGRLST;
TCSTAT = TCSTAT LAN O"1777";
FOR J1 = 0 STEP 16 WHILE J1 LS TCLEN DO
BEGIN
PFLIST[NDXPF] = XSFW(TBUFNAM[J1]);
TOTPRU = TOTPRU + TBUFCNT[J1+1];
LINX[0] = SPACES;
C<1,8>LINX[0] = C<0,8>PFLIST[NDXPF];
EDITX = XCDD (TBUFCNT[J1+1]);
LINX[1] = EDITX;
TBUFTYP[J1+7] = "IND";
PFTYPE[NDXPF] = IND;
IF (TBUF[J1+1] LAN O"4000") NQ 0 THEN
BEGIN
TBUFTYP[J1+7] = "DIR";
PFTYPE[NDXPF] = DIR;
END
C<0,3>LINX[1] = TBUFTYP[J1+7];
IF (NOT SHORT) THEN SHOTERM (LOC(LINX[0]), 2, FALSE);
NDXPF = NDXPF +1;
PFLIST[NDXPF] = 0;
END
MORE$2$DO = TCSTAT NQ STATEOI;
IF NDXPF GQ 96 THEN MORE$2$DO = FALSE;
END
IF TCSTAT EQ STATEOI THEN
BEGIN
LINX[0] = " TOTAL = ";
LINX[1] = XCDD (TOTPRU);
SHOTERM (LOC(LINX[0]), 2, TRUE);
END
END #CAT$LIST#
CONTROL EJECT;
#COPY$ONE FILE#
PROC COPY$ONE;
BEGIN
PFN1 = PFLIST[INDX1];
IF IN$RANGE THEN
BEGIN
STRIP55(PFN1);
C<0,4>PFN2 = "DUMP";
IF C<0,2>PFN1 EQ "NP" THEN C<0,4>PFN2 = "DUNP";
IF PFTYPE[INDX1] EQ IND THEN CPYGET;
IF PFTYPE[INDX1] EQ DIR THEN CPYATT;
SHOW$STAT (PFN1, "ACC", PFTYPE[INDX1]);
IF (NOT PFERR(PFN1)) THEN
BEGIN
IF FL2SAVE THEN
BEGIN
CPYFLS;
LINX[0] = " COPIED ";
LINX[1] = PFLIST[INDX1];
SHOTERM (LOC(LINX[0]), 2, TRUE);
END
IF FL2PURGE THEN
BEGIN
CPYRET;
PFN1 = PFLIST[INDX1];
STRIP55(PFN1);
CPYPUR;
SHOW$STAT (PFN1, "PUR", PFTYPE[INDX1]);
IF (NOT PFERR(PFN1)) THEN N = N;
END
END
CPYRET;
END
END #COPY$ONE#
CONTROL EJECT;
#FIND/COPY FILES #
PROC COPY$FILES;
BEGIN
FOR J1 = 0 STEP 1 WHILE C<0,1>PFNC1C2[J1] NQ 0 DO
BEGIN
J3 = 0;
IF C<0,2>PFNC1C2[J1] EQ "NP" THEN J3 = 20;
FOR J2 = J3 STEP 1 WHILE C<0,1>PFNC3[J2] NQ 0 DO
BEGIN
SCANF = SPACES;
C<0,2>SCANF = PFNC1C2[J1];
C<2,1>SCANF = PFNC3[J2];
LINX[0] = SPACES;
LINX[1] = "SEARCH-- ";
LINX[2] = SCANF;
IF (NOT SHORT) THEN SHOTERM (LOC(LINE), 3, TRUE);
FOR INDX1 = 0 STEP 1 WHILE INDX1 LS NDXPF DO
IF C<0,3>SCANF EQ C<0,3>PFLIST[INDX1] THEN COPY$ONE;
END
END
END #COPY$FILES#
*IF DEF,CDCNET
CONTROL EJECT;
PROC CPYMDIDUMP;
#
* COPY ONE MDI DUMP FILE
#
BEGIN
ITEM NFMRC U;
PFN1 = PFLIST[INDX1];
IF IN$RANGE
THEN BEGIN
C<0,4>PFN2 = "DMDI";
FOR K1 = 0 STEP 1 UNTIL 30 DO
NFMWORD[K1] = 0;
NFMLFN[0] = "CPYFL1";
NFMPFN[22] = PFN1;
NETFMA (LOC (NETFMBLOCK),NFMRC);
NFMSTAT[22] = NFMRC;
SHOW$STAT (NFMWORD[22], "ATT", NFM);
IF NFMRC EQ 0
THEN BEGIN
IF FL2SAVE
THEN BEGIN
CPYFLS;
LINX[0] = " COPIED ";
LINX[1] = PFLIST[INDX1];
SHOTERM (LOC(LINX[0]), 2, TRUE);
END
IF FL2PURGE
THEN BEGIN
CPYRET;
NFMSTAT[22] = 0;
NETFMP (LOC (NETFMBLOCK),NFMRC);
NFMSTAT[22] = NFMRC;
SHOW$STAT (NFMWORD[22], "PUR", NFM);
END
END
ELSE
BEGIN
# COULD NOT HAVE ACCESS TO THE FILE THROUGH NETFM. #
# GO AHEAD TRY TO CELLECT (AND/OR PURGE) IT DIRECTLY #
# WITHOUT CALLING NETFM. #
PFN1 = PFLIST[INDX1];
STRIP55(PFN1);
IF PFTYPE[INDX1] EQ IND # IF THIS IS AN INDIRECT #
THEN # ACCESS FILE , GET IT. #
CPYGET;
ELSE # OTHERWISE, IT MUST BE #
CPYATT; # DIRECT ACCESS, ATTACH IT. #
IF (NOT PFERR(PFN1)) THEN # IF NO ERROR IN ACCESS TO #
BEGIN # THE FILE, PROCESS IT. #
IF FL2SAVE THEN # IF NOSAVE IS NOT SPECIFIED#
BEGIN
CPYFLS;
LINX[0] = " COPIED ";
LINX[1] = PFLIST[INDX1];
SHOTERM (LOC(LINX[0]), 2, TRUE);
END
IF FL2PURGE THEN # IF NOPURGE IS NOT SPECIFIED #
BEGIN
CPYRET; # RETURN THE FILE #
PFN1 = PFLIST[INDX1];
STRIP55(PFN1);
CPYPUR; # PURGE THE FILE #
SHOW$STAT (PFN1, "PUR", PFTYPE[INDX1]);
END
END
END
CPYRET;
END
END # CPYMDIDUMP #
CONTROL EJECT;
PROC CPYMDIDMPS;
#
* THIS PROC VISITS EVERY FILE NAME IN PFLIST ONCE. IF A FILE NAME
* STARTS WITH SOMETHING IN THE RANGE DI..D9, IT WILL CALL CPYMDIDUMP
* TO COLLECT (AND/OR PURGE) THE FILE.
#
BEGIN
ITEM DI C(10) = "DI";
ITEM D9 C(10) = "D9";
FOR INDX1 = 0 STEP 1 WHILE INDX1 LS NDXPF DO
BEGIN
IF ( B<0,12>PFLIST[INDX1] GQ B<0,12>DI ) AND
( B<0,12>PFLIST[INDX1] LQ B<0,12>D9 )
THEN
CPYMDIDUMP;
END
END # CPYMDIDMPS #
*ENDIF
CONTROL EJECT;
# PROC COLLECT #
# (MAIN PROCESS) #
*IF DEF,CDCNET
NETCDA ($DEFAULT,$CURRENT); #USE NETDIR IN THE CURRENT USER #
*ENDIF
SETUP$CLCT;
PFN2 = "DUMPVVV";
C<4,3>PFN2 = C<4,3>NETINV;
UN2 = USERNUM;
UN1 = USERNUM;
STRIP55(UN1);
STRIP55(UN2);
STRIP55(PFN2);
IF FL2SAVE THEN
BEGIN
CPYOPN; # OPEN DUMPXXX FILE - ALL BUT NP/MDI FILES #
SHOW$STAT (PFN2, "OPN", DIR);
C<0,4>PFN2 = "DUNP";
CPYOPN; # OPEN DUNPXXX FILE - NP DUMP FILES #
SHOW$STAT (PFN2, "OPN", DIR);
*IF DEF,CDCNET
C<0,4>PFN2 = "DMDI";
CPYOPN; # OPEN DMDIXXX FILE - MDI DUMP FILES #
SHOW$STAT (PFN2, "OPN", DIR);
*ENDIF
C<0,4>PFN2 = "DUMP";
END
FOR TCSTAT = 0 WHILE TCSTAT NQ STATEOI DO
BEGIN
NDXPF = 0;
MORE$2$DO = TRUE;
CAT$LIST;
COPY$FILES;
*IF DEF,CDCNET
CPYMDIDMPS;
*ENDIF
END
C<0,4>PFN2 = "DUMP";
IF FL2SAVE THEN CPYSAV;
C<0,4>PFN2 = "DUNP";
IF FL2SAVE THEN CPYSAV;
*IF DEF,CDCNET
C<0,4>PFN2 = "DMDI";
IF FL2SAVE THEN CPYSAV;
*ENDIF
SIERRA;
NR2 = SIECPUS * 1000.0;
NR2 = NR2 + SIECPUMS;
NR2 = NR2 - NR1;
J2 = NR2;
EDITX = XCFD(J2);
OPMSG[0] = " CPU MS REQD ";
OPMSG1[2] = EDITX;
OPMSGZB[3] = 0;
SENDMSG;
SHOTERM (LOC(OPMSG[0]), 3, TRUE);
OFLUSH;
FINSHIO;
END #COLLECT#
TERM
*CWEOR,0