PRGM SSVAL; # TITLE SSVAL - SFM VALIDATE PROGRAM. # BEGIN # SSVAL # # ***** SSVAL - M860 CATALOG VALIDATION UTILITY. * * THE FUNCTION OF *SSVAL* IS TO EXAMINE THE SFM CATALOG AND * THE PERMANENT FILE CATALOG FOR THE SPECIFIED FAMILY, OPTIONALLY * EXAMINE SPECIFIED SMMAP FILES, AND ISSUE A REPORT DETAILING * ANY IRREGULARITIES OR DISCREPANCIES FOUND. A COUNT OF THE * NUMBER OF VALIDATION ERRORS DETECTED, IF ANY, IS PLACED IN * THE DAYFILE. IF SELECTED, *SSVAL* WILL RELEASE SFM SPACE * FOR PURGED FILES. WHEN ERROR CONDITIONS ARE FOUND, *SSVAL* * WILL OPTIONALLY SET FLAGS IN AFFECTED ENTRIES OF THESE FILES * TO PROTECT A PERMANENT FILE FROM BEING SUBJECT TO BEING * LOST AND TO PERMIT THE SITE TO RECOVER FROM THE ERROR VIA * THE *SSDEBUG* UTILITY. * * RUN TIME PARAMETERS ALLOW SELECTED SUBFAMILIES OR ALL * SUBFAMILIES AND SELECTED SUBCATALOGS OR ALL SUBCATALOGS * TO BE ANALYZED. * * THERE ARE TWO TYPES OF VALIDATION RUNS. THEY ARE - * 1) TO VALIDATE THE "LIVE" CATALOGS TO DETECT ERRORS AND ALLOW REPAIR OF THE CATALOGS. REPAIR REFERS TO THE PROCESS OF SETTING FLAGS WHICH, DEPENDING ON THE FLAG SET MAY OR MAY NOT CORRECT THE PROBLEM. * 2) TO VALIDATE THE COPIES OF THE CATALOGS FROM THE RELEASE * DATA FILE TO ALLOW RELEASE OF THE "FREE SPACE" IN THE * SFM CATALOG FOR FILES THAT WERE PURGED BY THE USER. * * THE REQUIREMENTS AND RESULTS OF THESE RUNS ARE - * * FOR TYPE 1 - * . THE SFM CATALOG PERMANENT FILE MUST BE ATTACHABLE. * . THE PERMANENT FILE CATALOG MUST BE ACCESSIBLE. * . THE SMMAP FILE MUST BE ATTACHABLE ( IF SELECTED ). * . THE CATALOGS ARE EXAMINED FOR VALIDATION ERRORS. * . THE VALIDATION REPORT IS ISSUED. * . THE CATALOGS ARE REPAIRED FOR ERRORS DETECTED TO * ALLOW CORRECTIVE ACTION. * * FOR TYPE 2 - * . NO LIVE CATALOGS ARE USED. * . NO VALIDATION OF THE SMMAP FILE OCCURS. * . COPIES OF THE SFM CATALOG AND THE *PFC* ARE * EXAMINED FOR VALIDATION ERRORS. * . THE VALIDATION REPORT IS ISSUED. * . THE "FREE SPACE" IN THE SFM CATALOG IS RELEASED. THIS CONSEQUENTLY RELEASES SPACE IN THE APPROPRIATE CARTRIDGE(S). * * THE REPAIR/RELEASE FUNCTION OF *SSVAL* CANNOT OCCUR IF THE * M860 *EXEC* SUBSYSTEM IS NOT RUNNING. * *** *SSVAL* IS THE M860 UTILITY THAT VALIDATES THE SFM CATALOG, * PERMANENT FILE CATALOG (*PFC*) AND THE SMMAP FILE, REPAIRS * THE CATALOGS AND RELEASES SPACE IN THE SFM CATALOG FOR PURGED * USER FILES. * *** INPUT DATA IS FROM THE SFM CATALOG FILE AND THE PERMANENT * FILE CATALOG FOR A SINGLE FAMILY. THESE TWO INPUT FILES MAY * EITHER BE FROM THEIR PERMANENT LOCATION ON THE FAMILY * PACKS ("LIVE") OR FROM THE RELEASE DATA FILE (*RDF*) * PRODUCED BY THE *PFDUMP* UTILITY. *SSVAL* WILL PRODUCE A *PFC * EXTRACT FILE* FROM EITHER OF THE ABOVE SOURCES. * * THE SMMAP FILE IS AN INPUT IF SPECIFIED BY AN OPTION ON * THE CONTROL CARD. IT IS ACCESSED ONLY FROM ITS PERMANENT * LOCATION ON THE SYSTEM DEFAULT FAMILY. * * SFM CATALOG FILE - CONTAINS THE CONTROL INFORMATION ABOUT * THE FILES ON THE MSF. THE FILE AND CARTRIDGE TABLE (*FCT*) * PORTION OF THE CATALOG CONTAINS THE ALLOCATION AND STATUS * INFORMATION FOR EACH CARTRIDGE. THE *FCT* * IS EXAMINED FOR IRREGULARITIES AND ERRORS. * * PERMANENT FILE CATALOG - CONTAINS CONTROL INFORMATION ABOUT * USER PERMANENT FILES RESIDING ON THE MSF. THE ALTERNATE * STORAGE ALLOCATION FIELD (*ASA*) CONTAINS THE POINTER * SPECIFIYING THE *SM* INDEX, *FCT* ORDINAL. * * SMMAP FILE - CONTAINS CONTROL INFORMATION ABOUT ALL CUBES * AND CARTRIDGES IN A GIVEN SM. * * RDF FILE - (RELEASE DATA FILE) CONTAINS A HEADER, *PFC* EXTRACT * RECORDS, AND COPIES OF SFM CATALOGS. IT IS PRODUCED BY * *PFDUMP*. THE DATE AND TIME WHEN THE FILE WAS CREATED IS * RECORDED IN THE HEADER. THE RDF FILE IS USED FOR BACKUP * PURPOSES ONLY. A DESCRIPTION OF THE FIELDS IN THE RDF FILE * MAY BE FOUND IN *COMSPFM*. * * *** CONTROL CARD CALL. * * SSVAL(P1,P2,...,PN) * * PARAMETER DESCRIPTION * --------- ----------- * * L LISTABLE OUTPUT ON FILE *OUTPUT*. * L = *LFN* LISTABLE OUTPUT ON FILE *LFN*. * L = 0 NO OUTPUT FILE GENERATED. * L OMITTED SAME AS L. * * RF RELEASE DATA FILE ON LOCAL FILE *ZZZZRDF*. * RF = *LFN* RELEASE DATA FILE ON FILE *LFN*. * RF OMITTED USE THE CURRENT VERSION OF THE SFM CATALOGS * FOR ANALYSIS. * * FM USE DEFAULT FAMILY. NOT PERMITTED IF *RF* * IS SPECIFIED. * FM=FAMILY FAMILY TO BE ANALYZED. NOT PERMITTED IF * *RF* IS SPECIFIED. * FM OMITTED SAME AS *FM* IF *RF* IS NOT SPECIFIED. USE * THE FAMILY ON THE RELEASE DATA FILE IF *RF* * IS SPECIFIED. * * SB ALL SUBFAMILIES ARE TO BE PROCESSED. * SB = CHARS SELECT UP TO EIGHT SUBFAMILIES. THERE * ARE EIGHT POSSIBLE SUBFAMILIES NUMBERED FROM * 0 THROUGH 7 (E.G. SB=723 SELECTS SUBFAMILIES * 2,3,AND 7). * SB OMITTED SAME AS *SB*. * * SM ALL *SM-S* PROCESSED. * SM = CHARS SELECT UP TO EIGHT *SM*-S INDICATED * BY THE LETTERS A-H (E.G. SM=ACHG SELECTS * *SM-S* A, C, AND H). * SM OMITTED SAME AS *SM*. * * AM ANALYZE THE SFM SMMAP. THIS OPTION MAY * ONLY BE USED IF *RF* IS NOT SPECIFIED. * *SSVAL* WILL ONLY EXAMINE A PARTICULAR * SMMAP IF THE SFM CATALOG HAS A SUBCATALOG * FOR THE CORRESPONDING *SM* AND IS THAT * *SM* WAS SELECTED BY THE *CS* PARAMETER. * AM OMITTED DO NOT ANALYZE THE SFM SMMAP. * * FX *PFC* AND SFM CATALOGS WILL NOT BE * AUTOMATICALLY FLAGGED OR FIXED AND RELEASE * PROCESSING WILL NOT BE PERFORMED IF THERE * ARE ANY ERRORS (SAME AS FX=0). * FX = N *PFC* AND SFM CATALOGS WILL ONLY BE * AUTOMATICALLY FIXED OR RELEASE PROCESSING * WILL BE PERFORMED ONLY IF THE TOTAL ERROR * COUNT IS LESS THAN OR EQUAL TO N. * FX OMITTED SAME AS *FX*. * * RL RELEASE PROCESSING IS TO BE PERFORMED. * THIS OPTION MAY ONLY BE USED IF *RF* * IS ALSO SELECTED. * RL OMITTED NO RELEASE PROCESSING WILL BE PERFORMED. * * ST FILES ARE INDICATED AS SCATTERED IF THEY * SPREAD ACROSS MORE THAN THE MINIMUM NUMBER * OF CARTRIDGES NEEDED TO CONTAIN THEM. * ST = N FILES ARE INDICATED AS SCATTERED IF THEY * SPREAD ACROSS N MORE CARTRIDGES THAN THE * MINIMUM NUMBER NEEDED TO CONTAIN THEM. * ST OMITTED SAME AS *ST*. * * *** THE VALIDATION PROCESS EXAMINES THE ALTERNATE STORAGE AND * PERMANENT FILE CATALOGS AND REPORTS VALIDATION ERRORS DETECTED. * * THE CATALOG ENTRIES ARE VALIDATED AS FOLLOWS. * . ALL *PFC* ENTRIES FOR USER FILES THAT RESIDE ON MSF. * - THE *ASA* FIELD. * * ASA NOT HEAD OF CHAIN. * * ASA OUT OF RANGE. * * INVALID *SM* IN ASA. * * MULTIPLE *PFC* ENTRIES OWN THE SFM FILE. * - THE READ DATA ERROR FLAG. * * READ ERROR FLAG SET IN *PFC* ENTRY. * . ALL *FCT* ENTRIES IN THE SFM CATALOG. * - THE CARTRIDGE STATUS (INHIBIT, LOST, EXCESSIVE * WRITE PARITY ERROR, START OF FRAGMENT, CONFLICT, SMMAP * ERROR,CSN AND Y AND Z COORDINATES). * * *FCT* ENTRIES CONTAIN THE FOLLOWING PROBLEMS - * - INHIBIT ALLOCATION FLAG SET. * - FROZEN CHAIN FLAG SET. * - EXCESSIVE WRITE PARITY ERRORS FLAG SET. * - START OF FRAGMENT FLAG SET. * - AU CONFLICT FLAG SET. * - LOST CARTRIDGE FLAG SET. * - THE AU CHAIN INFORMATION (CHAIN CONTROL, OFF CARTRIDGE * LINK FLAG, OFF CARTRIDGE LINKS). * * CHAINS INTERSECT OR ARE ILL-FORMED. * * FRAGMENTS DETECTED. * * SCATTERED FILE DETECTED. * * NO VALID SMMAP ENTRY FOR THE FCT. * * . ALL SMMAP ENTRIES ASSIGNED TO THE SUBFAMILY. * - THE VSN, FAMILY, SUBFAMILY, *FCT* ORDINAL FIELDS. * . SMMAP ENTRY ALLOCATED TO THE SUBFAMILY THAT HAS NO * VALID *FCT* ENTRY IN THE SFM CATALOG. * *** THE RESULTS OF RUNNING *SSVAL* ARE: * - THE VALIDATION REPORT. * - THE RELEASE OF FREE SFM SPACE IN THE SFM CATALOG. * - THE REPAIRS OF THE CATALOGS FOR VALIDATION ERRORS DETECTED. * * FREE SPACE IN THE SFM CATALOG IS RELEASED IF THE RF AND * RL CONTROL CARD PARAMETERS WERE SPECIFIED AND IF THE * TOTAL VALIDATION ERRORS DETECTED WERE LESS THAT THE * THRESHOLD SET BY THE FX CONTROL CARD PARAMETER. IN ADDITION, * THE RELEASE FOR A SPECIFIC SUBFAMILY AND *SM* OCCURS ONLY * IF THE RDF FILE DATE AND TIME IS MORE RECENT THAN THE * LAST PURGE DATE AND TIME RECORDED IN THE PREAMBLE OF THE * SFM CATALOG. * * REPAIRS TO THE CATALOGS OCCUR ONLY IF THE FM CONTROL CARD * PARAMETER IS ACTIVE AND THE TOTAL VALIDATION ERRORS ARE * LESS THAN THE THRESHOLD SET BY THE FX CONTROL CARD PARAMETER. * * *PFC* ENTRIES CAN ONLY BE REPAIRED IF THE FILE IS DISK RESIDENT. * - THE *ASA* IS CLEARED IN THE *PFC* ENTRY TO PREVENT THE * RELEASE OF THE DISK SPACE. * REPAIRS TO THE SFM CATALOG OCCUR IF ERRORS ARE DETECTED IN * *FCT* ENTRIES. * - THE FOLLOWING FLAGS ARE SET IN THE SFM CATALOG *FCT* ENTRY. * . THE FROZEN FLAG IS SET TO PREVENT AUTOMATIC RELEASE OF THE * SFM FILE SPACE AND ALLOW INSPECTION OF THE SFM DATA. * . THE START OF FRAGMENT FLAG IS SET IF A FRAGMENT WAS * DETECTED. * . THE SMMAP ERROR FLAG IS SET IF THE *FCT* HAS NO SMMAP * ENTRY. * . THE INHIBIT FLAG IS SET IF THE SMMAP ERROR OCCURRED. * REPAIR TO THE SMMAP FILE OCCURS FOR ERRORS DETECTED IN THE * SMMAP-*FCT* LINKAGE. * . THE ERROR FLAG IN THE SMMAP ENTRY IS SET. * * THE VALIDATION REPORT CONTAINS INFORMATIONAL AND ERROR LINES * DESCRIBING WHAT WAS VALIDATED AND WHAT WAS FOUND TO BE IN ERROR. * * COLUMN 0 IS RESERVED FOR THE CARRIAGE CONTROL CHARACTER. * * THE TITLE, INFORMATIONAL AND HEADING LINES START IN COLUMN 4. * * THE DETAIL LINES START IN COLUMN 7 OR BEYOND. * * LINE - GENERAL * TYPE - FORMAT * ---- - ------ * * TITLE - SSVAL - VALIDATION REPORT ...VER 1.0 * SUB-TITLE - FAMILY = NAME * * PRESET - (CONTROL CARD IMAGE) * DETAIL - (LIST OF) KEYWORD = VALUE. * * RDF DETAIL - RDF FILE FAMILY = NAME * - RDF FILE BUDT = DATE-TIME * * PRESET - *** PF = NAME INVALID SM IN PFC * ERRORS - UI = VALUE * * SUBCATALOG - SUBFAMILY = N *SM* = X "GOOD" * HEADINGS - "INTERSECTIONS" * - "PROBLEMS" * * SUB-HEADING - -HEAD OF CHAINS- * INTERSECTIONS - FCTORD-STRM FCTORD-STRM * * INTERSECTIONS - (CHAIN-ID) (CHAIN-ID) * DETAIL - * * SUB-HEADING - ERR IDENTIFICATION -CHAIN- ERROR * PROBLEMS - TYP FCT-STM-A/U-H-E * * PROBLEM - 4 PF=NAME * DETAIL - UI=VALUE * - BU=DATE-TIME * - DI=N/Y (CHAIN-ID) TEXT * (CHAIN-ID) (TEXT) * TEXT * * SUMMARY - FREE M860 FILE = NNN * - FREE M860 AU-S = NNNN * - TOTAL VALIDATION ERRORS = NNN * * MISCELLANEOUS - ***CONNECT TO EXEC FAILED * - CATALOGS NOT MODIFIED * - CATALOGS MODIFIED * - FREE FILES RELEASED * * * THE INTERSECTIONS REPORT SECTION IS ISSUED FOR THE SUBCATALOG * WHEN INTERSECTIONS ARE DETECTED. * * THE PROBLEM REPORT SECTION IS ISSUED AT THE END OF EACH * SUBCATALOG-S VALIDATION. * * ENOUGH IDENTIFICATION IS GIVEN TO ALLOW THE ANALYST TO LOCATE THE * ENTRY(S) RELATING TO THE PROBLEM IN THE CATALOGS: SFM CATALOG, * *PFC* OR SMMAP. * * ERROR TYPE VALUES IN THE PROBLEM REPORT SECTION ARE - * 1 - *FCT* ENTRY WITH NO VALID SMMAP ENTRY. * 2 - SMMAP ENTRY WITH NO VALID *FCT* ENTRY. * 3 - *PFC* ENTRY WITH INVALID ASA. * 4 - *PFC* ENTRY WITH PROBLEMS. * 5 - ORPHANS WITH PROBLEMS. * 6 - CHAIN FRAGMENTS. * 7 - UNALLOCATED SFM ENTRIES WITH PROBLEMS. * *** DAYFILE MESSAGES. * * * SSVAL COMPLETED.* * * SSVAL ABORTED.* * * FREE FILES RELEASED.* * * CATALOGS MODIFIED.* * * CATALOGS NOT MODIFIED.* * * TOTAL VALIDATION ERRORS = NN.* * * VALIDATING SB=N SM=X.* * * CONTROL CARD SYNTAX ERROR.* * * INVALID CS PARAMETER.* * * INVALID FX PARAMETER.* * * INVALID SB PARAMETER.* * * INVALID ST PARAMETER.* * * ILLEGAL - L AND RF PARAMETER.* * * ILLEGAL - RL AND NO RF PARAMETER.* * * ILLEGAL - RF AND FM PARAMETER.* * * ILLEGAL - RF AND AM PARAMETER.* * * SSVAL - MUST BE SYSTEM ORIGIN.* * * RDF FILE ERROR - MISSING HEADER.* * * RDF FILE ERROR - BAD RECORD LENGTH.* * * RDF FILE ERROR - UNIDENTIFIED DATA.* * * SFM CATALOG OPEN ERROR.* * * SFM CATALOG READ ERROR.* * * SMMAP OPEN ERROR.* * * SMMAP READ ERROR.* * * REQUIRED FL EXCEEDS JOB MAX.* * * CONNECT TO EXEC FAILED.* * * UCP CALL ERROR.* * * FAMILY NOT FOUND IN SYSTEM.* * * ERROR READING *PFC*.* * * SSVAL ABNORMAL* NAME.* * *** OPERATOR MESSAGES. * * * WAITING FOR FILE FILENAME.* * * WAITING FOR EXEC.* * * VALIDATING SB=N SM=X.* * *** SSVAL. * * *SSVAL* IS THE M860 UTILITY PROGRAM THAT VALIDATES DATA IN THE * SFM CATALOG, THE PERMANENT FILE CATALOG (PFC) AND THE SMMAP * FILE. IT CAN ALSO REPAIR THE CATALOGS FOR VALIDATION * ERRORS DETECTED AND RELEASE FREE SPACE IN THE SFM CATALOG FOR * PURGED USER FILES. * * SSVAL(P1,P2,...,PN) * * PRGM SSVAL * * MESSAGES * CONNECT TO EXEC FAILED.* * * SSVAL COMPLETED.* * * NOTES *SSVAL* - * . CALLS VLPRSET TO INITIALIZE FILES AND PARAMETERS. * . CONNECTS TO M860 *EXEC*. * . CALLS VLSUBFM FOR EACH SUBFAMILY TO VALIDATE. * . CALLS VLFIX TO PERFORM REPAIR/RELEASE PROCESSING * ON THE CATALOGS. * . DISCONNECTS AND CLOSES. * ********** ** METHOD. OR METHODS.... * * A NUMBER OF LOCAL FILES ARE USED TO RETAIN INFORMATION * THROUGHOUT THE VALIDATION PROCESS - * * . *PFC* EXTRACT FILES - CONTAIN EXTRACTS FROM THE LIVE * *PFC* OR FROM THE RDF FILE. THERE IS A SEPARATE * FILE FOR EACH SUBFAMILY. * * . PROBLEM FILE - CONTAINS ENTRIES FOR VALIDATION * ERRORS DETECTED. * * . FIXIT FILE - CONTAINS ENTRIES FOR ALL REPAIRS AND * RELEASES THAT MAY BE PERFORMED. * * . ZZZVALX FILES - CONTAIN COPIES OF THE SFM CATALOGS, * FROM THE RDF FILE. THERE IS A SEPARATE FILE * FOR EACH SUBFAMILY. * * A VALIDATION TABLE (*VT*) IS USED TO CONTAIN AND EXAMINE * THE *FCT* DATA FOR A SUBCATALOG IN THE SFM CATALOG. THE * *VT* HAS A 1 WORD ENTRY. * * EACH WORD (REPRESENTING ONE AU IN THE *FCT*) CONTAINS * STATUS AND LINKAGE INFORMATION ABOUT THE AU - * . ALLOCATED OR NOT. * . HEAD OF CHAIN AND/OR END OF CHAIN * . *PFC* OWNER FLAG * . VALIDATION ERROR FLAGS. * . A LINK TO THE NEXT AU IN THE CHAIN. * * VALIDATION ERROR FLAGS ARE ASSIGNED PROBLEM TYPES (1,2, OR 4) * THAT REFLECT THE SUBSEQUENT REPORT AND REPAIR PROCESSING * THAT SHOULD OCCUR - * TYPE 1 - REPORT THE PROBLEM AND DO NOT REPAIR. * TYPE 2 - REPORT THE PROBLEM. REPAIR ONLY IF THERE * IS AN ASSOCIATED *PFC* ENTRY. * TYPE 4 - REPORT THE PROBLEM AND REPAIR THE CATALOG(S). * * THE *VT* IS USED AS A FAST METHOD TO FOLLOW CHAINS TO * ENSURE THAT THEY ARE VALID. ERRORS ARE- * . INTERSECTING CHAINS. * . ILL-FORMED CHAINS. * * AS THE CHAIN IS FOLLOWED, EACH ENTRY IS MARKED BY SETTING * THE POINTER FIELD TO THE HEAD OF CHAIN ENTRY. * ** GENERAL RULES. * * *SSVAL* ALWAYS ISSUES A SUBSYSTEM REQUEST USING THE * SUBSYSTEM ID FOR THE M860 EXEC AND PARAMETERS FOR A * "CONNECT". IF THE M860 EXEC IS NOT PRESENT OR IF THE * M860 EXEC RETURNS AN ERROR STATUS, *SSVAL* ISSUES A * MESSAGE "CONNECT TO EXEC FAILED" AND CONTINUES. BUT * NO FURTHER SUBSYSTEM REQUESTS ARE MADE. THEREFORE, NO * REPAIR/RELEASE PROCESSING CAN OCCUR. SSVAL CONTINUES * IN THIS "LIMITED" MODE TO PRODUCE THE VALIDATION REPORT. * * THE CATALOGS ARE ATTACHED IN READ MODE. THIS PROVIDES AN * INTERLOCK TO ENSURE THAT NO ONE IS MODIFIYING THE DATA * DURING VALIDATION. * * I/O ERRORS WILL BE DETECTED AND PROCESSED BY *CIO*. * ** HEIRARCHY. * * 3 MAJOR STEPS - * * . PRESET - PROCESS THE CONTROL CARD PARAMETERS INTO * RUN TIME PARAMETERS. * - PROCESS INPUT FILES TO GENERATE WORKING FILES. * * . VALIDATE (THIS STEP REPEATS FOR ALL SELECTED * SUBCATALOGS WITHIN SELECTED SUBFAMILIES). * - ANALYZES ALL CATALOG DATA AND GENERATES THE * PROBLEM FILE. * - EXAMINES ALL PROBLEM FILE ENTRIES AND GENERATES * THE VALIDATION REPORT AND THE FIXIT FILE. * * . FIX - EXAMINES THE FIXIT FILE ENTRIES AND RELEASES FREE * SPACE IF THIS MODE IS SELECTED. * - EXAMINES THE FIXIT FILE ENTRIES AND REPAIRS CATALOG * ENTRIES IF THIS OPTION IS SELECTED. * * * *SSVAL* MAJOR ROUTINES. * 1.0 VLPRSET - PRESET PARAMETERS AND FILES. * 1.1 VLTAB - * 1.2 VLPFC - READ THE PFC. * 1.3 VLRDF - READ THE RDF FILE. * 1.3.1 VLRDF2 - PROCESS THE RDF RECORD. * * 2.0 VLSUBFM - SUBFAMILY VALIDATION. * 2.1 VLBLDVT - BUILD VALIDATION TABLE. * 2.1.1 VLCMAP - SMMAP LOOKUP. * 2.2 VLASFM - ANALYZE THE SFM CATALOG. * 2.2.1 VLNCS - NORMAL CHAIN SCAN. * 2.2.2 VLCFS - CHAIN FRAGMENT SCAN. * 2.2.3 VLSMSC - SMMAP SCAN. * 2.3 VLAPFC - ANALYZE THE *PFC* CATALOG. * 2.3.1 VLAPFC2 - ANALYZE *PFC* PASS 2. * 2.4 VLRPT - VALIDATION REPORT. * 2.4.1 VLRPTL - ISSUE REPORT LINE. * 2.4.2 VLSCH - SCAN CHAIN FOR REPORT. * * 3.0 VLFIX - FIX CATALOGS. * 3.1 VLFIXP - FIX PFC. * ** EXTERNAL INTERFACE ROUTINES. * * CATALOG/MAP ACCESS ROUTINES. * M860 REPORT FORMATTER. * NOS MACROS USING THE SYMPL INTERFACES ON MAC1. * SPECIAL ROUTINES ON MAC2. * - XARG * - CALLSS * - CINTLK * - GETFAM * - RDPFC * - SETASA * - SETPFP * - UATTACH # CONTROL PRESET; # **** PROC SSVAL - XREF LIST BEGIN. # XREF BEGIN PROC ABORT; # CALLS *ABORT* MACRO # PROC GETPFP; # GET USER INDEX AND FAMILY # PROC GETSPS; # GET SYSTEM ORIGIN STATUS # PROC MEMORY; # INTERFACE TO *MEMORY* MACRO # PROC RESTPFP; # RESTORE USER-S *PFP* AND ABORT OR RETURN # PROC RPCLOSE; # CLOSES A PRINT FILE # PROC VLERROR; # ISSUE ERROR MESSAGE # PROC VLFIX; # FIX CATALOGS # PROC VLMSG; # ISSUE INFORMATIONAL MESSAGE # PROC VLPRSET; # PRESET PARAMETERS AND FILES # PROC VLREQEX; # REQUEST TO EXEC # PROC VLSUBFM; # SUBFAMILY VALIDATION # END # **** PROC SSVAL - XREF LIST END. # DEF RSLEN #1#; # RETURN STATUS WORD LENGTH # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTINGS # *CALL COMBFAS *CALL COMBCMD *CALL COMBCPR *CALL COMBMAP *CALL COMBMCT *CALL COMBPFP *CALL COMTFMT *CALL COMTVLD *CALL COMTVLF *CALL COMTVLM *CALL COMTVLV *CALL COMTVLX ARRAY SCR$FET [0:0] S(SFETL);; # SCRATCH FET # ARRAY SPSSTAT [0:0] S(RSLEN); BEGIN ITEM SPS$STATUS U(00,48,12); # RETURN STATUS # END CONTROL EJECT; GETSPS(SPSSTAT); # GET SYSTEM ORIGIN STATUS # IF SPS$STATUS NQ 0 THEN BEGIN VLMSG(VM"NEEDSYOT"); # MUST HAVE SYSTEM PRIVILEGES # ABORT; END # * SAVE THE USER-S CURRENT FAMILY AND USER INDEX IN COMMON. # GETPFP(PFP[0]); USER$FAM[0] = PFP$FAM[0]; USER$UI[0] = PFP$UI[0]; # * GET CURRENT JOB FIELD LENGTH. # MEM$MIN = O"50000"; # SAVE PROGRAM SIZE # MEM$WDS[0] = MEM$MIN; MEMORY("CM",MEMRQST,RCL,NA); # SET MEMORY # # * GET MAXIMUM JOB FIELD LENGTH. # MEM$WDS[0] = REQMAXFL; MEMORY("CM",MEMRQST,RCL,NA); MEM$MAX = MEM$WDS[0]; # SAVE MAXIMUM MEMORY ALLOWED # # * PRESET - PROCESS CONTROL CARD AND INITIALIZE FILES. # VLPRSET; # * CONNECT TO SUBSYSTEM. # CONNECTED = TRUE; # INITIALIZE FOR VLREQEX CALL # VLREQEX(TYP"TYP1",REQTYP1"CONNECT"); IF STAT NQ 0 THEN # CONNECT REQUEST FAILED # BEGIN VLERROR(VE"NCONNECT",NOABT); # ISSUE ERROR MESSAGE # CONNECTED = FALSE; # NOT CONNECTED # END # * VALIDATE ALL SELECTED SUBFAMILIES. ONLY THOSE SUBFAMILIES * SELECTED BY THE CONTROL CARD AND WHO HAVE THE SFM CATALOG FILE * AVAILABLE IN THIS RUN ARE VALIDATED. # SLOWFOR SBINDX = 0 STEP 1 UNTIL MAXSF DO BEGIN IF (BPAR$SB EQ 1) AND (BSFMCATDEF EQ 1) THEN BEGIN VLSUBFM; # VALIDATE SUBFAMILY # END END # * RETURN MEMORY USED IN VALIDATION. # MEM$WDS[0] = MEM$MIN; MEMORY("CM",MEMRQST,RCL,NA); # REDUCE FL # # * FIX CATALOGS PROCESSING. # VLFIX; # * CLOSE THE REPORT FILE AND DISCONNECT. # RPCLOSE(RPTFADR); VLREQEX(TYP"TYP1",REQTYP1"DISCONNECT"); # DISCONNECT FROM EXEC # VLMSG(VM"VLDONE"); # SSVAL COMPLETED # IF TOTALERRS - PAR$FX LQ 0 THEN BEGIN RESTPFP(PFP$END); END ELSE BEGIN RESTPFP(PFP$ABORT); END STOP; END # SSVAL # TERM PROC VLAMSF; # TITLE VLASFM - ANALYZE THE SFM CATALOG. # BEGIN # VLASFM # # ** VLASFM - ANALYZE THE SFM CATALOG. * * *VLAMSF* CONTROLS THE VALIDATION PROCESS THAT EXAMINES * THE SFM CATALOG DATA IN THE *VT* TABLE. * * PROC VLASFM * * ENTRY (PAR$AM) - AM CONTROL CARD PARAMETER. * (ARRAY VTTABLE) - VALIDATION TABLE ENTRIES. * * EXIT (VTEN$PROB) - THIS FIELD IN EACH VALIDATION TABLE ENTRY * IS UPDATED TO REFLECT THE TYPE OF * VALIDATION PROBLEMS ENCOUNTERED SO FAR. * * NOTES *VLAMSF* PROCESSES BY - * . CALLING *VLNCS* TO PERFORM THE NORMAL CHAIN SCAN. * . CALLING *VLCFS* TO PERFORM THE CHAIN FRAGMENT SCAN. * . CALLING *VLSMSC* TO SCAN THE SMMAP. * . SCANNING ALL ENTRIES IN THE *VT* TABLE TO UPDATE THE * PROBLEM FIELD IN THE ENTRY AND IN ITS ASSOCIATED HEAD * OF CHAIN ENTRY. # # **** PROC VLASFM - XREF LIST BEGIN. # XREF BEGIN PROC VLCFS; # CHAIN FRAGMENT SCAN # PROC VLSMSC; # *SM* MAP SCAN # PROC VLNCS; # NORMAL CHAIN SCAN # END # **** PROC VLASFM - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMBFAS *CALL COMTVLD *CALL COMTVLV ITEM I I; # TEMPORARY VARIABLE # ITEM K I; # TEMPORARY VARIABLE # ITEM PT U; # PROBLEM TYPE # CONTROL EJECT; # * PERFORM NORMAL CHAIN SCAN. # VLNCS; # * PERFORM CHAIN FRAGMENT SCAN. # VLCFS; # * PERFORM SMMAP SCAN IF THE *AM* PARAMETER WAS SPECIFIED. # # * SCAN ALL *VT* ENTRIES TO UPDATE THE *VT* PROBLEM FIELD IN THE * ENTRY AND IN THE CORRESPONDING HEAD OF CHAIN ENTRY. THE PROBLEM * FIELD IS DEFINED TO BE THE LOGICAL SUM OF ALL THE PROBLEM TYPES * FOR ALL THE VALIDATION ERRORS DETECTED FOR THAT ENTRY. PROBLEM * TYPES FOR EACH VALIDATION ERROR ARE DEFINED IN THE *VTPTYPES* * ARRAY IN COMTVLV. # SLOWFOR I = VTFIRST STEP 1 UNTIL VTLAST DO BEGIN # SCAN OF *VT* ENTRIES # VTEN$WORD[0] = VT$ITEM[I]; # GET *VT* ENTRY # # * SCAN THE ERROR FLAGS IN THE *VT* ENTRY (BITS *VPS* THRU *VPX*). * ADD THE PROBLEM TYPE FOR EVERY ACTIVE ERROR FLAG TO THE LOGICAL * SUM. # PT = 0; SLOWFOR K = VPS STEP 1 UNTIL VPX DO BEGIN IF BVTEN$WORD[0] EQ 1 THEN BEGIN PT = PT LOR VTP$TYP[K]; # OR LOGICAL SUM TOGETHER # END END # * LOGICALLY ADD THE COMPUTED PROBLEM TYPES TO THE PROBLEM FIELD IN * IN THE *VT* ENTRY. # VTEN$PROB[0] = VTEN$PROB[0] LOR PT; VT$ITEM[I] = VTEN$WORD[0]; # STORE *VT* ENTRY # # * UPDATE *HOC* ENTRY PROBLEM FIELD ( LOGICAL SUM OF MEMBERS ). # VTEN$WORD[0] = VT$ITEM[VTEN$POINT[0]]; # GET *HOC* ENTRY # VTEN$PROB[0] = VTEN$PROB[0] LOR PT; # ADD VALUE OF MEMBER # VT$ITEM[VTEN$POINT[0]] = VTEN$WORD[0]; # UPDATE *HOC* ENTRY # END # SCAN OF *VT* ENTRIES # END # VLASFM # TERM PROC VLAPFC(GROUP); # TITLE VLAPFC - ANALYZE THE *PFC* CATALOG. # BEGIN # VLAPFC # # ** VLAPFC - ANALYZE THE *PFC* CATALOG DATA. * * *VLAPFC* READ THE *PFC* EXTRACT FILE FOR THE SUBFAMILY * AND VALIDATES EACH *PFC* ENTRY FOR THE SELECTED *SM*. * * PROC VLAPFC * * ENTRY (SMINDX) - *SM* NUMBER. * (PRM$ENTRC) - COUNT OF *FCT* ENTRIES IN PREAMBLE. * (SBINDX) - SUBFAMILY NUMBER. * (ARRAY VTTABLE) - VALIDATION TABLE ENTRIES. * * EXIT FOR DETECTED ERRORS - * . SET *VT* ENTRY ERROR FLAGS AND UPDATE THE * *VTEN$PROB* FIELD. * . A PROBLEM FILE RECORD IS WRITTEN (RECORD TYPE * REC"ASA" OR REC"OTHR"). * * MESSAGES * SSVAL ABNORMAL, VLAPFC.*. * * NOTES *VLAPFC* WILL DETECT THE FOLLOWING ERRORS - * . ILLEGAL *ASA* IN THE *PFC* (NO SFM CATALOG ENTRY * FOR THE *ASA* IN THE *VT*). * . MULTIPLE OWNERS. * . NOT HEAD OF CHAIN. * . DATA ERROR FLAG ON IN THE *PFC*. * . *PFC* POINTS TO A CHAIN WITH PROBLEMS. * * IF THE MULTIPLE OWNERS COUNTER IS NOT ZERO, *VLAPFC2* * IS CALLED TO FIND THE FIRST OWNER. # # **** PROC VLAPFC - XREF LIST BEGIN. # XREF BEGIN PROC MESSAGE; # MESSAGE TO DAYFILE # PROC VLWFIX; # WRITE FIXIT FILE RECORD # PROC READ; # INTERFACE TO *READ* MACRO # PROC READW; # INTERFACE TO *READW* MACRO # PROC REWIND; # INTERFACE TO *REWIND* MACRO # PROC VLAPFC2; # ANALYZE *PFC* PASS 2 # PROC VLERROR; # ISSUE ERROR MESSAGE # PROC VLWPROB; # WRITE PROBLEM FILE RECORD # FUNC XCOD C(10); # BINARY TO DISPLAY # PROC ZSETFET; # INITIALIZES A *FET* FOR *I/O* # END # **** PROC VLAPFC - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMBFAS *CALL COMBCMD *CALL COMBMCT *CALL COMTVLD *CALL COMTVLF *CALL COMTVLV ITEM GROUP I; # GROUP BEING PROCESSED # ITEM GMO I; # GLOBAL MULTIPLE OWNERS # ITEM I I; # TEMPORARY VARIABLE # ARRAY BLDLFN [0:0] S(1); # BUILD *LFN* # BEGIN ITEM BLDNAME C(00,00,07) = [ EXTLFN ]; # NAME OF FILE # ITEM BLDLFNX U(00,36,06); # SUBFAMILY NUMBER # END # * THIS ARRAY FOR LINK MESSAGE. # ARRAY LINK [0:0] P(3); BEGIN # LINK MESSAGE # ITEM LINK$MG C(00,00,10) = [" UI = "]; ITEM LINK$NO C(01,00,10); ITEM LINK$Z U(02,00,60) = [0]; # ZERO BYTE # END CONTROL EJECT; P = PRMBADR; GMO = 0; # INITIALIZE MULTIPLE OWNERS COUNTER # # * INITIALIZE THE *PFC* EXTRACT FILE FOR READING. # EXTFADR = LOC(EXTRACTFIL); # FET ADDRESS # EXTBADR = LOC(EXTRACBUF); # BUFFER ADDRESS # BLDLFNX = SBINDX + "0"; # APPEND SUBFAMILY TO *LFN* # ZSETFET(EXTFADR,BLDLFN,EXTBADR,LEXTBUF,SFETL); REWIND(EXTRACTFIL,RCL); READ(EXTRACTFIL,NRCL); # * PROCESS EACH RECORD IN THE *PFC* EXTRACT FILE FOR THE SUBFAMILY. # STAT = OK; REPEAT WHILE STAT EQ OK DO BEGIN # SCAN SUBFAMILY *PFC* ENTRIES # READW(EXTRACTFIL,EXTRECORD,RLEXTR,STAT); IF STAT NQ OK THEN # DETECTED EOR, EOF, EOI OR ERROR # BEGIN TEST DUMMY; # SKIP, NO RECORD READ # END # * SKIP THIS RECORD IF THE *SM* IN THE *PFC* IS NOT THE ONE BEING * PROCESSED. # IF EXTR$SM[0] NQ SMINDX THEN BEGIN TEST DUMMY; END # * SKIP THIS RECORD IF THE GROUP IN THE *PFC* IS NOT THE ONE * BEING PROCESSED. # IF EXTR$GP[0] NQ GROUP THEN BEGIN TEST DUMMY; END # * CHECK FOR VALID *ASA* IN THE *PFC*. # IF EXTR$GP[0] GR MAXGP OR EXTR$GPT[0] GR MAXGRT OR EXTR$AU[0] GR INAVOT THEN # *ASA* OUT OF RANGE # BEGIN VLWPROB(REC"ASA"); # BUILD PROBLEM ENTRY # TEST DUMMY; END # * DO NOT CHECK THE PFC AGAINST THE SFM CATALOG * IF THE CATALOG IS EMPTY. # IF VTLAST LS VTFIRST THEN BEGIN TEST DUMMY; END # * USING THE *ASA*, LOCATE AND EDIT THE *VT* ENTRY FOR THIS RECORD. # P = LOC(VTPTR); # BUILD LINK TO *VT* ENTRY # VTL$GRT[0] = EXTR$GPT[0]; VTL$AU[0] = EXTR$AU[0]; IF (VTL$WORD[0] LS VTFIRST) OR (VTL$WORD[0] GR VTLAST) THEN # INVALID LINK # BEGIN LINK$NO = XCOD(EXTR$UI[0]); MESSAGE(LINK,SYSUDF1); MP$WD[1] = " VLAPFC INVALID LINK "; VLERROR(VE"SYSERR",ABRT); # ABORT WITH MESSAGE # END VTEN$WORD[0] = VT$ITEM[VTPTR]; # GET ENTRY # # * IF *VT* ENTRY IS ALREADY OWNED AND THE MULTIPLE OWNER FLAG * IS NOT SET, 1) SET IT, 2) UPDATE THE PROBLEM TYPE FIELD, * AND 3) INCREMENT THE MULTIPLE OWNERS COUNTER. THIS COUNTER * WILL BE USED IN VLAPFC2 TO LOCATE THE FIRST OWNER(S). # IF VTEN$OWN AND NOT VTEN$MULT THEN # MULTIPLE OWNER DETECTED # BEGIN VTEN$MULT = TRUE; # SET MULTIPLE OWNER FLAG # VTEN$PROB = VTEN$PROB LOR VTP$TYP[BMUL]; # SET PROBLEM TYPE # GMO = GMO + 1; # INCREMENT OWNERS # END VTEN$OWN = TRUE; # SET OWNER FLAG # # * IF THE DATA ERROR FLAG IS SET IN THE *PFC*, SET THE ERROR FLAG * IN THE *VT* AND UPDATE THE PROBLEM FIELD. # IF EXTR$DERR[0] THEN BEGIN VTEN$RERR[0] = TRUE; VTEN$PROB[0] = VTEN$PROB[0] LOR VTP$TYP[BRER]; TPFCERRS = TPFCERRS + 1; END # * IF THE SYSTEM ERROR FLAG IS SET IN THE *PFC*, SET THE ERROR FLAG * IN THE *VT* AND UPDATE THE PROBLEM FIELD. # IF EXTR$SYS[0] THEN BEGIN VTEN$SYS[0] = TRUE; VTEN$PROB[0] = VTEN$PROB[0] LOR VTP$TYP[BSYS]; TPFCERRS = TPFCERRS + 1; END # * IF THE *PFC* DOES NOT POINT TO THE HEAD OF CHAIN, SET THE ERROR * FLAG AND UPDATE THE PROBLEM TYPE FIELD. # IF NOT VTEN$HOC[0] THEN BEGIN VTEN$MSH[0] = TRUE; VTEN$PROB[0] = VTEN$PROB[0] LOR VTP$TYP[BMSH]; END # * IF THE FREE CARTRIDGE FLAG IS SET ON CARTRIDE THEN ADD * A RECORD TO THE FIXIT FILE. # IF VTEN$FCF[0] AND NOT EXTR$FF[0] THEN # BUILD FICIT FILE ENTRY # BEGIN VLWFIX(REC"FCF"); END # * IF THE *PFC* POINTS TO A CHAIN WITH PROBLEMS, ADD THIS * ENTRY TO THE PROBLEM FILE. # IF VTEN$PROB[0] NQ 0 THEN BEGIN VLWPROB(REC"OTHR"); # BUILD PROBLEM ENTRY # END VT$ITEM[VTPTR] = VTEN$WORD[0]; # STORE THE *VT* ENTRY # # * IF THE *VT* ENTRY WAS NOT THE HEAD OF CHAIN, UPDATE THE *HOC*. # IF VTEN$POINT[0] NQ VTPTR THEN BEGIN # UPDATE *HOC* ENTRY # I = VTEN$PROB[0]; # SAVE PROBLEM OF MEMBER # VTEN$WORD[0] = VT$ITEM[VTEN$POINT[0]]; # GET *HOC* ENTRY # IF VTEN$OWN[0] THEN BEGIN VTEN$MULT[0] = TRUE; VTEN$PROB[0] = VTEN$PROB[0] LOR VTP$TYP[BMUL]; GMO = GMO + 1; END VTEN$OWN[0] = TRUE; VTEN$PROB[0] = VTEN$PROB[0] LOR I; # PROBLEM OF MEMBER # VT$ITEM[VTEN$POINT[0]] = VTEN$WORD[0]; END # UPDATE *HOC* ENTRY # END # SCAN SUBFAMILY *PFC* ENTRIES # # * IF AN UNEXPECTED *CIO* ERROR OCCURRED, ABORT. # IF STAT EQ CIOERR THEN BEGIN MP$WD[1] = "VLAPFC"; # NAME FOR MESSAGE # VLERROR(VE"SYSERR",ABRT); # ABORT WITH MESSAGE # END # * IF THERE ARE GLOBAL MULTIPLE OWNERS, PERFORM VLAPFC2 TO FIND * THE FIRST OWNER OF THE FILE. # IF GMO GR 0 THEN BEGIN VLAPFC2(GMO,GROUP); END END # VLAPFC # TERM PROC VLAPFC2(CNT,GROUP); # TITLE VLAPFC2 - ANALYZE *PFC* PASS 2. # BEGIN # VLAPFC2 # # ** VLAPFC2 - ANALYZE THE *PFC* PASS 2. * * *VLAPFC2* READS THE *PFC* EXTRACT FILE TO FIND THE FIRST OWNER * SINCE MULTIPLE OWNERS WERE FOUND IN *VLAPFC*. ALL OTHER * INTERSECTIONS WITH THIS PARTICULAR CHAIN ARE MARKED IN *VLAPFC*. * * PROC VLAPFC2(CNT) * * ENTRY (CNT) - COUNT OF MULTIPLE OWNERS. * (SMINDX) - *SM* NUMBER BEING PROCESSED. * ARRAY VTTABLE - VALIDATION TABLE ENTRIES. * ARRAY EXTRACTFIL - *PFC* EXTRACT FILE *FET*. * * EXIT FOR THE *PFC* ENTRY THAT IS THE "FIRST" OWNER - * . *VT* ENTRY *VTEN$1ST* FLAG IS SET. * . A PROBLEM FILE RECORD IS WRITTEN AS "OTHR" RECORD * TYPE. # ITEM GROUP I; # GROUP BEING PROCESSED # ITEM CNT I; # COUNT OF MULTIPLE *PFC* OWNERS # # **** PROC VLAPFC2 - XREF LIST BEGIN. # XREF BEGIN PROC READ; # INTERFACE TO *READ* MACRO # PROC READW; # INTERFACE TO *READW* MACRO # PROC REWIND; # INTERFACE TO *REWIND* MACRO # PROC VLWPROB; # WRITE PROBLEM FILE RECORD # END # **** PROC VLAPFC2 - XREF LIST END. # DEF LISTCON #0#; # TURN OFF LISTING # *CALL COMBFAS *CALL COMTVLD *CALL COMTVLF *CALL COMTVLV CONTROL EJECT; # * READ THE *PFC* EXTRACT FILE. # REWIND(EXTRACTFIL,RCL); READ(EXTRACTFIL,NRCL); # * READ THE EXTRACT FILE UNTIL, 1) THE FILE STATUS IS NOT OK, * OR 2) THERE ARE NO MORE MULTIPLE OWNERS. # STAT = 0; REPEAT WHILE STAT EQ OK AND (CNT GR 0) DO # PROCESS THE EXTRACT RECORD # BEGIN # READING EXTRACT FILE # READW(EXTRACTFIL,EXTRECORD,RLEXTR,STAT); # GET THE EXTRACT RECORD # IF STAT NQ OK THEN BEGIN TEST DUMMY; # DETECTED EOR, EOF, EOI OR ERROR # END # * PROCESS ONLY THE RECORDS FOR THE GIVEN SM. # IF EXTR$SM[0] NQ SMINDX THEN # NOT SELECTED # BEGIN TEST DUMMY; END IF EXTR$GP[0] NQ GROUP THEN BEGIN TEST DUMMY; END # * USING THE *ASA* IN THE EXTRACT RECORD, DEVELOP THE INDEX TO * THE *VT* ARRAY FOR THIS RECORD. # P = LOC(VTPTR); # BUILD LINK TO *VT* ENTRY # VTL$GRT[0] = EXTR$GPT[0]; VTL$AU[0] = EXTR$AU[0]; IF (VTL$WORD[0] LS VTFIRST) OR (VTL$WORD[0] GR VTLAST) THEN BEGIN TEST DUMMY; # SKIP IF THE INDEX IS BAD # END # * GET THE *VT* ENTRY FOR THIS *PFC* EXTRACT RECORD. # VTEN$WORD[0] = VT$ITEM[VTPTR]; # GET *VT* ENTRY # # * DETERMINE IF THIS IS THE 1ST OWNER OF MULTIPLY-OWNED FILE. # IF VTEN$MULT[0] AND (NOT VTEN$1ST[0]) THEN BEGIN VTEN$1ST[0] = TRUE; VT$ITEM[VTPTR] = VTEN$WORD[0]; # UPDATE ENTRY # VLWPROB(REC"OTHR"); # BUILD PROBLEM ENTRY # CNT = CNT - 1; END END # READING EXTRACT FILE # END # VLAPFC2 # TERM PROC VLBFILL(FLD,NWDS); # TITLE VLBFILL - BLANK FILL. # BEGIN # VLBFILL # # ** VLBFILL - BLANK FILL. * * *VLBFILL* CHANGES ALL BINARY ZERO CHARACTERS STARTING IN *FLD* * TO DISPLAY CODE BLANKS FOR A LENGTH OF *NWDS*. * * PROC VLBFILL * * ENTRY (FLD) - THE FIELD TO SCAN. * (WDS) - NUMBER OF WORDS TO SCAN. * * EXIT (FLD) - CONTAINS THE BLANK FILLED FIELD. # ITEM FLD I; # FIELD TO SCAN # ITEM NWDS I; # NUMBER OF WORDS TO SCAN # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMBFAS ITEM CHARINDX I; # INDEX FOR CHARACTERS SCANNED # ITEM NCHAR I; # NUMBER OF CHARACTERS TO SCAN # BASED ARRAY SCAN [0:0] S(200); # TO SCAN FIELD # ITEM SCAN$WD C(00,00,200); CONTROL EJECT; # * LOOK FOR A BINARY ZERO CHARACTER IN THE SPECIFIED FIELD AND * CHANGE IT TO A BLANK. # P = LOC(FLD); NCHAR = NWDS * 10; # NUMBER OF CHARACTERS TO SCAN # SLOWFOR CHARINDX = 0 STEP 1 UNTIL NCHAR - 1 DO BEGIN # CHARINDX # IF CSCAN$WD[0] EQ 00 THEN # FOUND A BINARY ZERO # BEGIN CSCAN$WD[0] = " "; # REPLACE WITH A BLANK # END END # CHARINDX # END # VLBFILL # TERM PROC VLBICT(E1,E2); # TITLE VLBICT - INTERSECTING CHAIN REPORT. # # *** # BEGIN # VLBICT # # ** VLBICT - INTERSECTING CHAIN REPORT. * * *VLBICT* ISSUES THE INTERSECTING CHAIN DETAIL LINE TO THE * REPORT FILE AND ALSO ISSUES THE SUBCATALOG HEADING LINE * WHEN CALLED THE FIRST TIME FOR THE SUBCATALOG. * * PROC VLBICT(E1,E2) * * ENTRY (E1) - *VT* ENTRY INDEX (*FCT* ORDINAL, AU) * FOR ENTRY 1. * (E2) - *VT* ENTRY INDEX (*FCT* ORDINAL, AU) * FOR ENTRY 2. * (RPTFADR) - ADDRESS OF THE REPORT FILE *FET*. * (SCDTLH) - SUBCATALOG DETAIL HEADING FLAG. * * EXIT INTERSECTING CHAIN DETAIL LINE WRITTEN TO THE REPORT * FILE. * (SCRPTED) - SUBCATALOG REPORTED FLAG. * (SCDTLH) - SUBCATALOG DETAIL HEADING FLAG. * * NOTES TO FORCE LEADING ZEROS ON THE *FCT* NUMBER AND * THE AU NUMBER THE *ZFD* VALUE IS ADDED BEFORE * CONVERSION. * # ITEM E1 I; # CHAIN ENTRY 1 # ITEM E2 I; # CHAIN ENTRY 2 # # **** PROC VLBICT - XREF LIST BEGIN. # XREF BEGIN PROC RPLINE; # CALLS *RPLINEX* TO PRINT A LINE # PROC VLERROR; # ISSUE ERROR MESSAGE # FUNC VLNTC C(10); # NUMERIC TO CHARACTER CONVERSION # PROC VLSUBHD; # ISSUE REPORT SUBHEADING # END # **** PROC VLBICT - XREF LIST END. # DEF LISTCON #0#; # TURN OFF LISTING # *CALL COMBFAS *CALL COMTVLD *CALL COMTVLF *CALL COMTVLV # * INTERSECTING CHAIN DETAIL LINE FOR THE REPORT FILE. # ARRAY ICLINE [0:0] S(3); # INTERSECTING CHAIN REPORT LINE # BEGIN ITEM ICL$DEF C(00,00,30) = ["000-0000 000-0000"]; ITEM ICL$FCT1 C(00,00,03); # *FCT* OF ENTRY ONE # ITEM ICL$AU1 C(00,24,04); # *AU* OF ENTRY ONE # ITEM ICL$FCT2 C(01,30,03); # *FCT* OF ENTRY TWO # ITEM ICL$AU2 C(01,54,04); # *AU* OF ENTRY TWO # END CONTROL EJECT; # * IF THE DETAIL HEADING HAS NOT BEEN PRINTED, PRINT IT. # IF NOT SCDTLH THEN BEGIN VLSUBHD(SHTYP"ICT"); # PRINT DETAIL HEADING # SCRPTED = TRUE; # SUBCATALOG REPORTED FLAG # SCDTLH = TRUE; # SET SUBCATALOG DETAIL HEADING FLAG # END # * FORMAT AND PRINT THE INTERSECTING REPORT LINE. # P = LOC(E1); # *VT* LINK FOR ENTRY 1 # ICL$FCT1[0] = VLNTC(GROUPX*16+VTL$GRT[0] +ZFD,"XCDD",3); ICL$AU1[0] = VLNTC(VTL$AU[0] # GET AU # +ZFD,"XCDD",4); P = LOC(E2); # *VT* LINK FOR ENTRY 2 # ICL$FCT2[0] = VLNTC(GROUPX*16+VTL$GRT[0] +ZFD,"XCDD",3); ICL$AU2[0] = VLNTC(VTL$AU[0] # GET AU # +ZFD,"XCDD",4); RPLINE(RPTFADR,ICLINE,24,30,EOPL); # ISSUE LINE TO REPORT # RETURN; END # VLBICT # TERM PROC VLBLDVT(GROUP); # TITLE VLBLDVT - BUILD VALIDATION TABLE. # BEGIN # VLBLDVT # # ** VLBLDVT - BUILD THE VALIDATION TABLE. * * *VLBLDVT* READS THE *FCT* IN THE SELECTED SUBCATALOG (SM) * OF THE SFM CATALOG BEING PROCESSED AND BUILDS A *VT* * TABLE ENTRY FOR EACH AU OF EACH *FCT* ENTRY. * * PROC VLBLDVT * * ENTRY (SMINDX) - *SM* INDEX CURRENTLY PROCESSING. * (PAR$AM) - AM PARAMETER FROM CONTROL CARD. * (PAR$FM) - FM PARAMETER FROM CONTROL CARD. * (SBINDX) - SUBFAMILY CURRENTLY PROCESSING. * P - START OF *VT* TABLE IN MEMORY. * (GROUP) - GROUP THAT WILL BE PROCESSED. * * EXIT (VTFIRST) - INDEX OF FIRST ENTRY IN THE TABLE. * (VTLAST) - INDEX OF LAST ENTRY IN THE TABLE. * (ARRAY VTTABLE) - CONTAINS ENTRIES FOR EACH AU IN * THE SUBCATALOG. * * MESSAGES *SFM CATALOG READ ERROR.* * * NOTES IF THE AM PARAMETER WAS SELECTED, THE *VLCMAP* * ROUTINE IS CALLED TO CHECK THE SMMAP ENTRY FOR EACH * *FCT* READ. * * THESE *VT* ENTRY FIELDS ARE SET DEPENDING ON THE * *FCT* ENTRY - * . VTEN$NONE - NO CARTRIDGE ( *VSN* = BLANKS ). * . VTEN$SM - SMMAP ENTRY ERROR. * . VTEN$INHB - INHIBIT FLAG SET. * . VTEN$LOST - LOST CARTRIDGE FLAG SET. * . VTEN$EWPE - EXCESSIVE WRITE PARITY ERRORS. * . VTEN$CONF - AU CONFLICT FLAG SET. * . VTEN$FROZ - FROZEN FLAG SET. * . VTEN$SOF - START OF FRAGMENT SET. * . VTEN$ALOC - AU ALLOCATED. * . VTEN$HOC - AU IS HEAD OF CHAIN. * . VTEN$EOC - AU IS END OF CHAIN. * . VTEN$LINK - INDEX TO NEXT AU IN CHAIN. * # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTINGS # # **** PROC VLBLDVT - XREF LIST BEGIN. # XREF BEGIN PROC CGETFCT; # GET AN *FCT* ENTRY # PROC VLCMAP; # *SM* MAP LOOKUP # PROC VLERROR; # ISSUE ERROR MESSAGE # END # **** PROC VLBLDVT - XREF LIST END. # *CALL COMBFAS *CALL COMBCMD *CALL COMBCMS *CALL COMBMAP *CALL COMBMCT *CALL COMTVLD *CALL COMTVLM *CALL COMTVLV ITEM EOCS B; # SAVE END OF CHAIN BIT # ITEM GROUP U; # GROUP TO BE PROCESSED # ITEM LINKHS I; # SAVE LINK POINTER HEADER # ITEM NEXT I; # INDEX TO *FCT* ORD TABLE # ITEM SMERR B; # FLAG RESULTS OF VLCMAP PROCESS # ITEM SW U; # AU WORD OFFSET # ITEM SP U; # AU POSITION IN WORD # ITEM START I; # START OF PROCESSING # ITEM TERMX I; # TERMINATION ORDINAL # ITEM ITEMP I; # TEMPORARY # ITEM I I; # INDUCTION VARIABLE # ITEM VPOINT U; # VOLUME HEAD POINTER # CONTROL EJECT; # * INITIALIZE *VT* POINTERS. # P = LOC(VTFIRST); # BUILD STARTING LINK ADDRESS # VTL$GRT[0] = 0; VTL$AU[0] = 1; VTPTR = VTL$WORD[0] - 1; # INITIALIZE ENTRY POINTER # GRTX = -1; EOCS = FALSE; # * PROCESS FOR EACH *FCT* RECORD. # START = GROUP * 16; TERMX = START + 15; SLOWFOR FCTORD = START STEP 1 WHILE FCTORD LQ TERMX AND FCTORD LQ (PRM$ENTRC[SMINDX] + 15) DO BEGIN # *FCT* PROCESSING # GRTX = GRTX + 1; # * READ THE *FCT* RECORD. # STAT = 0; FB$CWRD[0] = 0; CGETFCT(PAR$FM,SBINDX,SMINDX,FCTORD,LOC(VLFCTAREA),0,STAT); IF STAT NQ CMASTAT"NOERR" THEN BEGIN VLERROR(VE"CATR",ABRT); # ABORT WITH MESSAGE # END P = LOC(VLFCTAREA); SMERR = FALSE; # INITIALIZE TO NO *SM* ERROR # # * IF THE *AM* OPTION WAS SELECTED, PERFORM A SMMAP CHECK. # IF PAR$AM NQ 0 THEN BEGIN VLCMAP(SMERR); END # * PROCESS FOR EACH AU OF THE *FCT* RECORD. # SLOWFOR AUINDX = 1 STEP 1 UNTIL INAVOT DO BEGIN # AU PROCESSING # # * CALCULATE AU WORD AND OFFSET INTO *FCT* AREA. # SW = FCT$WD(AUINDX); SP = FCT$WP(AUINDX); IF FCT$CAUF(SW,SP) EQ 0 THEN # SAVE POINTER AT VOLUME START # BEGIN VPOINT = FCT$LINK(SW,SP); END # * BUILD *VT* ENTRY FOR THE AU. # VTEN$WORD[0] = 0; IF FCT$CSND[0] EQ " " OR FCT$1ST[0] EQ 0 THEN # * BUILD *VT* ENTRY WHEN NO CARTRIDGE. # BEGIN VTEN$NONE[0] = TRUE; EOCS = FALSE; VPOINT = 0; END ELSE # * BUILD *VT* ENTRY WHEN CARTRIDGE EXISTS. # BEGIN # CARTRIDGE EXISTS # VTEN$SME[0] = SMERR; VTEN$INHB[0] = FCT$IAF[0]; VTEN$LOST[0] = FCT$LCF[0]; VTEN$EWPE[0] = FCT$EEF[0]; VTEN$CONR[0] = FCT$AUCF(SW,SP); VTEN$FROZR[0] = FCT$FRCF(SW,SP); VTEN$SOFR[0] = FCT$SFF(SW,SP); VTEN$ALOCR[0] = FCT$FBF(SW,SP); VTEN$FCF[0] = FCT$FCF[0]; # * PROCESS AN ALLOCATED HEAD OF VOLUME *AU*. # IF VTEN$ALOC[0] AND FCT$CAUF(SW,SP) EQ 0 THEN BEGIN # AU ALLOCATED # ITEMP = FCT$CC(SW,SP); IF ITEMP EQ CHAINCON"FIRST" THEN BEGIN VTEN$HOC[0] = TRUE; # HEAD OF CHAIN # END IF ITEMP EQ CHAINCON"LAST" THEN BEGIN EOCS = TRUE; END IF ITEMP EQ CHAINCON"ONLY" THEN BEGIN VTEN$HOC[0] = TRUE; # SET BOTH HEAD AND # EOCS = TRUE; END # * IF NOT THE END OF THE CHAIN, SET LINK TO NEXT IN CHAIN. # IF NOT EOCS THEN BEGIN # LINK TO THE NEXT AU # ITEMP = FCT$CLKOCL(SW,SP); LINKHS = GRTX; IF ITEMP NQ 0 THEN BEGIN VTEN$OCL[0] = ITEMP; LINKHS = FCT$OCL[0]; IF ITEMP EQ 2 THEN BEGIN LINKHS = FCT$OCL1[0]; END ELSE BEGIN IF ITEMP EQ 3 THEN BEGIN LINKHS = FCT$OCL2[0]; END END END END # LINK TO THE NEXT AU # END # AU ALLOCATED # IF VTEN$ALOC[0] AND FCT$LEN(SW,SP) NQ 0 THEN # *AU*-S REMAIN IN VOLUME # BEGIN VTEN$LINKL[0] = AUINDX + 1; VTEN$LINKH[0] = GRTX; END IF VTEN$ALOC[0] AND FCT$LEN(SW,SP) EQ 0 THEN BEGIN VTEN$LINKL[0] = VPOINT; VTEN$LINKH[0] = GRTX; VTEN$EOC[0] = EOCS; IF EOCS THEN BEGIN VTEN$LINKH[0] = 0; END IF NOT EOCS THEN BEGIN VTEN$LINKH[0] = LINKHS; END EOCS = FALSE; END END # CARTRIDGE EXISTS # # * PUT *VT* ENTRY INTO TABLE IN MEMORY. # VTPTR = VTPTR + 1; # ADDRESS FOR NEXT ENTRY # VT$ITEM[VTPTR] = VTEN$WORD[0]; # PUT ENTRY IN TABLE # END # AU PROCESSING # VTPTR = VTPTR + 2048 - INAVOT; END # *FCT* PROCESSING # # * MARK END OF ENTRIES IN *VT* TABLE. # VTLAST = VTPTR; # SAVE END OF *VT* TABLE # RETURN; END # VLBLDVT # TERM PROC VLCFS; # TITLE VLCFS - CHAIN FRAGMENT SCAN. # BEGIN # VLCFS # # ** VLCFS - CHAIN FRAGMENT SCAN. * * *VLCFS* SCANS ALL ENTRIES IN THE *VT* TABLE TO DETECT CHAIN * FRAGMENTS. CHAIN FRAGMENTS ARE *VT* ENTRIES THAT ARE ALLOCATED * BUT ARE NOT MARKED AS MEMBERS OF NORMAL CHAINS (SEE *VLNCS*). * * PROC VLCFS * * ENTRY (VTFIRST) - INDEX TO FIRST ENTRY IN *VT*. * (VTLAST) - INDEX TO LAST ENTRY IN *VT*. * ARRAY VTTABLE - VALIDATION TABLE ENTRIES. * * EXIT THE FOLLOWING FIELDS IN THE *VT* ENTRIES MAY BE * UPDATED IF FRAGMENTS ARE DETECTED. * . VTEN$POINT - INDEX TO HEAD OF CHAIN. * . VTEN$SOF - START OF FRAGMENT FLAG SET. * . VTEN$ILL - SET IF CHAIN IS ILL-FORMED. * . VTEN$INTC - SET IF CHAIN IS INTERSECTING. * * THE INTERSECTING CHAIN DETAIL LINES ARE ISSUED * TO THE REPORT FILE IF INTERSECTIONS ARE DETECTED. * * NOTES AN ENTRY IS MARKED AS BEING ON A CHAIN BY * SETTING THE VTEN$POINT FIELD EQUAL TO *HOC* INDEX. * * THE CHAIN IS FOLLOWED UNTIL - * . AN END-OF-CHAIN ENTRY IS DETECTED. * . AN ILL-FORMED CHAIN IS DETECTED. * . AN INTERSECTING CHAIN IS DETECTED. * * AN ILL-FORMED CHAIN HAS AN ENTRY THAT LINKS TO ANOTHER * ENTRY ALREADY ON THE CHAIN OR LINKS TO AN ENTRY * THAT IS NOT ALLOCATED OR HAS A LINK THAT IS NOT ZERO * WHEN THE *EOC* IS SET. * * AN INTERSECTING CHAIN IS ONE WHOSE ENTRY LINKS TO AN * ENTRY ALREADY ON A DIFFERENT CHAIN. * * IF A FRAGMENT CHAIN RUNS INTO ANOTHER FRAGMENT CHAIN, * THE SECOND FRAGMENT IS CONSIDERED A TAIL OF THE * FIRST. IT IS FOLLOWED AND RE-MARKED SO THAT ITS * POINTER FIELD *VTEN$POINT* CONTAINS THE INDEX OF THE * FIRST START OF FRAGMENT ENTRY. * # # **** PROC VLCFS - XREF LIST BEGIN. # XREF BEGIN PROC VLBICT; # INTERSECTING CHAIN REPORT # END # **** PROC VLCFS - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMBFAS *CALL COMTVLD *CALL COMTVLV STATUS CHAIN # CHAIN STATUS # OK, # GOOD CHAIN # ILL, # ILL-FORMED CHAIN # INTC; # INTERSECTING CHAIN # ITEM ENDCHAIN B; # END OF CHAIN FLAG # ITEM HOCSTAT S : CHAIN; # CHAIN STATUS # ITEM I I; # TEMPORARY VARIABLE # ITEM TAIL B; # TAIL FLAG # ITEM TAILPTR I; # *VT* INDEX OF A TAIL # CONTROL EJECT; # * SCAN *VT* FOR ALLOCATED ENTRIES NOT ON CHAINS. THIS VALIDATION * STEP IS TO IDENTIFY PROBLEMS WITH AU-S THAT ARE NOT ON VALID * CHAINS. # SLOWFOR I = VTFIRST STEP 1 UNTIL VTLAST DO BEGIN # *VT* ENTRY # VTEN$WORD[0] = VT$ITEM[I]; # GET *VT* ENTRY # # * FIND AN ALLOCATED AU THAT IS NOT ON A CHAIN. * IT IS DEFINED AS A FRAGMENT CHAIN. IF THE ENTRY IS ALREADY * ASSIGNED TO A CHAIN, THE VTEN$POINT IS SET. # IF NOT VTEN$ALOC[0] OR VTEN$POINT[0] NQ 0 THEN BEGIN TEST I; # SKIP, NOT A FRAGMENT # END VTEN$SOF[0] = TRUE; # SET START OF FRAGMENT FLAG # # * INITIALIZE FIELDS USED TO FOLLOW THE FRAGMENT CHAIN. * THE VARIABLE I = INDEX OF FRAGMENT *HOC*. # VTPTR = I; # START AT THIS *HOC* # ENDCHAIN = FALSE; HOCSTAT = S"OK"; TAIL = FALSE; TAILPTR = 0; # * PROCESS EACH ENTRY IN FRAGMENT STARTING WITH *HOC* ENTRY. # REPEAT WHILE NOT ENDCHAIN DO # SCAN FRAGMENT CHAIN # BEGIN # FRAGMENT PROCESSING # IF (VTEN$POINT[0] EQ 0) OR (VTEN$POINT[0] EQ TAILPTR) THEN # * ENTRY BELONGS TO THIS CHAIN (EITHER A NEW ENTRY OR A TAIL ENTRY). # BEGIN # ADD ENTRY TO THE FRAGMENT CHAIN # VTEN$POINT[0] = I; IF NOT VTEN$ALOC[0] THEN BEGIN VTEN$SOF[0] = TRUE; END IF NOT VTEN$ALOC[0] OR VTEN$EOC[0] AND VTEN$LINK[0] NQ 0 THEN BEGIN HOCSTAT = S"ILL"; # ILL-FORMED CHAIN # END END # ADD ENTRY TO THE FRAGMENT CHAIN # ELSE # * ENTRY ALREADY ON SOME OTHER CHAIN. # BEGIN # ENTRY ON A CHAIN # IF VTEN$SOF[0] AND (VTPTR NQ I) # NOT LOOPING # AND VTEN$ALOC[0] AND VTPTR EQ VTEN$POINT[0] THEN # * THE OTHER CHAIN IS A TAIL. THE CHAIN BEING FOLLOWED POINTS TO * THE BEGINNING OF A FRAGMENT CHAIN. MAKE THE TWO CHAINS INTO ONE * FRAGMENT CHAIN BY FOLLOWING THIS TAIL AND UPDATING THE * VTEN$POINT. # BEGIN # START TAIL # TAIL = TRUE; VTEN$SOF[0] = FALSE; VTEN$INTC[0] = FALSE; VTEN$ILL[0] = FALSE; TAILPTR = VTEN$POINT[0]; # MARK THIS ONE, MARK REST IN MAIN LOOP # VTEN$POINT[0] = I; END # START TAIL # ELSE # * CHAIN INTERSECTS OR IS ILL-FORMED. # BEGIN # PROBLEM CHAIN # VTEN$INTS[0] = TRUE; IF VTEN$POINT[0] EQ I THEN # THE CHAIN IS ILL-FORMED # BEGIN HOCSTAT = S"ILL"; VTEN$LOOP[0] = TRUE; END ELSE # THE CHAIN INTERSECTS # BEGIN HOCSTAT = S"INTC"; VLBICT(I,VTEN$POINT[0]); # REPORT CHAINS # END END # PROBLEM CHAIN # END # ENTRY ON A CHAIN # # * UPDATE THE AU ENTRY. # VT$ITEM[VTPTR] = VTEN$WORD[0]; # UPDATE ENTRY # # * AN END OF CHAIN CONDITION IS SET HERE IF: * 1) *EOC* FLAG IS SET, OR * 2) A LINKAGE PROBLEM HAS BEEN DETECTED. # ENDCHAIN = VTEN$EOC[0] OR HOCSTAT NQ S"OK"; # BAD CHAIN # # * GET LINK TO NEXT AU IF NOT AT END OF CHAIN. # IF NOT ENDCHAIN THEN BEGIN # GET NEXT LINK # VTPTR = VTEN$LINK[0]; IF VTPTR LS VTFIRST OR VTPTR GR VTLAST THEN # LINK IS BAD # BEGIN HOCSTAT = S"ILL"; # ILL-FORMED CHAIN # ENDCHAIN = TRUE; END END # GET NEXT LINK # # * GET NEXT AU IN CHAIN. # IF NOT ENDCHAIN THEN BEGIN VTEN$WORD[0] = VT$ITEM[VTPTR]; # NEXT IN CHAIN # END END # FRAGMENT PROCESSING # # * UPDATE OTHER HEAD OF CHAIN IF INTERSECTING. # IF HOCSTAT EQ S"INTC" THEN BEGIN VTEN$WORD[0] = VT$ITEM[VTEN$POINT[0]]; # GET *HOC* ENTRY # VTEN$INTC[0] = TRUE; # SET INTERSECTING FLAG # VT$ITEM[VTEN$POINT[0]] = VTEN$WORD[0]; # STORE *HOC* ENTRY # END # * UPDATE HEAD OF CHAIN ENTRY. # VTEN$WORD[0] = VT$ITEM[I]; # GET *HOC* ENTRY # IF HOCSTAT EQ S"ILL" THEN BEGIN VTEN$ILL[0] = TRUE; # SET ILL-FORMED FLAG # END IF HOCSTAT EQ S"INTC" THEN BEGIN VTEN$INTC[0] = TRUE; # SET INTERSECTING FLAG # END VT$ITEM[I] = VTEN$WORD[0]; # STORE *HOC* ENTRY # END # *VT* ENTRY # END # VLCFS # TERM PROC VLCMAP(CMERR); # TITLE VLCMAP - *SM* MAP LOOKUP. # BEGIN # VLCMAP # # ** VLCMAP - SMMAP LOOKUP. * * *VLCMAP* READS THE SMMAP ENTRY FOR THE GIVEN Y,Z COORDINATES * IN THE *FCT* RECORD AND VERIFIES THAT THE ENTRY IS VALID. * * PROC VLCMAP(CMERR) * * ENTRY (SMINDX) - *SM* INDEX. * (FCTORD) - *FCT* ORDINAL. * (PAR$FM) - FAMILY. * (SBINDX) - SUBFAMILY INDEX. * (ARRAY VLFCTAREA) - CONTAINS *FCT* RECORD. * * EXIT (CMERR) = TRUE IF ERROR DETECTED. * = FALSE IF NO ERROR. * (ARRAY VLCMAP) - BIT SET FOR GIVEN Y, Z IF THE * SMMAP/FCT ENTRIES POINT TO EACH * OTHER. * * IF AN ERROR IS DETECTED, A PROBLEM FILE * RECORD (RT"FCT") IS WRITTEN. * * MESSAGES * SMMAP READ ERROR.* * * NOTES AN ERROR IN THE ENTRY IS DETECTED IF - * . IT IS NOT ASSIGNED TO THE SUBFAMILY. * . FAMILY IN ENTRY IS WRONG. * . SUBFAMILY IS WRONG. * . *FCT* ORDINAL IS WRONG. * . *CSN* IS WRONG. * # ITEM CMERR B; # INDICATES *SM* MAP ERROR # # **** PROC VLCMAP - XREF LIST BEGIN. # XREF BEGIN PROC MGETENT; # RETURN THE MAP ENTRY TO THE CALLER # PROC VLERROR; # ISSUE ERROR MESSAGE # PROC VLWPROB; # WRITE PROBLEM FILE RECORD # PROC ZFILL; # ZERO FILLS A CHARACTER ITEM # END # **** PROC VLCMAP - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMBFAS *CALL COMBCMD *CALL COMBCMS *CALL COMBMAP *CALL COMBMCT *CALL COMTVLD *CALL COMTVLF *CALL COMTVLM ITEM ORD U; # TO CALCULATE *SM* MAP ORDINAL # CONTROL EJECT; P = LOC(VLFCTAREA); # * SAVE Y AND Z COORDINATES. # Y = FCT$Y[0]; Z = FCT$Z[0]; CMERR = FALSE; # ASSUME NO ERROR # # * IF *FCT* DOES NOT POINT TO A SMMAP ENTRY, RETURN. # IF Y EQ 0 AND Z EQ 0 THEN BEGIN RETURN; END ZFILL(VLMAPAREA,MAPENTL); # CLEAR MAP ENTRY AREA # # * READ *SM* MAP ENTRY. # ORD = MAXORD - Z - (Y * (MAX$Z+1)); MGETENT(SMINDX,ORD,LOC(VLMAPAREA),STAT); # GET *SM* ENTRY # # * IF ERROR WHEN READING THE SMMAP, ISSUE MESSAGE AND ABORT. # IF (STAT NQ CMASTAT"NOERR") AND (STAT NQ CMASTAT"ORDERR") THEN BEGIN VLERROR(VE"MAPR",ABRT); # ABORT WITH MESSAGE # END P = LOC(VLMAPAREA); # * IF MAP ENTRY IS FOR ANOTHER SUBFAMILY, RETURN. # IF SBINDX NQ CM$SUB[0] THEN ## BEGIN RETURN; END # * IF THE *FCT* POINTS TO AN INCORRECT SMMAP ENTRY, WRITE THE * ENTRY TO THE PROBLEM FILE. # IF CM$CODE[0] NQ CUBSTAT"SUBFAM" ## OR PAR$FM NQ CM$FMLYNM[0] ## OR SBINDX NQ CM$SUB[0] ## OR FCTORD NQ CM$FCTORD[0] ## OR FCT$CSND[0] NQ CM$CSND[0] # # THEN BEGIN CMERR = TRUE; CSN = FCT$CSND[0]; VLWPROB(REC"FCT"); # WRITE PROBLEM ENTRY # END # * IF *FCT* AND *SM* POINT TO EACH OTHER, SET THE BIT IN CMAP * ARRAY TO INDICATE THAT A *FCT* ENTRY EXISTS FOR THIS SMMAP * ENTRY. # IF PAR$FM EQ CM$FMLYNM[0] AND SBINDX EQ CM$SUB[0] ## AND FCTORD EQ CM$FCTORD[0] THEN BEGIN BVLCM$Z[Z] = 1; END END # VLCMAP # TERM PROC VLSMSC; # TITLE VLSMSC - *SM* MAP SCAN. # BEGIN # VLSMSC # # ** VLSMSC - SMMAP SCAN. * * *VLSMSC* READS THE SMMAP FILE TO FIND ALL ENTRIES ASSIGNED * TO THE SPECIFIED SUBFAMILY WHICH HAVE NO CORRESPONDING * *FCT* ENTRY (THE BIT IN THE *VLCMAP* ARRAY IS OFF). * * PROC VLSMSC * * ENTRY (SMINDX) - *SM* INDEX. * (PAR$FM) - FAMILY. * (SBINDX) - SUBFAMILY INDEX. * (ARRAY VLCMAP) - BIT MAP FOR SMMAP ENTRIES THAT * HAVE VALID *FCT* ENTRIES. * * EXIT IF AN ERROR IS DETECTED, THEN A PROBLEM FILE * RECORD (RT"SM") IS WRITTEN. * * MESSAGES * SMMAP READ ERROR.* # # **** PROC VLSMSC - XREF LIST BEGIN. # XREF BEGIN PROC MGETENT; # RETURN THE MAP ENTRY TO THE CALLER # PROC VLERROR; # ISSUE ERROR MESSAGE # PROC VLWPROB; # WRITE PROBLEM FILE RECORD # END # **** PROC VLSMSC - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMBFAS *CALL COMBCMD *CALL COMBCMS *CALL COMBMAP *CALL COMBMCT *CALL COMTVLD *CALL COMTVLF *CALL COMTVLM ITEM ORD I; # ORDINAL # CONTROL EJECT; # * READ THE ENTIRE SMMAP FILE. # SLOWFOR Z = 0 STEP 1 UNTIL MAX$Z DO BEGIN # Z COORDINATE SCAN # SLOWFOR Y = 0 STEP 1 UNTIL MAX$Y DO BEGIN # Y COORDINATE SCAN # ORD = MAXORD - Z - (Y * (MAX$Z+1)); MGETENT(SMINDX,ORD,LOC(VLMAPAREA),STAT); # READ ENTRY # IF STAT NQ CMASTAT"NOERR" THEN BEGIN VLERROR(VE"MAPR",ABRT); # ABORT WITH MESSAGE # END P = LOC(VLMAPAREA); # * IF THE SMMAP ENTRY IS ASSIGNED TO THE SUBFAMILY BUT THERE * WAS NO CORRESPONDING *FCT* ENTRY, WRITE AN ENTRY TO THE PROBLEM * FILE. # IF (CM$CODE[0] EQ CUBSTAT"SUBFAM") AND (CM$FMLYNM[0] EQ PAR$FM) AND (CM$SUB[0] EQ SBINDX) AND (BVLCM$Z[Z] EQ 0) AND CM$FCTORD[0] NQ 0 AND CM$CSND[0] NQ " " THEN BEGIN CSN = CM$CSND[0]; # FIELDS FOR VLWPROB # FCTORD = CM$FCTORD[0]; VLWPROB(REC"SM"); # WRITE PROBLEM FILE ENTRY # END END # Y COORDINATE SCAN # END # Z COORDINATE SCAN # END # VLSMSC # TERM PROC VLERROR((ERNUM),(ABTFLG)); # TITLE VLERROR - ISSUE ERROR MESSAGE. # BEGIN # VLERROR # # ** VLERROR - ISSUE ERROR MESSAGE. * * THE ERROR MESSAGE SPECIFIED BY *ERNUM* IS ISSUED TO THE * DAYFILE AND REPORT FILE (IF OPENED). IF SELECTED, PARAMETERS * FROM THE *MPARAM* ARRAY MAY BE INSERTED INTO THE MESSAGE TEXT * FIRST. ALSO, A DETAIL STATUS FROM *STAT* WILL BE ISSUED IF * SPECIFIED. THE OPTIONS FOR A SPECIFIC ERROR ARE DEFINED * WITH THE ERROR MESSAGE TEXT (IN COMTVLD) AND RESIDE IN A * LOCAL ARRAY. * * PROC VLERROR(ERNUM,ABTFLG) * * ENTRY (ABTFLG) - ABORT FLAG (PROGRAM ABORTED IF TRUE) * (ERNUM) - ERROR NUMBER (FROM STATUS LIST *VE* * IN COMTVLD). * (RPTFADR) - REPORT FILE *FET* ADDRESS (ZERO IF * NOT OPENED). * (STAT) - DETAIL STATUS VALUE (OPTIONAL). * (ARRAY MPARAM) - CONTAINS PARAMETERS FOR ERROR MESSAGE * TEXT (OPTIONAL). * * EXIT (CNTPROGERR) - COUNT OF ERRORS. * * THE ERROR MESSAGE IS ISSUED TO THE REPORT FILE IF THE * FILE IS OPENED. * * MESSAGES * ** ERROR MESSAGE TEXT * * * DETAIL STATUS = NNN * (OPTIONAL) * # ITEM ERNUM I; # ERROR NUMBER # ITEM ABTFLG I; # ABORT RUN FLAG # # **** PROC VLERROR - XREF LIST BEGIN. # XREF BEGIN PROC MESSAGE; # INTERFACE TO *MESSAGE* MACRO # PROC RESTPFP; # RESTORE USER-S *PFP* AND ABORT OR RETURN # PROC RPCLOSE; # CLOSES A PRINT FILE # PROC RPLINE; # CALLS *RPLINEX* TO PRINT A LINE # PROC VLMSG; # ISSUE INFORMATIONAL MESSAGE # FUNC VLNTC C(10); # NUMERIC TO CHARACTER CONVERSION # PROC VLPFILL; # FILL PARAMETER IN MESSAGE TEXT # END # **** PROC VLERROR - XREF LIST END. # DEF LISTCON #0#; *CALL COMBFAS *CALL COMTVLD *CALL COMTVLF ITEM N I; # TEMPORARY VARIABLE # ITEM NP I; # TEMPORARY VARIABLE # ARRAY TEXT [0:0] S(5); # TO FORMAT ERROR MESSAGE # BEGIN ITEM TEX$MSG C(00,00,40); # MESSAGE TEXT # ITEM TEX$LEAD C(00,00,03); # LEADING CODES # ITEM TEX$ZERO U(04,00,60) = [ 0 ]; # ZERO BYTE # END ARRAY ERRCODES [0:0] S(1); # ERROR OPTION CODES # BEGIN ITEM ERR$CODES C(00,00,03); ITEM ERR$STAT C(00,00,01); # DETAIL STATUS FLAG # ITEM ERR$PARN U(00,06,06); # NUMBER OF PARAMETERS # END ARRAY DTLSTAT [0:0] S(5); # DETAIL STATUS MESSAGE # BEGIN ITEM DTL$MSG C(00,00,40) = [" DETAIL STATUS = "]; ITEM DTL$NUM C(02,00,04); # STATUS VALUE # ITEM DTL$ZERO U(04,00,60) = [ 0 ]; END # * ARRAY OF DEFINED ERROR MESSAGE TEXTS. WARNING - THE ORDER * OF THIS LIST IS DEPENDENT ON THE STATUS LIST "VE". * THE TEXTS ARE DEFINED IN *COMTVLD*. # ARRAY ERRTEXT [0:VE"EREND"] S(4); # ERROR MESSAGES ARRAY # BEGIN ITEM ERRMSG C(00,00,40) = [ " NO ERROR ", MSYNTAX, MSMPAR, MFXPAR, MSBPAR, MSTPAR, MLFRF, MRLNRF, MRFFM, MRFAM, MRDFH, MRDFL, MRDFU, MCATO, MCATR, MMAPO, MMAPR, MNOFL, MNCONN, MUCPERR, MNOFAM, MPFCER, MDUPSM, MDUPSB, MSYSERR, MABORT, " " ]; END CONTROL EJECT; CNTPROGERR = CNTPROGERR + 1; # * SET UP THE MESSAGE TEXT BASED ON THE ERROR NUMBER. # TEX$MSG[0] = ERRMSG[ERNUM]; ERR$CODES[0] = TEX$LEAD[0]; # * INSERT PARAMETERS INTO TEXT IF SPECIFIED. # IF ERR$PARN[0] NQ " " THEN # PARAMETERS SPECIFIED # BEGIN NP = ERR$PARN[0] - "0"; # CALCULATE THE NUMBER OF PARAMETERS # SLOWFOR N = 1 STEP 1 UNTIL NP DO BEGIN # N # VLPFILL(TEXT,MPARAM[N]); # MOVE PARAMETER TO TEXT # END # N # END # * ISSUE ERROR TEXT TO DAYFILE. # TEX$LEAD[0] = " **"; # DAYFILE MSG MUST HAVE 1 BLANK # MESSAGE(TEXT,SYSUDF1); # * ISSUE ERROR TEXT TO REPORT FILE, IF IT IS OPEN. # IF RPTFADR NQ 0 THEN BEGIN RPLINE(RPTFADR," ",0,1,EOPL); # BLANK LINE # TEX$LEAD[0] = "***"; # ERROR FLAG # RPLINE(RPTFADR,TEXT,4,40,EOPL); # ISSUE ERROR MESSAGE # END # * ISSUE DETAIL STATUS, IF SPECIFIED. # IF ERR$STAT[0] EQ "S" THEN BEGIN DTL$NUM[0] = VLNTC(STAT,"XCOD",4); # SET NUMBER FROM *STAT* # MESSAGE(DTLSTAT,SYSUDF1); # ISSUE DETAIL MESSAGE # IF RPTFADR NQ 0 THEN BEGIN RPLINE(RPTFADR,DTLSTAT,4,40,EOPL); # ISSUE TO REPORT FILE # END END # * IF ABORT FLAG IS SET, ABORT. # IF (ABTFLG EQ ABRT) THEN BEGIN IF (RPTFADR NQ 0) # CLOSE REPORT FILE IF IT IS OPENED # THEN BEGIN RPCLOSE(RPTFADR); END VLMSG(VM"VLABT"); # ISSUE SSVAL ABORTED MESSAGE # RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT # END RETURN; END # VLERROR # TERM PROC VLFIX; # TITLE VLFIX - FIX CATALOGS. # BEGIN # VLFIX # # ** VLFIX - FIX CATALOGS. * * *VLFIX* READS THE FIXIT FILE AND MODIFIES THE CORRESPONDING * CATALOG ENTRIES DEPENDING UPON THE MODE SPECIFIED BY THE * CONTROL CARD PARAMETERS. * * PROC VLFIX * * ENTRY (CNTORPHANS) - COUNT OF TROUBLE-FREE ORPHANS. * (CONNECTED) - CONNECTED TO *EXEC* FLAG. * (PAR$FX) - FX CONTROL CARD PARAMETER. * (PAR$RF) - RF CONTROL CARD PARAMETER. * (PAR$RL) - RL CONTROL CARD PARAMETER. * (RDFDT) - *RDF* FILE PACKED DATE AND TIME. * (RELEASABLE) - COUNT OF RELEASABLE AU-S. * (TOTALERRS) - TOTAL VALIDATION ERRORS. * (ARRAY FIXFILE) - FIXIT FILE *FET*. * * EXIT RELEASE PROCESSING OCCURRED IF MODE IS EQUAL TO * RELEASE. * REPAIR PROCESSING OCCURRED IF MODE IS EQUAL TO FIX. * INFORMATIONAL LINES WERE WRITTEN TO THE REPORT FILE. * * MESSAGES * TOTAL VALIDATION ERRORS = NNN * * * RELEASABLE M860 FILE = NNNN * * * RELEASABLE M860 AU-S = NNNN * * * CATALOGS NOT MODIFIED * * * CATALOGS MODIFIED * * * FREE FILES NOT RELEASED * * * FREE FILES RELEASED * * * NOTES THE MODES OF PROCESSING ARE - * * . RELEASE - RELEASE ORPHANS IN THE SFM CATALOG. * THIS MODE IS SET IF - * THE *RF* AND *RL* PARAMETERS WERE SPECIFIED AND * THE *TOTALERRS* IS LESS THAN THE *FX* PARAMETER. * * . FIX - SET APPROPRIATE FLAGS IN THE CATALOGS FOR * ERRORS DETECTED. * THIS MODE IS SET IF - * THE *FM* PARAMETER IS SET AND THE *TOTALERRS* * IS LESS THAN THE *FX* PARAMETER. * * . NONE - NO CATALOG MODIFICATIONS. * THIS MODE IS SET IF *SSVAL* IS NOT CONNECTED * TO *EXEC* OR NOT IN FIX OR RELEASE MODE. * * RELEASE OF FREE AU-S IN A SPECIFIC SUBCATALOG * OCCURS ONLY IF THE DATE AND TIME IN THE *RDF* FILE IS * MORE RECENT THAN THE LAST PURGE DATE AND TIME FOR THE * SUBCATALOG. * * THE REPAIRS THAT *SSVAL* CAN PERFORM ARE DEFINED IN * THE ARRAY *FIXARRAY*. THE REPAIRS TO BE TAKEN FOR * A SPECIFIC FIXIT FILE RECORD ARE DETERMINED BY THE * RECORD TYPE WHICH REFLECTS THE TYPE OF ERROR THAT * OCCURRED DURING VALIDATION. * # # **** PROC VLFIX - XREF LIST BEGIN. # XREF BEGIN PROC READ; # INTERFACE TO *READ* MACRO # PROC READW; # INTERFACE TO *READW* MACRO # PROC RETERN; # RETURN LOCAL FILE # PROC REWIND; # INTERFACE TO *REWIND* MACRO # PROC RPEJECT; # STARTS A NEW REPORT PAGE # PROC VLFIXP; # CONNECTS *PF* AND SETS *ASA* # PROC VLERROR; # ISSUE ERROR MESSAGE # PROC VLLPDT; # GET LAST PURGE DATE AND TIME # PROC VLMSG; # ISSUE INFORMATIONAL MESSAGE # FUNC VLNTC C(10); # NUMERIC TO CHARACTER CONVERSION # PROC VLREQEX; # REQUEST TO EXEC # PROC WRITEW; # WRITE TO WORKING BUFFER # PROC WRITEF; # INTERFACE TO *WRITEF* MACRO # END # **** PROC VLFIX - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMBFAS *CALL COMBCPR *CALL COMTVLD *CALL COMTVLF *CALL COMTVLV STATUS PROCTYP # PROCESSING TYPE # NONE, FIX, # FIX CATALOGS # RELEASE, # RELEASE FILE SPACE # PTEND; DEF FREE #0#; # SET FREE FLAG IN PFC # DEF ZERO #1#; # ZERO *PFC* ASA # ITEM FREFL B; # FREE CARTRIDGE FLAG SET # ITEM MODE S : PROCTYP = S"NONE"; # MODE FOR FIX PROCESS # ITEM LPDT U; # LAST PURGE DATE-TIME # ITEM FIXACTION I; # FIX ACTIONS FOR FIXIT RECORD # ITEM RDF$BEFORE B; # RDF BEFORE PURGE DATE # ITEM RELEASED B; # FREE FILES RELEASED FLAG # # * ACTION FLAGS TO DEFINE THE CATALOG REPAIRS THAT *SSVAL* CAN * PERFORM. # DEF ACT$NONE #O"000000"#; # NO ACTION # DEF ACT$UMAP #O"000001"#; # UPDATE SMMAP # DEF ACT$UPFC #O"000010"#; # UPDATE *PFC* ENTRY # DEF ACT$USM #O"000100"#; # UPDATE *SM* FLAG IN SFM CATALOG # DEF ACT$UFROZ #O"001000"#; # UPDATE FROZEN AU FLAG # DEF ACT$USOF #O"010000"#; # UPDATE *SOF* AU FLAG # DEF ACT$INHIB #O"100000"#; # SET INHIBIT FLAG IN *FCT* # DEF ACT$P$F$S #O"011010"#; DEF ACT$F$S #O"011000"#; # MULTIPLE ACTIONS # DEF ACT$UC$INH #O"100100"#; # MULTIPLE ACTIONS # DEF ACT$UF$UI #O"101000"#; # MULTIPLE ACTIONS # # * *CPR* WORKING BUFFER. # ARRAY CPRARRAY [0:0] S(CPRLEN);; # * DEFINE ACTIONS TO TAKE FOR THE VARIOUS FIXIT FILE RECORD TYPES. * DURING THE VALIDATION PROCESS, RECORDS WERE WRITTEN TO THE FIXIT * FILE FOR PROBLEMS DETECTED. THE RECORD TYPE REFLECTS THE TYPE OF * REPAIR PROCESSING TO BE DONE. # ARRAY FIXARRAY [0:REC"REND"] S(1); # FIX ACTIONS FOR FIX RECORDS # BEGIN ITEM FIXA$WD U(00,00,60); ITEM FIXA$TFO U(REC"TFORPH",0,60) = [ACT$NONE]; ITEM FIXA$FCT U(REC"FCT",0,60) = [ACT$UC$INH]; ITEM FIXA$SM U(REC"SM",0,60) = [ACT$UMAP]; ITEM FIXA$ASA U(REC"ASA",0,60) = [ACT$UPFC]; ITEM FIXA$PFC U(REC"OTHR",0,60) = [ACT$P$F$S]; ITEM FIXA$ORPH U(REC"BADORPH",0,60) = [ACT$UFROZ]; ITEM FIXA$FRAG U(REC"FRAG",0,60) = [ACT$F$S]; ITEM FIXA$HOLE U(REC"BADHOLE",0,60) = [ACT$UF$UI]; END CONTROL EJECT; # * CLOSE THE FIXIT FILE. # FREFL = FALSE; WRITEF(FIXITFILE,RCL); REWIND(FIXITFILE,RCL); # * ISSUE COUNT OF ORPHANS. # MP$WD[1] = VLNTC(CNTORPHANS,"XCDD",5); VLMSG(VM"NTFO"); # * ISSUE COUNT OF RELEASABLE AU-S. # MP$WD[1] = VLNTC(RELEASABLE,"XCDD",6); VLMSG(VM"RSPACE"); # * ISSUE NUMBER OF PFC SYSTEM AND DATA ERRORS. # IF TPFCERRS NQ 0 THEN BEGIN MP$WD[1] = VLNTC(TPFCERRS,"XCDD",4); VLMSG(VM"TPFCER"); END # * ISSUE NUMBER OF VALIDATION ERRORS. # MP$WD[1] = VLNTC(TOTALERRS,"XCDD",4); VLMSG(VM"TOTERR"); # * IF NOT CONNECTED TO EXEC, NO FIX/RELEASE PROCESSING CAN BE DONE. # IF NOT CONNECTED THEN BEGIN VLMSG(VM"NOFIX"); # ISSUE MESSAGE # RETURN; END # * DETERMINE MODE OF FIX PROCESSING BASED ON CONTROL CARD * PARAMETERS AND VALIDATION TOTAL ERRORS. # IF (PAR$RF EQ 0) AND (TOTALERRS LQ PAR$FX) AND (TOTALERRS NQ 0) THEN BEGIN VLMSG(VM"UPDED"); # ISSUE MESSAGE # MODE = S"FIX"; # FIX CATALOG MODE # END IF (PAR$RF NQ 0) AND (PAR$RL NQ 0) AND (TOTALERRS LQ PAR$FX) THEN BEGIN RELEASED = FALSE; # INITIALIZE FILES RELEASED FLAG # RDF$BEFORE = FALSE; # INITIALIZE RDF FLAG # MODE = S"RELEASE"; # RELEASE ORPHANS MODE # END IF MODE EQ S"NONE" THEN BEGIN VLMSG(VM"NOFIX"); # ISSUE MESSAGE # END # * READ THE FIXIT FILE AND PERFORM FIX/RELEASE ACTIONS BASED ON * RECORD TYPE. # READ(FIXITFILE,NRCL); STAT = OK; REPEAT WHILE STAT EQ OK DO BEGIN # PROCESS FIXIT FILE # READW(FIXITFILE,EXTRECORD,RLFIX,STAT); IF STAT NQ 0 THEN BEGIN TEST DUMMY; # EXIT, NO RECORD TO PROCESS # END SMINDX = EXTR$SM[0]; SBINDX = EXTR$SB[0]; # * FOR RELEASE MODE, PURGE TROUBLE-FREE ORPHANS. # IF (MODE EQ S"RELEASE") AND (FIX$RT[0] EQ REC"TFORPH") THEN BEGIN # RELEASE ORPHANS # VLLPDT(EXTR$SB[0],EXTR$SM[0],LPDT); # RETURNS LAST PURGE DATE/TIME # # * RELEASE ONLY IF THE SUBCATALOG LAST PURGE DATE/TIME IS LESS THAN * THE RDF FILE DATE/TIME. # IF LPDT LS RDFDT THEN BEGIN # * CONVERT TO *CPR* FORMAT. # P = LOC(CPRARRAY); CPR$C[0] = FALSE; CPR$CSU[0] = EXTR$SM[0]; CPR$SUB[0] = EXTR$SB[0]; CPR$FAM[0] = PAR$FM; CPR$FCT[0] = EXTR$FCT[0]; CPR$AU[0] = EXTR$AU[0]; CPR$RQT[0] = TYP"TYP3"; CPR$RQC[0] = REQTYP3"REL$SETUP"; WRITEW(RELCFILE,CPRARRAY,CPRLEN,STAT); RELEASED = TRUE; # FREE FILES RELEASED # TEST DUMMY; END ELSE BEGIN RDF$BEFORE = TRUE; END END # RELEASE ORPHANS # # * UPDATE *PFC* IF FILE IS TO BE REMOVED FROM CARTRIDGE. # IF FIX$RT[0] EQ REC"FCF" AND PAR$RF EQ 0 THEN # SET FREE CARTRIDGE FLAGS # BEGIN VLFIXP(FREE); IF STAT EQ 0 THEN BEGIN FREFL = TRUE; END END # * FOR FIX MODE, GET ACTIONS BASED ON THE FIXIT RECORD TYPE. # IF MODE NQ S"FIX" THEN BEGIN TEST DUMMY; # SKIP IF NOT FIX MODE # END FIXACTION = FIXA$WD[FIX$RT[0]]; # ACTIONS FOR THIS RECORD # # * UPDATE THE SMMAP ENTRY. # IF FIXACTION LAN ACT$UMAP NQ 0 THEN BEGIN VLREQEX(TYP"TYP3",REQTYP3"UPD$MAP"); END # * UPDATE *PFC* ENTRY IF THE FILE HAS A DISK IMAGE. # IF FIXACTION LAN ACT$UPFC NQ 0 AND EXTR$D[0] NQ 0 THEN BEGIN VLFIXP(ZERO); END # * UPDATE THE SFM CATALOG SMERR FLAG. # IF FIXACTION LAN ACT$USM NQ 0 THEN BEGIN CFIELD = UCF"CMAP"; # CHANGE SMERR FLAG # VLREQEX(TYP"TYP3",REQTYP3"UPD$CAT"); END # * UPDATE INHIBIT FLAG IN FCT. # IF FIXACTION LAN ACT$INHIB NQ 0 OR (FIXACTION LAN ACT$UFROZ NQ 0 AND NOT VTEN$ALOC[0]) THEN BEGIN CFIELD = UCF"INHIB"; # CHANGE INHIBIT FLAG # VLREQEX(TYP"TYP3",REQTYP3"UPD$CAT"); END # * UPDATE SFM CATALOG *FCT* AU FROZ FLAG. # IF FIXACTION LAN ACT$UFROZ NQ 0 THEN BEGIN CFIELD = UCF"FROZ"; # CHANGE FROZ FLAG # VLREQEX(TYP"TYP3",REQTYP3"UPD$CAT"); END # * UPDATE SFM CATALOG *FCT* AU *SOF* FLAG IF THE ENTRY IS * A START OF FRAGMENT. # VTEN$WORD[0] = FIX$VT[0]; # GET *VT* ENTRY FROM RECORD # IF FIXACTION LAN ACT$USOF NQ 0 AND VTEN$SOF[0] THEN BEGIN CFIELD = UCF"SOF"; # CHANGE *SOF* FLAG # VLREQEX(TYP"TYP3",REQTYP3"UPD$CAT"); END END # PROCESS FIXIT FILE # IF RELEASED AND MODE EQ S"RELEASE" THEN BEGIN WRITEF(RELCFILE,RCL); RETERN(RELCFILE,RCL); VLMSG(VM"REL"); VLREQEX(TYP"TYP3",REQTYP3"REL$SETUP"); MP$WD[1] = VLNTC(NFILER,"XCDD",5); VLMSG(VM"FCREL"); END IF NOT RELEASED AND MODE EQ S"RELEASE" THEN BEGIN VLMSG(VM"FSNREL"); IF RDF$BEFORE THEN BEGIN VLMSG(VM"RDFBF"); END END IF FREFL THEN # FREE CARTRIDGE FLAG SET # BEGIN VLMSG(VM"FFSET"); END END # VLFIX # TERM PROC VLFIXP(ACTION); # TITLE VLFIXP - ATTACHES PERMANENT FILE AND RESETS THE ASA. # BEGIN # VLFIXP # # ** VLFIXP - RESETS THE *ASA*. * * *VLFIXP* ATTACHES THE USER FILE SPECIFIED IN THE FIXIT * FILE ENTRY, VERIFIES THE *ASA* IS CORRECT, RESETS THE * *ASA*, THEN RETURNS THE FILE. * * PROC VLFIXP * * ENTRY (PAR$FM) - FAMILY. * (ACTION) IF ZERO THEN SET FREE FLAG IN *PFC*, ELSE * ZERO *ASA* IN *PFC*. * ARRAY EXTRECORD - FIXIT FILE RECORD. * * EXIT THE *ASA* FOR THE FIXIT FILE ENTRY IS SET TO ZERO. * THE USER FILE IS RETURNED. # # **** PROC VLFIXP - XREF LIST BEGIN. # XREF BEGIN PROC BZFILL; # ZERO FILL STORAGE # PROC MESSAGE; # SEND MESSAGE TO DAYFILE # PROC SETAF; # SET FLAG IN *PFC* # PROC RECALL; # INTERFACE TO RECALL # PROC RETERN; # RETURNS SPECIFIED FILE # PROC SETASA; # INTERFACE TO *SETASA* ROUTINE # PROC UATTACH; # INTERFACE TO *UATTACH* MACRO # PROC UGET; # UTILITY GET # END # **** PROC VLFIXP - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMBFAS *CALL COMBBZF; *CALL COMSPFM *CALL COMTVLD *CALL COMTVLF DEF ACCMD #1#; # READ MODE # DEF RP #4#; # FULL ERROR PROCESSING # DEF ZEROASA #0#; # ZERO THE *ASA* # ITEM ACTION U; # ZERO OR SET FLAG # ITEM FAMILY C(10); # FAMILY NAME # ITEM I U; # INDUCTION VARIABLE # ITEM J U; # INDUCTION # ITEM LFN C(10); # LOCAL FILE NAME # ITEM PFNM C(10); # PERMANENT FILE NAME # ITEM UFLAG U; # STATUS FLAG # ARRAY PFCCAT [0:0] S(16); # TEMPORARY ARRAY FOR *PFC* # BEGIN ITEM NOITEM U(00,00,60); # DUMMY ITEM # END ARRAY MSSGE[0:2];; # ARRAY FOR MESSAGE # ARRAY MSSG [0:0] P(2); BEGIN ITEM MSSG1 C(00,00,13); # ARRAY FOR MESSAGE # END CONTROL EJECT; # * SET ADDRESS FOR BASED ARRAY, *PFC*. # P = LOC(PFCCAT); # * ATTACH THE PERMANENT FILE. # LFN = UTTLFN; BZFILL(LFN,TYPFILL"ZFILL",10); PFNM= EXTR$PFNC[0]; BZFILL(PFNM,TYPFILL"ZFILL",10); FAMILY = PAR$FM; BZFILL(FAMILY,TYPFILL"ZFILL",10); # * SET THE FREE FLAG IF ACTION = 0. # IF ACTION EQ 0 THEN # SET *AFFRE* FLAG IN *PFC* # BEGIN SETAF(LFN,STAT,RP,EXTR$UI[0],FAMILY,EXTR$PFID[0], ## EXTR$ATASA[0],EXTR$CREA[0],AFFRE,MSSGE[0]); RETURN; END # * MAKE FILE LOCAL BEFORE SETASA. # IF EXTR$DA[0] THEN # DIRECT ACCESS FILE # BEGIN UATTACH(LFN,STAT,RP,PFNM,ACCMD,EXTR$UI[0],FAMILY, ## EXTR$PFID[0],PFCCAT[0],EXTR$CREA[0],MSSGE[0]); END ELSE # INDIRECT ACCESS FILE # BEGIN UFLAG = -1; SLOWFOR I = 0 WHILE UFLAG NQ 0 DO BEGIN # WAIT FOR UGET RESPONSE # UFLAG = -1; UGET(LFN,UFLAG,6,PFNM,EXTR$UI[0],FAMILY,EXTR$PFID[0], ## PFCCAT[0],EXTR$CREA[0],MSSGE[0]); IF UFLAG EQ PEA # EXCESS ACTIVITY # OR UFLAG EQ INA # NO INTERLOCK # THEN BEGIN TEST I; END IF UFLAG NQ 0 THEN BEGIN MSSG1 = " UGET FAILED."; MESSAGE(MSSG,UDFL1); UFLAG = 0; END END # WAIT FOR UGET REQUEST # END # * IF THERE WAS NO ERROR, AND IF THE CATALOG MAP *ASA* * MATCHES THE EXTRACT FILE *ASA*, * THEN - * RESET THE *ASA* TO ZERO USING THE *SETASA* MACRO. # IF (STAT EQ 0) AND (PFC$AA[0] EQ EXTR$ASA[0]) AND UFLAG EQ 0 AND ACTION EQ 1 THEN BEGIN SETASA(LFN,STAT,RP,EXTR$UI[0],FAMILY,EXTR$PFID[0] ## ,ZEROASA,EXTR$CREA[0],MSSGE[0]); END RETERN(UTTLFN,RCL); END # VLFIXP # TERM PROC VLLPDT(SUBPAR,SMPAR,LPDT); # TITLE VLLPDT - GET LAST PURGE DATE AND TIME. # BEGIN # VLLPDT # # ** VLLPDT - GET LAST PURGE DATE AND TIME. * * *VLLPDT* ISSUES A REQUEST TO *EXEC* TO GET THE "LAST * PURGE DATE AND TIME" FOR THE SUBCATALOG FROM THE * PREAMBLE IN THE SFM CATALOG FOR THE SPECIFIED SUBFAMILY. * * PROC VLLPDT(SUBPAR,SMPAR,LPDT) * * ENTRY (SUBPAR) - SUBFAMILY. * (SMPAR) - *SM* DESIGNATOR. * * EXIT (LPDT) - PACKED DATE AND TIME RETURNED FROM *EXEC*. # ITEM SUBPAR I; # SUBFAMILY # ITEM SMPAR I; # *SM* ID # ITEM LPDT I; # LAST PURGE DATE-TIME # # **** PROC VLLPDT - XREF LIST BEGIN. # XREF BEGIN PROC VLREQEX; # REQUEST TO EXEC # END # **** PROC VLLPDT - XREF LIST END. # DEF LISTCON #0#; # TURN OFF LISTING # *CALL COMBFAS *CALL COMBCPR *CALL COMTVLD *CALL COMTVLF ITEM CURRSB I = 0; # CURRENT SUBFAMILY # ITEM CURRSM I; # CURRENT *SM* # ITEM CURRLPDT I; # CURRENT LPDT # CONTROL EJECT; # * CALL *EXEC* TO GET THE LAST PURGE DATE/TIME FOR THE SUBCATALOG, * IF IT IS NOT CURRENT. # IF (CURRSB NQ SUBPAR) OR (CURRSM NQ SMPAR) THEN BEGIN CURRSB = SUBPAR; # SAVE CURRENT SUBFAMILY # CURRSM = SMPAR; # SAVE CURRENT *SM* # VLREQEX(TYP"TYP3",REQTYP3"GT$PRGDATE"); CURRLPDT = CPR$DATE[0]; # SAVE LAST PURGE DATE/TIME # END # * RETURN THE LAST PURGE DATE/TIME FOR THE SUBCATALOG. # LPDT = CURRLPDT; END # VLLPDT # TERM PROC VLMSG(MNUM); # TITLE VLMSG - ISSUE INFORMATIONAL MESSAGE. # BEGIN # VLMSG # # ** VLMSG - ISSUE INFORMATIONAL MESSAGE. * * *VLMSG* ISSUES A SPECIFIED MESSAGE TO THE DAYFILE AND/OR * TO THE REPORT FILE. * * PROC VLMSG(MNUM) * * ENTRY (MNUM) - MESSAGE NUMBER FROM STATUS LIST *VM*. * (ARRAY MPARAM) - CONTAINS PARAMETER(S) TO INSERT IN * THE MESSAGE TEXT. * * EXIT THE MESSAGE IS ISSUED. * * NOTES OPTIONS ARE SELECTED BY THE FIRST THREE * CHARACTERS OF THE MESSAGE TEXT. OPTIONS ARE - * . MSG$SYS (B) - ISSUES TO THE DAYFILE OR TO THE *B* * DISPLAY LINE 2. * . MSG$RPT (Y) - ISSUES TO THE REPORT FILE. * . NUMBER OF PARAMETERS TO FILL IN THE MESSAGE TEXT * FROM THE *MPARAM* ARRAY (NUMERIC, NOT A CHARACTER). # ITEM MNUM I; # **** PROC VLMSG - XREF LIST BEGIN. # XREF BEGIN PROC MESSAGE; # INTERFACE TO *MESSAGE* MACRO # PROC RPLINE; # CALLS *RPLINEX* TO PRINT A LINE # PROC VLPFILL; # FILL PARAMETER IN MESSAGE TEXT # END # **** PROC VLMSG - XREF LIST END. # DEF LISTCON #0#; *CALL COMBFAS *CALL COMTVLD *CALL COMTVLF ITEM NP I; # NUMBER OF PARAMETERS # ITEM N I; # TEMPORARY VARIABLE # # * ARRAY TO FORMAT THE MESSAGE TO ISSUE. # ARRAY VMTEXT [0:0] S(5); BEGIN ITEM VMT$LINE C(00,00,40); ITEM VMT$LEAD C(00,00,03); # LEADING CODE CHARACTERS # ITEM VMT$TEXT C(00,18,37); # MESSAGE TEXT # ITEM VMT$ZERO U(04,00,60); # ZERO BYTE # END # * ANALYZES ACTIONS TO DO BASED ON THE MESSAGE. # ARRAY MSGCODES [0:0] S(1); # MESSAGE CODES # BEGIN ITEM MSG$CODES C(00,00,03); ITEM MSG$SYS C(00,00,01); # ISSUE TO SYSTEM MACRO # ITEM MSG$RPT C(00,06,01); # ISSUE TO REPORT FILE # ITEM MSG$PARN U(00,12,06); # NUMBER OF PARAMETERS TO INSERT # END CONTROL EJECT; # * GET CODES FROM MESSAGE TEXT. # VMT$LINE[0] = VMESS$LINE[MNUM]; # GET MESSAGE TEXT REQUESTED # MSG$CODES[0] = VMT$LEAD[0]; # EXTRACT CODES FROM TEXT # VMT$LEAD[0] = " "; # CLEAR CODES FIELD IN TEXT # # * PUT PARAMETER(S) INTO MESSAGE IF THE NUMBER OF PARAMETERS IS * SPECIFIED IN CODES. # IF MSG$PARN[0] NQ " " THEN BEGIN NP = MSG$PARN[0] - "0"; # NUMBER CONVERTED TO BINARY # SLOWFOR N = 1 STEP 1 UNTIL NP DO BEGIN VLPFILL(VMTEXT,MPARAM[N]); # MOVE PARAMETER INTO TEXT # END END # * ISSUE MESSAGE REQUEST TO THE SYSTEM IF SPECIFIED. # IF MSG$SYS[0] NQ "N" THEN BEGIN # ISSUE TO SYSTEM # IF MSG$SYS[0] EQ "B" THEN BEGIN MESSAGE(VMT$TEXT[0],LINE2); # B ONLY # END ELSE BEGIN IF MSG$SYS[0] EQ "S" THEN BEGIN MESSAGE(VMT$TEXT[0],SYSUDF1); END ELSE BEGIN MESSAGE(VMT$TEXT[0],UDFL1); END END END # ISSUE TO SYSTEM # # * ISSUE MESSAGE TO THE REPORT FILE IF REQUESTED. # IF MSG$RPT[0] NQ "N" THEN BEGIN RPLINE(RPTFADR," ",0,1,EOPL); # BLANK LINE # RPLINE(RPTFADR,VMT$TEXT[0],3,37,EOPL); # ISSUE TO REPORT # END END # VLMSG # TERM PROC VLNCS; # TITLE VLNCS - NORMAL CHAIN SCAN. # BEGIN # VLNCS # # ** VLNCS - NORMAL CHAIN SCAN. * * *VLNCS* SCANS ALL ENTRIES IN THE *VT* TABLE LOCATING * AND MARKING NORMAL CHAINS. THE CHAIN IS SEARCHED * BEGINNING WITH THE HEAD OF CHAIN ENTRY AND PROCEEDING * THROUGH THE LINKAGE UNTIL *EOC* OR AN ERROR IS DETECTED. * ALL ENTRIES ON A CHAIN ARE MARKED BY SETTING THE POINTER * FIELD TO THE INDEX OF THE HEAD OF CHAIN (*HOC*) ENTRY. * FLAGS ARE SET IN THE *VT* ENTRIES FOR ERRORS DETECTED. * * PROC VLNCS * * ENTRY (PAR$ST) - SCATTER FILE PARAMETER. * (VTFIRST) - INDEX OF FIRST ENTRY IN *VT*. * (VTLAST) - INDEX OF LAST ENTRY IN *VT*. * (ARRAY VTTAB) - VALIDATION TABLE. * * EXIT THE FOLLOWING FIELDS IN THE *VT* ENTRY MAY BE UPDATED. * (VTEN$POINT) - INDEX OF THE *HOC* ENTRY. * (VTEN$ILL) - ILL-FORMED CHAIN. * (VTEN$INTC) - INTERSECTING CHAIN. * (VTEN$INTS) - INTERSECTING AU. * (VTEN$SCAT) - SCATTERED FILE. * * INTERSECTING CHAIN DETAIL LINES ARE ISSUED TO THE * REPORT FILE IF INTERSECTIONS ARE DETECTED. * * NOTES CHAINS ARE FOLLOWED UNTIL - * . AN END OF CHAIN ENTRY IS DETECTED. * . AN ILL-FORMED CHAIN IS DETECTED. * . AN INTERSECTING CHAIN IS DETECTED. * * ILL-FORMED CHAINS ARE THOSE WHICH HAVE A MEMBER * THAT LINKS TO AN ENTRY ON THIS CHAIN (LOOPING) * OR THAT LINKS TO AN UNALLOCATED ENTRY OR HAS A * LINK THAT IS NOT ZERO WHEN THE *EOC* FLAG IS SET. * * INTERSECTING CHAINS ARE THOSE THAT HAVE A MEMBER * THAT LINKS TO AN ENTRY ON A DIFFERENT CHAIN. * * A SCATTERED FILE CHECK IS PERFORMED. THE SCATTERED * FLAG IS SET IF THE NUMBER OF CARTRIDGES FOR THE * CHAIN IS GREATER THAN THE *ST* PARAMETER. * # # **** PROC VLNCS - XREF LIST BEGIN. # XREF BEGIN PROC VLBICT; # INTERSECTING CHAIN REPORT # END # **** PROC VLNCS - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMBFAS *CALL COMTVLD *CALL COMTVLV STATUS CHAIN # CHAIN STATUS # OK, # GOOD CHAIN # ILL, # ILL-FORMED CHAIN # INTC; # INTERSECTING CHAIN # ITEM ENDCHAIN B; # END OF CHAIN FLAG # ITEM FREESTAT B; # FREE FLAG STATUS # ITEM HOCSTAT S : CHAIN; # HEAD-OF-CHAIN STATUS # ITEM I I; # TEMPORARY VARIABLE # ITEM AUCNT I; # COUNT OF AU-S IN CHAIN # ITEM CARTCNT I; # COUNT OF CARTRIDGES IN CHAIN # CONTROL EJECT; # * SCAN *VT* FOR *HOC* ENTRIES. # SLOWFOR I = VTFIRST STEP 1 UNTIL VTLAST DO BEGIN # *VT* SCAN # VTEN$WORD[0] = VT$ITEM[I]; # GET ENTRY # IF NOT VTEN$HOC[0] # SKIP IF NOT HEAD OF CHAIN # THEN BEGIN TEST I; END VTPTR = I; # SET TO HEAD OF CHAIN # # * INITIALIZE. # AUCNT = 0; CARTCNT = 1; ENDCHAIN = FALSE; FREESTAT = FALSE; HOCSTAT = S"OK"; # ASSUME GOOD # # * PROCESS EACH ENTRY IN THE CHAIN STARTING WITH HEAD OF CHAIN. * NOTE - ENTRIES ARE PLACED ON A CHAIN BY SETTING THE VTEN$POINT * FIELD EQUAL TO THE INDEX FOR THE HEAD OF CHAIN. * I = HEAD OF CHAIN INDEX. # REPEAT WHILE NOT ENDCHAIN DO # NORMAL CHAIN PROCESS # BEGIN # NOT END OF CHAIN # IF VTEN$POINT[0] EQ 0 THEN # * PUT ENTRY ON CHAIN. # BEGIN # ADD TO CHAIN # VTEN$POINT[0] = I; # MARK ENTRY ON CHAIN # IF NOT VTEN$ALOC[0] THEN BEGIN VTEN$SOF[0] = TRUE; END IF NOT VTEN$ALOC[0] OR VTEN$EOC[0] AND VTEN$LINK[0] NQ 0 THEN BEGIN HOCSTAT = S"ILL"; # ILL-FORMED CHAIN # END AUCNT = AUCNT + 1; IF VTEN$OCL[0] NQ 0 THEN # LINK IS OFF CARTRIDGE # BEGIN CARTCNT = CARTCNT + 1; END IF VTEN$FCF[0] THEN # FREE CARTRIDGE FLAG SET # BEGIN FREESTAT = TRUE; END END # ADD TO CHAIN # ELSE # VTEN$POINT[0] NOT EQUAL TO 0 # # * ENTRY ALREADY ASSIGNED TO A CHAIN. # BEGIN # ENTRY ON A CHAIN # VTEN$INTS[0] = TRUE; IF VTEN$POINT[0] EQ I THEN BEGIN HOCSTAT = S"ILL"; # ILL-FORMED CHAIN # VTEN$LOOP[0] = TRUE; END ELSE BEGIN HOCSTAT = S"INTC"; # INTERSECTING CHAIN # VLBICT(I,VTEN$POINT[0]); # REPORT INTERSECTIONS # END END # ENTRY ON A CHAIN # # * UPDATE AU ENTRY. # VT$ITEM[VTPTR] = VTEN$WORD[0]; # STORE ENTRY TO *VT* # # * DETERMINE IF END-OF-CHAIN. THE END IS WHEN THE END OF CHAIN * FLAG IS SET OR A CHAIN WITH LINKAGE PROBLEMS HAS BEEN DETECTED. # ENDCHAIN = VTEN$EOC[0] OR HOCSTAT NQ 0; # * GET LINK TO NEXT IF NOT AT END. # IF NOT ENDCHAIN THEN BEGIN # LINK TO NEXT # VTPTR = VTEN$LINK[0]; IF (VTPTR LS VTFIRST) OR (VTPTR GR VTLAST) THEN # BAD LINK # BEGIN HOCSTAT = S"ILL"; # ILL-FORMED CHAIN # ENDCHAIN = TRUE; END END # LINK TO NEXT # # * GET NEXT AU IN CHAIN. # IF NOT ENDCHAIN THEN BEGIN VTEN$WORD[0] = VT$ITEM[VTPTR]; # NEXT AU # END END # NOT END OF CHAIN # # * IF INTERSECTING CHAINS, UPDATE OTHER *HOC* ENTRY. # IF HOCSTAT EQ S"INTC" THEN BEGIN VTEN$WORD[0] = VT$ITEM[VTEN$POINT[0]]; # GET *HOC* ENTRY # VTEN$INTC[0] = TRUE; # SET INTERSECTING # VT$ITEM[VTEN$POINT[0]] = VTEN$WORD[0]; # STORE *HOC* ENTRY # END # * UPDATE THE *HOC* ENTRY. # VTEN$WORD[0] = VT$ITEM[I]; # GET *HOC* ENTRY # IF HOCSTAT EQ S"ILL" THEN BEGIN VTEN$ILL[0] = TRUE; # SET ILL-FORMED BIT # END IF HOCSTAT EQ S"INTC" THEN BEGIN VTEN$INTC[0] = TRUE; # SET INTERSECTING BIT # END # * DO SCATTERED FILE CHECK. # IF CARTCNT GR PAR$ST THEN BEGIN VTEN$SCAT[0] = TRUE; # SET SCATTERED BIT # END IF FREESTAT THEN # FREE CARTRIDGE FLAG WAS SET # BEGIN VTEN$FCF[0] = TRUE; END VT$ITEM[I] = VTEN$WORD[0]; # STORE *HOC* ENTRY # END # *VT* SCAN # END # VLNCS # TERM FUNC VLNTC((FLD),(CONVTYP),(SIZE)) C(10); # TITLE VLNTC - NUMERIC TO CHARACTER CONVERSION. # BEGIN # VLNTC # # ** VLNTC - NUMERIC TO CHARACTER CONVERSION. * * *VLNTC* CONVERTS THE DECIMAL/OCTAL NUMERIC TYPE DATA FIELD * INTO A LEFT-JUSTIFIED CHARACTER TYPE FIELD. * * THE DATA IN *FLD* IS CONVERTED AS SPECIFIED IN *CONVTYP*. * THEN THE NUMBER (*SIZE*) OF RIGHT-JUSTIFIED CONVERTED * CHARACTERS IS LEFT-JUSTIFIED INTO THE RESULT FIELD *VLNTC*. * * FUNC VLNTC(FLD,CONVTYP,SIZE) * * ENTRY (FLD) - DATA FIELD TO CONVERT (RIGHT JUSTIFIED). * (CONVTYP) - "XCDD" FOR DECIMAL DISPLAY CONVERSION. * "XCOD" FOR OCTAL DISPLAY CONVERSION. * ANYTHING ELSE IMPLIES NO CONVERSION. * (SIZE) - NUMBER OF CHARACTERS IN CONVERTED RESULT * TO RETURN. * * EXIT (VLNTC) - CONVERTED DATA, LEFT JUSTIFIED, BLANK * FILLED. * # ITEM FLD I; # FIELD TO CONVERT # ITEM CONVTYP C(10); # TYPE OF CONVERSION # ITEM SIZE I; # SIZE OF RESULT # # **** FUNC VLNTC - XREF LIST BEGIN. # XREF BEGIN PROC VLBFILL; # BLANK FILL # FUNC XCDD; # CONVERT INTEGER TO DECIMAL DISPLAY # FUNC XCOD; # CONVERT INTEGER TO OCTAL DISPLAY # END # **** FUNC VLNTC - XREF LIST END. # ITEM NUMBER I; # TEMPORARY VARIABLE # CONTROL EJECT; NUMBER = FLD; # * CONVERT FIELD AS SPECIFIED. # IF CONVTYP EQ "XCDD" # INTEGER TO DECIMAL # THEN BEGIN NUMBER = XCDD(FLD); END IF CONVTYP EQ "XCOD" # INTEGER TO OCTAL # THEN BEGIN NUMBER = XCOD(FLD); END # * BLANK FILL. # VLBFILL(NUMBER,1); # * RETURN THE FIELD WITH THE NUMBER OF CHARACTERS SPECIFIED, * LEFT JUSTIFIED, BLANK FILLED. # VLNTC = C<10-SIZE,SIZE>NUMBER; END # VLNTC # TERM PROC VLPFC; # TITLE VLPFC - READ PFC. # BEGIN # VLPFC # # ** VLPFC - READ THE *PFC*. * * *VLPFC* BUILDS THE *PFC* EXTRACT FILES FROM THE *PFC* * CATALOG ENTRIES FOR THE SELECTED SUBFAMILIES AND * SELECTED SM(S). * * PROC VLPFC * * ENTRY (DEVMASK) - SELECTED SUBFAMILY(S) DEVICE MASK. * (PAR$CS) - SELECTED *SM-S*. * (PAR$FM) - FAMILY. * (PAR$SB) - SELECTED SUBFAMILIES. * (RPTFADR) - REPORT FILE *FET* ADDRESS. * * EXIT THE *PFC* EXTRACT FILES ARE WRITTEN. * * FOR ERRORS DETECTED - * 1) (TOTALERRS) - TOTAL VALIDATION ERRORS INCREMENTED. * 2) ERROR DETAIL LINES WRITTEN TO THE REPORT FILE. * * MESSAGES * ERROR READING *PFC* * * * NOTES VALIDATION ERRORS DETECTED ARE - * . INVALID *SM* IN *ASA*. * # # **** PROC VLPFC - XREF LIST BEGIN. # XREF BEGIN PROC LOFPROC; # LIST OF FILES PROCESSOR # PROC RDPFC; # READ PERMANENT FILE CATALOG # PROC REWIND; # INTERFACE TO *REWIND* MACRO # PROC RPLINE; # CALLS *RPLINEX* TO PRINT A LINE # PROC VLERROR; # ISSUE ERROR MESSAGE # PROC VLMSG; # ISSUE INFORMATIONAL MESSAGE # FUNC VLNTC C(10); # NUMERIC TO CHARACTER CONVERSION # PROC WRITEF; # INTERFACE TO *WRITEF* MACRO # PROC WRITEW; # INTERFACE TO *WRITEW* MACRO # PROC ZSETFET; # INITIALIZES A *FET* FOR *I/O* # END # **** PROC VLPFC - XREF LIST END. # DEF LISTCON #0#; # TURN COMMON DECK LISTING OFF # *CALL COMBFAS *CALL COMSPFM *CALL COMTCTW *CALL COMTVLD *CALL COMTVLF *CALL COMTVLX ITEM VPEO I; # *PFC* ENTRY ORDINAL # ITEM I I; # TEMPORARY VARIABLE # ITEM IWC I; # INCREMENTED WORD COUNT # ITEM K I; # TEMPORARY VARIABLE # ITEM WDCNT I; # WORD COUNT # # * BUFFER AREA FOR *PFC* ENTRY. # ARRAY VPFCBUFFER [0:O"101"] S(1); # *PFC* BUFFER # ITEM VPFC$WD U(00,00,60); # * ERROR LINES FOR REPORT FILE. # ARRAY BADSM [0:0] S(5); # INVALID *SM* REPORT LINE # BEGIN ITEM BAD$DESC C(00,00,50) = ["***PF = XXXXXXX "]; ITEM BAD$PFN C(00,48,07); ITEM BAD$ERR C(02,00,20) = ["INVALID SM IN PFC "]; END ARRAY BADSM2 [0:0] S(5); # INVALID *SM* REPORT LINE 2 # BEGIN ITEM BAD$DESC2 C(00,00,50) = [" UI = NNNNNN "]; ITEM BAD$UI C(00,48,06); END CONTROL EJECT; # * INITIALIZE FETS. # SLOWFOR I = 0 STEP 1 UNTIL MAXSF DO # *PFC* EXTRACT FILES # BEGIN PEXTFADR = LOC(PFCE$FET[I]); PEXTBADR = LOC(PFCE$BUF[I]); PFCE$LFN[0] = EXTLFN; # *LFN* OF *PFC* EXTRACT FILES # PFCE$LFNX[0] = I + "0"; # APPEND SUBFAMILY TO *LFN* # ZSETFET(PEXTFADR,PFCENAME,PEXTBADR,LPFCEBUF,SFETL); LOFPROC(PFCENAME); # ADD LFN TO LIST OF FILES # REWIND(PFCEXTN[I],RCL); END LOFPROC("CATS"); # ADD LFN TO LIST OF FILES # # * READ THE *PFC* FOR THE SELECTED SUBFAMILIES (DEVMASK). # STAT = 0; SLOWFOR I = 0 STEP 1 WHILE STAT EQ 0 DO BEGIN # READ *PFC* ENTRIES # RDPFC(PAR$FM,DEVMASK,VPFCBUFFER,WDCNT,STAT); # * EXIT IF NO SECTOR WAS RETURNED. # IF STAT NQ 0 THEN BEGIN TEST I; END # * ELSE, PROCESS THE *PFC* SECTOR THAT WAS RETURNED. # P = LOC(VPFCBUFFER) + WDCNT; # RETURN CONTROL WORD # VPEO = -1; # INITIALIZE *PFC* ENTRY ORDINAL # SLOWFOR IWC = 0 STEP PFCENTL WHILE (IWC LS WDCNT) DO BEGIN # *PFC* SELECTION # VPEO = VPEO + 1; P = LOC(VPFC$WD[IWC]); # SET POINTER TO A *PFC* ENTRY # # * SKIP THE *PFC* ENTRY IF IT IS NOT ACTIVE. # IF PFC$UI[0] EQ 0 THEN BEGIN TEST IWC; # *PFC* ENTRY IS NOT ACTIVE # END # * PERMANENT FILE DOES EXIST. # SBINDX = PFC$SF[0]; # SUBFAMILY INDEX # P = LOC(PFC$AA); # ASA DEFINITIONS # SMINDX = ASASM[0]; # EXTRACT *SM* INDEX # # * IF NOT *MAS* *PFC*. # IF PFC$AT NQ ATAS THEN BEGIN TEST IWC; END # * FOR INVALID *SM*, ISSUE DIAGNOSTIC. # IF (PFC$AA[0] NQ 0) AND ((SMINDX EQ 0) OR (SMINDX GR "H")) THEN BEGIN TOTALERRS = TOTALERRS + 1; RPLINE(RPTFADR," ",0,1,EOPL); # BLANK LINE # BAD$PFN[0] = VLNTC(PFC$FN[0]," ",10); # *PFN* IN ERROR # RPLINE(RPTFADR,BADSM,4,50,EOPL); # ISSUE ERROR LINE # BAD$UI[0] = VLNTC(PFC$UI[0],"XCOD",6); # SET UI IN ERROR LINE # RPLINE(RPTFADR,BADSM2,4,50,EOPL); # ISSUE ERROR LINE # TEST IWC; END # * SKIP *PFC* ENTRIES THAT DO NOT MATCH THE SELECTED SUBFAMILY * OR *SM*. # IF (BPAR$SB EQ 0 ) ## OR (BPAR$SM EQ 0) ## OR (PFC$AT[0] NQ ATAS) THEN BEGIN TEST IWC; END # * BUILD THE EXTRACT RECORD. # EXTR$PEO[0] = VPEO; # *PFC* ENTRY ORDINAL # EXTR$DN[0] = CNTR$DN[0]; # DEVICE NUMBER # EXTR$TRK[0] = CNTR$TRK[0]; # TRACK # EXTR$SEC[0] = CNTR$SEC[0]; # SECTOR # EXTR$DA[0] = PFC$DA[0]; EXTR$FLG[0] = PFC$AF[0]; # *ASA* FLAGS # EXTR$D[0] = 0; # INITIALIZE DISK IMAGE FLAG # IF PFC$BT[0] NQ 0 THEN # *PFC* TRACK IS NOT ZERO # BEGIN EXTR$D[0] = 1; # DISK IMAGE EXISTS # END EXTR$ASA[0] = PFC$AA[0]; # SET THE *ASA* # EXTR$AT[0] = PFC$AT[0]; EXTR$FCT[0] = EXTR$GP[0]*16 + EXTR$GPT[0]; EXTR$PFN[0] = PFC$FN[0]; # SET THE *PFN* # EXTR$UI[0] = PFC$UI[0]; # SET THE *UI* # EXTR$BKDT[0] = PFC$UD[0]; # SET THE BACKUP DATE/TIME # EXTR$CREA[0] = PFC$CD[0]; # CREATION DATE/TIME # # * SET THE BACKUP DATE/TIME TO BE THE LATEST DATE/TIME FROM * THE UTILITY CONTROL AND CONTROL MODIFICATION DATE/TIME * FIELDS. # IF PFC$UD[0] LS PFC$KD[0] THEN # CONTROL IS NEWER THAN UTILITY # BEGIN EXTR$BKDT[0] = PFC$KD[0]; # BACKUP DATE/TIME # END WRITEW(PFCEXTN[SBINDX],EXTRECORD,RLEXTR,K); END # *PFC* SELECTION # END # READ *PFC* ENTRIES # # * IF ERROR READING PFC, ISSUE MESSAGE AND ABORT. # IF STAT NQ 1 # IF NOT *EOI* # THEN # ERROR TYPE 2, 3, OR 4 # BEGIN VLERROR(VE"PFCERR",ABRT); # ISSUE MESSAGE AND ABORT # END # * WRITE EOFS ON ALL FILES. # SLOWFOR I = 0 STEP 1 UNTIL MAXSF DO BEGIN WRITEF(PFCEXTN[I],RCL); REWIND(PFCEXTN[I],RCL); END # * SET BITS TO INDICATE ALL SFM CATALOG FILES DO EXIST AND ARE * TO BE VALIDATED. # B<0,8>SFMCATDEF = O"777"; # TURN THE 8 SUBCATALOG FLAGS ON # END # VLPFC # TERM PROC VLPFILL(FLD,(PARAM)); # TITLE VLPFILL - FILL PARAMETER IN MESSAGE TEXT. # BEGIN # VLPFILL # # ** VLPFILL - FILL PARAMETER INTO MESSAGE TEXT. * * *VLPFILL* LOCATES THE PARAMETER PLACE-HOLDER IN THE * TEXT AND REPLACES IT WITH THE PARAMETER CHARACTERS * IN THE *PARAM* WORD. * * A MAXIMUM OF 40 CHARACTERS IS SCANNED. * * PROC VLPFILL(FLD,PARAM) * * ENTRY (FLD) - TEXT TO SCAN. * (PARAM) - PARAMETER TO PLACE IN TEXT. * * EXIT (FLD) - TEXT WITH THE PARAMETER FROM *PARAM* INSERTED. * # ITEM FLD I; # TEXT TO SCAN # ITEM PARAM C(10); # PARAMETER TO INSERT # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMBFAS ITEM PCHAR I; # PARAMETER CHARACTER INDEX # ITEM QCHAR I; # Q CHARACTER INDEX # ITEM Q I; # Q CHARACTER TEMPORARY # BASED ARRAY SCAN [0:0] S(4); # TO SCAN TEXT FIELD # ITEM SCAN$WD C(00,00,40); CONTROL EJECT; P = LOC(FLD); Q = 0; QCHAR = -1; # INITIALIZE # # * SCAN THE TEXT LOOKING FOR A PARAMETER PLACE-HOLDER. # REPEAT WHILE QCHAR LQ 40 AND Q NQ "Q" DO BEGIN # PLACE-HOLDER SEARCH # QCHAR = QCHAR + 1; Q = CSCAN$WD[0]; # GET A CHARACTER # END # PLACE-HOLDER SEARCH # # * MOVE PARAMETER INTO THE PLACE-HOLDER IF THERE WAS ONE. # SLOWFOR PCHAR = 0 STEP 1 WHILE Q EQ "Q" DO BEGIN # PLACE-HOLDER INSERT # CSCAN$WD[0] = CPARAM; # REPLACE Q CHARACTER # QCHAR = QCHAR + 1; Q = CSCAN$WD[0]; # GET NEXT CHARACTER # END # PLACE-HOLDER INSERT # RETURN; END # VLPFILL # TERM PROC VLPRSET; # TITLE VLPRSET - PRESET PARAMETERS AND FILES. # BEGIN # VLPRSET # # ** VLPRSET - PRESET PARAMETERS AND FILES. * * *VLPRSET* INITIALIZES ALL PARAMETERS AND PERFORMS * ALL PRESET FUNCTIONS. THIS INCLUDES - * . GET DEFAULT FAMILY AND SUBSYSTEM ID. * . CRACK CONTROL CARD AND EDIT PARAMETERS. * . LIST THE CONTROL CARD PARAMETERS IN THE REPORT FILE. * . OPEN/INITIALIZE FILES. * * PROC VLPRSET * * ENTRY THE CONTROL CARD IN *RA* + 70B. * * EXIT (DEF$FAM) - DEFAULT FAMILY. * (DEVMASK) - DEVICE MASK FOR SELECTED * SUBFAMILIES. * (PAR$XX) - PARAMETER VALUES WHERE XX = * KEYWORD. * (RPTFILE) - ADDRESS OF REPORT FILE *FET*. * (SSID$VL) - SUBSYTEM IDENTIFICATION. * (ARRAY FIXITFILE) - FIXIT FILE *FET*. * (ARRAY PROBFILE) - PROBLEM FILE *FET*. * * MESSAGES * INVALID SM PARAMETER.* * * INVALID FX PARAMETER.* * * ILLEGAL - L AND RF PARAMETERS.* * * ILLEGAL - RF AND AM PARAMETERS.* * * ILLEGAL - RF AND FM PARAMETERS.* * * ILLEGAL - RL AND NO RF PARAMETERS.* * * INVALID - SB PARAMETER.* * * INVALID - ST PARAMETER.* * * CONTROL CARD SYNTAX ERROR.* * * ABORT RUN DUE TO ERRORS.* * # # **** PROC VLPRSET - XREF LIST BEGIN. # XREF BEGIN PROC BZFILL; # BLANK OR ZERO FILL # PROC GETFAM; # SET FAMILY TABLE # PROC LOFPROC; # LIST OF FILES PROCESSOR # PROC PFD; # PERMANENT FILE ACCESS # PROC SETPFP; # SET FILE PARAMETERS# PROC RETERN; # RETURNS SPECIFIED FILE # PROC REWIND; # INTERFACE TO *REWIND* MACRO # PROC RPLINE; # CALLS *RPLINEX* TO PRINT A LINE # PROC RPOPEN; # OPENS A PRINT FILE # PROC VLBFILL; # BLANK FILL # PROC VLERROR; # ISSUE ERROR MESSAGE # FUNC VLNTC C(10); # NUMERIC TO CHARACTER CONVERSION # PROC VLPFC; # READ *PFC* # PROC VLRDF; # READ RDF FILE # PROC VLTAB; PROC VLTITLE; # ISSUE REPORT TITLE # PROC XARG; # CRACK PARAMETER LIST # FUNC XDXB; # CONVERT DISPLAY CODE TO BINARY # PROC ZSETFET; # INITIALIZES A *FET* FOR *I/O* # END # **** PROC VLPRSET - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTINGS # *CALL COMBFAS *CALL COMBBZF *CALL COMBPFP *CALL COMSPFM *CALL COMTVLD *CALL COMTVLF *CALL COMTVLP *CALL COMTVLX ITEM ARGADDR I; # ARGUMENT TABLE ADDRESS # ITEM ARGERR I; # CTL CARD ARGUMENT ERROR # ITEM CHAR I; # SCRATCH FIELD # ITEM I I; # TEMPORARY VARIABLE # ITEM J I; # TEMPORARY VARIABLE # ITEM K I; # TEMPORARY VARIABLE # ITEM PAR I; # SCRATCH FIELD # BASED ARRAY ARGELEMENT [0:0] S(1); # TO EXTRACT THE ARGUMENTS # BEGIN ITEM ARGITEM U(00,00,60); ITEM ARGITEMC C(00,00,10); ITEM ARGSCAN C(00,00,20); # FOR A 2 WORD PARAMETER # END ARRAY PARIDS [0:VARGL] S(1); # PARAMETER IDS FOR REPORT # BEGIN ITEM PARNME C(00,30,5); ITEM PARNME1 C(VLF,30,5) = [ "L = " ]; ITEM PARNME2 C(VRF,30,5) = [ "RF = " ]; ITEM PARNME3 C(VAM,30,5) = [ "AM = " ]; ITEM PARNME4 C(VSM,30,5) = [ "SM = " ]; ITEM PARNME6 C(VFM,30,5) = [ "FM = " ]; ITEM PARNME7 C(VFX,30,5) = [ "FX = " ]; ITEM PARNME8 C(VRL,30,5) = [ "RL = " ]; ITEM PARNME9 C(VSB,30,5) = [ "SB = " ]; ITEM PARNME10 C(VST,30,5) = [ "ST = " ]; END # * TO BUILD THE PARAMETER FOR THE REPORT FILE. # ARRAY PARVALUE [0:0] S(2); # PARAMETER DISPLAY CD VALUE # BEGIN ITEM PAR$VALUE C(00,00,20); # PARAMETER # ITEM PAR$VALEND U(00,42,18); # END OF FIRST PARAMETER # ITEM PAR$VAL2 C(01,00,10); # SECOND WORD OF PARAMETER # END CONTROL EJECT; # * GET THE SYSTEM DEFAULT FAMILY AND THE SUBSYSTEM IDENTIFICATION. # SSID$VL = ATAS; GETFAM(FAMT,I,J,K,SSID$VL); DEF$FAM = FAM$NAME[K]; # * CRACK THE CONTROL CARD. # VLTAB(ARGADDR); # GET ADDR OF ARGUMENT TABLE # XARG(ARGADDR,0,ARGERR); # CRACK PARAMETERS BASED ON TABLE # IF ARGERR NQ 0 THEN # SYNTAX ERROR # BEGIN VLERROR(VE"SYNTAX",ABRT); # ABORT WITH MESSAGE # END P = LOC(VARGUMENTS); # * MOVE CONTROL CARD ARGUMENTS TO PARAMETERS. PARAMETERS ARE * STORED IN PAR$XX (WHERE XX IS THE KEYWORD) FOR SUBSEQUENT * PROGRAM ACCESS. # PAR$LF = VARG$LF[0]; # *L* PARAMETER VALUE # PAR$RF = VARG$RF[0]; # *RF* PARAMETER VALUE # PAR$AM = VARG$AM[0]; # *AM* PARAMETER VALUE # SLOWFOR I = 0 STEP 1 UNTIL 7 DO # *SM* PARAMETER # BEGIN # MOVE ARGUMENTS # CHAR = CARGSCAN[VSM]; # A *SM* CHARACTER # IF CHAR EQ 0 THEN # END OF *CS* PARAMETER # BEGIN TEST I; END IF CHAR GR "H" THEN # ILLEGAL CHARACTER # BEGIN VLERROR(VE"SMPAR",NOABT); # ISSUE MESSAGE # END ELSE BEGIN # SET *SM* BIT # IF BPAR$SM EQ 1 THEN BEGIN VLERROR(VE"DUPCS",NOABT); END ELSE BEGIN BPAR$SM = 1; END END # SET *CS* BIT # END # MOVE ARGUMENTS # PAR$FM = VARG$FM[0]; # FM PARAMETER VALUE # STAT = XDXB(VARG$FX[0],"D",PAR$FX); # CONVERT FX VALUE # IF STAT NQ 0 THEN # ILLEGAL FX VALUE # BEGIN VLERROR(VE"FXPAR",NOABT); # ISSUE MESSAGE # END PAR$RL = VARG$RL[0]; # RL PARAMETER VALUE # SLOWFOR J = 0 STEP 1 UNTIL 9 DO # SB PARAMETER # BEGIN # SUBFAMILY ARGUMENTS # CHAR = CARGITEM[VSB]; # EXTRACT A SUBFAMILY NUMBER # IF CHAR EQ 0 THEN # END OF SB VALUE # BEGIN TEST J; END IF CHAR LS "0" OR CHAR GR "7" THEN # ILLEGAL SUBFAMILY # BEGIN VLERROR(VE"SBPAR",NOABT); # ISSUE MESSAGE # END ELSE BEGIN # SET SUBFAMILY BIT # IF BPAR$SB EQ 1 THEN BEGIN VLERROR(VE"DUPSB",NOABT); END ELSE BEGIN BPAR$SB = 1; # SET *SB* BIT # B<59-(CHAR-"0"),1>DEVMASK = 1; # RIGHT JUSTIFIED MASK # END END # SET SUBFAMILY BIT # END # SUBFAMILY ARGUMENTS # IF VARG$ST[0] EQ O"30555555555555555555" THEN # DEFAULT *ST* # BEGIN VARG$ST[0] = O"34555555555555555555"; END STAT = XDXB(VARG$ST[0],"D",PAR$ST); # CONVERT ST PARAMETER # IF STAT NQ 0 THEN # ILLEGAL ST VALUE # BEGIN VLERROR(VE"STPAR",NOABT); # ISSUE MESSAGE # END # * VERIFY THAT THE PARAMETER COMBINATIONS ARE LEGAL. * ERRORS ARE - * . *RF* AND *AM* PARAMETER TOGETHER, * . *RF* AND *FM* PARAMETER TOGETHER, * . *RL* AND NO *RF* PARAMETER. # # * L PARAMETER = RF PARAMETER. # IF (PAR$LF NQ 0) AND (PAR$LF EQ PAR$RF) THEN BEGIN VLERROR(VE"LFRF",NOABT); # ISSUE MESSAGE # END # * RL PARAMETER BUT NO RF. # IF (PAR$RL NQ 0) AND (PAR$RF EQ 0) THEN BEGIN VLERROR(VE"RLNRF",NOABT); # ISSUE MESSAGE # END # * RF AND FM SPECIFIED. # IF (PAR$RF NQ 0) AND (PAR$FM NQ 0) THEN BEGIN VLERROR(VE"RFFM",NOABT); # ISSUE MESSAGE # END # * RF AND AM SPECIFIED. # IF (PAR$RF NQ 0) AND (PAR$AM NQ 0) THEN BEGIN VLERROR(VE"RFAM",NOABT); # ISSUE MESSAGE # END # * IF ANY CONTROL CARD ERRORS, ABORT. * (ERRORS ARE COUNTED IN VLERROR). # IF CNTPROGERR NQ 0 THEN # SOME ERRORS OCCURRED # BEGIN VLERROR(VE"ABORT",ABRT); # ABORT WITH MESSAGE # END # * SET THE FAMILY PARAMETER TO THE DEFAULT FAMILY IF THE * FM OPTION IS ACTIVE (NO RF PARAMETER) BUT THE FAMILY WAS * NOT SPECIFIED. # IF (PAR$RF EQ 0) AND ((VARG$IFM[0] EQ -1) OR (PAR$FM EQ 0)) THEN BEGIN PAR$FM = DEF$FAM; VARG$FM[0] = PAR$FM; END # * OPEN REPORT FILE. # IF PAR$LF NQ 0 THEN # L PARAMETER ACTIVE # BEGIN RPTFADR = LOC(RPTFILE); # REPORT FILE FET ADDRESS # END RPOPEN(PAR$LF,RPTFADR,VLTITLE); # * ISSUE REPORT OF SPECIFIED AND DEFAULTED PARAMETERS. # # * PRINT THE CONTROL CARD AS IT IS IN THE RA(70) AREA. # P = 0; VLBFILL(RACOM[CCADDR],8); # BLANK FILL # RPLINE(RPTFADR," ",0,1,EOPL); # A BLANK LINE # RPLINE(RPTFADR,RACOM[CCADDR],12,80,EOPL); # CONTROL CARD # RPLINE(RPTFADR," ",0,1,EOPL); # A BLANK LINE # # * LIST ALL PARAMETERS AND THEIR VALUES. # SLOWFOR PAR = 0 STEP 1 UNTIL VARGL - 1 DO BEGIN # PARAMETER LISTING # IF PAR EQ VSM+1 # 2ND WORD OF *SM* PARAMETER # THEN BEGIN TEST PAR; END RPLINE(RPTFADR,PARNME[PAR],25,5,COPL); # KEYWORD # IF ARGITEM[PAR] EQ -1 THEN BEGIN ARGITEMC[PAR] = "Y"; END IF ARGITEM[PAR] EQ 0 THEN # PARAMETER NOT SPECIFIED # BEGIN ARGITEMC[PAR] = "0"; # USE A CODED ZERO # END PAR$VALUE = ARGITEMC[PAR]; # GET PARAMETER VALUE # IF PAR EQ VSM THEN # INDEX AT CS PARAMETER # BEGIN PAR$VAL2[0] = ARGITEMC[PAR+1]; # GET 2ND WORD # END IF PAR EQ VFM THEN BEGIN PAR$VALEND[0] = 0; END VLBFILL(PARVALUE,2); RPLINE(RPTFADR,PARVALUE[0],30,20,EOPL); # PARAMETER VALUE # END # PARAMETER LISTING # RPLINE(RPTFADR,"0",0,1,EOPL); # 2 BLANK LINES # # * BUILD *PFC* EXTRACT FILES FROM THE *PFC* IF NO RF PARAMETER * WAS SPECIFIED. # IF PAR$RF EQ 0 THEN BEGIN VLPFC; END # * BUILD *PFC* EXTRACT FILES FROM THE RDF FILE IF THE RF PARAMETER * WAS SPECIFIED. # ELSE BEGIN VLRDF; END # * INITIALIZE INTERNAL FILES. # PROBFADR = LOC(PROBFILE); # PROBLEM FILE # PROBBADR = LOC(PROBBUF); ZSETFET(PROBFADR,PROBLFN,PROBBADR,LPROBBUF,SFETL); RETERN(PROBFILE[0],RCL); LOFPROC(PROBLFN); # ADD LFN TO LIST OF FILES # FIXFADR = LOC(FIXITFILE); # FIXIT FILE # FIXBADR = LOC(FIXITBUF); ZSETFET(FIXFADR,FIXLFN,FIXBADR,LFIXBUF,SFETL); RETERN(FIXITFILE[0],RCL); LOFPROC(FIXLFN); # ADD LFN TO LIST OF FILES # REWIND(FIXITFILE,RCL); # * INITIALIZE RELEASE FILE. # PFP$FAM[0] = PAR$FM; PFP$UI[0] = DEF$UI; PFP$FG1[0] = TRUE; PFP$FG4[0] = TRUE; SETPFP(PFP); IF PFP$STAT[0] NQ 0 THEN BEGIN VLERROR(VE"NOFAM",ABRT); END IF (PAR$RF NQ 0) AND (PAR$RL NQ 0) THEN # SET UP *RELCOM* FILE # BEGIN RELNAME = RELLFN; # ATTACH COMMUNICATION FILE # BZFILL(RELNAME,TYPFILL"ZFILL",7); PFD("ATTACH",RELNAME,0,"M","W","RC",STAT,"NA",0,0); IF STAT NQ OK THEN # PROCESS ATTACH ERROR FLAG # BEGIN IF STAT EQ FBS THEN # COMMUNICATION FILE BUSY # BEGIN VLERROR(VE"ABORT",ABRT); END IF STAT EQ FNF THEN # FILE DOES NOT EXIST # BEGIN PFD("DEFINE",RELNAME,0,"BR","N","RC",STAT,0); IF STAT NQ OK THEN # DEFINE ERROR # BEGIN VLERROR(VE"ABORT",ABRT); END END ELSE # ERROR OTHER THAN FBS OR FNF # BEGIN VLERROR(VE"ABORT",ABRT); END END # PROCESS ATTACH ERROR # RELFADR = LOC(RELCFILE); RELBADR = LOC(RELCBUF); ZSETFET(RELFADR,RELNAME,RELBADR,LFIXBUF); LOFPROC(RELNAME); # ADD LFN TO LIST OF FILES # REWIND(RELCFILE[0],RCL); END # SET UP *RELCOM* FILE # END # VLPRSET # TERM PROC VLRCL(COUNT); # TITLE VLRCL - RECALL. # BEGIN # VLRCL # # ** VLRCL - RECALL. * * *VLRCL* ISSUES RECALLS TO THE SYSTEM UNTIL THE *COUNT* * EXPIRES. * * PROC VLRCL(COUNT) * * ENTRY (COUNT) - NUMBER OF TIMES TO ISSUE THE PERIODIC RECALL. * # ITEM COUNT I; # RECALL LOOP CONTROL # # **** PROC VLRCL - XREF LIST BEGIN. # XREF BEGIN PROC RECALL; # INTERFACE TO *RECALL* MACRO # END # **** PROC VLRCL - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMBFAS ITEM II I; # TEMPORARY LOOP VARIABLE # CONTROL EJECT; SLOWFOR II = 0 STEP 1 UNTIL COUNT DO BEGIN RECALL(0); END RETURN; END # VLRCL # TERM PROC VLRDF; # TITLE VLRDF - READ RDF FILE. # BEGIN # VLRDF # # ** VLRDF - READ THE *RDF* FILE. * * *VLRDF* BUILDS THE *PFC* EXTRACT FILES AND THE SFM CATALOG * FILES FROM THE *RDF* FILE SELECTED BY THE *RF* CONTROL CARD * PARAMETER. THIS ROUTINE CONTROLS THE READING OF THE *RDF* * FILE. IT CALLS *VLRDF2* TO PROCESS THE DATA. * * PROC VLRDF * * ENTRY (PAR$CS) - SELECTED *SM-S*. * (PAR$RF) - LFN OF THE *RDF* FILE. * (PAR$SB) - SELECTED SUBFAMILIES. * (RPTFADR) - ADDRESS OF THE REPORT FILE *FET*. * * EXIT THE SFM CATALOG FILES ARE BUILT AS LOCAL FILES. * * THE *PFC* EXTRACT FILES ARE BUILT AS LOCAL FILES. * * IF A VALIDATION ERROR IS DETECTED IN THE *PFC* DATA - * 1) (TOTALERRS) IS INCREMENTED. * 2) DETAIL LINES DESCRIBING THE ERROR ARE WRITTEN TO * THE REPORT FILE. * * MESSAGES * SSVAL ABNORMAL, VLRDF.* * * *RDF* FILE ERROR - MISSING HEADER.* * * *RDF* FILE ERROR - BAD RECORD LENGTH.* * * NOTES THE STRUCTURE OF THE *RDF* FILE IS - * DATA RECORDS - CONSIST OF A ONE WORD CONTROL WORD * AND DATA WORDS. * CONTROL WORD - SPECIFIES THE LENGTH AND TYPE OF THE * FOLLOWING DATA. * DATA TYPES - HEADER RECORD. * *PFC* EXTRACT RECORD. * SFM CATALOG RECORD(S). * DATA LENGTH - LENGTH OF THE DATA IN WORDS. IF THE * LENGTH IS ZERO, THE DATA RECORD IS * TERMINATED BY A LOGICAL-END-OF-RECORD. * *EOR* - (LOGICAL-END-OF-RECORD) MAY BE USED * BETWEEN DATA RECORDS AT LOGICAL * BREAKS AND SHOULD BE EXPECTED * ANYWHERE. * * A TYPICAL SEQUENCE IS - * - HEADER RECORD FOLLOWED BY *EOR*. * - *PFC* EXTRACT RECORDS FOR A DEVICE FOLLOWED BY * *EOR* * - . * - . * - . * - SFM CATALOG RECORD (COPY OF THE PERMANENT FILE) * FOR A SUBFAMILY FOLLOWED BY *EOR*. * - . * - . * - . * -EOI * * IF THE *RDF* HEADER RECORD IS INVALID OR MISSING, THE * PROGRAM ABORTS WITH A DIAGNOSTIC MESSAGE. AN INVALID * HEADER IS DETERMINED BY THE IDENTIFICATION THAT IS * PLACED IN THE HEADER BY *PFDUMP*. * * ONLY THE *PFC* EXTRACT RECORDS FOR THE SELECTED * SUBFAMILIES AND SELECTED *SM-S* ARE WRITTEN TO THE * *PFC* EXTRACT FILE THE RECORDS ARE SELECTED BY * ANALYZING THE *ASA* FIELD. THE *SM* IN THE *ASA* IS * INVALID, ERROR DETAIL LINES ARE FORMATTED AND ISSUED * TO THE REPORT FILE AND THE ERROR IS INCLUDED IN THE * TOTAL ERRORS COUNTER. * * THE SFM CATALOGS ARE WRITTEN TO LOCAL FILES TO BE * ACCESSED LATER VIA THE CATALOG ACCESS ROUTINES. A MASK * IS BUILT IDENTIFYING THOSE SUBFAMILIES THAT WERE * PRESENT ON THE *RDF* FILE. ONLY THOSE SUBFAMILIES WILL * BE USED IN THE VALIDATION PROCESS. # # **** PROC VLRDF - XREF LIST BEGIN. # XREF BEGIN FUNC EDATE C(10); # EDIT DATE FROM PACKED FORMAT # FUNC ETIME C(10); # EDIT TIME FROM PACKED FORMAT # PROC LOFPROC; # LIST OF FILES PROCESSOR # PROC READ; # INTERFACE TO *READ* MACRO # PROC READO; # INTERFACE TO *READO* MACRO # PROC READW; # INTERFACE TO *READW* MACRO # PROC REWIND; # INTERFACE TO *REWIND* MACRO # PROC RPLINE; # CALLS *RPLINEX* TO PRINT A LINE # PROC WRITEF; # INTERFACE TO *WRITEF* MACRO # PROC VLERROR; # ISSUE ERROR MESSAGE # PROC VLMSG; # ISSUE INFORMATIONAL MESSAGE # FUNC VLNTC C(10); # NUMERIC TO CHARACTER CONVERSION # PROC VLRDF2; # PROCESS RDF FILE RECORDS # PROC WRITEW; # INTERFACE TO *WRITEW* MACRO # PROC ZSETFET; # INITIALIZES A *FET* FOR *I/O* # END # **** PROC VLRDF - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTINGS # *CALL COMBFAS *CALL COMBCMD *CALL COMBMCT *CALL COMBMAP *CALL COMTVLD *CALL COMTVLF *CALL COMTVLM *CALL COMTVLP *CALL COMTVLX ITEM DATA I; # LOGICAL RECORD SIZE # ITEM FATEOR B; # FILE AT EOR # ITEM I I; # TEMPORARY LOOP VARIABLE # ITEM J I; # TEMPORARY LOOP VARIABLE # ITEM L I; # TEMPORARY LOOP VARIABLE # CONTROL EJECT; # * INITIALIZE THE FETS. # SLOWFOR I = 0 STEP 1 UNTIL MAXSF DO # *PFC* EXTRACT FILES, 1 PER SUBFAMILY # BEGIN # *FET* INITIALIZATION # PEXTFADR = LOC(PFCE$FET[I]); PEXTBADR = LOC(PFCE$BUF[I]); PFCE$LFN[0] = EXTLFN; # *LFN* FOR *PFC* EXTRACT FILE # PFCE$LFNX[0] = I + "0"; # APPEND SUBFAMILY TO *LFN* # ZSETFET(PEXTFADR,PFCENAME,PEXTBADR,LPFCEBUF,SFETL); LOFPROC(PFCENAME); # ADD LFN TO LIST OF FILES # REWIND(PFCEXTN[I],RCL); END # *FET* INITIALIZATION # RDFFADR = LOC(RDFFILE); # RDF FILE # RDFBADR = LOC(RDFBUF); ZSETFET(RDFFADR,PAR$RF,RDFBADR,LRDFBUF,SFETL); ZVALFADR = LOC(ZZZVALX); # SFM CATALOG FILE # ZVALBADR = LOC(ZZZVBUF); ZSETFET(ZVALFADR,ZVALLFN,ZVALBADR,LZZZVBUF,SFETL); LOFPROC(ZVALLFN); # ADD LFN TO LIST OF FILES # REWIND(RDFFILE,RCL); # * PROCESS UNTIL EOI IS ENCOUNTERED ON THE RDF FILE. # FATEOR = TRUE; # TO FORCE INITIAL READ # STAT = 0; REPEAT WHILE STAT NQ EOI DO BEGIN # PROCESS RDF FILE # IF FATEOR THEN # FILE IS AT EOR CONDITION # BEGIN READ(RDFFILE,NRCL); # START *CIO* READ # FATEOR = FALSE; END # * READ ONE WORD TO GET THE CONTROL WORD. # RDFC$CTYP[0] = 0; READO(RDFFILE,RDFCTLWORD,STAT); # * IF CIO ERROR ON RDF, ABORT. # IF STAT EQ CIOERR THEN BEGIN MP$WD[1] = "VLRDF"; # NAME FOR MESSGE # VLERROR(VE"SYSERR",ABRT); # ABORT WITH MESSAGE # END # * IF AT EOR, EOF, OR EOI, THEN NO DATA TO PROCESS. # IF STAT NQ OK THEN BEGIN FATEOR = TRUE; # INDICATE *CIO* HAS STOPPED # TEST DUMMY; # EXIT, NO DATA # END # * CHECK CONTENTS OF RDF CONTROL WORD COUNT FIELD. # IF RDFC$WC[0] GR RDFMAXWC THEN # RDF DATA LENGTH ILLEGAL # BEGIN VLERROR(VE"RDFLEX",ABRT); # ABORT WITH MESSAGE # END # * CALCULATE LENGTH OF DATA FOLLOWING CONTROL WORD. # DATA = RDFC$WC[0]; # LENGTH OF DATA RECORD # IF DATA EQ 0 THEN # DATA ENDS AT EOR # BEGIN DATA = 77777777; # SET SIZE TO VERY LARGE # END # * SET THE LENGTH PARAMETER FOR READW TO BE THE MINIMUM OF * THE DATA SIZE OR THE RDF BUFFER SIZE. # L = DATA; # SIZE OF DATA EXPECTED # IF L GR LRDFRB THEN BEGIN L = LRDFRB; # SIZE OF RECORD BUFFER # END # * READ THE DATA RECORD (MAY TAKE MORE THAN ONE READ * DEPENDING ON THE LENGTH). # SLOWFOR J = 0 STEP 1 WHILE DATA GR 0 DO BEGIN # READING DATA RECORD # DATA = DATA - L; # LENGTH REMAINING # READW(RDFFILE,RDFRECORD,L,STAT); # GET RECORD # # * IF CIO ERROR, ABORT. # IF STAT EQ CIOERR THEN BEGIN MP$WD[1] = "VLRDF"; VLERROR(VE"SYSERR",ABRT); # ABORT WITH MESSAGE # END # * IF A SHORT RECORD WAS DETECTED, THEN THE FILE IS AT EOR. # IF STAT NQ OK THEN BEGIN FATEOR = TRUE; # INDICATE AT EOR # DATA = 0; # END OF RECORD CONDITION # L = STAT - LOC(RDFRECORD); # LENGTH THAT WAS READ # END # * PROCESS THE DATA IN THE RECORD BUFFER. # VLRDF2(J,DATA,L); # PROCESS THE DATA RECORD # END # READING DATA RECORD # END # PROCESS RDF FILE # IF NOT RDFHDROK THEN # INVALID RDF FILE HEADER # BEGIN VLERROR(VE"RDFHDR",ABRT); # ABORT WITH MESSAGE # END # * WRITE EOF"S ON *PFC* EXTRACT FILES AND REWIND. # SLOWFOR I = 0 STEP 1 UNTIL MAXSF DO BEGIN WRITEF(PFCEXTN[I],RCL); REWIND(PFCEXTN[I],RCL); END END # VLRDF # TERM PROC VLRDF2(BFLG,EFLG,L); # TITLE VLRDF2 - PROCESS RDF FILE RECORDS. # BEGIN # VLRDF2 # # ** VLRDF2 - PROCESS THE *RDF* FILE RECORDS. * * *VLRDF2* VERIFIES THE *RDF* DATA RECORD AND PROCESSES IT * ACCORDING TO ITS DATA TYPE. *PFC* EXTRACT DATA RECORDS * ARE WRITTEN TO THE APPROPRIATE LOCAL *PFC* EXTRACT FILE. * SFM CATALOG DATA RECORDS ARE WRITTEN TO THEIR LOCAL * FILE. * * PROC VLRDF2(BFLG,EFLG,L) * * ENTRY (BFLG) - INDICATES BEGINNING OF DATA IF * ZERO. * (EFLG) - INDICATES END OF DATA IF ZERO. * (L) - LENGTH OF THE DATA IN THE BUFFER. * (PAR$CS) - SELECTED *SM-S*. * (PAR$SB) - SELECTED SUBFAMILIES. * (ARRAY RDFRECORD) - BUFFER THAT CONTAINS THE DATA * READ. * (ARRAY RDFCTLWORD) - CONTAINS THE CONTROL WORD. * * EXIT (PAR$FM) - *RDF* FAMILY FROM THE *RDF* HEADER RECORD. * (RDFDT) - PACKED DATE AND TIME OF THE *RDF* FILE. * *PFC* EXTRACT FILE(S) CREATED. * SFM CATALOG FILE(S) CREATED. * * THE *RDF* FAMILY AND BACKUP DATE/TIME INFORMATIONAL * LINES ARE WRITTEN TO THE REPORT FILE. * * IF AN INVALID *SM* WAS DETECTED IN THE *PFC* EXTRACT * RECORD, * . ERROR LINES WERE WRITTEN TO THE REPORT FILE. * . (TOTALERRS) - TOTAL VALIDATION ERRORS COUNTER * INCREMENTED. * * MESSAGES * *RDF* FILE ERROR - UNIDENTIFIED DATA.* * * *RDF* FILE ERROR - MISSING HEADER.* * * # ITEM BFLG I; # BEGINNING OF RECORD IF = 0 # ITEM EFLG I; # END OF RECORD IF = 0 # ITEM L I; # LENGTH OF DATA RECORD # # **** PROC VLRDF2 - XREF LIST BEGIN. # XREF BEGIN FUNC EDATE C(10); # EDIT DATE FROM PACKED FORMAT # FUNC ETIME C(10); # EDIT TIME FROM PACKED FORMAT # PROC REWIND; # INTERFACE TO *REWIND* MACRO # PROC RPLINE; # CALLS *RPLINEX* TO PRINT A LINE # PROC VLERROR; # ISSUE ERROR MESSAGE # PROC VLMSG; # ISSUE INFORMATIONAL MESSAGE # FUNC VLNTC C(10); # NUMERIC TO CHARACTER CONVERSION # PROC WRITEF; # INTERFACE TO *WRITEF* MACRO # PROC WRITEW; # INTERFACE TO *WRITEW* MACRO # END # **** PROC VLRDF2 - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMBFAS *CALL COMBCMD *CALL COMBMCT *CALL COMBMAP *CALL COMSPFM *CALL COMTVLD *CALL COMTVLF *CALL COMTVLX ITEM KSTAT I; # TEMPORARY VARIABLE # ITEM PROCESSED B; # RECORD PROCESSED OK # # * ERROR LINES FOR THE REPORT. # ARRAY BADSM [0:0] S(5); # INVALID *SM* REPORT LINE # BEGIN ITEM BAD$DESC C(00,00,50) = ["***PF = XXXXXXX "]; ITEM BAD$PFN C(00,48,07); # *PFN* OF *PFC* # ITEM BAD$ERR C(02,00,20) = ["INVALID SM IN PFC "]; END ARRAY BADSM2 [0:0] S(5); # INVALID *SM* REPORT LINE 2 # BEGIN ITEM BAD$DESC2 C(00,00,50) = [" UI = NNNNNN "]; ITEM BAD$UI C(00,48,06); # UI OF *PFC* # END CONTROL EJECT; PROCESSED = FALSE; # * HEADER RECORD PROCESSING OCCURS IF THE CONTROL WORD TYPE * INDICATES THAT IT IS A HEADER RECORD. IF THE DATA IS FROM THE * FIRST READ OF THE RECORD, IMPORTANT DATA IS EXTRACTED FROM THE * RECORD, ELSE THE DATA IS IGNORED. # IF RDFC$CTYP[0] EQ RDFHDRREC THEN BEGIN # RDF HEADER # IF BFLG EQ 0 THEN BEGIN # EXTRACT DATA # IF RDFH$ID[0] NQ "PFDUMP" THEN # INVALID FILE # BEGIN VLERROR(VE"RDFHDR",ABRT); # ABORT WITH MESSAGE # END RDFDT = RDFC$PDT[0]; # PACKED DATE AND TIME # PAR$FM = RDFH$FAM[0]; # RDF FAMILY # MP$WD[1] = VLNTC(PAR$FM," ",10); # FAMILY IN MESSAGE # VLMSG(VM"RDFFM"); # ISSUE MESSAGE # MP$WD[1] = EDATE(B<24,18>RDFDT); # EDITED DATE # MP$WD[2] = ETIME(B<42,18>RDFDT); # EDITED TIME # VLMSG(VM"RDFDT"); # ISSUE MESSAGE # RDFHDROK = TRUE; PROCESSED = TRUE; END # EXTRACT DATA # ELSE BEGIN PROCESSED = TRUE; END END # RDF HEADER # # * *PFC* EXTRACT RECORD PROCESSING OCCURS IF THE CONTROL WORD * TYPE INDICATES IT IS A *PFC* RECORD. # IF RDFC$CTYP[0] EQ RDFPFCREC THEN BEGIN # *PFC* EXTRACT # SBINDX = RDFR$SB[0]; # *PFC* SUBFAMILY # # * BUILD AN EXTRACT RECORD FOR THE SELECTED SUBFAMILY AND SM. # IF (BPAR$SB EQ 1) AND (BPAR$SM EQ 1) AND (RDFR$AT[0] EQ ATAS) THEN BEGIN # BUILD EXTRACT # EXTR$ASA[0] = RDFR$ASA[0]; EXTR$PFN[0] = RDFR$PFN[0]; EXTR$UI[0] = RDFR$UI[0]; EXTR$BKDT[0] = RDFR$UCDT[0]; # BACKUP = UTILITY # IF RDFR$UCDT[0] LS RDFR$CMDT[0] THEN # CONTROL IS MORE RECENT THAN UTILITY # BEGIN EXTR$BKDT[0] = RDFR$CMDT[0]; # BACKUP = CONTROL # END EXTR$D[0] = RDFR$D[0]; EXTR$FLG[0] = RDFR$ASCF[0]; WRITEW(PFCEXTN[SBINDX],EXTRECORD,RLEXTR,KSTAT); END # BUILD EXTRACT # # * FOR AN INVALID *SM*, REPORT PROBLEM. # IF (RDFR$ASA[0] NQ 0) AND (RDFR$AT[0] EQ ATAS) AND (RDFR$SM[0] EQ 0 OR RDFR$SM[0] GR "H") THEN BEGIN TOTALERRS = TOTALERRS + 1; RPLINE(RPTFADR," ",0,1,EOPL); # BLANK LINE # BAD$PFN[0] = VLNTC(RDFR$PFN[0]," ",7); # *PFN* INTO LINE # RPLINE(RPTFADR,BADSM,4,50,EOPL); # ISSUE ERROR LINE # BAD$UI[0] = VLNTC(RDFR$UI[0],"XCOD",6); # UI INTO LINE # RPLINE(RPTFADR,BADSM2,4,50,EOPL); # ISSUE ERROR LINE # END PROCESSED = TRUE; END # *PFC* EXTRACT # # * SFM CATALOG RECORDS. # IF RDFC$CTYP[0] EQ RDFCATREC THEN BEGIN # SFM CATALOG # IF BFLG EQ 0 # BEGINNING OF CATALOG # THEN BEGIN P = LOC(RDFRECORD); ZZZV$LFNX[0] = PRM$SUBF[0]+"0"; # APPEND SUBFAMILY TO *LFN* # BSFMCATDEF = 1; # FLAG THAT CATALOG EXISTS # REWIND(ZZZVALX,RCL); END IF L GR 0 THEN BEGIN WRITEW(ZZZVALX,RDFRECORD,L,KSTAT); END IF EFLG EQ 0 THEN # END OF CATALOG, CLOSE IT # BEGIN WRITEF(ZZZVALX,RCL); REWIND(ZZZVALX,RCL); END PROCESSED = TRUE; END # SFM CATALOG # # * IF AT END OF FILE, SET THE PROCESSED FLAG. # IF RDFC$CTYP[0] EQ RDFEOF THEN # AT END OF FILE # BEGIN PROCESSED = TRUE; END # * UNIDENTIFIED DATA RECORD IN RDF FILE. # IF NOT PROCESSED THEN BEGIN VLERROR(VE"RDFUND",NOABT); # ISSUE MESSAGE # END END # VLRDF2 # TERM PROC VLREQEX(RTYP,RFUNC); # TITLE VLREQEX - REQUEST TO EXEC. # BEGIN # VLREQEX # # ** VLREQEX - SEND REQUEST TO THE M860 EXEC SUBSYSTEM. * * *VLREQEX* FORMATS AND ISSUES THE REQUEST TO EXEC ACCORDING * TO THE REQUEST TYPE AND THE REQUEST FUNCTION. AFTER COMPLETION * OF THE SUBSYSTEM REQUEST, *VLREQEX* PROCESSES THE RESPONSE. * * PROC VLREQEX(RTYP,RFUNC) * * ENTRY (RTYP) - REQUEST TYPE. * (RFUNC) - REQUEST FUNCTION. * (CFIELD) - CATALOG FIELD TO MODIFY (OPTIONAL). * (CONNECTED) - FLAG INDICATES *SSVAL* CONNECTED TO * *EXEC*. * (PAR$FM) - FAMILY. * (SMINDX) - SM INDEX. * (SBINDX) - SUBFAMILY INDEX. * (ARRAY EXTRECORD) - CONTAINS THE FIXIT FILE RECORD. * * EXIT (STAT) - RESPONSE CODE FROM THE SYSTEM OR *EXEC* * ON A TYPE 1 REQUEST. * * IF THE RESPONSE INDICATES AN ERROR ON A TYPE 3 REQUEST, * THE PROGRAM ABORTS WITH A MESSAGE. * * MESSAGES * WAITING FOR EXEC.* * * UCP CALL ERROR.* * * NOTES IF THE "CONNECTED" FLAG IS NOT SET, THE REQUEST IS * IGNORED. THIS ALLOWS *SSVAL* TO RUN WHEN EXEC IS NOT * PRESENT (IN A LIMITED MODE). * * FOR TYPE 3 RESPONSES, "RESUBMIT" AND "INTERLOCK", AN * INFORMATIVE MESSAGE IS ISSUED TO THE B DISPLAY AND THE * REQUEST IS RE-ISSUED. * # ITEM RTYP I; # REQUEST TYPE # ITEM RFUNC I; # REQUEST FUNCTION # # **** PROC VLREQEX - XREF LIST BEGIN. # XREF BEGIN PROC CALLSS; # ISSUES A CALLSS REQUEST TO A SUBSYSTEM # PROC VLERROR; # ISSUE ERROR MESSAGE # PROC VLMSG; # ISSUE INFORMATIONAL MESSAGE # PROC VLRCL; # RECALL # PROC ZFILL; # ZERO FILLS A CHARACTER ITEM # END # **** PROC VLREQEX - XREF LIST END. # DEF LISTCON #0#; # TURN OFF LISTING # *CALL COMBFAS *CALL COMBCPR *CALL COMBMAP *CALL COMBUCR *CALL COMTVLD *CALL COMTVLF ITEM PROCESSED B; # CONTROL FLAG # ARRAY CPRARRAY [0:0] S(CPRLEN); ; # CALLSS PARAMETER ARRAY # CONTROL EJECT; # * IGNORE THIS REQUEST IF NOT CONNECTED TO EXEC. # IF NOT CONNECTED THEN BEGIN RETURN; # SKIP IF NOT CONNECTED # END # * BUILD THE PARAMETER ARRAY FOR THE CALLSS MACRO. # ZFILL(CPRARRAY,CPRLEN); # ZERO FILL THE ARRAY # P = LOC(CPRARRAY); CPR$RQT[0] = RTYP; # SET REQUEST TYPE # CPR$RQC[0] = RFUNC; # SET REQUEST FUNCTION # CPR$RQI[0] = REQNAME"RQIVALD"; # SET REQUESTOR ID # CPR$SSPFLG[0] = TRUE; CPR$SSBFLG[0] = TRUE; CPR$FAM[0] = PAR$FM; # * BUILD TYPE1 FIELDS FOR A *TYP1* REQUEST. # IF RTYP EQ TYP"TYP1" THEN BEGIN CPR$WC[0] = TYP1$WC; END # * BUILD TYPE3 FIELDS FOR A *TYP3* REQUEST. # IF (RTYP EQ TYP"TYP3") THEN # SET WORD COUNT # BEGIN CPR$WC[0] = TYP3$WC; END IF (RTYP EQ TYP"TYP3") AND (RFUNC NQ REQTYP3"REL$SETUP") THEN BEGIN # TYP3 REQUEST # CPR$WC[0] = TYP3$WC; CPR$CSU[0] = SMINDX; # *SM* FROM FIXIT FILE RECORD # CPR$SUB[0] = SBINDX; # SUBFAMILY # CPR$FAM[0] = PAR$FM; CPR$FCT[0] = EXTR$FCT[0]; CPR$AU[0] = EXTR$AU[0]; # * BUILD SMMAP FIELDS IF IT IS AN *UPDATE MAP* FUNCTION. # IF RFUNC EQ REQTYP3"UPD$MAP" THEN BEGIN CPR$Y[0] = PROB$Y[0]; CPR$Z[0] = PROB$Z[0]; CPR$MAPENT[0] = PROB$MAPEN[0]; P = LOC(CPR$MAPENT[0]); CM$FLAG1[0] = TRUE; END # * BUILD CATALOG FIELDS IF IT IS AN "UPDATE CATALOG" FUNCTION. # IF RFUNC EQ REQTYP3"UPD$CAT" THEN BEGIN CPR$FLD[0] = CFIELD; # CATALOG FIELD NAME FLAG # CPR$VAL[0] = 1; END END # TYP3 REQUEST # # * ISSUE REQUEST TO EXEC. # PROCESSED = FALSE; REPEAT WHILE NOT PROCESSED DO BEGIN # EXEC REQUEST # CPR$RQR[0] = 0; # INITIALIZE RESPONSE CODE # CPR$C[0] = FALSE; # INITIALIZE COMPLETE BIT # CALLSS(SSID$VL,CPR,RCL); # * RE-ISSUE IF EXEC RETURNS A "RE-ISSUE" STATUS. # IF (RTYP EQ TYP"TYP3") AND (CPR$RQR[0] EQ RESPTYP3"RESUB$REQ") THEN BEGIN VLMSG(VM"WAITEX"); # ISSUE MESSAGE # TEST DUMMY; # REPEAT THE REQUEST # END # * DELAY AND RE-ISSUE IF EXEC RETURNS "FILE INTERLOCKED" STATUS. # IF (RTYP EQ TYP"TYP3") AND (CPR$RQR[0] EQ RESPTYP3"C$M$INTLCK") THEN BEGIN VLMSG(VM"WAITEX"); # ISSUE MESSAGE # VLRCL(WAITEX); # DELAY AWHILE # TEST DUMMY; # REPEAT THE REQUEST # END PROCESSED = TRUE; END # EXEC REQUEST # VLMSG(VM"CLEARB"); # * ABORT IF THE REQUEST WAS A TYPE3 AND EXEC RESPONDED * WITH AN ERROR. # STAT = CPR$RQR[0]; # GET EXEC RESPONSE # IF RTYP EQ TYP"TYP3" AND (STAT NQ 0) AND STAT NQ RESPTYP3"NO$SUB$CAT" AND CPR$RQC[0] NQ REQTYP3"REL$SETUP" THEN BEGIN VLERROR(VE"UCPERR",ABRT); # ABORT WITH MESSAGE # END # * RETURN NUMBER OF FILES RELEASED. # IF (RTYP EQ TYP"TYP3") AND (RFUNC EQ REQTYP3"REL$SETUP") THEN BEGIN NFILER = CPR$RELC[0]; END # * RETURN THE SYSTEM RESPONSE CODE IF THE REQUEST WAS A * TYPE1 AND THE SYSTEM RETURNED AN ERROR CODE. # IF CPR$ES[0] NQ 0 AND (RTYP EQ TYP"TYP1") THEN BEGIN STAT = CPR$ES[0]; # RETURN SYSTEM RESPONSE # END RETURN; END # VLREQEX # TERM PROC VLRPT(GROUP); # TITLE VLRPT - VALIDATION REPORT. # BEGIN # VLRPT # # ** VLRPT - VALIDATION REPORT. * * *VLRPT* GENERATES A REPORT OF PROBLEMS DETECTED IN THE * PREVIOUS STEPS. PROBLEMS ARE IDENTIFIED BY THE RECORDS * ON THE PROBLEM FILE AND BY ENTRIES IN THE *VT* TABLE * THAT HAVE ERROR FLAGS ON. THE PROBLEMS ARE FORMATTED * INTO DETAIL LINES AND WRITTEN TO THE REPORT FILE VIA * THE REPORT FORMATTER ROUTINES. * * FOR PROBLEMS/ORPHANS THAT REQUIRE CATALOG FIXES(REPAIRS OR * RELEASES), A FIXIT FILE RECORD IS WRITTEN. * * PROC VLRPT * * ENTRY (RPTFADR) - ADDRESS OF THE REPORT FILE *FET*. * (GROUP) - GROUP BEGIN PROCESSED. * (VTFIRST) - INDEX OF FIRST ENTRY IN *VT*. * (VTLAST) - INDEX OF LAST ENTRY IN *VT*. * (ARRAY PROBFILE) - PROBLEM FILE *FET*. * * EXIT (CNTORPHANS) - NUMBER OF TROUBLE-FREE ORPHANS DETECTED. * (RELEASABLE) - NUMBER OF AU-S ALLOCATED TO ORPHANS. * (TOTALERR) - TOTAL VALIDATION ERRORS. * * RECORDS ARE WRITTEN TO THE FIXIT FILE IF DESIRED. * * DETAIL LINES ARE ISSUED TO THE REPORT FILE FOR PROBLEMS * DETECTED. * * NOTES SEE *SSVAL* DOCUMENTATION FOR A DESCRIPTION OF THE * REPORT FILE ENTRIES. * * THE DETAIL LINES TO BE ISSUED ARE SELECTED BY THE * TYPE OF PROBLEM BEING PROCESSED. * * THE DETAIL LINES ARE TO IDENTIFY THE PROBLEM TYPE, * THE IDENTITY OF THE SPECIFIC ENTRY (Y ORDINAL, Z * ORDINAL, PFN, UI, ETC.) AND THE ERROR TEXT. * * FOR PROBLEM ENTRIES THAT INVOLVE CHAINS, THE CHAIN * ENTRIES ARE REPORTED BY CALLING THE ROUTINE *VLSCH*. * * THE VARIABLE INFORMATION FOR EACH DETAIL LINE IS * INSERTED INTO THE LINE USING A CONVERSION ROUTINE * *VLNTC* TO GET DISPLAY CODE (LEFT-JUSTIFIED) DATA WHEN * NECESSARY. * # # **** PROC VLRPT - XREF LIST BEGIN. # XREF BEGIN FUNC EDATE C(10); # EDIT DATE FROM PACKED FORMAT # FUNC ETIME C(10); # EDIT TIME FROM PACKED FORMAT # PROC READ; # INTERFACE TO *READ* MACRO # PROC READW; # INTERFACE TO *READW* MACRO # PROC REWIND; # INTERFACE TO *REWIND* MACRO # PROC RPEJECT; # STARTS A NEW REPORT PAGE # PROC VLRPTL; # ISSUE REPORT LINE # PROC VLSUBHD; # ISSUE REPORT SUBHEADING # FUNC VLNTC C(10); # NUMERIC TO CHARACTER CONVERSION # PROC VLSCH; # SCAN CHAIN FOR REPORT # PROC VLWFIX; # WRITE FIX FILE RECORD # END # **** PROC VLRPT - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTINGS # *CALL COMBFAS *CALL COMTVLD *CALL COMTVLF *CALL COMTVLV DEF LIST #TRUE#; # SELECT CHAIN LIST # DEF NOLIST #FALSE#; # SELECT NO CHAIN LIST # ITEM RECHAR C(10); # CHARACTER TYPE TEMPORARY # ITEM GROUP U; # GROUP BEING PROCESSED # ITEM FCT U; # *FCT* ORDINAL # # * THE FOLLOWING ARRAYS ARE FORMATTED LINES FOR THE REPORT FILE. * THE VARIABLE PORTION IS UPDATED WHEN THE LINE IS TO BE USED * DURING THE PROBLEM RECORD PROCESSING. # ARRAY RLINE1 [0:0] S(2); BEGIN ITEM RLINE1$DEF C(00,00,20) = ["Y = NN"]; ITEM RLINE1$YN C(00,30,02); END ARRAY RLINE2 [0:0] S(2); BEGIN ITEM RLINE2$DEF C(00,00,20) = ["Z = NN"]; ITEM RLINE2$ZN C(00,30,02); END ARRAY RLINE2A [0:0] S(2); BEGIN ITEM RLINE2A$DEF C(00,00,20) = ["CM = A-"]; ITEM RLINE2A$CM C(00,30,02); END ARRAY RLINE3 [0:0] S(2); BEGIN ITEM RLINE3$DEF C(00,00,20) = ["CSN= CSNNAMEX"]; ITEM RLINE3$CSN C(00,30,08); END ARRAY RLINE4 [0:0] S(2); BEGIN ITEM RLINE4$DEF C(00,00,20) = ["FCT= NNNN"]; ITEM RLINE4$FCT C(00,30,04); END ARRAY RLINE5 [0:0] S(2); BEGIN ITEM RLINE5$DEF C(00,00,20) = ["PF = PFNNAME"]; ITEM RLINE5$PFN C(00,30,07); END ARRAY RLINE6 [0:0] S(2); BEGIN ITEM RLINE6$DEF C(00,00,20) = ["UI = NNNNNN "]; ITEM RLINE6$UI C(00,30,06); END ARRAY RLINE7 [0:0] S(2); BEGIN ITEM RLINE7$DEF C(00,00,20) = ["DI = N"]; ITEM RLINE7$D C(00,30,01); END ARRAY RLINE8 [0:0] S(3); BEGIN ITEM RLINE8$DEF C(00,00,30) = ["BU = MO-DA-YR HR.MN.SC"]; ITEM RLINE8$BUDA C(00,24,10); ITEM RLINE8$BUTI C(01,24,10); END ARRAY RLINE9 [0:0] S(1); BEGIN ITEM RLINE9$DEF C(00,00,10) = ["000-0000"]; ITEM RLINE9$FCT C(00,00,03); ITEM RLINE9$AU C(00,24,04); END CONTROL EJECT; # * INITIALIZE. # SCDTLH = FALSE; # DETAIL HEADING FLAG # REWIND(PROBFILE,RCL); READ(PROBFILE,NRCL); # * PROCESS EACH PROBLEM FROM THE RECORDS ON THE PROBLEM FILE. * THE PROCESS FOR EACH PROBLEM IS TO - * - FORMAT THE SELECTED REPORT LINES AND WRITE THEM TO THE * REPORT FILE USING THE REPORT FORMATTER VIA THE VLRPTL * ROUTINE. THE CALLING SEQUENCE TO VLRPTL IS THE SAME AS FOR * THE REPORT FORMATTER. * - WRITE A RECORD TO THE FIXIT FILE IDENTIFYING THE TYPE OF * CATALOG REPAIR/RELEASE ACTION VIA THE RECORD TYPE. * - INCREMENT THE TOTAL ERRORS COUNTER. # STAT = 0; REPEAT WHILE STAT EQ OK DO BEGIN # PROBLEM PROCESSING # READW(PROBFILE,EXTRECORD,RLPROB,STAT); # READ PROBLEM FILE # IF STAT NQ OK THEN BEGIN TEST DUMMY; # EOR, EOF, EOI OR ERROR # END # * START THE REPORT LINE WITH THE ERROR TYPE FROM THE FIXIT * FILE RECORD TYPE. WRITE THE ERROR TYPE TO THE REPORT FILE * USING THE *CONTINUE LINE* OPTION OF THE REPORT FORMATTER. # VLRPTL(RPTFADR," ",0,1,EOPL); # A BLANK LINE # RECHAR = VLNTC(PROB$RT[0],"XCOD",1); VLRPTL(RPTFADR,RECHAR,8,1,COPL); # ERROR TYPE # # * FORMAT IDENTIFICATION LINES IF THE PROBLEM TYPE IS *FCT* OR * *SM* BY FILLING THE *FCT*, Y COORDINATE, Z COORDINATE AND CSN * INTO THE REPORT LINES. # IF PROB$RT[0] EQ REC"FCT" OR PROB$RT[0] EQ REC"SM" THEN BEGIN RLINE4$FCT[0] = VLNTC(EXTR$FCT[0] + ZFD,"XCDD",4); RLINE1$YN[0] = VLNTC(PROB$Y[0]+ZFD,"XCDD",2); RLINE2$ZN[0] = VLNTC(PROB$Z[0]+ZFD,"XCDD",2); RLINE2A$CM[0] = VLNTC(PROB$CM[0]," ",2); RLINE3$CSN[0] = VLNTC(PROB$CSN[0]," ",8); END # * PROCESS PROBLEM RECORD TYPE *FCT* (*SM* ORDINAL ERROR IN *FCT* * ENTRY). # IF PROB$RT[0] EQ REC"FCT" THEN BEGIN VLRPTL(RPTFADR,RLINE4,11,20,EOPL); # *FCT* ID # VLRPTL(RPTFADR,RLINE1,11,20,EOPL); # Y ORD ID # VLRPTL(RPTFADR,RLINE2,11,20,EOPL); # Z ORD ID # VLRPTL(RPTFADR,RLINE3,11,20,COPL); # CSN ID # VLRPTL(RPTFADR,ECORD,50,40,EOPL); # ERROR TEXT # VLWFIX(REC"FCT"); # BUILD FIXIT FILE RECORD # TOTALERRS = TOTALERRS + 1; END # * PROCESS PROBLEM TYPE *SM* (*FCT* ORDINAL ERROR IN SMMAP * ENTRY). # IF PROB$RT[0] EQ REC"SM" THEN BEGIN VLRPTL(RPTFADR,RLINE1,11,20,EOPL); # Y ORD ID # VLRPTL(RPTFADR,RLINE2,11,20,EOPL); # Z ORD ID # VLRPTL(RPTFADR,RLINE3,11,20,EOPL); # CSN ID # VLRPTL(RPTFADR,RLINE4,11,20,COPL); # *FCT* ID # VLRPTL(RPTFADR,EFORD,50,40,EOPL); # ERROR TEXT # TOTALERRS = TOTALERRS + 1; VLWFIX(REC"SM"); # BUILD FIXIT FILE RECORD # END # * FORMAT THE IDENTIFICATION FIELDS IF THE PROBLEM TYPE IS * *ASA* OR *OTHR*. # IF PROB$RT[0] EQ REC"ASA" OR PROB$RT[0] EQ REC"OTHR" THEN BEGIN # ISSUE ID LINES # IF VTLAST GQ VTFIRST THEN BEGIN # CHECK *VT* ENTRY # P = LOC(VTPTR); # BUILD LINK TO *VT* ENTRY # VTL$GRT[0] = EXTR$GPT[0]; VTL$AU[0] = EXTR$AU[0]; VTEN$WORD[0] = VT$ITEM[VTL$WORD[0]]; # GET *VT* ENTRY # IF VTEN$PROB[0] EQ VPT1 THEN BEGIN VLRPTL(RPTFADR," ",8,1,COPL); # SCATTERED ERROR TYPE # END END # CHECK *VT* ENTRY # RLINE5$PFN[0] = VLNTC(EXTR$PFN[0]," ",7); # *PFN* # RLINE6$UI[0] = VLNTC(EXTR$UI[0],"XCOD",6); # UI # RLINE7$D[0] = "N"; # DISK IMAGE = NO # IF EXTR$D[0] NQ 0 THEN BEGIN RLINE7$D[0] = "Y"; # DISK IMAGE = YES # END RLINE8$BUDA[0] = EDATE(EXTR$BKDA[0]); # BACKUP DATE # RLINE8$BUTI[0] = ETIME(EXTR$BKTI[0]); # BACKUP TIME # # * WRITE THE FORMATTED LINES TO THE REPORT FILE. # VLRPTL(RPTFADR,RLINE5,11,20,EOPL); # *PFN* ID # VLRPTL(RPTFADR,RLINE6,11,20,EOPL); # UI # VLRPTL(RPTFADR,RLINE8,11,30,EOPL); # BACK UP DATE-TIME # VLRPTL(RPTFADR,RLINE7,11,20,COPL); # DISK IMAGE FLAG # END # ISSUE ID LINES # # * PROCESS THE PROBLEM TYPE *ASA* (INVALID ASA). # IF PROB$RT[0] EQ REC"ASA" THEN BEGIN FCT = GROUP * 16 + VTL$GRT[0]; RLINE9$FCT[0] = VLNTC(FCT + ZFD,"XCDD",3); RLINE9$AU[0] = VLNTC(EXTR$AU[0]+ZFD,"XCDD",4); VLRPTL(RPTFADR,RLINE9,34,7,COPL); # FCT-AU # VLRPTL(RPTFADR,EASA,50,20,EOPL); # ERROR TEXT # TOTALERRS = TOTALERRS + 1; VLWFIX(REC"ASA"); # BUILD FIXIT FILE RECORD # END # * PROCESS THE PROBLEM TYPE *OTHR* (PFC OWNER WITH PROBLEM * SFM FILE). # IF PROB$RT[0] EQ REC"OTHR" THEN BEGIN P = LOC(VTPTR); # BUILD LINK TO *VT* ENTRY # VTL$GRT[0] = EXTR$GPT[0]; VTL$AU[0] = EXTR$AU[0]; VTEN$WORD[0] = VT$ITEM[VTL$WORD[0]]; # GET *VT* ENTRY # IF VTEN$TYP2[0] OR VTEN$TYP4[0] THEN # TYPE 2 OR TYPE 4 VALIDATION ERROR # BEGIN TOTALERRS = TOTALERRS + 1; VLWFIX(REC"OTHR"); # BUILD FIXIT FILE ENTRY # END VLSCH(LIST,GROUP); END END # PROBLEM PROCESSING # CONTROL EJECT; # * SCAN THE VALIDATION TABLE (VT) - TO REPORT REMAINING PROBLEMS. * * - TO DETECT TROUBLE-FREE ORPHANS. # SLOWFOR VTPTR = VTFIRST STEP 1 UNTIL VTLAST DO BEGIN # *VT* SCAN # VTEN$WORD[0] = VT$ITEM[VTPTR]; # GET *VT* ENTRY # # * PROCESS TROUBLE-FREE ORPHANS. # IF VTEN$HOC[0] AND NOT VTEN$OWN[0] AND NOT VTEN$TYP4[0] THEN BEGIN VLWFIX(REC"TFORPH"); # BUILD FIXIT FILE ENTRY # VLSCH(NOLIST,GROUP); RELEASABLE = RELEASABLE + AUCOUNT; CNTORPHANS = CNTORPHANS + 1; TEST VTPTR; END # * PROCESS PROBLEM CHAINS. PROBLEM CHAINS ARE - * - ORPHAN CHAINS WITH PROBLEMS. * - CHAINS THAT ARE OWNED, HAVE PROBLEMS, AND ARE NOT * YET REPORTED. # IF (VTEN$HOC[0] AND NOT VTEN$OWN[0] AND VTEN$TYP4[0]) OR (VTEN$OWN[0] AND (VTEN$PROB[0] NQ 0) AND NOT VTEN$RPTED[0]) THEN BEGIN TOTALERRS = TOTALERRS + 1; VLWFIX(REC"BADORPH"); # BUILD FIXIT FILE ENTRY # VLRPTL(RPTFADR,"0",0,1,COPL); # 2 BLANK LINES # VLRPTL(RPTFADR,"5",8,1,COPL); # ERROR TYPE # VLRPTL(RPTFADR,"ORPHAN",11,6,COPL); VLSCH(LIST,GROUP); TEST VTPTR; END # * PROCESS FRAGMENT CHAINS. FRAGMENT CHAINS ARE IDENTIFIED BY THE * START OF FRAGMENT FLAG. # IF VTEN$SOF[0] AND VTEN$ALOC[0] THEN BEGIN TOTALERRS = TOTALERRS + 1; VLWFIX(REC"FRAG"); # BUILD FIXIT FILE ENTRY # VLRPTL(RPTFADR,"0",0,1,COPL); VLRPTL(RPTFADR,"6",8,1,COPL); VLRPTL(RPTFADR,"FRAGMENT",11,8,COPL); VLSCH(TRUE,GROUP); TEST VTPTR; END # * PROCESS NOT ALLOCATED ENTRIES (NOT ON CHAIN) THAT CONTAIN * TYPE 4 VALIDATION ERRORS. # IF NOT VTEN$ALOC[0] AND VTEN$TYP4[0] THEN BEGIN TOTALERRS = TOTALERRS + 1; VLWFIX(REC"BADHOLE"); VLRPTL(RPTFADR,"0",0,1,COPL); VLRPTL(RPTFADR,"7",8,1,COPL); VLRPTL(RPTFADR,"UNALLOCATED",11,11,COPL); VTEN$POINT[0] = VTPTR; # INPUT TO *VLSCH* # VLSCH(TRUE,GROUP); TEST VTPTR; END END # *VT* SCAN # # * END OF REPORT PROCESS # END # VLRPT # TERM PROC VLRPTL(P1,P2,P3,P4,P5); # TITLE VLRPTL - ISSUE REPORT LINE. # BEGIN # VLRPTL # # ** VLRPTL - ISSUE REPORT LINE. * * *VLRPTL* ISSUES THE REPORT FILE LINES FOR *VLRPT*. THE * PURPOSE OF THIS ROUTINE IS TO SIMPLY GET THE SUBCATALOG * DETAIL HEADING LINE ISSUED BEFORE THE FIRST DETAIL LINE * FROM *VLRPT*. * * PROC VLRPTL(P1,P2,P3,P4,P5) * * ENTRY (P1) - PARAMETER 1 ( PARAMETERS TO PASS THROUGH * (P2) - PARAMETER 2 TO THE REPORT FORMATTER * (P3) - PARAMETER 3 *RPLINE* ). * (P4) - PARAMETER 4. * (P5) - PARAMETER 5. * (SCDTLH) - SUBCATALOG DETAIL HEADING FLAG. * * EXIT (SCDTLH) - SUBCATALOG DETAIL HEADING FLAG. * (SCRPTED) - SUBCATALOG REPORTED FLAG. * * REPORT LINE WAS WRITTEN TO THE REPORT FILE VIA * THE REPORT FORMATTER. * * NOTES SCDTLH GETS TURNED ON AND OFF IN THE INTERSECTING * CHAIN REPORT PROCESS AND IN THE PROBLEM REPORT PROCESS. * * SCRPTED IS A FLAG TO INDICATE IF EITHER OF THE ABOVE * REPORTS OCCURRED WHICH THEN SUPPRESSES THE SUBSEQUENT * "GOOD" SUBCATALOG HEADING. * # ITEM P1 I; # PARAMETER 1 FOR RPLINE # ITEM P2 I; # PARAMETER 2 FOR RPLINE # ITEM P3 I; # PARAMETER 3 FOR RPLINE # ITEM P4 I; # PARAMETER 4 FOR RPLINE # ITEM P5 I; # PARAMETER 5 FOR RPLINE # # **** PROC VLRPTL - XREF LIST BEGIN. # XREF BEGIN PROC RPLINE; # CALLS *RPLINEX* TO PRINT A LINE # PROC VLSUBHD; # ISSUE REPORT SUBHEADING # END # **** PROC VLRPTL - XREF LIST END. # DEF LISTCON #0#; *CALL COMBFAS *CALL COMTVLD CONTROL EJECT; # * IF THE PROBLEM REPORT DETAIL HEADING IS NOT YET PRINTED, * PRINT IT. # IF NOT SCDTLH THEN BEGIN VLSUBHD(SHTYP"PRPT"); # ISSUE DETAIL HEADING # SCRPTED = TRUE; # SET SUBCATALOG REPORTED FLAG # SCDTLH = TRUE; # SET DETAIL HEADING PRINTED FLAG # END # * PRINT THE REPORT LINE. # RPLINE(P1,P2,P3,P4,P5); END # VLRPTL # TERM PROC VLSCH(LISTOPT,GROUP); # TITLE VLSCH - SCAN CHAIN FOR REPORT. # BEGIN # VLSCH # ITEM LISTOPT B; # TRUE - LIST EACH CHAIN ENTRY # # **** PROC VLSCH - XREF LIST BEGIN. # XREF BEGIN PROC RPLINE; # CALLS *RPLINEX* TO PRINT A LINE # PROC VLERROR; # ISSUE ERROR MESSAGE # FUNC VLNTC C(10); # NUMERIC TO CHARACTER CONVERSION # END # **** PROC VLSCH - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMBFAS *CALL COMTVLD *CALL COMTVLF *CALL COMTVLV ITEM ENDCHAIN B; # END OF CHAIN FLAG # ITEM FCT U; # *FCT* ORDINAL # ITEM GROUP U; # GROUP PROCESSED # ITEM HOCPTR I; # HEAD OF CHAIN POINTER # ITEM I I; # TEMPORARY VARIABLE # ITEM J I; # TEMPORARY VARIABLE # ITEM LFADDR I; # RPT FET ADDR IF LISTOPT = TRUE # ITEM PRTFLAG B; # PRINT FLAG # # * FORMATTED LINE FOR THE REPORT FILE FOR THE CHAIN IDENTIFICATION. # ARRAY CHAINID [0:0] S(2); # CHAIN ID REPORT LINE # BEGIN ITEM CHAIN$DEF C(00,00,20) = ["000-0000 A 0"]; ITEM CHAIN$FCT C(00,00,03); # *FCT* # ITEM CHAIN$AU C(00,24,04); # *AU* # ITEM CHAIN$AF C(00,54,01); ITEM CHAIN$MID C(01,00,02); # CHAIN STATUS # ITEM CHAIN$HOC C(01,00,01); # HEAD OF CHAIN # ITEM CHAIN$EOC C(01,06,01); # END OF CHAIN # END BASED ARRAY REM [0:0] S(1); ; # REPORT ERROR MSG # CONTROL EJECT; # * SET THE REPORT FILE FET ADDRESS IF THE CHAIN ENTRY ID * IS TO BE LISTED IN THE REPORT FILE. # IF LISTOPT THEN BEGIN LFADDR = RPTFADR; # REPORT THE CHAIN ENTRIES # END ELSE BEGIN LFADDR = 0; # TURN REPORT OFF # END I = VTPTR; # STARTING INDEX # HOCPTR = VTEN$POINT[0]; # SAVE START OF CHAIN ID # AUCOUNT = 0; # * PROCESS EACH ENTRY IN CHAIN STARTING WITH GIVEN ENTRY (VTPTR). # ENDCHAIN = FALSE; REPEAT WHILE NOT ENDCHAIN DO BEGIN # *VT* CHAIN PROCESS # # * CALCULATE SFM SPACE IN CHAIN # AUCOUNT = AUCOUNT + 1; # * BUILD THE CHAIN IDENTIFICATION FOR THE REPORT. # P = LOC(I); # TO EXTRACT FCT,STRM FROM LINK # FCT = GROUP * 16 + VTL$GRT[0]; CHAIN$FCT[0] = VLNTC(FCT + ZFD,"XCDD",3); CHAIN$AU[0] = VLNTC(VTL$AU[0]+ZFD,"XCDD",4); CHAIN$AF[0] = "U"; # UNALLOCATED # IF VTEN$ALOC[0] THEN # CHAIN ENTRY IS ALLOCATED # BEGIN CHAIN$AF[0] = "A"; # SET ALLOCATED # END CHAIN$MID[0] = "--"; # SET CHAIN STATUS # IF VTEN$HOC[0] THEN BEGIN CHAIN$HOC[0] = "H"; # SET HEAD OF CHAIN # END IF VTEN$EOC[0] THEN BEGIN CHAIN$EOC[0] = "E"; # SET END OF CHAIN # END RPLINE(LFADDR,CHAINID,34,14,COPL); # ISSUE CHAIN ID # # * SCAN THE *VT* ENTRY FOR ERRORS (BITS VPS THRU VPX IN THE * *VT* ENTRY). FOR EACH VALIDATION ERROR FLAG THAT IS SET, * GET THE ASSOCIATED ERROR MESSAGE AND ISSUE IT TO THE REPORT. # PRTFLAG = FALSE; SLOWFOR J = VPS STEP 1 UNTIL VPX DO BEGIN IF BVTEN$WORD[0] EQ 1 AND (VTER$MSG[J] NQ "0") THEN BEGIN P = LOC(VTER$MSG[J]); # GET ERROR TEXT # RPLINE(LFADDR,REM,50,35,EOPL); # ISSUE TO REPORT # PRTFLAG = TRUE; # SET LINE PRINTED FLAG # END END # * IF NO ERRORS WERE FOUND, THE CHAIN ID LINE HAS NOT YET * BEEN PRINTED. (IT WAS ISSUED USING THE "CONTINUE LINE" * OPTION). # IF NOT PRTFLAG THEN BEGIN RPLINE(LFADDR,0,0,0,EOPL); # PRINT THE LINE # END # * DETERMINE IF AT END-OF-CHAIN. # ENDCHAIN = VTEN$EOC[0] OR NOT VTEN$ALOC[0] ## OR VTEN$LINK[0] EQ 0 OR VTEN$LINK[0] EQ HOCPTR; # * UPDATE THIS ENTRY. # VTEN$RPTED[0] = TRUE; VT$ITEM[I] = VTEN$WORD[0]; # STORE THE *VT* ENTRY # # * GET NEXT AU IN CHAIN. # IF NOT ENDCHAIN THEN BEGIN # GET NEXT AU # I = VTEN$LINK[0]; IF I GR VTLAST THEN # INVALID LINK # BEGIN ENDCHAIN = TRUE; # FORCE END OF CHAIN # P = LOC(I); # TO GET FCT,STRM FROM LINK # FCT = GROUP * 16 + VTL$GRT[0]; CHAIN$FCT[0] = VLNTC(FCT + ZFD,"XCDD",3); CHAIN$AU[0] = VLNTC(VTL$AU[0] + ZFD,"XCDD",4); RPLINE(LFADDR,CHAINID,34,8,COPL); # REPORT ID # RPLINE(LFADDR,ELNK,50,15,EOPL); # INVALID LINK # END ELSE BEGIN VTEN$WORD[0] = VT$ITEM[I]; # GET NEXT AU FROM *VT* # END END # GET NEXT AU # END # *VT* CHAIN PROCESS # END # VLSCH # TERM PROC VLSUBFM; # TITLE VLSUBFM - SUBFAMILY VALIDATION. # BEGIN # VLSUBFM # # ** VLSUBFM - SUBFAMILY VALIDATION. * * *VLSUBFM* CONTROLS THE VALIDATION PROCESS FOR A * GIVEN SUBFAMILY. * * PROC VLSUBFM * * ENTRY (DEF$FAM) - THE DEFAULT FAMILY. * (MEM$MAX) - MAXIMUM MEMORY ALLOWED FOR THE JOB. * (MEM$MIN) - MEMORY REQUIRED FOR THE PROGRAM. * (PAR$AM) - AM OPTION. * (PAR$FM) - FAMILY BEING VALIDATED. * (PAR$RF) - *RDF* FILE NAME. * (SBINDX) - SUBFAMILY BEING PROCESSED. * (ARRAY VLCTLFN) - SFM CATALOG LOCAL FILE NAME. * (ARRAY VLPFN) - SFM CATALOG PERMANENT FILE NAME. * * EXIT THE SUBFAMILY WAS VALIDATED AND DESCRIPTIVE LINES * WRITTEN TO THE REPORT FILE. THE FIXIT FILE RECORDS * (IDENTIFYING REPAIRS/RELEASES FOR THE SUBFAMILY) WERE * WRITTEN. * * MESSAGES * FAMILY NOT FOUND IN SYSTEM.* * * WAITING FOR FILE FILENAME.* * * SFM CATALOG OPEN ERROR.* * * VALIDATING SB=N SM=X.* * * SMMAP OPEN ERROR.* * * REQUIRED FL EXCEEDS JOB MAX.* * * SSVAL ABNORMAL, VLSUBFM.* * * NOTES *VLSUBFM*: * * CALLS *ASINIT* TO INITIALIZE FIELDS FOR THE * SFM CATALOG AND SMMAP ACCESS ROUTINES. * * OPENS THE SFM CATALOG FILE FOR THE SUBFAMILY * (EITHER THE LIVE CATALOG IS ATTACHED AND OPENED * OR THE LOCAL FILE CREATED FROM THE *RDF* FILE IS * OPENED). * * VALIDATES EACH SELECTED *SM* THAT IS SELECTED * IN THE *SM* PARAMETER. * * - OPENS THE PROBLEM FILE. * - OPENS THE SMMAP FILE (IF AM PARAMETER). * - GETS MEMORY SPACE FOR THE *VT* TABLE. * - INITIALIZES THE *VLCMAP* ARRAY. * - CALLS *VLBLDVT* TO BUILD THE *VT* TABLE. * - CALLS *VLAMSF* TO ANALYZE THE SFM DATA * IN THE *VT*. * - CALLS *VLAPFC* TO ANALYZE THE *PFC* DATA IN * THE *PFC* EXTRACT FILES. * - CLOSES THE PROBLEM FILE. * - CALLS *VLRPT* TO GENERATE THE PROBLEM REPORT. * - CLOSES THE SMMAP (IF OPENED). * - ISSUES A SUBCATALOG "GOOD" HEADING ON THE * REPORT FILE IF NO ERRORS WERE DETECTED IN * PREVIOUS STEPS. * CLOSES THE SFM CATALOG FILE. # # **** PROC VLSUBFM - XREF LIST BEGIN. # XREF BEGIN PROC SSINIT; PROC CINTLK; # GET/RELEASE CATALOG INTERLOCK # PROC COPEN; # OPEN CATALOG # PROC CCLOSE; PROC CRDAST; # READ *AST* # PROC LOFPROC; # LIST OF FILES PROCESSOR # PROC MCLOSE; # TERMINATE MAP REFERENCE BY CALLER # PROC MOPEN; # EXTABLISH CALLER ACCESS TO MAP FILE # PROC MEMORY; # REQUEST FIELD LENGTH CHANGE # PROC PFD; # *PFM* REQUEST INTERFACE # PROC REWIND; # INTERFACE TO *REWIND* MACRO # PROC RPEJECT; # STARTS A NEW REPORT PAGE # PROC SETPFP; # SET PERMANENT FILE PARAMETERS # PROC VLAMSF; # ANALYZE THE SFM CATALOG # PROC VLAPFC; # ANALYZE THE *PFC* CATALOG # PROC VLBLDVT; # BUILD VALIDATION TABLE # PROC VLERROR; PROC VLMSG; # ISSUE INFORMATIONAL MESSAGE # PROC VLSMSC; # # PROC VLRCL; # RECALL # PROC VLREQEX; # REQUEST TO EXEC # PROC VLRPT; # VALIDATION REPORT # PROC VLSUBHD; # ISSUE REPORT SUBHEADING # PROC WRITEF; # INTERFACE TO *WRITEF* MACRO # PROC ZFILL; # ZERO FILL BLOCK # END # **** PROC VLSUBFM - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTINGS # *CALL COMBFAS *CALL COMBCMD *CALL COMBCMS *CALL COMBCPR *CALL COMBMAP *CALL COMBMCT *CALL COMBPFP *CALL COMSPFM *CALL COMTVLD *CALL COMTVLF *CALL COMTVLM *CALL COMTVLV ITEM J I; # TEMPORARY VARIABLE # ITEM FLAG I; # STATUS FLAG # ITEM I I; # INDUCTION VARIABLE # ITEM PROCESSED B; # FLAG TO CONTROL LOOP # CONTROL EJECT; # * INITIALIZE CATALOG AREAS. # SSINIT; # * VALIDATE THE "LIVE" SFM CATALOGS IF THE RF PARAMETER * WAS NOT SELECTED. # IF PAR$RF EQ 0 THEN BEGIN # GET LIVE CATALOG # # * SET FAMILY AND UI IN JOB ATTRIBUTES FOR THE SFM CATALOG FILES. # PFP$FAM[0] = PAR$FM; PFP$UI[0] = DEF$UI + SBINDX; PFP$FG1[0] = TRUE; # SET FAMILY # PFP$FG4[0] = TRUE; # SET UI # SETPFP(PFP); IF PFP$STAT[0] NQ 0 THEN # FAMILY NOT FOUND IN SYSTEM # BEGIN VLERROR(VE"NOFAM",ABRT); # ISSUE MESSAGE AND ABORT # END # * ATTACH THE SFM CATALOG FILE FOR SUBFAMILY. # VLCT$LFNX[0] = SBINDX + "0"; # APPEND SUBFAMILY TO *LFN* # VLPF$NAMEX[0] = SBINDX + "0"; # APPEND SUBFAMILY TO *PFN* # PROCESSED = FALSE; REPEAT WHILE NOT PROCESSED DO BEGIN # ATTACH SFM CATALOG # PFD("ATTACH",VLCTLFN,VLPFN,"M","RM","RC",STAT,"NA",0,0); IF STAT EQ FBS OR STAT EQ PFA THEN # FILE IS BUSY # BEGIN MP$WD[1] = VLPF$NAME[0]; LFUN = (ATAS*8) + LGET; CINTLK(LFUN,PAR$FM,2**SBINDX); # GET THE INTERLOCK # CINTLK(LGET,PAR$FM,2**SBINDX); # GET THE INTERLOCK # VLRCL(WAITPF); # DELAY AWHILE # END ELSE BEGIN IF STAT NQ 0 THEN BEGIN VLERROR(VE"CATO",ABRT); END ELSE BEGIN PROCESSED = TRUE; END END END # ATTACH SFM CATALOG # VLMSG(VM"CLEARB"); END # GET LIVE CATALOG # ELSE # PAR$RF DOES NOT EQUAL 0 # # * OTHERWISE USE THE SFM CATALOG FILE CREATED FROM THE RDF FILE. # BEGIN VLCT$LFNX[0] = SBINDX+"0"; # APPEND SUBFAMILY TO *LFN* # END # * OPEN THE SFM CATALOG FOR THE SUBFAMILY. # COPEN(PAR$FM,SBINDX,VLCTLFN,"RM",TRUE,STAT); LOFPROC(VLCTLFN); # ADD LFN TO LIST OF FILES # IF STAT NQ CMASTAT"NOERR" THEN # ERROR WHEN OPENING # BEGIN VLERROR(VE"CATO",ABRT); # ABORT WITH MESSAGE # END # * PERFORM SUBCATALOG VALIDATION FOR EACH SELECTED *SM* THAT * EXISTS. # SLOWFOR SMINDX = 1 STEP 1 UNTIL 8 DO BEGIN # SUBCATALOG VALIDATION # # * SKIP IF THE *SM* WAS NOT SELECTED IN THE *SM* PARAMETER. # IF BPAR$SM EQ 0 THEN BEGIN TEST SMINDX; END # * BEGIN VALIDATION FOR THE SUBCATALOG. # MP$WD[1] = SBINDX + "0"; MP$WD[2] = SMINDX; VLMSG(VM"VALX"); # VALIDATING SB = N SM = X # SCRPTED = FALSE; # SUB-CATALOG HEADING FLAG # SCDTLH = FALSE; REWIND(PROBFILE,RCL); # OPEN PROBLEM FILE # # * ATTACH AND OPEN THE SMMAP FILE IF THE AM OPTION WAS SELECTED. # IF PAR$AM NQ 0 THEN BEGIN # GET SMMAP FILE # PFP$FAM[0] = DEF$FAM; PFP$UI[0] = DEF$UI; PFP$FG1[0] = TRUE; # SET FAMILY # PFP$FG4[0] = TRUE; # SET UI # SETPFP(PFP); VLCM$LFNX[0] = SMINDX; PROCESSED = FALSE; REPEAT WHILE NOT PROCESSED DO BEGIN # SMMAP ACCESS # MOPEN(SMINDX,VLCMLFN,"RM",STAT); # OPEN SMMAP # LOFPROC(VLCMLFN); # ADD LFN TO LIST OF FILES # IF STAT EQ CMASTAT"INTLK" THEN # FILE BUSY # BEGIN MP$WD[1] = VLCM$LFN[0]; VLMSG(VM"WAITCAT"); # ISSUE MESSAGE TO B DISPLAY # VLREQEX(TYP"TYP3",REQTYP3"REL$MPLK"); # GET INTERLOCK # VLRCL(WAITPF); # DELAY # END ELSE BEGIN PROCESSED = TRUE; # OPEN COMPLETED # END END # SMMAP ACCESS # IF STAT NQ CMASTAT"NOERR" THEN # ERROR WHEN OPENING # BEGIN VLERROR(VE"MAPO",ABRT); # ABORT WITH MESSAGE # END END # GET SMMAP FILE # # * CALCULATE THE MEMORY SIZE REQUIRED FOR THE *VT* TABLE AND * ISSUE THE MEMORY REQUEST TO THE SYSTEM. # MEM$WDS[0] = MEM$MIN + 2048*MAXGRT + 64; IF MEM$WDS[0] GQ MEM$MAX THEN # MEMORY NOT AVAILABLE # BEGIN VLERROR(VE"NOFL",ABRT); # ABORT WITH MESSAGE # END MEMORY("CM",MEMRQST,RCL,NA); # REQUEST MEMORY # P = MEM$MIN; # ARRAY BASED AT MEM$MIN # ZFILL(VTTABLE,2048 * MAXGRT); SLOWFOR J = 0 STEP 1 UNTIL MAX$Z DO # CLEAR VLCMAP ARRAY # BEGIN VLCM$Z[J] = 0; END # * ANALYZE EACH GROUP OF SUBFAMILY AND WRITE TO PROBLEM FILE. # SLOWFOR J = 1 STEP 1 ## WHILE J LQ MAXGP ## AND (J-1) LQ (PRM$ENTRC[SMINDX]/16) DO # PROCESS EACH GROUP # BEGIN GROUPX = J; VLBLDVT(J); # BUILD *VT* TABLE # VLAMSF; # VALIDATE ENTRIES IN *VT* # VLAPFC(J); # VALIDATE THE *PFC* ENTRIES # IF (J EQ MAXGP ## OR J-1 EQ PRM$ENTRC[SMINDX]/16) ## AND PAR$AM NQ 0 THEN # LAST CARTRIDGE IN GROUP # BEGIN VLSMSC; END WRITEF(PROBFILE,RCL); VLRPT(J); ZFILL(VTTABLE,2048*MAXGRT); REWIND(PROBFILE,RCL); WRITEF(PROBFILE,RCL); REWIND(PROBFILE,RCL); END # * CLOSE THE SMMAP FILE IF IT WAS OPENED. # IF PAR$AM NQ 0 THEN BEGIN MCLOSE(SMINDX,STAT); IF STAT NQ CMASTAT"NOERR" THEN # ERROR IN CLOSING # BEGIN MP$WD[1] = "VLSUBFM"; # NAME FOR MESSAGE # VLERROR(VE"SYSERR",ABRT); # ABORT WITH MESSAGE # END VLREQEX(TYP"TYP3",REQTYP3"REC$MPLK"); # RETURN INTERLOCK # END # * ISSUE THE "GOOD" SUBCATALOG HEADING IF NO ERRORS WERE DETECTED. # IF NOT SCRPTED THEN BEGIN VLSUBHD(SHTYP"OK"); # SUB-CATALOG HEADING # END END # SUBCATALOG VALIDATION # # * CLOSE THE SFM CATALOG. # CCLOSE(PAR$FM,SBINDX,0,STAT); IF STAT NQ CMASTAT"NOERR" THEN # ERROR IN CLOSING # BEGIN MP$WD[1] = "VLSUBFM"; # NAME FOR MESSAGE # VLERROR(VE"SYSERR",ABRT); # ABORT WITH MESSAGE # END # * IF USING THE LIVE SFM CATALOG, RELEASE THE LOCK. # IF PAR$RF EQ 0 THEN BEGIN LFUN = (ATAS*8) + LREL; CINTLK(LFUN,PAR$FM,2**SBINDX); # RELEASE INTERLOCK # END END # VLSUBFM # TERM PROC VLSUBHD(RTYP); # TITLE VLSUBHD - ISSUE REPORT SUBHEADING. # BEGIN # VLSUBHD # # ** VLSUBHD - ISSUE SUBCATALOG HEADING. * * *VLSUBHD* FORMATS AND ISSUES THE SUBCATALOG HEADING. * * PROC VLSUBHD(RTYP) * * ENTRY (RTYP) - HEADING TYPE. * * EXIT THE SUBCATALOG HEADING IS WRITTEN TO THE * REPORT FILE. THE HEADING WILL BE ONE OF THE FOLLOWING - * - "GOOD" * - "INTERSECTIONS" AND ITS SUB-HEADING. * - "PROBLEMS" AND ITS SUB-HEADING. * * NOTES SEE *SSVAL* DOCUMENTATION FOR A GENERAL * DESCRIPTION OF THE REPORT. # ITEM RTYP I; # HEADING TYPE # # **** PROC VLSUBHD - XREF LIST BEGIN. # XREF BEGIN PROC RPLINE; # CALLS *RPLINEX* TO PRINT A LINE # PROC VLBFILL; # BLANK FILL # PROC VLSUBTD; # GET SUB-HEADING TIME AND DATE # END # **** PROC VLSUBHD - XREF LIST END. # DEF LISTCON #0#; *CALL COMBFAS *CALL COMTVLD *CALL COMTVLF ITEM TYP I; # HEADING TYPE # # * THE FOLLOWING ARRAYS ARE REPORT FILE HEADING LINES. # ARRAY SUBHEAD1 [0:0] S(8); # SUB-HEADING LINE # BEGIN ITEM SH$D1 C(00,00,80) = ["0 SUBFAMILY = N SM = X "]; ITEM SH$SUB C(01,36,01); ITEM SH$SM C(02,30,01); ITEM SH$DESC C(02,48,14); ITEM SH$D2 C(04,24,06) = ["LPDT ="]; ITEM SH$DATE C(05,00,10); ITEM SH$TIME C(06,00,10); END ARRAY RDTL [0:0] S(8); # PROBLEM HEADING # BEGIN ITEM RD$DEF C(00,00,80) = [" ERR "]; ITEM RD$D1 C(01,18,20) = ["IDENTIFICATION"]; ITEM RD$D2 C(03,30,12) = [" -CHAIN- "]; ITEM RD$D3 C(05,06,20) = ["ERROR DESCRIPTION"]; END ARRAY RDTL2 [0:0] S(8); # PROBLEM HEADING 2 # BEGIN ITEM RD$DD1 C(00,00,80) = [" TYP"]; ITEM RD$DD2 C(03,18,20) = ["FCT - AU - A/U - H/E"]; END ARRAY ICHDR [0:0] S(5); # INTERSECTION HEADING # BEGIN ITEM ICH$DEF C(00,00,50) = [" "]; ITEM ICH$D1 C(02,36,20) = ["- HEAD OF CHAINS -"]; END ARRAY ICDTL [0:0] S(5); # INTERSECTION HEADING 2 # BEGIN ITEM ICD$DEF C(00,00,50) = [" "]; ITEM ICD$D1 C(02,12,11) = ["FCTORD - AU"]; ITEM ICD$D2 C(03,42,11) = ["FCTORD - AU"]; END CONTROL EJECT; TYP = RTYP; # SET HEADING TYPE # # * GET THE LAST PURGED DATE/TIME FOR THE SUBCATALOG. # VLSUBTD(SCPDATE,SCPTIME); SH$DATE[0] = SCPDATE; # SUBCATALOG DATE # SH$TIME[0] = SCPTIME; # SUBCATALOG TIME # # * BUILD THE VARIABLE FIELDS OF THE REPORT HEADING. # SH$SUB[0] = SBINDX + "0"; SH$SM[0] = SMINDX; # * FILL IN THE REPORT DESCRIPTION DEPENDING ON THE REQUESTED * HEADING TYPE. # IF TYP EQ SHTYP"OK" THEN BEGIN SH$DESC[0] = " -- GOOD -- "; END IF TYP EQ SHTYP"ICT" THEN BEGIN SH$DESC[0] = "INTERSECTIONS"; END IF TYP EQ SHTYP"PRPT" THEN BEGIN SH$DESC[0] = " PROBLEMS "; END # * ISSUE THE SUBCATALOG HEADING TO THE REPORT FILE. # RPLINE(RPTFADR," ",0,1,EOPL); # BLANK LINE # RPLINE(RPTFADR,SUBHEAD1,0,80,EOPL); # * ISSUE THE INTERSECTING CHAIN SUBHEADING IF REQUESTED. # IF TYP EQ SHTYP"ICT" THEN BEGIN RPLINE(RPTFADR,ICHDR,0,50,EOPL); RPLINE(RPTFADR,ICDTL,0,50,EOPL); END # * ISSUE THE PROBLEM REPORT SUBHEADING IF REQUESTED. # IF TYP EQ SHTYP"PRPT" THEN BEGIN RPLINE(RPTFADR,RDTL,0,80,EOPL); RPLINE(RPTFADR,RDTL2,0,80,EOPL); END END # VLSUBHD # TERM PROC VLSUBTD; # TITLE VLSUBTD - GET SUB-HEADING TIME AND DATE. # BEGIN # VLSUBTD # # ** VLSUBTD - GET SUBCATALOG HEADING TIME AND DATE. * * THE LAST PURGED TIME AND DATE FOR THE SUBCATALOG * IN THE SUBFAMILY IS RETRIEVED AND EDITED. * * PROC VLSUBTD * * ENTRY (SMINDX) - *SM* INDEX. * (PAR$FM) - FAMILY PARAMETER. * (PAR$RF) - *RDF* FILE PARAMETER. * (SBINDX) - SUBFAMILY INDEX. * * EXIT (SCPDATE) - EDITED DATE OR "****". * (SCPTIME) - EDITED TIME OR "****". * * NOTES IF THE SFM CATALOG FROM THE *RDF* FILE IS BEING * PROCESSED THE DATE AND TIME IS RETRIEVED BY A *CALLSS* * TO *EXEC*. * * IF THE LIVE *MSF* CATALOG IS BEING PROCESSED, THE DATE * AND TIME IS RETRIEVED BY THE CATALOG ACCESS ROUTINE * *CGETPD*. * * IF THE SUBCATALOG DATE AND TIME IS NOT AVAILABLE * OR NOT DEFINED, A FILLER "****" IS PLACED IN THE * FIELDS TO BE RETURNED. # # **** PROC VLSUBTD - XREF LIST BEGIN. # XREF BEGIN PROC CGETPD; # GET PURGE DATE # FUNC EDATE C(10); # EDIT DATE FROM PACKED FORMAT # FUNC ETIME C(10); # EDIT TIME FROM PACKED FORMAT # PROC VLLPDT; # GET LAST PURGE DATE AND TIME # END # **** PROC VLSUBTD - XREF LIST END. # DEF LISTCON #0#; *CALL COMBFAS *CALL COMTVLD ITEM PDATE I; # DATE/TIME FOR SUBCATALOG # ITEM QRADDR I; # TEMPORARY # CONTROL EJECT; PDATE = 0; # * IF THE LIVE CATALOG IS ATTACHED AND OPENED, GET THE * SUBCATALOG DATE/TIME FROM THE CATALOG ACCESS ROUTINE. # IF PAR$RF EQ 0 THEN BEGIN CGETPD(PAR$FM,SBINDX,SMINDX,PDATE,QRADDR,STAT); END # * OTHERWISE, GET THE SUBCATALOG DATE/TIME FROM THE LIVE * CATALOG VIA A REQUEST TO THE *EXEC*. # ELSE BEGIN VLLPDT(SBINDX,SMINDX,PDATE); END IF PDATE EQ 0 THEN # NO DATE/TIME DEFINED OR AVAILABLE # BEGIN SCPDATE = " ******** "; # FILL DATE SPACE # SCPTIME = " ******** "; # FILL TIME SPACE # END ELSE # SUBCATALOG LAST PURGED DATE/TIME # BEGIN SCPDATE = EDATE(B<24,18>PDATE); # EDITED DATE # SCPTIME = ETIME(B<42,18>PDATE); # EDITED TIME # END END # VLSUBTD # TERM PROC VLTITLE; # TITLE VLTITLE - ISSUE REPORT TITLE. # BEGIN # VLTITLE # # ** VLTITLE - ISSUE REPORT TITLES. * * *VLTITLE* ISSUES THE REPORT FILE TITLE LINE AND, IF THE * FAMILY NAME IS DEFINED, ISSUES THE SUB-TITLE LINE. * * PROC VLTITLE * * ENTRY (PAR$FM) - FAMILY. # # **** PROC VLTITLE - XREF LIST BEGIN. # XREF BEGIN PROC RPLINEX; # PRINTS A REPORT LINE # PROC VLBFILL; # BLANK FILL # PROC VLSUBHD; # ISSUE REPORT SUBHEADING # END # **** PROC VLTITLE - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMDECK LISTINGS # *CALL COMBFAS *CALL COMTVLD *CALL COMTVLF # * TITLE LINES FOR THE REPORT FILE. # ARRAY RHDR [0:0] S(8); # TITLE LINE # BEGIN ITEM RH$LINE C(00,00,80) = ["0"]; ITEM RH$ID C(00,24,08) = ["SSVAL - "]; ITEM RH$DESC C(01,12,40) = ["VALIDATION REPORT"]; ITEM RH$ID2 C(05,36,08) = ["SSVAL - "]; ITEM RH$VER C(06,24,07) = [VLVER]; END ARRAY RSUBHD [0:0] S(8); # SUB-TITLE LINE # BEGIN ITEM RS$LINE C(00,00,80) = [" FAMILY ="]; ITEM RS$FAM C(02,06,07); END CONTROL EJECT; RPLINEX(RPTFADR,RHDR,0,80,EOPL); # ISSUE TITLE LINE # # * ISSUE THE SUB-TITLE LINE IF THE FAMILY PARAMETER IS DEFINED. # IF PAR$FM NQ 0 THEN BEGIN RS$FAM[0] = PAR$FM; VLBFILL(RSUBHD,8); RPLINEX(RPTFADR,RSUBHD,0,80,EOPL); # ISSUE SUB-TITLE LINE # END RPLINEX(RPTFADR,"0",0,1,EOPL); # 2 BLANK LINES # RETURN; END # VLTITLE # TERM PROC VLWFIX(TYP); # TITLE VLWFIX - WRITE FIX FILE RECORD. # BEGIN # VLWFIX # # ** VLWFIX - WRITE A FIXIT FILE RECORD. * * WRITE A FIXIT FILE RECORD. FOR SOME RECORD TYPES, THE * RECORD DATA IS IN THE *EXTRECORD* ARRAY. FOR OTHER RECORD * TYPES, THE RECORD IS BUILT/MODIFIED USING THE ENTRY * FIELDS SPECIFIED. * * PROC VLWFIX(TYP) * * ENTRY (TYP) - FIXIT FILE RECORD TYPE. * (SMINDX) - *SM* (OPTIONAL). * (SBINDX) - SUBFAMILY (OPTIONAL). * (VTPTR) - INDEX TO CURRENT *VT* ENTRY * (OPTIONAL). * (ARRAY EXTRECORD) - CURRENT PROBLEM FILE RECORD * (OPTIONAL). * (ARRAY FIXIT) - FIXIT FILE *FET*. * (ARRAY VTENTRY) - CURRENT *VT* ENTRY (OPTIONAL). * * EXIT A RECORD IS WRITTEN TO THE FIXIT FILE. # ITEM TYP I; # FIXIT FILE RECORD TYPE # # **** PROC VLWFIX - XREF LIST BEGIN. # XREF BEGIN PROC WRITEW; # INTERFACE TO *WRITEW* MACRO # END # **** PROC VLWFIX - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMDECK LISTINGS # *CALL COMBFAS *CALL COMTVLD *CALL COMTVLF *CALL COMTVLV CONTROL EJECT; # * BUILD AND WRITE THE FIXIT FILE RECORD. IN MOST CASES * THE PROBLEM RECORD IN THE EXTRECORD ARRAY BECOMES THE * FIXIT RECORD. BUT FOR SOME RECORD TYPES, ADDITIONAL * FIELDS ARE ADDED OR THE WHOLE RECORD IS BUILT. # FIX$RT[0] = TYP; # RECORD TYPE # IF TYP EQ REC"OTHR" THEN # ADD THE *VT* ENTRY # BEGIN FIX$VT[0] = VT$ITEM[VTPTR]; END IF TYP EQ REC"BADORPH" ## OR TYP EQ REC"FRAG" ## OR TYP EQ REC"BADHOLE" ## OR TYP EQ REC"TFORPH" THEN # BUILD THE FIXIT RECORD # BEGIN EXTR$SM[0] = SMINDX; EXTR$SB[0] = SBINDX; P = LOC(VTPTR); # TO EXTRACT *FCT* AND AU # EXTR$GPT[0] = VTL$GRT[0]; EXTR$AU[0] = VTL$AU[0]; FIX$VT[0] = VT$ITEM[VTPTR]; EXTR$GP[0] = GROUPX; EXTR$FCT[0] = EXTR$GP[0] * 16 + EXTR$GPT[0]; END WRITEW(FIXITFILE,EXTRECORD,RLFIX,STAT); END # VLWFIX # TERM PROC VLWPROB(TYP); # TITLE VLWPROB - WRITE PROBLEM FILE RECORD. # BEGIN # VLWPROB # # ** VLWPROB - WRITE THE PROBLEM FILE RECORD. * * WRITE A PROBLEM FILE RECORD. FOR SOME RECORD TYPES, THE * RECORD'S DATA IS IN THE *EXTRECORD* ARRAY. FOR OTHER TYPES, THE * RECORD IS BUILT / MODIFIED USING THE ENTRY FIELDS SPECIFIED. * * PROC VLWPROB(TYP) * * ENTRY (TYP) - RECORD TYPE. * (SMINDX) - *SM* (OPTIONAL). * (FCTORD) - *FCT* ORDINAL (OPTIONAL). * (SBINDX) - SUBFAMILY (OPTIONAL). * (CSN) - *CSN* (OPTIONAL). * (Y) - Y ORDINAL (OPTIONAL). * (Z) - Z ORDINAL (OPTIONAL). * (ARRAY SMMAP) - SMMAP ENTRY (OPTIONAL). * (ARRAY EXTRECORD) - CURRENT EXTRACT FILE RECORD * (ARRAY PROBFILE) - PROBLEM FILE *FET*. * * EXIT A RECORD IS WRITTEN TO THE PROBLEM FILE. * # ITEM TYP I; # PROBLEM RECORD TYPE # # **** PROC VLWPROB - XREF LIST BEGIN. # XREF BEGIN PROC VLERROR; # ISSUE ERROR MESSAGE # PROC WRITEW; # INTERFACE TO *WRITEW* MACRO # END # **** PROC VLWPROB - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMBFAS *CALL COMBMAP *CALL COMTVLD *CALL COMTVLF CONTROL EJECT; # * BUILD THE RECORD FOR THE PROBLEM FILE. IN MOST CASES THE * EXTRACT FILE RECORD IN THE EXTRECORD ARRAY BECOMES THE * PROBLEM FILE RECORD. BUT FOR SOME TYPES, THE WHOLE * RECORD MUST BE BUILT. # PROB$RT[0] = TYP; # RECORD TYPE # IF TYP EQ REC"FCT" OR TYP EQ REC"SM" THEN # BUILD A PROBLEM FILE RECORD # BEGIN PROB$Y[0] = Y; PROB$Z[0] = Z; PROB$CSN[0] = CSN; EXTR$FCT[0] = FCTORD; EXTR$SB[0] = SBINDX; EXTR$SM[0] = SMINDX; PROB$SM0[0] = CM$WRD1[0]; PROB$SM1[0] = CM$WRD2[0]; PROB$SM2[0] = CM$WRD3[0]; END WRITEW(PROBFILE,EXTRECORD,RLPROB,STAT); END # VLWPROB # TERM