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 (B<SBINDX,1>PAR$SB EQ 1) AND (B<SBINDX,1>SFMCATDEF 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 B<K,1>VTEN$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;
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<VTLINK> = 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<VTLINK> = 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<SCAN> = LOC(FLD);
NCHAR = NWDS * 10; # NUMBER OF CHARACTERS TO SCAN #
SLOWFOR CHARINDX = 0 STEP 1 UNTIL NCHAR - 1
DO
BEGIN # CHARINDX #
IF C<CHARINDX,1>SCAN$WD[0] EQ 00
THEN # FOUND A BINARY ZERO #
BEGIN
C<CHARINDX,1>SCAN$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<VTLINK> = 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<VTLINK> = 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<VTTABLE> - 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<VTLINK> = 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<FCT> = 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<FCT> = 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<SMUMAP> = 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
B<Y,1>VLCM$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<SMUMAP> = 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 (B<Y,1>VLCM$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<CPR> = 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*.
#
#
* 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<CNTRWORD> = 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<PFC> =
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<ASA> =
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 (B<SBINDX,1>PAR$SB EQ 0 ) ##
OR (B<SMINDX,1>PAR$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<SCAN> = 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 = C<QCHAR,1>SCAN$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 #
C<QCHAR
,1>SCAN
$WD
[0] =
C<PCHAR
,1>PARAM
; # REPLACE Q CHARACTER #
QCHAR = QCHAR + 1;
Q = C<QCHAR,1>SCAN$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<ARGELEMENT> =
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 = C<I,1>ARGSCAN[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 B<CHAR,1>PAR$SM EQ 1
THEN
BEGIN
VLERROR(VE"DUPCS",NOABT);
END
ELSE
BEGIN
B<CHAR,1>PAR$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 = C<J,1>ARGITEM[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 B<CHAR-"0",1>PAR$SB EQ 1
THEN
BEGIN
VLERROR(VE"DUPSB",NOABT);
END
ELSE
BEGIN
B<CHAR-"0",1>PAR$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<RACOM> = 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 (B<SBINDX,1>PAR$SB EQ 1) AND (B<RDFR$SM,1>PAR$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<PREAMBLE> =
LOC(RDFRECORD
); ZZZV$LFNX[0] = PRM$SUBF[0]+"0"; # APPEND SUBFAMILY TO
*LFN* #
B<PRM
$SUBF
[0],1>SFMCATDEF =
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<CPR> = 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<SMUMAP> = 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<VTLINK> = 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<VTLINK> = 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<VTLINK> = 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 B<J,1>VTEN$WORD[0] EQ 1 AND (VTER$MSG[J] NQ "0")
THEN
BEGIN
P<REM> = 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<VTLINK> = 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 B<SMINDX,1>PAR$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<VTTABLE> = 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<VTLINK> = 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