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 P = BADDR; # * 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 = 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 = 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 BSEL$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 BSEL$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 = CSMARG; 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 BSEL$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 BSEL$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 = CUSARG$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 BSEL$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 BSEL$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 = CUSARG$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 BSEL$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 BSEL$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 = 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 BSEL$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 = 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 BSEL$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 BSEL$SM EQ 0 THEN # SM NOT SELECTED # BEGIN TEST SM; END P = PRMBADR; 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 P = ASTADR; # * 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 = 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 BSEL$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 BSEL$SM EQ 0 THEN # SM NOT SELECTED # BEGIN TEST SM; END P = PRMBADR; 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 = 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 BSEL$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 BSEL$SM EQ 0 THEN # SM NOT SELECTED # BEGIN TEST SM; END P = PRMBADR; 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 P = ASTADR; # * 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 = 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