PRGM SSUSE;
# TITLE SSUSE - INITIALIZES *SSUSE*. #
BEGIN # SSUSE #
#
*** SSUSE - INITIALIZES *SSUSE*.
*
* THIS PRGM DOES THE INITIALIZATION FOR THE *SSUSE*
* UTILITY BY PROCESSING THE CONTROL CARD AND SETTING
* UP POINTERS AND DEFAULT VALUES.
*
* SSUSE,OP,FM,SM,SB,CN,CM,L.
*
* PRGM SSUSE.
*
* ENTRY. INPUTS TO SSUSE ARE-
* OP SELECTS BASIC USAGE REPORT.
* OP=A OPTIONAL REPORT A AND THE BASIC REPORT.
* OP=B OPTIONAL REPORT B AND THE BASIC REPORT.
* OP=C OPTIONAL REPORT C AND THE BASIC REPORT.
* OP=D OPTIONAL REPORT D AND THE BASIC REPORT.
* OP=ABCD OPTIONAL REPORTS A, B, C, AND D AND ANY
* COMBINATION OF A, B, C, AND D MAY
* BE USED.
* OP OMITTED SAME AS OP.
*
* FM USE DEFAULT FAMILY.
* FM=FAMILY THE SPECIFIED FAMILY WILL BE REPORTED.
* FM OMITTED SAME AS FM.
*
* SB ALL SUBFAMILIES ARE TO BE PROCESSED.
* SB=CHARS SELECT UP TO EIGHT SUBFAMILIES. THERE
* ARE EIGHT POSSIBLE SUBFAMILIES FROM 0
* TO 7 (E.G. SB=723 SELECTS SUBFAMILIES
* 2, 3, AND 7).
* SB OMITTED SAME AS SB.
*
* SM SM A WILL BE REPORTED.
* SM=CHARS SELECT UP TO EIGHT SM-S, WHICH CAN
* BE ANY OF THE FOLLOWING (E.G. SM=AGC
* SELECTS SM A, C, AND G):
* A - SM A
* B - SM B
* C - SM C
* D - SM D
* E - SM E
* F - SM F
* G - SM G
* H - SM H
* SM OMITTED SAME AS SM.
*
* L LISTABLE OUTPUT ON FILE *OUTPUT*.
* L=LFN LISTABLE OUTPUT ON FILE *LFN*.
* L=0 NO OUTPUT FILE GENERATED.
* L OMITTED SAME AS L.
*
* CN NOT PERMITTED.
* CN=CSN THE SELECTED CSN WILL BE REPORTED IN
* REPORT D.
* CN OMITTED NOT PERMITTED.
*
* CM MANUFACTURER OF CARTRIDGE *CN*. DEFAULT
* MANUFACTURER IS USED.
* CM=A MANUFACTURER *A-* IS USED, (A- = IBM).
* CM OMITTED SAME AS *CM*.
*
* EXIT. *SSUSE* PROCESSING COMPLETE OR AN ERROR
* CONDITION ENCOUNTERED.
*
* MESSAGES. 1. SSUSE COMPLETE.
* 2. SSUSE - ARGUMENT ERROR.
* 3. SSUSE - MUST BE SYSTEM ORIGIN.
*
* NOTES. PRGM *SSUSE* INITIALIZES *SSUSE*. A PARAMETER
* TABLE IS SET UP BEFORE ANY PROCESSING IS DONE.
* *SSUSE* THEN PROCESSES THE CONTROL CARD, WHERE THE
* PROCESSED PARAMETERS ARE RETURNED IN THE COMMON
* AREA *TUSPCOM*. ANY SYNTAX ERROR IN THE CONTROL
* CARD CAUSES *SSUSE* TO ABORT. AFTER THE PARAMETERS
* ARE PROCESSED AND SYNTAX CHECKED, THEY ARE THEN
* CHECKED BY *USOPT* TO SEE IF THE OPTIONS SPECIFIED
* ARE VALID. *USOPT* ABORTS WITH A DESCRIPTIVE
* ERROR MESSAGE WHENEVER IT ENCOUNTERS AN
* ERROR CONDITION. PROC *USRPBAS* IS CALLED TO
* GENERATE THE BASIC AND OPTIONAL REPORTS. AN
* *SSUSE COMPLETE* MESSAGE IS ISSUED TO THE DAYFILE
* IF ALL REPORTS HAVE BEEN GENERATED SUCCESSFULLY.
* COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
#
#
**** PROC SSUSE - XREF LIST BEGIN.
#
XREF
BEGIN
PROC ABORT; # CALLS *ABORT* MACRO #
PROC GETFAM; # GETS DEFAULT FAMILY #
PROC GETPFP; # GET USER INDEX AND FAMILY #
PROC GETSPS; # GET SYSTEM ORIGIN STATUS #
PROC MESSAGE; # DISPLAYS MESSAGE IN DAYFILE #
PROC RESTPFP; # RESTORE USER-S *PFP* AND ABORT
OR RETURN #
PROC SSINIT; # SETS UP TABLES AND POINTERS #
PROC USOPT; # CHECKS FOR VALID OPTIONS #
PROC USRPBAS; # GENERATES BASIC AND OPTIONAL
REPORTS #
PROC USTAB; # SETS UP PARAMETER TABLE #
PROC XARG; # CRACK PARAMETER LIST #
END
#
**** PROC SSUSE - XREF LIST END.
#
DEF RSLEN #1#; # RETURN STATUS WORD LENGTH #
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
CONTROL PRESET;
*CALL COMBFAS
*CALL COMBCMD
*CALL COMBMCT
*CALL COMBPFP
*CALL COMXMSC
*CALL COMSPFM
*CALL COMTFMT
*CALL COMTUSE
*CALL COMTUSP
ITEM ARGLIST U; # ADDRESS OF ARGUMENT TABLE #
ITEM DEFAULT I; # DEFAULT FAMILY ORDINAL #
ITEM FAM$NUM I; # NUMBER OF FAMILIES #
ITEM FLAG I; # ERROR FLAG #
ITEM LINK I; # LINK FAMILY ORDINAL #
ITEM SSID I; # SUBSYSTEM ID #
ARRAY SPSSTAT [0:0] S(RSLEN);
BEGIN
ITEM SPS$STATUS U(00,48,12); # RETURN STATUS #
END
CONTROL EJECT;
#
* IF THE USER JOB HAS SYSTEM ORIGIN PRIVILEGES THEN SAVE THE USER-S
* CURRENT FAMILY AND INDEX IN COMMON.
#
GETSPS(SPSSTAT); # GET SYSTEM ORIGIN STATUS #
IF SPS$STATUS NQ 0
THEN
BEGIN
SSMSG$LINE[0] = " SSUSE - MUST BE SYSTEM ORIGIN.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
ABORT;
END
GETPFP(PFP[0]);
USER$FAM[0] = PFP$FAM[0];
USER$UI[0] = PFP$UI[0];
#
* PROCESS THE PARAMETERS ON *SSUSE* CALL.
#
USTAB(ARGLIST); # SET UP THE ARGUMENT LIST #
XARG(ARGLIST,0,FLAG); # PROCESS THE CONTROL STATEMENT #
IF FLAG NQ 0
THEN # SYNTAX ERROR #
BEGIN
SSMSG$LINE[0] = " SSUSE - ARGUMENT ERROR.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
#
* CONVERT PARAMETERS AND CHECK FOR ALL THE VALID
* OPTIONS ON THE CONTROL CARD.
#
USOPT;
#
* IF *FM* IS NOT SPECIFIED, USE THE DEFAULT FAMILY.
#
SSID = ATAS;
GETFAM(FAMT[1],FAM$NUM,LINK,DEFAULT,SSID);
DEF$FAM = FAM$NAME[DEFAULT];
IF USARG$FM[0] EQ 0
THEN
BEGIN
USARG$FM[0] = DEF$FAM;
END
#
* INITIALIZE TABLES AND POINTERS NEEDED BY
* CATALOG/MAP ACCESS ROUTINES.
#
SSINIT;
#
* GENERATE THE BASIC AND OPTIONAL REPORTS REQUESTED BY
* THE CONTROL CARD PARAMETERS.
#
USRPBAS;
#
* DISPLAY *SSUSE COMPLETE* IN THE DAYFILE.
#
SSMSG$LINE[0] = " SSUSE COMPLETE.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RESTPFP(PFP$END); # RESTORE USER-S *PFP* #
END # SSUSE #
TERM
PROC USANALS((SUBFAM),(SMID));
# TITLE USANALS - ANALYZES SFMCATALOG ENTRIES FOR A SM. #
BEGIN # USANALS #
#
** USANALS - ANALYZES SFM CATALOG ENTRIES FOR A SM.
*
* THIS PROCEDURE ANALYZES THE *AST* AND *FCT* ENTRIES FOR A SM.
*
* PROC USANALS((SUBFAM),(SMID)).
*
* ENTRY (SUBFAM) = SUBFAMILY IDENTIFIER.
* (SMID) = SM IDENTIFIER.
*
* EXIT SUB-TOTALS COUNTERS ARE UPDATED IN THE COMMON
* AREA.
*
* MESSAGES 1. SFMCATALOG PARITY ERROR.
* 2. FAMILY NOT FOUND.
* 3. SMMAP PARITY ERROR.
* 4. UNABLE TO OPEN SMMAP.
* 5. SSUSE ABNORMAL, USANALS.
*
* NOTES PROC *USANALS* CALLS *CRDAST* TO GET THE *AST* FOR THE
* SPECIFIED SM. IT THEN CALLS *CGETFCT* TO GET AN *FCT*
* ENTRY. THE VARIOUS FIELDS WITHIN EACH *AST* AND *FCT*
* ENTRY ARE CHECKED FOR CERTAIN CONDITIONS AND THE
* APPROPRIATE COUNTERS ARE UPDATED. THE SMMAP IS
* SEARCHED FOR EMPTY CUBICLES ASSIGNED TO THIS SUBFAMILY.
#
ITEM SUBFAM I; # SUBFAMILY IDENTIFIER #
ITEM SMID U; # SM IDENTIFIER #
#
**** PROC USANALS - XREF LIST BEGIN.
#
XREF
BEGIN
PROC CGETFCT; # GETS *FCT* ENTRY #
PROC CRDAST; # READS *AST* #
PROC LOFPROC; # LIST OF FILES PROCESSOR #
PROC MCLOSE; # CLOSE SMMAP #
PROC MESSAGE; # ISSUES MESSAGE IN DAYFILE #
PROC MGETENT; # GETS MAP ENTRY #
PROC MOPEN; # OPENS SMMAP #
PROC RESTPFP; # RESTORE USER-S *PFP* AND ABORT
OR RETURN #
PROC RPCLOSE; # CLOSES THE REPORT FILE #
PROC SETPFP; # SET FAMILY AND USER INDEX #
END
#
**** PROC USANALS - XREF LIST END.
#
DEF PROCNAME #"USANALS."#; # PROC NAME #
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBCMD
*CALL COMBCMS
*CALL,COMBMAP
*CALL,COMBPFP
*CALL,COMSPFM
*CALL COMBMCT
*CALL COMXMSC
*CALL COMTOUT
*CALL COMTUSE
*CALL COMTUSP
ITEM BADDR I; # *AST* BUFFER ADDRESS #
ITEM BFADDR I; # *FCT* BUFFER ADDRESS #
ITEM FLAG I; # ERROR FLAG #
ITEM GP I; # GROUP #
ITEM I I; # LOOP VARIABLE #
ITEM N I; # LOOP VARIABLE #
ITEM MAP$ORD I; # SMMAP ORDINAL #
ITEM SM$ADDR I; # ADDRESS OF SMMAP #
ITEM Y I; # Y COORDINATE #
ITEM Z I; # Z COORDINATE #
ARRAY SMMAP$NM [0:0] P(1); # ARRAY TO BUILD SMMAP #
BEGIN
ITEM SMAP$NAME C(00,00,07); # SMMAP FILE NAME #
ITEM SMAP$CHAR C(00,00,05); # FIRST FIVE CHARACTERS #
ITEM SMAP$SMID C(00,30,01); # SM-ID #
ITEM SMAP$Z U(00,36,24) = [0]; # ZERO FILL FILE NAME #
END
CONTROL EJECT;
#
* GET THE *AST* AND CHECK THE RETURNED ERROR STATUS.
#
BADDR = LOC(US$ASTENT[0]);
CRDAST(USARG$FM[0],SUBFAM,SMID,BADDR,0,FLAG);
IF FLAG NQ CMASTAT"NOERR"
THEN # UNABLE TO GET *AST* #
BEGIN
SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
#
* PROCESS ALL *AST* AND *FCT* ENTRIES.
#
SLOWFOR I = 16 STEP 1 UNTIL PRM$ENTRC[SMID] + 15
DO
BEGIN # PROCESS AN *AST* AND *FCT* ENTRY #
#
* GET AN *FCT* ENTRY AND CHECK THE RETURNED ERROR STATUS.
#
BFADDR = LOC(US$FCTENT[0]);
CGETFCT(USARG$FM[0],SUBFAM,SMID,I,BFADDR,0,FLAG);
IF FLAG NQ CMASTAT"NOERR"
THEN # UNABLE TO GET *FCT* #
BEGIN
SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
P<FCT> = BFADDR;
GP = I / MAXGRT; # SET GROUP INDEX #
#
* UPDATE CUBE COUNTER AND CHECK CUBE STATUS. IF NO CARTRIDGE
* ASSIGNED TO THIS CUBICLE, GET NEXT ENTRY.
#
IF FCT$CSND[0] EQ " "
OR FCT$CSNI[0] EQ 0
THEN # NO CARTRIDGE ASSIGNED TO CUBE #
BEGIN
TEST I;
END
GRP$LOC[GP] = GRP$LOC[GP] + 1;
GRP$RES[GP] = GRP$RES[GP] + 1; # NUM CARTRIDGES IN GROUP #
#
* UPDATE THE AVAILABLE AU FOR SMALL AND LARGE FILES.
#
GRP$AUSF[GP] = GRP$AUSF[GP] + AST$AUSF[I];
GRP$AULF[GP] = GRP$AULF[GP] + AST$AULF[I];
#
* CHECK FOR AVAILABLE OFF CARTRIDGE LINKS AND UPDATE THE COUNTER.
#
IF NOT AST$NOCLF[I]
THEN # OFF CARTRIDGE LINKS AVAILABLE #
BEGIN
GRP$OCL[GP] = GRP$OCL[GP] + 1;
END
#
* CHECK *FCT* FLAGS AND UPDATE THE APPROPRIATE COUNTERS.
#
IF FCT$IAF[0]
THEN # INHIBIT ALLOCATION #
BEGIN
GRP$INH[GP] = GRP$INH[GP] + 1;
END
IF FCT$LCF[0]
THEN # CARTRIDGE LOST #
BEGIN
GRP$LOST[GP] = GRP$LOST[GP] + 1;
END
IF FCT$EEF[0]
THEN # EXCESSIVE ERRORS #
BEGIN
GRP$XPE[GP] = GRP$XPE[GP] + 1;
END
IF FCT$SEF[0]
THEN # SMMAP ERROR #
BEGIN
GRP$SE[GP] = GRP$SE[GP] + 1;
END
IF FCT$FCF[0]
THEN # FREE CARTRIDGE #
BEGIN
GRP$FRC[GP] = GRP$FRC[GP] + 1;
END
#
* CHECK EACH AU FOR ERRORS AND AVAILABILITY. UPDATE THE
* APPROPRIATE COUNTERS.
#
SLOWFOR N = 1 STEP 1 UNTIL INAVOT
DO
BEGIN # FOR EACH AU #
#
* CHECK AU FLAGS, UPDATE COUNTERS IF NECESSARY.
#
SETFCTX(N); # SET *FWD* AND *FPS* VALUES #
IF FCT$AUCF(FWD,FPS) NQ 0
THEN # AU CONFLICT #
BEGIN
GRP$AUC[GP] = GRP$AUC[GP] + 1;
END
IF FCT$FRCF(FWD,FPS) NQ 0
THEN # FROZEN CHAIN #
BEGIN
GRP$FC[GP] = GRP$FC[GP] + 1;
END
IF FCT$SFF(FWD,FPS) NQ 0
THEN # START OF FRAGMENT #
BEGIN
GRP$SF[GP] = GRP$SF[GP] + 1;
END
IF FCT$FAUF(FWD,FPS) NQ 0
THEN # FLAWED AU #
BEGIN
IF FCT$FBF(FWD,FPS) NQ 0
THEN # FLAWED AND ALLOCATED #
BEGIN
GRP$FB[GP] = GRP$FB[GP] + 1;
END
ELSE # FLAWED AND UNALLOCATED #
BEGIN
GRP$FA[GP] = GRP$FA[GP] +1;
END
END
END # FOR EACH AU #
END # PROCESS AN *AST* AND AN *FCT* ENTRY #
#
* SEARCH THE SMMAP FOR ANY EMPTY CUBICLES ASSIGNED
* TO THIS SUBFAMILY.
#
PFP$WRD0[0] = 0;
PFP$FAM[0] = DEF$FAM;
PFP$UI[0] = DEF$UI;
PFP$FG1[0] = TRUE;
PFP$FG4[0] = TRUE;
SETPFP(PFP[0]);
IF PFP$STAT NQ 0
THEN # FAMILY NOT FOUND #
BEGIN
SSMSG$LINE[0] = " FAMILY NOT FOUND.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
SMAP$SMID[0] = SMID;
SMAP$CHAR[0] = SMMAP;
#
* OPEN THE SMMAP AND CHECK THE RETURNED ERROR STATUS.
#
MOPEN(SMID,SMAP$NAME[0],"RM",FLAG);
IF FLAG EQ CMASTAT"NOERR"
THEN
BEGIN
LOFPROC(SMAP$NAME[0]); # ADD LFN TO LIST OF FILES #
END
SM$ADDR = LOC(MAPBUFR[0]);
P<SMUMAP> = SM$ADDR;
IF FLAG NQ CMASTAT"NOERR"
THEN
BEGIN # SMMAP NOT OPENED SUCCESSFULLY #
IF FLAG EQ CMASTAT"CIOERR"
THEN
BEGIN
SSMSG$LINE[0] = " SMMAP PARITY ERROR.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
IF FLAG EQ CMASTAT"INTLK" ##
OR FLAG EQ CMASTAT"ATTERR"
THEN
BEGIN
SSMSG$LINE[0] = " UNABLE TO OPEN SMMAP.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
ELSE
BEGIN
SSMSG$PROC[0] = PROCNAME;
MESSAGE(SSMSG[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
END # SMMAP NOT OPENED SUCCESSFULLY #
#
* PROCESS EACH Y,Z PAIR.
#
SLOWFOR Y = 0 STEP 1 UNTIL MAX$Y
DO
BEGIN # PROCESS EACH Y COORDINATE #
SLOWFOR Z = 0 STEP 1 UNTIL MAX$Z
DO
BEGIN # PROCESS EACH Z COORDINATE #
#
* DO NOT PROCESS THE COORDINATES CONTAINING THE DRD-S
* OR THE ENTRY-EXIT TRAY.
#
IF (Z LQ 1 ##
AND (Y LQ 15 AND Y GQ 11)) ##
OR Z EQ Z$NO$CUBE
THEN
BEGIN
TEST Z;
END
#
* CALCULATE THE ORDINAL OF THE SMMAP ENTRY.
#
MAP$ORD = MAXORD - Z - (Y * 16);
#
* GET THE SMMAP ENTRY AND CHECK THE RETURNED ERROR STATUS.
#
MGETENT(SMID,MAP$ORD,SM$ADDR,FLAG);
IF FLAG NQ CMASTAT"NOERR"
THEN
BEGIN # CHECK FOR TYPE OF ERROR #
IF FLAG EQ CMASTAT"CIOERR"
THEN
BEGIN
SSMSG$LINE[0] = " SMMAP PARITY ERROR.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
ELSE
BEGIN
SSMSG$PROC[0] = PROCNAME;
MESSAGE(SSMSG[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
END # CHECK FOR TYPE OF ERROR #
#
* SEARCH FOR EMPTY CUBICLES ASSIGNED TO THIS SUBFAMILY.
#
IF CM$CODE[0] NQ CUBSTAT"SUBFAM"
THEN # NOT IN ANY SUBFAMILY #
BEGIN
TEST Z;
END
IF CM$FMLYNM[0] EQ USARG$FM[0] ##
AND CM$SUB[0] EQ SUBFAM ##
AND CM$FCTORD[0] EQ 0
THEN # FOUND EMPTY CUBICLE #
BEGIN
GRP$LOC[0] = GRP$LOC[0] + 1;
END
END # PROCESS EACH Z COORDINATE #
END # PROCESS EACH Y COORDINATE #
#
* CLOSE THE SMMAP.
#
MCLOSE(SMID,FLAG);
IF FLAG NQ CMASTAT"NOERR"
THEN
BEGIN
SSMSG$PROC[0] = PROCNAME;
MESSAGE(SSMSG[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT);
END
END # USANALS #
TERM
PROC USBASLN((SUBFAM),(SM));
# TITLE USBASLN - PRINTS DETAIL LINES FOR THE BASIC REPORT. #
BEGIN # USBASLN #
#
** USBASLN - PRINTS DETAIL LINES FOR THE BASIC REPORT.
*
* THIS PROCEDURE PRINTS OUT THE BASIC USAGE REPORT INFORMATION
* TO THE REPORT FILE.
*
* PROC USBASLN((SUBFAM),(SM)).
*
* ENTRY. (SUBFAM) = SUBFAMILY IDENTIFIER.
* (SM) = SM IDENTIFIER.
*
* EXIT BASIC REPORT LINES HAVE BEEN WRITTEN TO
* THE REPORT FILE.
*
* NOTES PROC *USBASLN* CALLS *XCDD* TO CONVERT THE
* GROUP TOTALS IN THE *GRP$TOT* ARRAY FROM INTEGER
* TO DISPLAY CODE. THESE VALUES ARE THEN DISPLAYED
* IN THE REPORT FILE. TOTALS ARE ACCUMULATED FOR
* THE SM AND SUBFAMILY.
#
#
**** PROC USBASLN - XREF LIST BEGIN.
#
XREF
BEGIN
PROC BZFILL; # BLANK FILL CHARACTERS #
PROC RPEJECT; # PAGE EJECTS FOR REPORT FILE #
PROC RPLINE; # WRITES A LINE TO REPORT FILE #
PROC RPSPACE; # PUT BLANK LINE ON REPORT FILE #
FUNC XCDD C(10); # CONVERTS INTEGERS TO DISPLAY #
END
#
**** PROC USBASLN - XREF LIST END.
#
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBBZF
*CALL COMBMCT
*CALL COMXMSC
*CALL COMTOUT
*CALL COMTUSE
*CALL COMTUSP
ITEM GP I; # LOOP VARIABLE #
ITEM LN$CNT I; # LINE COUNT #
ITEM SM I; # SM IDENTIFIER #
ITEM SUBFAM I; # SUBFAMILY IDENTIFIER #
ITEM TEMP$FAM C(7); # HOLDS FAMILY NAME #
ITEM TEMP$SM C(1); # SM CHARACTER #
ITEM TOT I; # ARRAY INDEX FOR TOTALS #
CONTROL EJECT;
TEMP$FAM = USARG$FM[0];
BZFILL(TEMP$FAM,TYPFILL"BFILL",7);
TEMP$SM = SM;
#
* WRITE HEADER TO REPORT FILE IF NEW PAGE.
#
IF (LN$CNT / MAX$LN) * MAX$LN EQ LN$CNT
THEN # PAGE EJECT AND PRINT HEADER #
BEGIN
RPEJECT(OUT$FETP);
RPLINE(OUT$FETP,"SSUSE BASIC REPORT",5,18,1);
RPLINE(OUT$FETP,"FAMILY = ",35,9,1);
RPLINE(OUT$FETP,TEMP$FAM,44,7,0);
#
* WRITE NOTES TO REPORT FILE.
#
RPSPACE(OUT$FETP,SP"SPACE",1);
RPLINE(OUT$FETP,"CUBE = CUBICLES",5,15,1);
RPLINE(OUT$FETP,"CARTRIDGE FLAGS",36,15,1);
RPLINE(OUT$FETP,"AU FLAGS",86,8,0);
RPLINE(OUT$FETP,"CART = CARTRIDGES",5,17,1);
RPLINE(OUT$FETP,"M = MISSING",37,11,1);
RPLINE(OUT$FETP,"FA = FLAWED AND ALLOCATED",87,25,0);
RPLINE(OUT$FETP,"I = INHIBIT ALLOCATION",37,22,1);
RPLINE(OUT$FETP,"FU = FLAWED AND UNALLOCATED",87,27,0);
RPLINE(OUT$FETP,"** = SUBFAMILY TOTAL",5,20,1);
RPLINE(OUT$FETP,"F = FREE CARTRIDGE",37,18,1);
RPLINE(OUT$FETP,"SF = START OF FRAGMENT",87,22,0);
RPLINE(OUT$FETP,"- = UNASSIGNED GROUP",5,21,1);
RPLINE(OUT$FETP,"L = OFF CARTRIDGE LINKS AVAILABLE",37,33,1);
RPLINE(OUT$FETP,"FC = FROZEN CHAIN",87,17,0);
RPLINE(OUT$FETP,"P = EXCESSIVE PARITY ERRORS",37,27,1);
RPLINE(OUT$FETP,"AC = AU CONFLICT",87,16,0);
RPLINE(OUT$FETP,"E = MAP ERROR(AS DETECTED BY SSVAL)",37,36,0);
RPSPACE(OUT$FETP,SP"SPACE",1);
#
* WRITE COLUMN HEADINGS TO REPORT FILE.
#
RPLINE(OUT$FETP,"----AVAILABLE----",24,17,1);
RPLINE(OUT$FETP,"-----NUMBER CARTRIDGES FLAGGED----",43,34,1);
RPLINE(OUT$FETP,"-------------NUMBER AU FLAGGED",81,30,1);
RPLINE(OUT$FETP,"-------------",111,13,0);
RPLINE(OUT$FETP,"SUB SM GR",1,9,1);
RPLINE(OUT$FETP,"CUBE CART",12,10,1);
RPLINE(OUT$FETP,"AU AU",26,12,1);
RPLINE(OUT$FETP,"M I F L P E",46,31,1);
RPLINE(OUT$FETP,"FA FU",86,11,1);
RPLINE(OUT$FETP,"SF FC AC",104,20,0);
RPLINE(OUT$FETP,"(SMALL) (LARGE)",24,17,0);
RPSPACE(OUT$FETP,SP"SPACE",1);
LN$CNT = 16;
END
#
* SET INDEX TO ACCUMULATE TOTALS.
#
TOT = MAXGP + 1;
#
* CONVERT THE TOTALS FOR EACH GROUP TO DISPLAY CODE AND WRITE
* THEM TO THE REPORT FILE. THE FIRST TIME THROUGH (GP = 0)
* THE NUMBER OF EMPTY CUBICLES ASSIGNED TO THIS SUBFAMILY WILL
* BE PRINTED. THE LAST TIME THROUGH (GP = MAXGP + 1) THE SM
* TOTALS WILL BE PRINTED.
#
SLOWFOR GP = 0 STEP 1 UNTIL MAXGP + 1
DO
BEGIN # FOR EACH GROUP #
#
* WRITE GROUP SUBTOTALS TO REPORT FILE. IF NO CUBICLES ARE
* ASSIGNED TO THIS GROUP, PROCESS THE NEXT GROUP.
#
IF GP EQ MAXGP + 1
THEN # PRINT TOTAL FOR ALL GROUPS #
BEGIN
CHAR$10[0] = XCDD(SUBFAM);
RPLINE(OUT$FETP,CHAR$R1[0],2,1,1);
RPLINE(OUT$FETP,TEMP$SM,5,1,1);
RPLINE(OUT$FETP,"**",8,2,1);
END
ELSE # PRINT ONE GROUP AT A TIME #
BEGIN
IF GRP$LOC[GP] EQ 0
THEN # NO CUBICLES IN THIS GROUP #
BEGIN
TEST GP;
END
CHAR$10[0] = XCDD(SUBFAM);
RPLINE(OUT$FETP,CHAR$R1[0],2,1,1);
RPLINE(OUT$FETP,TEMP$SM,5,1,1);
IF GP EQ 0
THEN
BEGIN
RPLINE(OUT$FETP,"-",9,1,1);
END
ELSE
BEGIN
CHAR$10[0] = XCDD(GP);
RPLINE(OUT$FETP,CHAR$R2[0],8,2,1);
END
END
#
* LIST THE NUMBER OF CUBICLES ASSIGNED TO A GROUP.
#
CHAR$10[0] = XCDD(GRP$LOC[GP]);
RPLINE(OUT$FETP,CHAR$R4[0],12,4,1);
#
* LIST THE NUMBER OF CARTRIDGES IN A GROUP.
#
CHAR$10[0] = XCDD(GRP$RES[GP]);
RPLINE(OUT$FETP,CHAR$R4[0],18,4,1);
#
* LIST THE NUMBER OF AVAILABLE AU FOR SMALL AND LARGE FILES.
#
CHAR$10[0] = XCDD(GRP$AUSF[GP]);
RPLINE(OUT$FETP,CHAR$R7[0],24,7,1);
CHAR$10[0] = XCDD(GRP$AULF[GP]);
RPLINE(OUT$FETP,CHAR$R7[0],34,7,1);
#
* LIST THE NUMBER OF LOST CARTRIDGES.
#
CHAR$10[0] = XCDD(GRP$LOST[GP]);
RPLINE(OUT$FETP,CHAR$R4[0],43,4,1);
#
* LIST THE NUMBER OF CARTRIDGES WITH THE INHIBIT FLAG SET.
#
CHAR$10[0] = XCDD(GRP$INH[GP]);
RPLINE(OUT$FETP,CHAR$R4[0],49,4,1);
#
* LIST THE NUMBER OF CARTRIDGES WITH FREE CARTRIDGE FLAG SET.
#
CHAR$10[0] = XCDD(GRP$FRC[GP]);
RPLINE(OUT$FETP,CHAR$R4[0],55,4,1);
#
* LIST THE NUMBER OF CARTRIDGES WITH AVAILABLE OFF-CARTRIDGE LINKS.
#
CHAR$10[0] = XCDD(GRP$OCL[GP]);
RPLINE(OUT$FETP,CHAR$R4[0],61,4,1);
#
* LIST THE NUMBER OF CARTRIDGES WITH EXCESSIVE PARITY ERRORS.
#
CHAR$10[0] = XCDD(GRP$XPE[GP]);
RPLINE(OUT$FETP,CHAR$R4[0],67,4,1);
CHAR$10[0] = XCDD(GRP$SE[GP]);
RPLINE(OUT$FETP,CHAR$R4[0],73,4,1);
#
* LIST THE NUMBER OF FLAWED AND ALLOCATED AU.
#
CHAR$10[0] = XCDD(GRP$FB[GP]);
RPLINE(OUT$FETP,CHAR$R7[0],81,7,1);
#
* LIST THE NUMBER OF FLAWED AND UNALLOCATED AU.
#
CHAR$10[0] = XCDD(GRP$FA[GP]);
RPLINE(OUT$FETP,CHAR$R7[0],90,7,1);
#
* LIST THE NUMBER OF START OF FRAGMENT AU.
#
CHAR$10[0] = XCDD(GRP$SF[GP]);
RPLINE(OUT$FETP,CHAR$R7[0],99,7,1);
#
* LIST THE NUMBER OF FROZEN CHAIN AU.
#
CHAR$10[0] = XCDD(GRP$FC[GP]);
RPLINE(OUT$FETP,CHAR$R7[0],108,7,1);
#
* LIST THE NUMBER OF AU WITH ALLOCATION CONFLICT.
#
CHAR$10[0] = XCDD(GRP$AUC[GP]);
RPLINE(OUT$FETP,CHAR$R7[0],117,7,0);
LN$CNT = LN$CNT + 1;
#
* DO NOT ACCUMULATE TOTALS THE LAST TIME THROUGH.
#
IF GP EQ MAXGP + 1
THEN # DO NOT ADD TO TOTALS #
BEGIN
RPSPACE(OUT$FETP,SP"SPACE",1);
LN$CNT = LN$CNT + 1;
TEST GP;
END
#
* TOTALS FOR ALL GROUPS IN A SM PER SUBFAMILY ARE ACCUMULATED
* UNDER THE MAXGP+1 INDEX OF THE GROUP TOTALS ARRAY.
* *GRP$TOT[MAXGP+1]*.
#
GRP$AUC[TOT] = GRP$AUC[TOT] + GRP$AUC[GP];
GRP$AULF[TOT] = GRP$AULF[TOT] + GRP$AULF[GP];
GRP$AUSF[TOT] = GRP$AUSF[TOT] + GRP$AUSF[GP];
GRP$FA[TOT] = GRP$FA[TOT] + GRP$FA[GP];
GRP$FB[TOT] = GRP$FB[TOT] + GRP$FB[GP];
GRP$FC[TOT] = GRP$FC[TOT] + GRP$FC[GP];
GRP$FRC[TOT] = GRP$FRC[TOT] + GRP$FRC[GP];
GRP$INH[TOT] = GRP$INH[TOT] + GRP$INH[GP];
GRP$LOC[TOT] = GRP$LOC[TOT] + GRP$LOC[GP];
GRP$LOST[TOT] = GRP$LOST[TOT] + GRP$LOST[GP];
GRP$OCL[TOT] = GRP$OCL[TOT] + GRP$OCL[GP];
GRP$RES[TOT] = GRP$RES[TOT] + GRP$RES[GP];
GRP$SE[TOT] = GRP$SE[TOT] + GRP$SE[GP];
GRP$SF[TOT] = GRP$SF[TOT] + GRP$SF[GP];
GRP$XPE[TOT] = GRP$XPE[TOT] + GRP$XPE[GP];
END # FOR EACH GROUP #
#
* ACCUMULATE SM TOTALS.
#
SM$AUC[SM] = SM$AUC[SM] + GRP$AUC[TOT];
SM$AULF[SM] = SM$AULF[SM] + GRP$AULF[TOT];
SM$AUSF[SM] = SM$AUSF[SM] + GRP$AUSF[TOT];
SM$FA[SM] = SM$FA[SM] + GRP$FA[TOT];
SM$FB[SM] = SM$FB[SM] + GRP$FB[TOT];
SM$FC[SM] = SM$FC[SM] + GRP$FC[TOT];
SM$FRC[SM] = SM$FRC[SM] + GRP$FRC[TOT];
SM$INH[SM] = SM$INH[SM] + GRP$INH[TOT];
SM$LOC[SM] = SM$LOC[SM] + GRP$LOC[TOT];
SM$LOST[SM] = SM$LOST[SM] + GRP$LOST[TOT];
SM$OCL[SM] = SM$OCL[SM] + GRP$OCL[TOT];
SM$RES[SM] = SM$RES[SM] + GRP$RES[TOT];
SM$SE[SM] = SM$SE[SM] + GRP$SE[TOT];
SM$SF[SM] = SM$SF[SM] + GRP$SF[TOT];
SM$XPE[SM] = SM$XPE[SM] + GRP$XPE[TOT];
#
* ACCUMULATE SUBFAMILY TOTALS.
#
SF$AUC[SUBFAM] = SF$AUC[SUBFAM] + GRP$AUC[TOT];
SF$AULF[SUBFAM] = SF$AULF[SUBFAM] + GRP$AULF[TOT];
SF$AUSF[SUBFAM] = SF$AUSF[SUBFAM] + GRP$AUSF[TOT];
SF$FA[SUBFAM] = SF$FA[SUBFAM] + GRP$FA[TOT];
SF$FB[SUBFAM] = SF$FB[SUBFAM] + GRP$FB[TOT];
SF$FC[SUBFAM] = SF$FC[SUBFAM] + GRP$FC[TOT];
SF$FRC[SUBFAM] = SF$FRC[SUBFAM] + GRP$FRC[TOT];
SF$INH[SUBFAM] = SF$INH[SUBFAM] + GRP$INH[TOT];
SF$LOC[SUBFAM] = SF$LOC[SUBFAM] + GRP$LOC[TOT];
SF$LOST[SUBFAM] = SF$LOST[SUBFAM] + GRP$LOST[TOT];
SF$OCL[SUBFAM] = SF$OCL[SUBFAM] + GRP$OCL[TOT];
SF$RES[SUBFAM] = SF$RES[SUBFAM] + GRP$RES[TOT];
SF$SE[SUBFAM] = SF$SE[SUBFAM] + GRP$SE[TOT];
SF$SF[SUBFAM] = SF$SF[SUBFAM] + GRP$SF[TOT];
SF$XPE[SUBFAM] = SF$XPE[SUBFAM] + GRP$XPE[TOT];
RETURN;
END # USBASLN #
TERM
PROC USBASTOT;
# TITLE USBASTOT - WRITES SM AND SUBFAMILY TOTALS TO THE REPORT FILE. #
BEGIN # USBASTOT #
#
** USBASTOT - WRITES SM AND SUBFAMILY TOTALS TO THE REPORT FILE.
*
* PROC USBASTOT.
*
* ENTRY. (SEL$SB) = BITS SET FOR THE SELECTED SUBFAMILIES.
* (SEL$SM) = BITS SET FOR THE SELECTED SM-S.
*
* EXIT. TOTALS HAVE BEEN WRITTEN TO REPORT FILE.
*
* NOTES. PROC *USBASTOT* CALLS *XCDD* TO CONVERT THE VARIOUS
* FIELDS IN THE *SM$TOT* AND *SF$TOT* ARRAYS FROM
* INTEGER TO DISPLAY CODE. THE CONVERTED VALUES ARE
* WRITTEN TO THE REPORT FILE.
#
#
**** PROC USBASTOT - XREF LIST BEGIN.
#
XREF
BEGIN
PROC BZFILL; # BLANK FILL CHARACTERS #
PROC RPEJECT; # PAGE EJECTS FOR REPORT FILE #
PROC RPLINE; # WRITES A LINE TO REPORT FILE #
PROC RPSPACE; # PUTS BLANK LINE ON REPORT FILE #
FUNC XCDD C(10); # CONVERTS INTEGER TO DISPLAY #
END
#
**** PROC USBASTOT - XREF LIST END.
#
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBBZF
*CALL COMBMCT
*CALL COMXMSC
*CALL COMTOUT
*CALL COMTUSE
*CALL COMTUSP
ITEM SM I; # SM IDENTIFIER #
ITEM SUBFAM I; # SUBFAMILY IDENTIFIER #
ITEM TEMP$FAM C(7); # FAMILY CHARACTER #
ITEM TEMP$SM C(1); # SM CHARACTER #
CONTROL EJECT;
TEMP$FAM = USARG$FM[0];
BZFILL(TEMP$FAM,TYPFILL"BFILL",7);
#
* WRITE COLUMN HEADINGS TO REPORT FILE.
#
RPEJECT(OUT$FETP);
RPLINE(OUT$FETP,"SSUSE BASIC REPORT",5,18,1);
RPLINE(OUT$FETP,"SM AND SUBFAMILY TOTALS",27,23,1);
RPLINE(OUT$FETP,"FAMILY = ",54,9,1);
RPLINE(OUT$FETP,TEMP$FAM,63,7,0);
RPSPACE(OUT$FETP,SP"SPACE",1);
RPLINE(OUT$FETP,"----AVAILABLE----",24,17,1);
RPLINE(OUT$FETP,"-----NUMBER CARTRIDGES FLAGGED----",43,34,1);
RPLINE(OUT$FETP,"-------------NUMBER AU FLAGGED",81,30,1);
RPLINE(OUT$FETP,"-------------",111,13,0);
RPLINE(OUT$FETP,"SUB SM GR",1,9,1);
RPLINE(OUT$FETP,"CUBE CART",12,10,1);
RPLINE(OUT$FETP,"AU AU",26,12,1);
RPLINE(OUT$FETP,"M I F L P E",46,31,1);
RPLINE(OUT$FETP,"FA FU",86,11,1);
RPLINE(OUT$FETP,"SF FC AC",104,20,0);
RPLINE(OUT$FETP,"(SMALL) (LARGE)",24,17,0);
RPSPACE(OUT$FETP,SP"SPACE",1);
RPLINE(OUT$FETP,"SM TOTALS FOR SPECIFIED SUBFAMILIES",1,35,0);
#
* WRITE SM TOTALS TO REPORT FILE.
#
SLOWFOR SM = 1 STEP 1 UNTIL MAXSM
DO
BEGIN # FOR EACH SM #
IF B<SM,1>SEL$SM EQ 0
THEN
BEGIN
TEST SM;
END
TEMP$SM = SM;
#
* CONVERT VALUES TO DISPLAY CODE AND PRINT THEM.
#
RPSPACE(OUT$FETP,SP"SPACE",1);
RPLINE(OUT$FETP,"**",2,2,1);
RPLINE(OUT$FETP,TEMP$SM,5,1,1);
RPLINE(OUT$FETP,"**",8,2,1);
CHAR$10[0] = XCDD(SM$LOC[SM]);
RPLINE(OUT$FETP,CHAR$R4[0],12,4,1);
CHAR$10[0] = XCDD(SM$RES[SM]);
RPLINE(OUT$FETP,CHAR$R4[0],18,4,1);
CHAR$10[0] = XCDD(SM$AUSF[SM]);
RPLINE(OUT$FETP,CHAR$R7[0],24,7,1);
CHAR$10[0] = XCDD(SM$AULF[SM]);
RPLINE(OUT$FETP,CHAR$R7[0],34,7,1);
CHAR$10[0] = XCDD(SM$LOST[SM]);
RPLINE(OUT$FETP,CHAR$R4[0],43,4,1);
CHAR$10[0] = XCDD(SM$INH[SM]);
RPLINE(OUT$FETP,CHAR$R4[0],49,4,1);
CHAR$10[0] = XCDD(SM$FRC[SM]);
RPLINE(OUT$FETP,CHAR$R4[0],55,4,1);
CHAR$10[0] = XCDD(SM$OCL[SM]);
RPLINE(OUT$FETP,CHAR$R4[0],61,4,1);
CHAR$10[0] = XCDD(SM$XPE[SM]);
RPLINE(OUT$FETP,CHAR$R4[0],67,4,1);
CHAR$10[0] = XCDD(SM$SE[SM]);
RPLINE(OUT$FETP,CHAR$R4[0],73,4,1);
CHAR$10[0] = XCDD(SM$FB[SM]);
RPLINE(OUT$FETP,CHAR$R7[0],81,7,1);
CHAR$10[0] = XCDD(SM$FA[SM]);
RPLINE(OUT$FETP,CHAR$R7[0],90,7,1);
CHAR$10[0] = XCDD(SM$SF[SM]);
RPLINE(OUT$FETP,CHAR$R7[0],99,7,1);
CHAR$10[0] = XCDD(SM$FC[SM]);
RPLINE(OUT$FETP,CHAR$R7[0],108,7,1);
CHAR$10[0] = XCDD(SM$AUC[SM]);
RPLINE(OUT$FETP,CHAR$R7[0],117,7,0);
END # FOR EACH SM #
RPSPACE(OUT$FETP,SP"SPACE",2);
RPLINE(OUT$FETP,"SUBFAMILY TOTALS FOR SPECIFIED SM-S",1,35,0);
#
* WRITE SUBFAMILY TOTALS TO REPORT FILE.
#
SLOWFOR SUBFAM = 0 STEP 1 UNTIL MAXSF
DO
BEGIN # FOR EACH SUBFAMILY #
IF B<SUBFAM,1>SEL$SB EQ 0
THEN
BEGIN
TEST SUBFAM;
END
#
* CONVERT VALUES TO DISPLAY CODE AND PRINT THEM.
#
RPSPACE(OUT$FETP,SP"SPACE",1);
CHAR$10[0] = XCDD(SUBFAM);
RPLINE(OUT$FETP,CHAR$R1[0],2,1,1);
RPLINE(OUT$FETP,"**",5,2,1);
RPLINE(OUT$FETP,"**",8,2,1);
CHAR$10[0] = XCDD(SF$LOC[SUBFAM]);
RPLINE(OUT$FETP,CHAR$R4[0],12,4,1);
CHAR$10[0] = XCDD(SF$RES[SUBFAM]);
RPLINE(OUT$FETP,CHAR$R4[0],18,4,1);
CHAR$10[0] = XCDD(SF$AUSF[SUBFAM]);
RPLINE(OUT$FETP,CHAR$R7[0],24,7,1);
CHAR$10[0] = XCDD(SF$AULF[SUBFAM]);
RPLINE(OUT$FETP,CHAR$R7[0],34,7,1);
CHAR$10[0] = XCDD(SF$LOST[SUBFAM]);
RPLINE(OUT$FETP,CHAR$R4[0],43,4,1);
CHAR$10[0] = XCDD(SF$INH[SUBFAM]);
RPLINE(OUT$FETP,CHAR$R4[0],49,4,1);
CHAR$10[0] = XCDD(SF$FRC[SUBFAM]);
RPLINE(OUT$FETP,CHAR$R4[0],55,4,1);
CHAR$10[0] = XCDD(SF$OCL[SUBFAM]);
RPLINE(OUT$FETP,CHAR$R4[0],61,4,1);
CHAR$10[0] = XCDD(SF$XPE[SUBFAM]);
RPLINE(OUT$FETP,CHAR$R4[0],67,4,1);
CHAR$10[0] = XCDD(SF$SE[SUBFAM]);
RPLINE(OUT$FETP,CHAR$R4[0],73,4,1);
CHAR$10[0] = XCDD(SF$FB[SUBFAM]);
RPLINE(OUT$FETP,CHAR$R7[0],81,7,1);
CHAR$10[0] = XCDD(SF$FA[SUBFAM]);
RPLINE(OUT$FETP,CHAR$R7[0],90,7,1);
CHAR$10[0] = XCDD(SF$SF[SUBFAM]);
RPLINE(OUT$FETP,CHAR$R7[0],99,7,1);
CHAR$10[0] = XCDD(SF$FC[SUBFAM]);
RPLINE(OUT$FETP,CHAR$R7[0],108,7,1);
CHAR$10[0] = XCDD(SF$AUC[SUBFAM]);
RPLINE(OUT$FETP,CHAR$R7[0],117,7,0);
END # FOR EACH SUBFAMILY #
RETURN;
END # USBASTOT #
TERM
PROC USHEAD((FETP));
# TITLE USHEAD - WRITES HEADER ON OUTPUT FILE. #
BEGIN # USHEAD #
#
** USHEAD - WRITES HEADER LINE ON OUTPUT FILE.
*
* PROC USHEAD((FETP)).
*
* ENTRY (FETP) = AN ITEM CONTAINING THE FWA OF THE FET.
*
* EXIT HEADER IS WRITTEN ON THE OUTPUT FILE.
*
* NOTES THE REPORT FORMATTER IS USED TO
* PRINT THE HEADER LINES.
#
ITEM FETP I; # FWA OF THE FET #
#
**** PROC USHEAD - XREF LIST BEGIN.
#
XREF
BEGIN
PROC RPLINEX; # PRINTS A REPORT LINE #
END
#
**** PROC USHEAD - XREF LIST END.
#
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
*CALL COMBFAS
CONTROL EJECT;
#
* PRINT THE HEADER LINE.
#
RPLINEX(FETP,"SSUSE REPORT FILE",2,17,0);
RPLINEX(FETP," ",1,1,0); # WRITE A BLANK LINE #
RETURN;
END # USHEAD #
TERM
PROC USOPT;
# TITLE USOPT - CONVERTS PARAMETERS AND CHECKS FOR VALID OPTIONS. #
BEGIN # USOPT #
#
** USOPT - CONVERTS AND CHECKS PARAMETERS FOR ALL VALID OPTIONS.
*
* THIS PROC CHECKS PARAMETERS FOR LEGALITY. IF INVALID OPTIONS ARE
* FOUND IT ISSUES A DAYFILE MESSAGE AND THEN ABORTS.
*
* ENTRY PARAMETERS PROCESSED AND SET UP IN *TUSPCOM*.
*
* EXIT ALL OPTIONS HAVE BEEN VALIDATED, OR IF VALID
* OPTIONS HAVE BEEN MISUSED, THE PROC ISSUES A
* DAYFILE MESSAGE AND THEN ABORTS.
*
* MESSAGES 1) INCORRECT SM.
* 2) INCORRECT SUBFAMILY.
* 3) INCORRECT REPORT OPTION.
* 4) DUPLICATE SM.
* 5) DUPLICATE SUBFAMILY.
* 6) DUPLICATE OPTION.
* 7) CN NOT SPECIFIED.
*
* NOTES ALL PARAMETER OPTIONS ARE TESTED FOR INVALID OPTIONS.
* THE VALID OPTIONS ON *SSUSE* CALLS ARE
* 1. *OP* MUST EITHER CONTAIN ANY COMBINATION OF THE
* VALID CHARACTERS A, B, C, OR D, OR IT CAN BE
* OMITTED.
* 2. *SM* MUST BE A VALID SM NAME OR A VALID
* COMBINATION OF VALID SM NAMES, OR IT CAN BE
* OMITTED.
* 3. *SB* MUST BE FROM 0 TO 7 OR A VALID COMBINATION
* OF LEGAL SUBFAMILY NUMBERS, OR IT CAN BE OMITTED
* 4. *CN* MUST BE SPECIFIED IF REPORT D IS SELECTED.
* ANY VIOLATION OF THE VALID OPTIONS CAUSES A MESSAGE
* TO BE PRINTED IN THE DAYFILE AND CAUSES PROC
* *USOPT* TO ABORT.
#
#
**** PROC USOPT - XREF LIST BEGIN.
#
XREF
BEGIN
PROC BZFILL; # BLANK FILLS CHARACTERS #
PROC MESSAGE; # DISPLAYS MESSAGE IN DAYFILE #
PROC RESTPFP; # RESTORE USER-S *PFP* AND ABORT
OR RETURN #
END
#
**** PROC USOPT - XREF LIST END.
#
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL,COMBBZF
*CALL COMBMCT
*CALL COMXMSC
*CALL COMTUSE
*CALL COMTUSP
ITEM I I; # LOOP VARIABLE #
ITEM MORE B; # MORE SM-ID/SUBFAMILY INDICATOR #
ITEM SMARG C(10); # SM ARGUMENTS #
ITEM TEMPC C(1); # TEMPORARY CHARACTER #
CONTROL EJECT;
#
* CHECK ALL SPECIFIED VALUES OF *SM*.
#
MORE = TRUE;
SMARG = USARG$SM[0];
BZFILL(SMARG,TYPFILL"BFILL",10);
SLOWFOR I = 0 STEP 1 WHILE I LS MAXSM AND MORE
DO
BEGIN # CHECK SPECIFIED SM-ID-S #
TEMPC = C<I,1>SMARG;
IF TEMPC EQ " "
THEN # NO MORE SM-ID-S #
BEGIN
MORE = FALSE;
TEST I;
END
IF TEMPC GR "H" OR TEMPC LS "A"
THEN # INCORRECT SM #
BEGIN
SSMSG$LINE[0] = " INCORRECT SM.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
IF B<TEMPC,1>SEL$SM EQ 1
THEN # DUPLICATE SM #
BEGIN
SSMSG$LINE[0] = " DUPLICATE SM.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
B<TEMPC,1>SEL$SM = 1; # TURN SM BIT ON #
END # CHECK SPECIFIED SM-ID-S #
#
* CHECK ALL SPECIFIED VALUES OF *SB*.
#
MORE = TRUE;
SLOWFOR I = 0 STEP 1 WHILE I LQ MAXSF AND MORE
DO
BEGIN # CHECK SPECIFIED SUBFAMILIES #
TEMPC = C<I,1>USARG$SB[0];
IF TEMPC EQ 0
THEN # NO MORE SUBFAMILIES #
BEGIN
MORE = FALSE;
TEST I;
END
IF TEMPC LS "0" OR TEMPC GR "7"
THEN # INCORRECT SUBFAMILY #
BEGIN
SSMSG$LINE[0] = " INCORRECT SUBFAMILY.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
IF B<TEMPC - "0",1>SEL$SB EQ 1
THEN # DUPLICATE SUBFAMILY #
BEGIN
SSMSG$LINE[0] = " DUPLICATE SUBFAMILY.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
B<TEMPC - "0",1>SEL$SB = 1; # TURN SUBFAMILY BIT ON #
END # CHECK SPECIFIED SUBFAMILIES #
#
* CHECK THE VALUES OF *OP*.
#
REPORT$A = FALSE;
REPORT$B = FALSE;
REPORT$C = FALSE;
REPORT$D = FALSE;
SLOWFOR I = 0 STEP 1 UNTIL 9
DO
BEGIN # CHECK ALL VALUES OF *OP* #
TEMPC = C<I,1>USARG$OP[0];
IF TEMPC NQ 0
THEN
BEGIN # CHECK SPECIFIED *OP* #
IF TEMPC GR "D" OR TEMPC LS "A"
THEN
BEGIN
SSMSG$LINE[0] = " INCORRECT REPORT OPTION.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
ELSE
BEGIN # SET APPROPRIATE FLAG #
IF TEMPC EQ "A"
THEN # REPORT A SELECTED #
BEGIN
IF NOT REPORT$A
THEN # UNIQUE OPTION #
BEGIN
REPORT$A = TRUE;
TEST I;
END
ELSE # DUPLICATE OPTION #
BEGIN
SSMSG$LINE[0] = " DUPLICATE OPTION.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
END
IF TEMPC EQ "B"
THEN # REPORT B SELECTED #
BEGIN
IF NOT REPORT$B
THEN # UNIQUE OPTION #
BEGIN
REPORT$B = TRUE;
TEST I;
END
ELSE # DUPLICATE OPTION #
BEGIN
SSMSG$LINE[0] = " DUPLICATE OPTION.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
END
IF TEMPC EQ "C"
THEN # REPORT C SELECTED #
BEGIN
IF NOT REPORT$C
THEN # UNIQUE OPTION #
BEGIN
REPORT$C = TRUE;
TEST I;
END
ELSE # DUPLICATE OPTION #
BEGIN
SSMSG$LINE[0] = " DUPLICATE OPTION.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
END
IF TEMPC EQ "D"
THEN # REPORT D SELECTED #
BEGIN
IF NOT REPORT$D
THEN # UNIQUE OPTION #
BEGIN
REPORT$D = TRUE;
TEST I;
END
ELSE # DUPLICATE OPTION #
BEGIN
SSMSG$LINE[0] = " DUPLICATE OPTION.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
END
END # SET APPROPRIATE FLAG #
END # CHECK SPECIFIED *OP* #
END # CHECK ALL VALUES OF *OP* #
#
* CHECK THAT *CN* IS SPECIFIED IF REPORT D IS SELECTED.
#
IF REPORT$D
THEN
BEGIN # CHECK *CN* #
IF USARG$CN[0] EQ 0
THEN
BEGIN
SSMSG$LINE[0] = " CN NOT SPECIFIED.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
END # CHECK *CN* #
IF USARG$CM[0] NQ 0
THEN
BEGIN
C<1,1>USARG$CM[0] = "-";
END
RETURN;
END # USOPT #
TERM
PROC USRPBAS;
# TITLE USRPBAS - GENERATES BASIC AND SPECIFIED OPTIONAL REPORTS. #
BEGIN # USRPBAS #
#
** USRPBAS - GENERATES BASIC AND SPECIFIED OPTIONAL REPORTS.
*
* THIS PROCEDURE GENERATES THE BASIC REPORT AND ANY OPTIONAL
* REPORTS SELECTED FOR ALL THE SM-S AND SUBFAMILIES SPECIFIED.
*
* PROC USRPBAS.
*
* ENTRY PROCESSED AND SYNTAX-CHECKED PARAMETERS SET UP IN
* *TUSPCOM*.
* (USARG$FM) = FAMILY NAME.
* (SEL$SM) = BITS SET FOR THE SELECTED SM-S.
* (SEL$SB) = BITS SET FOR THE SELECTED SUBFAMILIES.
* (REPORT$A) = OPTIONAL REPORT SELECTION CODE,
* TRUE, REPORT A SELECTED,
* FALSE, REPORT A NOT SELECTED.
* (REPORT$B) = OPTIONAL REPORT SELECTION CODE,
* TRUE, REPORT B SELECTED,
* FALSE, REPORT B NOT SELECTED.
* (REPORT$C) = OPTIONAL REPORT SELECTION CODE,
* TRUE, REPORT C SELECTED,
* FALSE, REPORT C NOT SELECTED.
* (REPORT$D) = OPTIONAL REPORT SELECTION CODE,
* TRUE, REPORT D SELECTED,
* FALSE, REPORT D NOT SELECTED.
*
* EXIT ALL SPECIFIED REPORTS HAVE BEEN GENERATED.
*
* MESSAGES 1) FAMILY NOT FOUND.
* 2) UNABLE TO OPEN CATALOG.
* 3) SSUSE ABNORMAL, USRPBAS.
* 4) SFM CATALOG PARITY ERROR.
*
* NOTES *USRPBAS* GENERATES THE BASIC REPORT FOR ALL SM-S
* SPECIFIED FOR ALL OF THE SUBFAMILIES SPECIFIED IN
* THE BITS OF *SEL$SB*. IF ANY OPTIONAL REPORTS
* ARE DESIRED, *USRPBAS* CALLS THE APPROPRIATE ROUTINES
* TO GENERATE THOSE REPORTS.
#
#
**** PROC USRPBAS - XREF LIST BEGIN.
#
XREF
BEGIN
PROC BZFILL; # BLANK FILLS CHARACTERS #
PROC CCLOSE; # CLOSES THE CATALOG #
PROC COPEN; # OPENS THE CATALOG #
PROC LOFPROC; # LIST OF FILES PROCESSOR #
PROC MESSAGE; # DISPLAYS MESSAGE IN DAYFILE #
PROC RESTPFP; # RESTORE USER-S *PFP* AND ABORT
OR RETURN #
PROC RPCLOSE; # CLOSES THE REPORT FILE #
PROC RPEJECT; # PAGE EJECTS THE REPORT FILE #
PROC RPLINE; # WRITES LINE TO REPORT FILE #
PROC RPOPEN; # OPENS THE REPORT FILE #
PROC RPSPACE; # PUTS BLANK LINE ON REPORT FILE #
PROC SETPFP; # SET FAMILY AND USER INDEX #
PROC USANALS; # ANALYZE *FCT* ENTRIES FOR A SM #
PROC USBASLN; # PRINTS LINE ON BASIC REPORT #
PROC USBASTOT; # PRINTS TOTAL ON BASIC REPORT #
PROC USHEAD; # WRITES HEADER ON OUTPUT FILE #
PROC USRPTA; # GENERATES OPTIONAL REPORT A #
PROC USRPTB; # GENERATES OPTIONAL REPORT B #
PROC USRPTC; # GENERATES OPTIONAL REPORT C #
PROC USRPTD; # GENERATES OPTIONAL REPORT D #
PROC ZFILL; # ZERO FILL ARRAY #
FUNC XCDD C(10); # CONVERTS INTEGERS TO DISPLAY #
END
#
**** PROC USRPBAS - XREF LIST END.
#
DEF PROCNAME #"USRPBAS."#; # PROC NAME #
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBBZF
*CALL COMBCMD
*CALL COMBCMS
*CALL COMBMCT
*CALL COMBPFP
*CALL COMXMSC
*CALL COMSPFM
*CALL COMTOUT
*CALL COMTUSE
*CALL COMTUSP
ITEM EJEC$FLAG B; # FLAG TO TEST FOR EJECT #
ITEM FLAG I; # ERROR FLAG #
ITEM GROUP I; # LOOP VARIABLE #
ITEM SM I; # LOOP VARIABLE #
ITEM SUBFAM I; # LOOP VARIABLE #
ITEM TEMP$FAM C(7); # HOLDS FAMILY NAME #
ITEM TEMP$SM C(1); # SM CHARACTER #
ARRAY OUT$FET [0:0] S(SFETL);; # FET FOR OUTPUT FILE #
CONTROL EJECT;
#
* SET THE FET POINTER FOR THE OUTPUT FILE.
#
IF USARG$LZ[0] EQ 0
THEN # NO OUTPUT FILE #
BEGIN
OUT$FETP = 0;
END
ELSE # SET UP THE FWA OF THE FET #
BEGIN
OUT$FETP = LOC(OUT$FET[0]);
END
#
* OPEN THE OUTPUT FILE.
#
RPOPEN(USARG$L[0],OUT$FETP,USHEAD);
#
* CHANGE ZERO-FILL TO SPACE-FILL FOR FAMILY.
#
TEMP$FAM = USARG$FM[0];
BZFILL(TEMP$FAM,TYPFILL"BFILL",7);
#
* GENERATE THE BASIC REPORT ON EACH SUBFAMILY SPECIFIED.
#
EJEC$FLAG = FALSE; # DO NOT EJECT ON FIRST PAGE #
SLOWFOR SUBFAM = 0 STEP 1 UNTIL MAXSF
DO
BEGIN # PROCESS EACH SUBFAMILY #
IF B<SUBFAM,1>SEL$SB EQ 0
THEN # SUBFAMILY NOT SELECTED #
BEGIN
TEST SUBFAM;
END
#
* SWITCH TO THE SPECIFIED FAMILY AND USER INDEX FOR
* THE SELECTED SUBFAMILY.
#
PFP$WRD0[0] = 0;
PFP$FAM[0] = USARG$FM[0];
PFP$UI[0] = DEF$UI + SUBFAM;
PFP$FG1[0] = TRUE;
PFP$FG4[0] = TRUE;
SETPFP(PFP[0]);
IF PFP$STAT[0] NQ 0
THEN # FAMILY NOT FOUND #
BEGIN
SSMSG$LINE[0] = " FAMILY NOT FOUND.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
#
* OPEN THE CATALOG FOR THE SUBFAMILY AND CHECK THE RETURNED
* ERROR STATUS.
#
CHAR$10[0] = XCDD(SUBFAM);
SFMCAT$LST[0] = CHAR$R1[0];
COPEN(USARG$FM[0],SUBFAM,SFMCATNM[0],"RM",TRUE,FLAG);
IF FLAG EQ CMASTAT"NOERR"
THEN
BEGIN
LOFPROC(OCT$LFN[1]); # ADD LFN TO LIST OF FILES #
END
IF FLAG NQ CMASTAT"NOERR"
THEN
BEGIN # CHECK FOR ERROR TYPE #
IF FLAG EQ CMASTAT"INTLK" ##
OR FLAG EQ CMASTAT"ATTERR"
THEN
BEGIN
SSMSG$LINE[0] = " UNABLE TO OPEN CATALOG.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
IF FLAG EQ CMASTAT"CIOERR"
THEN
BEGIN
SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
ELSE
BEGIN
SSMSG$PROC[0] = PROCNAME;
MESSAGE(SSMSG[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
END # CHECK FOR ERROR TYPE #
#
* GENERATE BASIC REPORT DETAIL LINES FOR EACH SM SPECIFIED.
#
SLOWFOR SM = 1 STEP 1 UNTIL MAXSM
DO
BEGIN # PROCESS EACH SM #
IF B<SM,1>SEL$SM EQ 0
THEN # SM NOT SELECTED #
BEGIN
TEST SM;
END
TEMP$SM = SM;
#
* CLEAR THE SUB-TOTAL COUNTERS FOR EACH GROUP.
#
ZFILL(GRP$TOT,8*MAXGP);
IF EJEC$FLAG
THEN # NOT FIRST PAGE #
BEGIN
RPEJECT(OUT$FETP);
END
#
* CHECK THE NUMBER OF *FCT* ENTRIES FOR THIS SM. IF NONE, PRINT
* AN APPROPRIATE MESSAGE AND PROCESS THE NEXT SPECIFIED SM.
#
P<PREAMBLE> = PRMBADR
; # SET PREAMBLE TABLE ADDRESS # IF PRM$SCW1[SM] EQ 0
THEN # SM NOT ASSIGNED TO SUBFAMILY #
BEGIN
RPLINE(OUT$FETP,"SM ",3,3,1);
RPLINE(OUT$FETP,TEMP$SM,6,1,1);
RPLINE(OUT$FETP," NOT ASSIGNED TO SUBFAMILY .",7,29,1);
CHAR$10[0] = XCDD(SUBFAM);
RPLINE(OUT$FETP,CHAR$R1[0],34,1,0);
RPSPACE(OUT$FETP,SP"SPACE",1);
TEST SM;
END
#
* ANALYZE THE *AST* AND *FCT* ENTRIES FOR THE SELECTED SM. SET UP
* THE SUB-TOTALS COUNTERS.
#
USANALS(SUBFAM,SM);
#
* DISPLAY THE SUB-TOTALS COUNTERS ON THE REPORT FILE.
#
USBASLN(SUBFAM,SM);
END # PROCESS EACH SM #
#
* CLOSE THE SFM CATALOG.
#
CCLOSE(USARG$FM[0],SUBFAM,0,FLAG);
IF FLAG NQ CMASTAT"NOERR"
THEN # UNABLE TO CLOSE CATALOG #
BEGIN
SSMSG$PROC[0] = PROCNAME;
MESSAGE(SSMSG[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
ZFILL(FCTBUFCW,1); # CLEAR CONTROL BUFFER #
END # PROCESS EACH SUBFAMILY #
#
* WRITE SM AND SUBFAMILY TOTALS TO REPORT FILE.
#
USBASTOT;
#
* CALL SPECIFIED OPTIONAL REPORTS.
#
IF REPORT$A
THEN # OPTIONAL REPORT A SPECIFIED #
BEGIN
USRPTA;
END
IF REPORT$B
THEN # OPTIONAL REPORT B SPECIFIED #
BEGIN
USRPTB;
END
IF REPORT$C
THEN # OPTIONAL REPORT C SPECIFIED #
BEGIN
USRPTC;
END
IF REPORT$D
THEN # OPTIONAL REPORT D SPECIFIED #
BEGIN
USRPTD;
END
#
* CLOSE THE REPORT FILE.
#
RPCLOSE(OUT$FETP);
RETURN;
END # USRPBAS #
TERM
PROC USRPTA;
# TITLE USRPTA - GENERATES OPTIONAL REPORT A. #
BEGIN # USRPTA #
#
** USRPTA - GENERATES OPTIONAL REPORT A.
*
* THIS PROC LISTS THE CONTENTS OF A STORAGE MODULE AS DESCRIBED
* IN THE SMMAP.
*
* PROC USRPTA.
*
* ENTRY. (SEL$SB) = BITS SET FOR THE SELECTED SUBFAMILIES.
* (SEL$SM) = BITS SET FOR THE SELECTED SM-S.
*
* EXIT. OPTIONAL REPORT A GENERATED.
*
* MESSAGES. 1) SMMAP PARITY ERROR.
* 2) UNABLE TO OPEN SMMAP.
* 3) SSUSE ABNORMAL, USRPTA.
* 4) FAMILY NOT FOUND.
*
* NOTES. FOR EACH SELECTED SM, PROC *USRPTA* OPENS THE
* CORRESPONDING SMMAP AND PRINTS THE CONTENTS
* OF THE Y,Z COORDINATES. THE COLUMN CONTAINING
* THE DRD-S IS NOT REPORTED ON. THIS REPORT IS FIFTEEN
* PAGES LONG WITH 1 Z AND 22 Y COORDINATES
* LISTED PER PAGE.
#
#
**** PROC USRPTA - XREF LIST BEGIN.
#
XREF
BEGIN
PROC BZFILL; # BLANK FILLS CHARACTERS #
PROC LOFPROC; # LIST OF FILES PROCESSOR #
PROC MCLOSE; # CLOSES SMMAP #
PROC MESSAGE; # PRINTS MESSAGE IN DAYFILE #
PROC MGETENT; # GETS SMMAP ENTRY #
PROC MOPEN; # OPENS SMMAP #
PROC RESTPFP; # RESTORE USER-S *PFP* AND ABORT
OR RETURN #
PROC RPCLOSE; # CLOSES THE REPORT FILE #
PROC RPEJECT; # PAGE EJECTS FOR REPORT FILE #
PROC RPLINE; # WRITES LINE TO REPORT FILE #
PROC RPSPACE; # PUTS BLANK LINE ON REPORT FILE #
PROC SETPFP; # SET FAMILY AND USER INDEX #
FUNC XCDD C(10); # CONVERTS INTEGER TO DISPLAY #
END
#
**** PROC USRPTA - XREF LIST END.
#
DEF PROCNAME #"USRPTA."#; # PROC NAME #
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBBZF
*CALL COMBCMD
*CALL COMBCMS
*CALL COMBMAP
*CALL COMBMCT
*CALL COMBPFP
*CALL COMSPFM
*CALL COMTOUT
*CALL COMTUSE
*CALL COMTUSP
ITEM FLAG I; # ERROR FLAG #
ITEM GP I; # GROUP #
ITEM GRT I; # GROUP ORDINAL #
ITEM MAP$ORD I; # SMMAP ORDINAL #
ITEM RPTFLAG C(7); # REPORT FLAG #
ITEM SM I; # LOOP VARIABLE #
ITEM SM$ADDR I; # ADDRESS OF SMMAP #
ITEM TEMP$SM C(1); # SM CHARACTER #
ITEM Y I; # LOOP VARIABLE #
ITEM Z I; # LOOP VARIABLE #
ARRAY SMMAP$NM [0:0] P(1); # ARRAY TO BUILD SMMAP #
BEGIN
ITEM SMAP$NAME C(00,00,07); # SMMAP FILE NAME #
ITEM SMAP$CHAR C(00,00,05); # FIRST FIVE CHARACTERS #
ITEM SMAP$SMID C(00,30,01); # SM-ID #
ITEM SMAP$Z U(00,36,24) = [0]; # ZERO FILL FILE NAME #
END
CONTROL EJECT;
#
* SET DEFAULT FAMILY AND USER INDEX.
#
PFP$WRD0[0] =0;
PFP$FAM[0] = DEF$FAM;
PFP$UI[0] = DEF$UI;
PFP$FG1[0] = TRUE;
PFP$FG4[0] = TRUE;
SETPFP(PFP[0]);
IF PFP$STAT NQ 0
THEN # FAMILY NOT FOUND #
BEGIN
SSMSG$LINE[0] = " FAMILY NOT FOUND.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
#
* PROCESS EACH SPECIFIED SM.
#
SLOWFOR SM = 1 STEP 1 UNTIL MAXSM
DO
BEGIN # PROCESS EACH SM #
IF B<SM,1>SEL$SM EQ 0
THEN # SM NOT SELECTED #
BEGIN
TEST SM;
END
TEMP$SM = SM;
SMAP$SMID[0] = TEMP$SM;
SMAP$CHAR[0] = SMMAP;
#
* OPEN THE SMMAP AND CHECK THE RETURNED ERROR STATUS.
#
MOPEN(SM,SMAP$NAME[0],"RM",FLAG);
IF FLAG EQ CMASTAT"NOERR"
THEN
BEGIN
LOFPROC(SMAP$NAME[0]); # ADD LFN TO LIST OF FILES #
END
SM$ADDR = LOC(MAPBUFR[0]);
P<SMUMAP> = SM$ADDR;
IF FLAG NQ CMASTAT"NOERR"
THEN
BEGIN # SMMAP NOT OPENED SUCCESSFULLY #
IF FLAG EQ CMASTAT"CIOERR"
THEN
BEGIN
SSMSG$LINE[0] = " SMMAP PARITY ERROR.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
IF FLAG EQ CMASTAT"INTLK" ##
OR FLAG EQ CMASTAT"ATTERR"
THEN
BEGIN
SSMSG$LINE[0] = " UNABLE TO OPEN SMMAP.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
ELSE
BEGIN
SSMSG$PROC[0] = PROCNAME;
MESSAGE(SSMSG[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
END # SMMAP NOT OPENED SUCCESSFULLY #
#
* PROCESS EACH Y,Z PAIR.
#
SLOWFOR Z = 0 STEP 1 UNTIL MAX$Z
DO
BEGIN # PROCESS EACH Z COORDINATE #
#
* DO NOT PROCESS THE COLUMN CONTAINING THE DRD-S.
#
IF Z EQ Z$NO$CUBE
THEN
BEGIN
TEST Z;
END
#
* WRITE HEADER TO REPORT FILE.
#
RPEJECT(OUT$FETP);
RPLINE(OUT$FETP,"SSUSE OPTIONAL REPORT A - ",5,26,1);
RPLINE(OUT$FETP,"STORAGE MODULE MAP FOR SM = ",31,28,1);
RPLINE(OUT$FETP,TEMP$SM,59,1,0);
RPSPACE(OUT$FETP,SP"SPACE",1);
RPLINE(OUT$FETP,"FLAGS:",5,6,1);
RPLINE(OUT$FETP,"P = CARTRIDGE EXISTS IN POOL",15,28,1);
RPLINE(OUT$FETP,"S = RESERVED FOR SYSTEM USE",49,27,1);
RPLINE(OUT$FETP,"C = RESERVED FOR CUSTOMER ",81,26,1);
RPLINE(OUT$FETP,"ENGINEERING",107,11,0);
RPLINE(OUT$FETP,"F = NOT ASSIGNED TO THIS FAMILY",15,31,1);
RPLINE(OUT$FETP,"E = ERROR FLAG",49,14,1);
RPLINE(OUT$FETP,"N = (Y,Z) DOES NOT EXIST",81,24,1);
RPLINE(OUT$FETP," IN SMMAP",105,9,0);
RPLINE(OUT$FETP,"R = RESERVED FOR ALTERNATE SMMAP",15,32,1);
RPLINE(OUT$FETP,"GPORD = ORDINAL IN GROUP",81,24,0);
RPSPACE(OUT$FETP,SP"SPACE",1);
RPLINE(OUT$FETP,"Y Z CM CSN",6,18,1);
RPLINE(OUT$FETP,"FAMILY SUBFAMILY",30,21,1);
RPLINE(OUT$FETP,"GROUP GPORD FLAGS",56,24,0);
RPSPACE(OUT$FETP,SP"SPACE",1);
SLOWFOR Y = 0 STEP 1 UNTIL MAX$Y
DO
BEGIN # PROCESS EACH Y COORDINATE #
#
* CALCULATE THE ORDINAL OF THE SMMAP ENTRY.
#
MAP$ORD = MAXORD - Z - (Y * 16);
#
* GET THE SMMAP ENTRY AND CHECK THE RETURNED ERROR STATUS.
#
MGETENT(SM,MAP$ORD,SM$ADDR,FLAG);
IF FLAG NQ CMASTAT"NOERR"
THEN
BEGIN # CHECK FOR TYPE OF ERROR #
IF FLAG EQ CMASTAT"CIOERR"
THEN
BEGIN
SSMSG$LINE[0] = " SMMAP PARITY ERROR.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
ELSE
BEGIN
SSMSG$PROC[0] = PROCNAME;
MESSAGE(SSMSG[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
END # CHECK FOR TYPE OF ERROR #
#
* CHECK CARTRIDGE FLAGS AND SET THE APPROPRIATE CHARACTERS
* INTO THE REPORT FLAG.
#
RPTFLAG = " ";
IF CM$FLAG1[0]
THEN
BEGIN
C<0,1>RPTFLAG = "E";
END
IF CM$CODE[0] EQ CUBSTAT"CEUSE"
THEN # RESERVED FOR CUSTOMER ENGINEER #
BEGIN
C<1,1>RPTFLAG = "C";
END
IF CM$CODE[0] EQ CUBSTAT"SCRPOOL"
THEN # ASSIGNED TO POOL #
BEGIN
C<2,1>RPTFLAG = "P";
END
IF CM$CODE[0] EQ CUBSTAT"SYSUSE"
THEN # RESERVED FOR SYSTEM USE #
BEGIN
C<3,1>RPTFLAG = "S";
END
IF CM$CODE[0] EQ CUBSTAT"NOCUBE"
THEN # NO CUBICLE AT THIS ORDINAL #
BEGIN
C<4,1>RPTFLAG = "N";
END
IF CM$FMLYNM[0] NQ USARG$FM[0]
THEN # NOT IN THIS FAMILY #
BEGIN
C<5,1>RPTFLAG = "F";
END
IF CM$CODE[0] EQ CUBSTAT"ALTCSU"
THEN # RESERVED FOR OTHER SMMAP #
BEGIN
C<6,1>RPTFLAG = "R";
END
#
* CONVERT VALUES TO DISPLAY CODE AND WRITE THEM TO THE
* REPORT FILE.
#
CHAR$10[0] = XCDD(Y);
RPLINE(OUT$FETP,CHAR$R2[0],5,2,1);
CHAR$10[0] = XCDD(Z);
RPLINE(OUT$FETP,CHAR$R2[0],11,2,1);
CHAR$10[0] = CM$CCOD[0];
BZFILL(CHAR,TYPFILL"BFILL",10);
RPLINE(OUT$FETP,CHAR$L2[0],17,2,1);
CHAR$10[0] = CM$CSND[0];
BZFILL(CHAR,TYPFILL"BFILL",10);
RPLINE(OUT$FETP,CHAR$L8[0],19,8,1);
CHAR$10[0] = CM$FMLYNM[0];
BZFILL(CHAR,TYPFILL"BFILL",10);
RPLINE(OUT$FETP,CHAR$L7[0],30,7,1);
#
* DO NOT PRINT SUBFAMILY, GROUP, OR GROUP ORDINAL UNLESS THEY
* HAVE BEEN ASSIGNED.
#
IF CM$CODE[0] EQ CUBSTAT"SUBFAM"
THEN
BEGIN # ASSIGNED TO SUBFAMILY #
CHAR$10[0] = XCDD(CM$SUB[0]);
RPLINE(OUT$FETP,CHAR$R1[0],46,1,1);
IF CM$FCTORD[0] NQ 0
THEN
BEGIN
GP = CM$FCTORD[0] / MAXGRT;
CHAR$10[0] = XCDD(GP);
RPLINE(OUT$FETP,CHAR$R2[0],57,2,1);
GRT = CM$FCTORD[0] - (GP * MAXGRT);
CHAR$10[0] = XCDD(GRT);
RPLINE(OUT$FETP,CHAR$R2[0],67,2,1);
END
END # ASSIGNED TO SUBFAMILY #
RPLINE(OUT$FETP,RPTFLAG,74,7,0);
END # PROCESS EACH Y COORDINATE #
END # PROCESS EACH Z COORDINATE #
#
* CLOSE THE SMMAP.
#
MCLOSE(SM,FLAG);
IF FLAG NQ CMASTAT"NOERR"
THEN
BEGIN
SSMSG$PROC[0] = PROCNAME;
MESSAGE(SSMSG[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT);
END
END # PROCESS EACH SM #
RETURN;
END # USRPTA #
TERM
PROC USRPTB;
# TITLE USRPTB - GENERATES OPTIONAL REPORT B. #
BEGIN # USRPTB #
#
** USRPTB - GENERATES OPTIONAL REPORT B.
*
* THIS PROC IDENTIFIES THE AVAILABLE AU ON EACH CARTRIDGE, THE
* NUMBER OF FLAGGED AU ON EACH CARTRIDGE, AND THE FLAGS SET
* FOR EACH CARTRIDGE IN THE SFMCATALOG.
*
* PROC USRPTB.
*
* ENTRY. (SEL$SB) = BITS SET FOR THE SELECTED SUBFAMILIES.
* (SEL$SM) = BITS SET FOR THE SELECTED SM-S.
* (USARG$FM) = FAMILY NAME.
*
* EXIT. OPTIONAL REPORT B GENERATED.
*
* MESSAGES. 1) FAMILY NOT FOUND.
* 2) UNABLE TO OPEN CATALOG.
* 3) SFMCATALOG PARITY ERROR.
* 4) SSUSE ABNORMAL, USRPTB.
*
* NOTES. PROC *USRPTB* LISTS GENERAL STATUS INFORMATION FOR
* EACH CARTRIDGE IN THE SFMCATALOG. THE NUMBER OF
* AVAILABLE AU AND FLAGGED AU FOR EACH CARTRIDGE, AND
* THE FLAGS SET FOR EACH CARTRIDGE ARE LISTED.
#
#
**** PROC USRPTB - XREF LIST BEGIN.
#
XREF
BEGIN
PROC BZFILL; # BLANK FILLS CHARACTERS #
PROC CCLOSE; # CLOSES CATALOG #
PROC CGETFCT; # GETS AN *FCT* ENTRY #
PROC COPEN; # OPENS CATALOG #
PROC CRDAST; # READS *AST* #
PROC LOFPROC; # LIST OF FILES PROCESSOR #
PROC MESSAGE; # PRINTS MESSAGE IN DAYFILE #
PROC RESTPFP; # RESTORE USER-S *PFP* AND ABORT
OR RETURN #
PROC RPCLOSE; # CLOSES THE REPORT FILE #
PROC RPEJECT; # PAGE EJECTS FOR REPORT FILE #
PROC RPLINE; # WRITES LINE TO REPORT FILE #
PROC RPSPACE; # PUTS BLANK LINE ON REPORT FILE #
PROC SETPFP; # SET FAMILY AND USER INDEX #
PROC ZFILL; # ZERO FILL ARRAY #
FUNC XCDD C(10); # CONVERTS INTEGER TO DISPLAY #
END
#
**** PROC USRPTB - XREF LIST END.
#
DEF PROCNAME #"USRPTB."#; # PROC NAME #
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBBZF
*CALL COMBCMD
*CALL COMBCMS
*CALL COMBMCT
*CALL COMBPFP
*CALL COMSPFM
*CALL COMXMSC
*CALL COMTOUT
*CALL COMTUSE
*CALL COMTUSP
ITEM ACFLAG I; # AU CONFLICT COUNT #
ITEM ASTADR I; # *AST* BUFFER ADDRESS #
ITEM FAFLAG I; # FLAWED,ALLOCATED AU COUNT #
ITEM FCFLAG I; # FROZEN CHAIN AU COUNT #
ITEM FCTADR I; # *FCT* BUFFER ADDRESS #
ITEM FLAG I; # ERROR FLAG #
ITEM FUFLAG I; # FLAWED,UNALLOCATED AU COUNT #
ITEM GP I; # GROUP #
ITEM GRT I; # GROUP ORDINAL #
ITEM J I; # LOOP VARIABLE #
ITEM LN$CNT I; # COUNT OF PRINTED LINES #
ITEM N I; # LOOP VARIABLE #
ITEM RPTFLAG C(6); # REPORT FLAG #
ITEM SFFLAG I; # START OF FRAGMENT AU COUNT #
ITEM SM I; # LOOP VARIABLE #
ITEM SUBFAM I; # LOOP VARIABLE #
ITEM TEMP$FAM C(7); # HOLDS FAMILY NAME #
ITEM TEMP$SM C(1); # SM CHARACTER #
CONTROL EJECT;
FCTADR = LOC(US$FCTENT[0]);
ASTADR = LOC(US$ASTENT[0]);
#
* CHANGE ZERO-FILL TO SPACE-FILL FOR FAMILY.
#
TEMP$FAM = USARG$FM[0];
BZFILL(TEMP$FAM,TYPFILL"BFILL",7);
#
* CHECK IF SUBFAMILY SELECTED.
#
SLOWFOR SUBFAM = 0 STEP 1 UNTIL MAXSF
DO
BEGIN # PROCESS EACH SUBFAMILY #
IF B<SUBFAM,1>SEL$SB EQ 0
THEN # SUBFAMILY NOT SELECTED #
BEGIN
TEST SUBFAM;
END
#
* SET THE FAMILY AND USER INDEX.
#
PFP$WRD0[0] = 0;
PFP$FAM[0] = USARG$FM[0];
PFP$UI[0] = DEF$UI + SUBFAM;
PFP$FG1[0] = TRUE;
PFP$FG4[0] = TRUE;
SETPFP(PFP[0]);
IF PFP$STAT[0] NQ 0
THEN # FAMILY NOT FOUND #
BEGIN
SSMSG$LINE[0] = " FAMILY NOT FOUND.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
#
* OPEN THE CATALOG AND CHECK THE RETURNED ERROR STATUS.
#
CHAR$10[0] = XCDD(SUBFAM);
SFMCAT$LST[0] = CHAR$R1[0];
COPEN(USARG$FM[0],SUBFAM,SFMCATNM[0],"RM",TRUE,FLAG);
IF FLAG EQ CMASTAT"NOERR"
THEN
BEGIN
LOFPROC(OCT$LFN[1]); # ADD LFN TO LIST OF FILES #
END
IF FLAG NQ CMASTAT"NOERR"
THEN
BEGIN # CHECK FOR TYPE OF ERROR #
IF FLAG EQ CMASTAT"INTLK" ##
OR FLAG EQ CMASTAT"ATTERR"
THEN
BEGIN
SSMSG$LINE[0] = " UNABLE TO OPEN CATALOG.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
IF FLAG EQ CMASTAT"CIOERR"
THEN
BEGIN
SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT);
END
ELSE
BEGIN
SSMSG$PROC[0] = PROCNAME;
MESSAGE(SSMSG[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
END # CHECK FOR TYPE OF ERROR #
#
* CHECK IF SM ASSIGNED TO SUBFAMILY.
#
SLOWFOR SM = 1 STEP 1 UNTIL MAXSM
DO
BEGIN # CHECK EACH SELECTED SM #
IF B<SM,1>SEL$SM EQ 0
THEN # SM NOT SELECTED #
BEGIN
TEST SM;
END
LN$CNT = MAX$LN + 1; # INITIALIZE LINE COUNT #
#
* IF NO ENTRIES FOR THIS SM, PROCESS THE NEXT SPECIFIED SM.
#
IF PRM$SCW1[SM] EQ 0
THEN # SM NOT ASSIGNED TO SUBFAMILY #
BEGIN
TEST SM;
END
#
* GET THE *AST* AND CHECK THE RETURNED ERROR STATUS.
#
CRDAST(USARG$FM[0],SUBFAM,SM,ASTADR,0,FLAG);
IF FLAG NQ CMASTAT"NOERR"
THEN # UNABLE TO GET *AST* #
BEGIN
SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
#
* PROCESS ALL *AST* AND *FCT* ENTRIES.
#
SLOWFOR J = 16 STEP 1 UNTIL PRM$ENTRC[SM] + 15
DO
BEGIN # PROCESS AN *AST* AND *FCT* ENTRY #
#
* GET THE *FCT* ENTRY AND CHECK THE RETURNED ERROR STATUS.
#
CGETFCT(USARG$FM[0],SUBFAM,SM,J,FCTADR,0,FLAG);
IF FLAG NQ CMASTAT"NOERR"
THEN # UNABLE TO GET *FCT* #
BEGIN
SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
P<FCT> = FCTADR;
#
* CHECK THE CUBICLE STATUS. IF IT DOES NOT CONTAIN A
* CARTRIDGE GO TO NEXT CUBICLE.
#
IF FCT$CSND[0] EQ " "
OR FCT$CSNI[0] EQ 0
THEN # NO CARTRIDGE AT THIS LOCATION #
BEGIN
TEST J;
END
#
* WRITE HEADER TO REPORT FILE IF NEW PAGE.
#
IF LN$CNT GQ MAX$LN
THEN # PAGE EJECT AND PRINT HEADER #
BEGIN
TEMP$SM = SM;
RPEJECT(OUT$FETP);
RPLINE(OUT$FETP,"SSUSE OPTIONAL REPORT B - ",5,26,1);
RPLINE(OUT$FETP,"CARTRIDGE SUMMARY REPORT",31,24,1);
RPLINE(OUT$FETP,"SM = ",58,5,1);
RPLINE(OUT$FETP,TEMP$SM,63,1,1);
RPLINE(OUT$FETP,"SUBFAMILY = ",67,12,1);
CHAR$10[0] = XCDD(SUBFAM);
RPLINE(OUT$FETP,CHAR$R1[0],79,1,1);
RPLINE(OUT$FETP,"FAMILY = ",84,9,1);
RPLINE(OUT$FETP,TEMP$FAM,93,7,0);
RPSPACE(OUT$FETP,SP"SPACE",1);
#
* PRINT NOTES AND COLUMN HEADINGS.
#
RPLINE(OUT$FETP,"NOTES:",5,6,1);
RPLINE(OUT$FETP,"CARTRIDGE FLAGS:",46,16,0);
RPLINE(OUT$FETP,"FA = FLAWED AND ALLOCATED",7,25,1);
RPLINE(OUT$FETP,"M = MISSING",48,11,0);
RPLINE(OUT$FETP,"FU = FLAWED AND UNALLOCATED",7,27,1);
RPLINE(OUT$FETP,"I = INHIBIT",48,11,0);
RPLINE(OUT$FETP,"SF = START OF FRAGMENT",7,22,1);
RPLINE(OUT$FETP,"F = FREE CARTRIDGE",48,18,0);
RPLINE(OUT$FETP,"FC = FROZEN CHAIN",7,17,1);
RPLINE(OUT$FETP,"L = LINK(FREE AU EXIST, ",48,24,1);
RPLINE(OUT$FETP,"NO OFF CARTRIDGE LINK)",72,22,0);
RPLINE(OUT$FETP,"AC = AU CONFLICT",7,16,1);
RPLINE(OUT$FETP,"P = EXCESSIVE WRITE ERRORS",48,26,0);
RPLINE(OUT$FETP,"GPORD = ORDINAL IN GROUP",7,24,1);
RPLINE(OUT$FETP,"E = MAP ERROR",48,13,1);
RPLINE(OUT$FETP,"(DETECTED BY SSVAL)",61,19,0);
RPSPACE(OUT$FETP,SP"SPACE",1);
RPLINE(OUT$FETP,"------ERROR CONDITIONS------",60,28,0);
RPLINE(OUT$FETP,"FREE AU CART",39,17,1);
RPLINE(OUT$FETP,"--------NUMBER OF AU--------",60,28,0);
RPLINE(OUT$FETP,"GP GPORD Y",5,13,1);
RPLINE(OUT$FETP,"Z CM CSN",21,11,1);
RPLINE(OUT$FETP,"SMALL LARGE FLAGS",36,21,1);
RPLINE(OUT$FETP,"FA FU SF",62,14,1);
RPLINE(OUT$FETP,"FC AC",80,8,0);
RPSPACE(OUT$FETP,SP"SPACE",1);
LN$CNT = 17;
END
#
* CHECK FOR FLAGS AND SET THE APPROPRIATE CHARACTERS INTO THE
* REPORT FLAG.
#
RPTFLAG = " ";
IF FCT$LCF[0]
THEN # CARTRIDGE MISSING #
BEGIN
C<1,1>RPTFLAG = "M";
END
IF FCT$IAF[0]
THEN # INHIBIT ALLOCATION #
BEGIN
C<2,1>RPTFLAG = "I";
END
IF FCT$FCF[0]
THEN # FREE CARTRIDGE #
BEGIN
C<3,1>RPTFLAG = "F";
END
IF AST$AULF[J] GR 0 ##
OR AST$AUSF[J] GR 0
THEN # FREE AU EXIST #
BEGIN
IF FCT$OCLF[0] EQ 7
THEN # NO LINKS AVAILABLE #
BEGIN
C<4,1>RPTFLAG = "L";
END
END
IF FCT$EEF[0]
THEN # EXCESSIVE PARITY ERRORS #
BEGIN
C<5,1>RPTFLAG = "P";
END
IF FCT$SEF[0]
THEN # SMMAP ERROR FLAG SET #
BEGIN
C<0,1>RPTFLAG = "E";
END
#
* PROCESS EACH AU. CHECK FOR ERRORS AND UPDATE THE APPROPRIATE
* COUNTERS.
#
ACFLAG = 0;
FAFLAG = 0;
FCFLAG = 0;
FUFLAG = 0;
SFFLAG = 0;
SLOWFOR N = 1 STEP 1 UNTIL INAVOT
DO
BEGIN # PROCESS EACH AU #
SETFCTX(N); # SET *FWD* AND *FPS* VALUES #
IF FCT$FAUF(FWD,FPS) NQ 0
THEN # FLAWED AU #
BEGIN
IF FCT$FBF(FWD,FPS) EQ 0
THEN # FLAWED AND UNALLOCATED #
BEGIN
FUFLAG = FUFLAG + 1;
END
ELSE # FLAWED AND ALLOCATED #
BEGIN
FAFLAG = FAFLAG + 1;
END
END
IF FCT$SFF(FWD,FPS) NQ 0
THEN
BEGIN
SFFLAG = SFFLAG + 1; # START OF FRAGMENT #
END
IF FCT$FRCF(FWD,FPS) NQ 0
THEN
BEGIN
FCFLAG = FCFLAG + 1; # FROZEN CHAIN #
END
IF FCT$AUCF(FWD,FPS) NQ 0
THEN
BEGIN
ACFLAG = ACFLAG + 1; # AU CONFLICT #
END
END # PROCESS EACH AU #
#
* CONVERT VALUES TO DISPLAY CODE AND WRITE THEM TO THE REPORT
* FILE. BLANK FILL CSN AND CARTRIDGE MANUFACTURER CODE.
#
GP = J / MAXGRT;
CHAR$10[0] = XCDD(GP);
RPLINE(OUT$FETP,CHAR$R2[0],5,2,1);
GRT = J - (GP * MAXGRT);
CHAR$10[0] = XCDD(GRT);
RPLINE(OUT$FETP,CHAR$R2[0],10,2,1);
CHAR$10[0] = XCDD(FCT$Y[0]);
RPLINE(OUT$FETP,CHAR$R2[0],16,2,1);
CHAR$10[0] = XCDD(FCT$Z[0]);
RPLINE(OUT$FETP,CHAR$R2[0],20,2,1);
CHAR$10[0] = FCT$CCOD[0];
BZFILL(CHAR,TYPFILL"BFILL",10);
RPLINE(OUT$FETP,CHAR$L2[0],25,2,1);
CHAR$10[0] = FCT$CSND[0];
BZFILL(CHAR,TYPFILL"BFILL",10);
RPLINE(OUT$FETP,CHAR$L8[0],27,8,1);
CHAR$10[0] = XCDD(AST$AUSF[J]);
RPLINE(OUT$FETP,CHAR$R4[0],37,4,1);
CHAR$10[0] = XCDD(AST$AULF[J]);
RPLINE(OUT$FETP,CHAR$R4[0],44,4,1);
RPLINE(OUT$FETP,RPTFLAG,51,6,1);
CHAR$10[0] = XCDD(FAFLAG);
RPLINE(OUT$FETP,CHAR$R4[0],60,4,1);
CHAR$10[0] = XCDD(FUFLAG);
RPLINE(OUT$FETP,CHAR$R4[0],66,4,1);
CHAR$10[0] = XCDD(SFFLAG);
RPLINE(OUT$FETP,CHAR$R4[0],72,4,1);
CHAR$10[0] = XCDD(FCFLAG);
RPLINE(OUT$FETP,CHAR$R4[0],78,4,1);
CHAR$10[0] = XCDD(ACFLAG);
RPLINE(OUT$FETP,CHAR$R4[0],84,4,0);
LN$CNT = LN$CNT + 1; # INCREMENT LINE COUNT #
END # PROCESS AN *AST* AND *FCT* ENTRY #
END # CHECK EACH SELECTED SM #
#
* CLOSE THE CATALOG.
#
CCLOSE(USARG$FM[0],SUBFAM,0,FLAG);
IF FLAG NQ CMASTAT"NOERR"
THEN # UNABLE TO CLOSE CATALOG #
BEGIN
SSMSG$PROC[0] = PROCNAME;
MESSAGE(SSMSG[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
ZFILL(FCTBUFCW,1); # CLEAR CONTROL BUFFER #
END # PROCESS EACH SUBFAMILY #
RETURN;
END # USRPTB #
TERM
PROC USRPTC;
# TITLE USRPTC - GENERATES OPTIONAL REPORT C. #
BEGIN # USRPTC #
#
** USRPTC - GENERATES OPTIONAL REPORT C.
*
* THIS PROC LISTS CARTRIDGE USAGE INFORMATION FOR EACH ENTRY
* IN THE SFMCATALOG.
*
* PROC USRPTC.
*
* ENTRY. (SEL$SB) = BITS SET FOR THE SELECTED SUBFAMILIES.
* (SEL$SM) = BITS SET FOR THE SELECTED SM-S.
* (USARG$FM) = FAMILY NAME.
*
* EXIT. OPTIONAL REPORT C GENERATED.
*
* MESSAGES. 1) FAMILY NOT FOUND.
* 2) UNABLE TO OPEN CATALOG.
* 3) SFMCATALOG PARITY ERROR.
* 4) SSUSE ABNORMAL, USRPTC.
#
#
**** PROC USRPTC - XREF LIST BEGIN.
#
XREF
BEGIN
PROC BZFILL; # BLANK FILLS CHARACTERS #
PROC CCLOSE; # CLOSES CATALOG #
PROC CGETFCT; # GETS AN *FCT* ENTRY #
PROC COPEN; # OPENS CATALOG #
PROC LOFPROC; # LIST OF FILES PROCESSOR #
PROC MESSAGE; # PRINTS MESSAGE IN DAYFILE #
PROC RESTPFP; # RESTORE USER-S *PFP* AND ABORT
OR RETURN #
PROC RPCLOSE; # CLOSES THE REPORT FILE #
PROC RPEJECT; # PAGE EJECTS FOR REPORT FILE #
PROC RPLINE; # WRITES LINE TO REPORT FILE #
PROC RPSPACE; # PUTS BLANK LINE ON REPORT FILE #
PROC SETPFP; # SET FAMILY AND USER INDEX #
PROC ZFILL; # ZERO FILL ARRAY #
FUNC XCDD C(10); # CONVERTS INTEGER TO DISPLAY #
END
#
**** PROC USRPTC - XREF LIST END.
#
DEF PROCNAME #"USRPTC."#; # PROC NAME #
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBBZF
*CALL COMBCMD
*CALL COMBCMS
*CALL COMBMCT
*CALL COMBPFP
*CALL COMSPFM
*CALL COMXMSC
*CALL COMTOUT
*CALL COMTUSE
*CALL COMTUSP
ITEM FCTADR I; # *FCT* BUFFER ADDRESS #
ITEM FLAG I; # ERROR FLAG #
ITEM GP I; # GROUP #
ITEM J I; # LOOP VARIABLE #
ITEM LN$CNT I; # COUNT OF PRINTED LINES #
ITEM OCL I; # AVAILABLE LINK COUNT #
ITEM RPTFLAG C(4); # REPORT FLAG #
ITEM SM I; # LOOP VARIABLE #
ITEM SUBFAM I; # LOOP VARIABLE #
ITEM TEMP$FAM C(7); # HOLDS FAMILY NAME #
ITEM TEMP$SM C(1); # SM CHARACTER #
CONTROL EJECT;
FCTADR = LOC(US$FCTENT[0]);
#
* CHANGE ZERO-FILL TO SPACE-FILL FOR FAMILY.
#
TEMP$FAM = USARG$FM[0];
BZFILL(TEMP$FAM,TYPFILL"BFILL",7);
#
* CHECK IF SUBFAMILY SELECTED.
#
SLOWFOR SUBFAM = 0 STEP 1 UNTIL MAXSF
DO
BEGIN # PROCESS EACH SUBFAMILY #
IF B<SUBFAM,1>SEL$SB EQ 0
THEN # SUBFAMILY NOT SELECTED #
BEGIN
TEST SUBFAM;
END
#
* SET THE FAMILY AND USER INDEX.
#
PFP$WRD0[0] = 0;
PFP$FAM[0] = USARG$FM[0];
PFP$UI[0] = DEF$UI + SUBFAM;
PFP$FG1[0] = TRUE;
PFP$FG4[0] = TRUE;
SETPFP(PFP[0]);
IF PFP$STAT[0] NQ 0
THEN # FAMILY NOT FOUND #
BEGIN
SSMSG$LINE[0] = " FAMILY NOT FOUND.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
#
* OPEN THE CATALOG AND CHECK THE RETURNED ERROR STATUS.
#
CHAR$10[0] = XCDD(SUBFAM);
SFMCAT$LST[0] = CHAR$R1[0];
COPEN(USARG$FM[0],SUBFAM,SFMCATNM[0],"RM",TRUE,FLAG);
IF FLAG EQ CMASTAT"NOERR"
THEN
BEGIN
LOFPROC(OCT$LFN[1]); # ADD LFN TO LIST OF FILES #
END
IF FLAG NQ CMASTAT"NOERR"
THEN
BEGIN # CHECK FOR TYPE OF ERROR #
IF FLAG EQ CMASTAT"INTLK" ##
OR FLAG EQ CMASTAT"ATTERR"
THEN
BEGIN
SSMSG$LINE[0] = " UNABLE TO OPEN CATALOG.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
IF FLAG EQ CMASTAT"CIOERR"
THEN
BEGIN
SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT);
END
ELSE
BEGIN
SSMSG$PROC[0] = PROCNAME;
MESSAGE(SSMSG[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
END # CHECK FOR TYPE OF ERROR #
#
* CHECK IF SM ASSIGNED TO SUBFAMILY.
#
SLOWFOR SM = 1 STEP 1 UNTIL MAXSM
DO
BEGIN # CHECK EACH SELECTED SM #
IF B<SM,1>SEL$SM EQ 0
THEN # SM NOT SELECTED #
BEGIN
TEST SM;
END
TEMP$SM = SM;
LN$CNT = MAX$LN + 1; # INITIALIZE LINE COUNT #
#
* IF NO ENTRIES FOR THIS SM, PROCESS THE NEXT SPECIFIED SM.
#
IF PRM$SCW1[SM] EQ 0
THEN # SM NOT ASSIGNED TO SUBFAMILY #
BEGIN
TEST SM;
END
#
* PROCESS ALL *FCT* ENTRIES.
#
SLOWFOR J = 16 STEP 1 UNTIL PRM$ENTRC[SM] + 15
DO
BEGIN # PROCESS AN *FCT* ENTRY #
#
* GET THE *FCT* ENTRY AND CHECK THE RETURNED ERROR STATUS.
#
CGETFCT(USARG$FM[0],SUBFAM,SM,J,FCTADR,0,FLAG);
IF FLAG NQ CMASTAT"NOERR"
THEN # UNABLE TO GET *FCT* #
BEGIN
SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
P<FCT> = FCTADR;
#
* CHECK THE CUBICLE STATUS. IF IT DOES NOT CONTAIN A
* CARTRIDGE GO TO NEXT CUBICLE.
#
IF FCT$CSND[0] EQ " "
OR FCT$CSNI[0] EQ 0
THEN # NO CARTRIDGE AT THIS LOCATION #
BEGIN
TEST J;
END
#
* WRITE HEADER TO REPORT FILE IF NEW PAGE.
#
IF LN$CNT GQ MAX$LN
THEN # PAGE EJECT AND PRINT HEADER #
BEGIN
RPEJECT(OUT$FETP);
RPLINE(OUT$FETP,"SSUSE OPTIONAL REPORT C - ",5,26,1);
RPLINE(OUT$FETP,"DETAILED CARTRIDGE REPORT",31,25,1);
RPLINE(OUT$FETP,"SM = ",58,5,1);
RPLINE(OUT$FETP,TEMP$SM,63,1,1);
RPLINE(OUT$FETP,"SUBFAMILY = ",67,12,1);
CHAR$10[0] = XCDD(SUBFAM);
RPLINE(OUT$FETP,CHAR$R1[0],79,1,1);
RPLINE(OUT$FETP,"FAMILY = ",84,9,1);
RPLINE(OUT$FETP,TEMP$FAM,93,7,0);
RPSPACE(OUT$FETP,SP"SPACE",1);
#
* PRINT NOTES AND COLUMN HEADINGS.
#
RPLINE(OUT$FETP,"FLAGS:",5,6,1);
RPLINE(OUT$FETP,"I = INHIBIT ALLOCATION",15,22,1);
RPLINE(OUT$FETP,"M = MISSING",49,12,1);
RPLINE(OUT$FETP,"P = EXCESSIVE PARITY ERRORS",81,27,0);
RPLINE(OUT$FETP,"E = MAP ERROR",15,13,1);
RPLINE(OUT$FETP,"OCL = AVAILABLE LINK COUNT",49,26,1);
RPLINE(OUT$FETP,"FCTORD = SFM CATALOG ORDINAL",81,28,0);
RPSPACE(OUT$FETP,SP"SPACE",1);
RPLINE(OUT$FETP,"------AU------ CARTRIDGE",55,29,0);
RPLINE(OUT$FETP," Y Z CM CSN",2,17,1);
RPLINE(OUT$FETP,"GROUP FCTORD FLAGS",26,23,1);
RPLINE(OUT$FETP,"FIRST FIRST DIVISION",55,29,1);
RPLINE(OUT$FETP,"OCL",88,3,0);
RPLINE(OUT$FETP,"SMALL LARGE POINT",55,27,0);
LN$CNT = 11;
END
#
* CHECK FOR FLAGS AND SET THE APPROPRIATE CHARACTERS INTO THE
* REPORT FLAG.
#
RPTFLAG = " ";
IF FCT$IAF[0]
THEN # INHIBIT ALLOCATION FLAG SET #
BEGIN
C<1,1>RPTFLAG = "I";
END
IF FCT$LCF[0]
THEN # CARTRIDGE MISSING #
BEGIN
C<2,1>RPTFLAG = "M";
END
IF FCT$EEF[0]
THEN # EXCESSIVE ERROR FLAG SET #
BEGIN
C<3,1>RPTFLAG = "P";
END
IF FCT$SEF[0]
THEN # SMMAP ERROR FLAG SET #
BEGIN
C<0,1>RPTFLAG = "E";
END
#
* COUNT AVAILABLE OFF CARTRIDGE LINKS.
#
OCL = 0;
IF B<0,1>FCT$OCLF[0] EQ 0
THEN
BEGIN
OCL = OCL + 1;
END
IF B<1,1>FCT$OCLF[0] EQ 0
THEN
BEGIN
OCL = OCL + 1;
END
IF B<2,1>FCT$OCLF[0] EQ 0
THEN
BEGIN
OCL = OCL + 1;
END
#
* CONVERT VALUES TO DISPLAY CODE AND WRITE THEM TO THE REPORT
* FILE.
#
CHAR$10[0] = XCDD(FCT$Y[0]);
RPLINE(OUT$FETP,CHAR$R2[0],2,2,1);
CHAR$10[0] = XCDD(FCT$Z[0]);
RPLINE(OUT$FETP,CHAR$R2[0],6,2,1);
CHAR$10[0] = FCT$CCOD[0];
BZFILL(CHAR,TYPFILL"BFILL",10);
RPLINE(OUT$FETP,CHAR$L2[0],12,2,1);
CHAR$10[0] = FCT$CSND[0];
BZFILL(CHAR,TYPFILL"BFILL",10);
RPLINE(OUT$FETP,CHAR$L8[0],14,8,1);
GP = J / MAXGRT;
CHAR$10[0] = XCDD(GP);
RPLINE(OUT$FETP,CHAR$R2[0],27,2,1);
CHAR$10[0] = XCDD(J);
RPLINE(OUT$FETP,CHAR$R3[0],36,3,1);
RPLINE(OUT$FETP,RPTFLAG,44,4,1);
CHAR$10[0] = XCDD(FCT$FAUSF[0]);
RPLINE(OUT$FETP,CHAR$R4[0],55,4,1);
CHAR$10[0] = XCDD(FCT$FAULF[0]);
RPLINE(OUT$FETP,CHAR$R4[0],64,4,1);
CHAR$10[0] = XCDD(FCT$CDP[0]);
RPLINE(OUT$FETP,CHAR$R4[0],77,4,1);
CHAR$10[0] = XCDD(OCL);
RPLINE(OUT$FETP,CHAR$R2[0],88,2,0);
LN$CNT = LN$CNT + 1; # INCREMENT LINE COUNT #
END # PROCESS AN *FCT* ENTRY #
END # CHECK EACH SELECTED SM #
#
* CLOSE THE CATALOG.
#
CCLOSE(USARG$FM[0],SUBFAM,0,FLAG);
IF FLAG NQ CMASTAT"NOERR"
THEN # UNABLE TO CLOSE CATALOG #
BEGIN
SSMSG$PROC[0] = PROCNAME;
MESSAGE(SSMSG[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
ZFILL(FCTBUFCW,1); # CLEAR CONTROL BUFFER #
END # PROCESS EACH SUBFAMILY #
RETURN;
END # USRPTC #
TERM
PROC USRPTD;
# TITLE USRPTD - GENERATES OPTIONAL REPORT D. #
BEGIN # USRPTD #
#
** USRPTD - GENERATES OPTIONAL REPORT D.
*
* THIS PROC LISTS DETAILED AU STATUS INFORMATION FOR EACH
* ENTRY IN THE SFMCATALOG PLUS CARTRIDGE USAGE INFORMATION.
*
* PROC USRPTD.
*
* ENTRY. (SEL$SB) = BITS SET FOR THE SELECTED SUBFAMILIES.
* (SEL$SM) = BITS SET FOR THE SELECTED SM-S.
* (USARG$FM) = FAMILY NAME.
*
* EXIT. OPTIONAL REPORT D GENERATED.
*
* MESSAGES. 1) FAMILY NOT FOUND.
* 2) UNABLE TO OPEN CATALOG.
* 3) SFMCATALOG PARITY ERROR.
* 4) SSUSE ABNORMAL, USRPTD.
* 5) CARTRIDGE NOT FOUND.
*
* NOTES. FOR EACH SELECTED SUBFAMILY, PROC *USRPTD* OPENS THE
* SFM CATALOG AND SEARCHES FOR THE CARTRIDGE WITH THE
* SELECTED *CSN* AND *CM*. WHEN THE CARTRIDGE IS FOUND
* THE CARTRIDGE LINK FIELD OF THE *FCT* ENTRY IS
* PRINTED IN OCTAL FOR EACH AU. IF THE CARTRIDGE
* IS NOT FOUND A MESSAGE IS ISSUED TO THE DAYFILE
* AND *SSUSE* ABORTS.
#
#
**** PROC USRPTD - XREF LIST BEGIN.
#
XREF
BEGIN
PROC BZFILL; # BLANK FILLS CHARACTERS #
PROC CCLOSE; # CLOSES CATALOG #
PROC CGETFCT; # GETS AN *FCT* ENTRY #
PROC COPEN; # OPENS CATALOG #
PROC CRDAST; # READ *AST* #
PROC LOFPROC; # LIST OF FILES PROCESSOR #
PROC MESSAGE; # PRINTS MESSAGE IN DAYFILE #
PROC RESTPFP; # RESTORE USER-S *PFP* AND ABORT
OR RETURN #
PROC RPCLOSE; # CLOSES THE REPORT FILE #
PROC RPEJECT; # PAGE EJECTS FOR REPORT FILE #
PROC RPLINE; # WRITES LINE TO REPORT FILE #
PROC RPSPACE; # PUTS BLANK LINE ON REPORT FILE #
PROC SETPFP; # SET FAMILY AND USER INDEX #
PROC ZFILL; # ZERO FILL ARRAY #
FUNC XCDD C(10); # CONVERTS INTEGER TO DISPLAY #
FUNC XCOD C(10); # CONVERTS OCTAL TO DISPLAY #
PROC XWOD; # CONVERT OCTAL TO DISPLAY #
END
#
**** PROC USRPTD - XREF LIST END.
#
DEF PROCNAME #"USRPTD."#; # PROC NAME #
DEF LISTCON #0#; # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBBZF
*CALL COMBCMD
*CALL COMBCMS
*CALL COMBMCT
*CALL COMBPFP
*CALL COMSPFM
*CALL COMXMSC
*CALL COMTLAB
*CALL COMTOUT
*CALL COMTUSE
*CALL COMTUSP
ITEM ASTADR I; # *AST* BUFFER ADDRESS #
ITEM CODE C(2); # CODE FIELD FOR OUTPUT #
ITEM COLUMN I; # COLUMN POSITION FOR OUTPUT #
ITEM ER$CODE C(1); # CODE FIELD FOR OUTPUT #
ITEM FCTADR I; # *FCT* BUFFER ADDRESS #
ITEM FLAG I; # ERROR FLAG #
ITEM GP I; # GROUP #
ITEM FOUND B; # CSN FOUND FLAG #
ITEM I I; # LOOP VARIABLE #
ITEM J I; # LOOP VARIABLE #
ITEM LN$CNT I; # COUNT OF PRINTED LINES #
ITEM N I; # LOOP VARIABLE #
ITEM NUM C(10); # AU NUMBER #
ITEM SM I; # LOOP VARIABLE #
ITEM SUBFAM I; # LOOP VARIABLE #
ITEM TEMP$FAM C(7); # HOLDS FAMILY NAME #
ITEM TEMP$SM C(1); # TEMPORARY CHARACTER #
ARRAY DIS[0:0] P(2);
BEGIN
ITEM DIS$CLFG C(01,00,10); # LINK FIELD IN DISPLAY CODE #
END
CONTROL EJECT;
ASTADR = LOC(US$ASTENT[0]);
FCTADR = LOC(US$FCTENT[0]);
SEL$CSN = USARG$CN[0];
FOUND = FALSE;
IF USARG$CM[0] EQ 0
THEN # USE DEFAULT MANUFACTURER #
BEGIN
SEL$CM = IBMCART;
END
ELSE # USE SPECIFIED MANUFACTURER #
BEGIN
SEL$CM = USARG$CM[0];
END
#
* CHANGE ZERO FILL TO SPACE FILL FOR FAMILY AND CARTRIDGE-ID.
#
TEMP$FAM = USARG$FM[0];
BZFILL(TEMP$FAM,TYPFILL"BFILL",7);
BZFILL(SEL$CM,TYPFILL"BFILL",2);
BZFILL(SEL$CSN,TYPFILL"BFILL",8);
#
* CHECK IF SUBFAMILY SELECTED.
#
SLOWFOR SUBFAM = 0 STEP 1 UNTIL MAXSF
DO
BEGIN # PROCESS EACH SUBFAMILY #
IF B<SUBFAM,1>SEL$SB EQ 0
THEN # SUBFAMILY NOT SELECTED #
BEGIN
TEST SUBFAM;
END
#
* SET THE FAMILY AND USER INDEX.
#
PFP$WRD0[0] = 0;
PFP$FAM[0] = USARG$FM[0];
PFP$UI[0] = DEF$UI + SUBFAM;
PFP$FG1[0] = TRUE;
PFP$FG4[0] = TRUE;
SETPFP(PFP[0]);
IF PFP$STAT[0] NQ 0
THEN # FAMILY NOT FOUND #
BEGIN
SSMSG$LINE[0] = " FAMILY NOT FOUND.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT);
END
#
* OPEN THE CATALOG AND CHECK THE RETURNED ERROR STATUS.
#
CHAR$10 = XCDD(SUBFAM);
SFMCAT$LST[0] = CHAR$R1[0];
RPLINE(OUT$FETP,CHAR$R3[0],8,3,1);
COPEN(USARG$FM[0],SUBFAM,SFMCATNM[0],"RM",TRUE,FLAG);
IF FLAG EQ CMASTAT"NOERR"
THEN
BEGIN
LOFPROC(OCT$LFN[1]); # ADD LFN TO LIST OF FILES #
END
IF FLAG NQ CMASTAT"NOERR"
THEN
BEGIN # CHECK FOR TYPE OF ERROR #
IF FLAG EQ CMASTAT"INTLK" ##
OR FLAG EQ CMASTAT"ATTERR"
THEN
BEGIN
SSMSG$LINE[0] = " UNABLE TO OPEN CATALOG";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT);
END
IF FLAG EQ CMASTAT"CIOERR"
THEN
BEGIN
SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT);
END
ELSE
BEGIN
SSMSG$PROC[0] = PROCNAME;
MESSAGE(SSMSG[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT);
END
END # CHECK FOR TYPE OF ERROR #
#
* CHECK IF SM ASSIGNED TO SUBFAMILY.
#
SLOWFOR SM = 1 STEP 1 UNTIL MAXSM
DO
BEGIN # CHECK EACH SELECTED SM #
IF B<SM,1>SEL$SM EQ 0
THEN # SM NOT SELECTED #
BEGIN
TEST SM;
END
TEMP$SM = SM;
LN$CNT = MAX$LN + 1; # INITIALIZE LINE COUNT #
#
* IF NO ENTRIES FOR THIS SM, PROCESS THE NEXT SPECIFIED SM.
#
IF PRM$SCW1[SM] EQ 0
THEN # SM NOT ASSIGNED TO SUBFAMILY #
BEGIN
TEST SM;
END
#
* READ THE *AST* AND CHECK THE RETURNED ERROR STATUS.
#
CRDAST(USARG$FM[0],SUBFAM,SM,ASTADR,0,FLAG);
IF FLAG NQ CMASTAT"NOERR"
THEN # UNABLE TO GET *AST* #
BEGIN
SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT #
END
#
* PROCESS ALL *FCT* ENTRIES.
#
SLOWFOR J = 16 STEP 1 UNTIL PRM$ENTRC[SM] + 15
DO
BEGIN # PROCESS AN *FCT* ENTRY #
#
* GET THE *FCT* ENTRY AND CHECK THE RETURNED ERROR STATUS.
#
CGETFCT(USARG$FM[0],SUBFAM,SM,J,FCTADR,0,FLAG);
IF FLAG NQ CMASTAT"NOERR"
THEN # UNABLE TO GET *FCT* #
BEGIN
SSMSG$LINE[0] = " SFMCATALOG PARITY ERROR.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT);
END
P<FCT> = FCTADR;
#
* CHECK THE CSN OF THE CARTRIDGE IN THIS CUBICLE. IF IT IS
* NOT THE SELECTED CSN, GET THE NEXT ENTRY.
#
IF FCT$CSND[0] NQ SEL$CSN
THEN
BEGIN
TEST J;
END
#
* IF THE CARTRIDGE MANUFACTURER IS DIFFERENT FROM THE SELECTED
* MANUFACTURER, GET THE NEXT ENTRY.
#
IF SEL$CM NQ FCT$CCOD[0]
THEN
BEGIN
TEST J;
END
FOUND = TRUE;
#
* PROCESS EACH AU.
#
SLOWFOR N = 0 STEP 8 UNTIL INAVOT
DO
BEGIN # PROCESS EACH AU #
#
* WRITE HEADER TO REPORT FILE IF NEW PAGE.
#
IF LN$CNT GQ MAX$LN
THEN
BEGIN # PAGE EJECT AND PRINT HEADER #
RPEJECT(OUT$FETP);
RPLINE(OUT$FETP,"SSUSE OPTIONAL REPORT D - ",5,26,1);
RPLINE(OUT$FETP,"DETAILED AU STATUS REPORT",31,25,1);
RPLINE(OUT$FETP,"SM = ",59,5,1);
RPLINE(OUT$FETP,TEMP$SM,64,1,1);
CHAR$10[0] = XCOD(SUBFAM);
RPLINE(OUT$FETP,"SUBFAMILY = ",68,12,1);
RPLINE(OUT$FETP,CHAR$R1[0],80,1,1);
RPLINE(OUT$FETP,"FAMILY = ",84,9,1);
RPLINE(OUT$FETP,TEMP$FAM,93,7,0);
RPSPACE(OUT$FETP,SP"SPACE",1);
RPLINE(OUT$FETP,"F = FLAWED AU ",9,14,1);
RPLINE(OUT$FETP,"(DEMARK FAILURE)",23,16,0);
RPLINE(OUT$FETP,"V = START OF VOLUME",9,19,0);
RPLINE(OUT$FETP,"E = ONE OF THE ERROR FLAGS",9,26,1);
RPLINE(OUT$FETP," SET (AU CONFLICT, FROZEN ",35,26,1);
RPLINE(OUT$FETP,"CHAIN, START OF FRAGMENT)",61,25,0);
RPSPACE(OUT$FETP,SP"SPACE",1);
RPLINE(OUT$FETP,"FCTORD Y Z",5,18,1);
RPLINE(OUT$FETP,"CM CSN GROUP",30,20,0);
CHAR$10[0] = XCDD(J);
RPLINE(OUT$FETP,CHAR$R3[0],5,3,1);
CHAR$10[0] = XCDD(FCT$Y[0]);
RPLINE(OUT$FETP,CHAR$R2[0],15,2,1);
CHAR$10[0] = XCDD(FCT$Z[0]);
RPLINE(OUT$FETP,CHAR$R2[0],21,2,1);
CHAR$10[0] = FCT$CCOD[0];
BZFILL(CHAR,TYPFILL"BFILL",2);
RPLINE(OUT$FETP,CHAR$L2[0],30,2,1);
CHAR$10[0] = FCT$CSND[0];
BZFILL(CHAR,TYPFILL"BFILL",10);
RPLINE(OUT$FETP,CHAR$L8[0],32,8,1);
GP = J / MAXGRT;
CHAR$10[0] = XCDD(GP);
RPLINE(OUT$FETP,CHAR$R2[0],46,2,1);
IF (AST$AUSF[J] + AST$AULF[J] + AST$FLAWS[J]) EQ INAVOT
THEN
BEGIN
RPLINE(OUT$FETP,"*** EMPTY CARTRIDGE ***",55,23,0);
END
ELSE
BEGIN
RPLINE(OUT$FETP," ",55,1,0);
END
RPSPACE(OUT$FETP,SP"SPACE",1);
RPLINE(OUT$FETP,"AU XXX0",6,15,1);
RPLINE(OUT$FETP,"XXX1 XXX2",32,19,1);
RPLINE(OUT$FETP,"XXX3 XXX4",62,19,1);
RPLINE(OUT$FETP,"XXX5 XXX6",92,19,1);
RPLINE(OUT$FETP,"XXX7",122,4,0);
LN$CNT = 13;
END # PAGE EJECT AND PRINT HEADER #
NUM = XCOD(N);
RPLINE(OUT$FETP,C<6,3>NUM,5,3,1);
RPLINE(OUT$FETP,"X",8,1,1);
COLUMN = 12;
SLOWFOR I = N STEP 1 UNTIL N + 7
DO
BEGIN # PRINT EIGHT AU ON A LINE #
#
* DO NOT CONTINUE IF ALL AU-S HAVE BEEN REPORTED.
#
IF I GR INAVOT
THEN
BEGIN
RPLINE(OUT$FETP," ",135,1,0); # PRINT LINE #
TEST N;
END
#
* DO NOT REPORT ON AU ZERO.
#
IF N EQ 0 AND I EQ 0
THEN
BEGIN
COLUMN = COLUMN + 15;
TEST I;
END
ER$CODE = " ";
CODE = " ";
SETFCTX(I); # SET *FWD* AND *FPS* VALUES #
#
* CHECK EACH AU FOR FLAGS.
#
IF FCT$AUCF(FWD,FPS) NQ 0 ##
OR FCT$FRCF(FWD,FPS) NQ 0 ##
OR FCT$SFF(FWD,FPS) NQ 0
THEN # ONE OF THE ERROR FLAGS SET #
BEGIN
ER$CODE = "E";
END
IF FCT$FAUF(FWD,FPS) NQ 0
THEN # FLAWED AU #
BEGIN
CODE = " F";
END
IF FCT$CAUF(FWD,FPS) EQ 0
THEN # START OF VOLUME #
BEGIN
CODE = " V";
END
IF FCT$FAUF(FWD,FPS) NQ 0 ##
AND FCT$CAUF(FWD,FPS) EQ 0
THEN # FLAWED AU AND START OF VOLUME #
BEGIN
CODE = "FV";
END
#
* CONVERT THE CARTRIDGE LINK FIELD TO OCTAL AND PRINT IT.
#
XWOD(FCT$CLFG(FWD,FPS),DIS);
RPLINE(OUT$FETP,CODE,COLUMN,2,1);
RPLINE(OUT$FETP,DIS$CLFG[0],COLUMN + 2,10,1);
RPLINE(OUT$FETP,ER$CODE,COLUMN + 12,1,1);
COLUMN = COLUMN + 15;
END # PRINT EIGHT AU ON A LINE #
LN$CNT = LN$CNT + 1;
RPLINE(OUT$FETP," ",135,1,0); # PRINT OUT LINE #
END # PROCESS EACH AU #
#
* CLOSE THE SFM CATALOG AND RETURN.
#
CCLOSE(USARG$FM[0],SUBFAM,0,FLAG);
IF FLAG NQ CMASTAT"NOERR"
THEN
BEGIN
SSMSG$PROC[0] = PROCNAME;
MESSAGE(SSMSG[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT);
END
RETURN;
END # PROCESS AN *FCT* ENTRY #
END # CHECK EACH SELECTED SM #
#
* CLOSE THE CATALOG.
#
CCLOSE(USARG$FM[0],SUBFAM,0,FLAG);
IF FLAG NQ CMASTAT"NOERR"
THEN # UNABLE TO CLOSE CATALOG #
BEGIN
SSMSG$PROC[0] = PROCNAME;
MESSAGE(SSMSG[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT);
END
ZFILL(FCTBUFCW,1); # CLEAR CONTROL BUFFER #
END # PROCESS EACH SUBFAMILY #
#
* IF CSN WAS NOT FOUND ISSUE MESSAGE TO DAYFILE AND ABORT.
#
IF NOT FOUND
THEN
BEGIN
SSMSG$LINE[0] = " CARTRIDGE NOT FOUND.";
MESSAGE(SSMSG$BUF[0],SYSUDF1);
RPCLOSE(OUT$FETP);
RESTPFP(PFP$ABORT);
END
RETURN;
END # USRPTD #
TERM