Trailing-Edge
-
PDP-10 Archives
-
decuslib20-07
-
decus/20-0168/cssvld.cbl
There is 1 other file named cssvld.cbl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
PROGRAM-ID. CSSVLD, VERSION-5, EDIT-2.
AUTHOR. BOB CONLON.
DATE-WRITTEN. 22-SEP-75, MODIFIED 22-NOV-78.
DATE-COMPILED.
REMARKS. THIS PROGRAM MAINTAINS AND LISTS THE CSS
DATA BASE VALIDATION FILE.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. DECSYSTEM-10.
OBJECT-COMPUTER. DECSYSTEM-10.
SPECIAL-NAMES.
CHANNEL (1) IS TOP-OF-FORM.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT VLD-FILE ASSIGN TO DSK.
SELECT FORMAT-FILE ASSIGN TO DSK.
SELECT FILE-OUT ASSIGN TO DSK.
DATA DIVISION.
FILE SECTION.
FD VLD-FILE; VALUE OF IDENTIFICATION IS VLD-NAME.
01 VLD-RECORD; DISPLAY-6 PIC X(4000).
FD FORMAT-FILE; VALUE OF IDENTIFICATION IS FMT-NAME.
01 FORMAT-RECORD.
02 PROMPT-TABLE OCCURS 150 TIMES PIC X(20).
02 LENGTH-OF-FIELD OCCURS 150 TIMES PIC 9(3).
02 NUMBER-FIELDS PIC 9(3).
02 NAMES OCCURS 28 TIMES PIC X(6).
02 VAL-ID PIC X.
02 AC-DAT PIC X.
02 SPC PIC X.
02 FILLER PIC X(3).
02 IND-BLOCK-FACT PIC 9(3).
02 OVER-LAY-PAGE PIC 9(3).
02 BLOCKING-FACTOR PIC 9(3).
02 PRIV OCCURS 28 TIMES PIC 9(3).
02 FILLER PIC X(3).
02 VERSION-NUMBER PIC 9(3).
02 NUM-CHARS PIC 9(4).
02 POS-KEY PIC 99.
02 NUM-PAGES PIC 9(3).
02 TOP-LINE OCCURS 50 TIMES PIC 9(3).
02 DECIMAL-POSIT OCCURS 150 TIMES PIC 9.
FD FILE-OUT; VALUE OF IDENTIFICATION IS OUT-NAME.
01 REC-OUT; DISPLAY-7 PIC X(72).
WORKING-STORAGE SECTION.
77 PR-IND PIC S9(3); COMP.
77 VLD-IND PIC S9(3); COMP.
77 WRK-IND PIC S9(3); COMP.
77 LINE-NUMBER PIC S9(3); COMP.
77 N-O PIC A.
77 S-OL PIC S9(3); COMP.
77 F-OL PIC S9(3); COMP.
77 T-OL PIC S9(3); COMP.
77 X PIC S9(3); COMP.
77 Y PIC S9(3); COMP.
77 REC-TYPE PIC S9(3); COMP.
01 VLD-ARRAY.
02 VLD-BUFF OCCURS 4000 TIMES PIC X.
01 BLANK-LINE.
02 BL-NUM PIC Z(3).
02 FILLER PIC X(3); VALUE "...".
02 BL-PT PIC X(20).
02 FILLER PIC X; VALUE ":".
01 WORK-RECORD.
02 WR1 OCCURS 34 TIMES PIC X.
01 LINE-OUT.
02 LO-NUM PIC Z(3).
02 FILLER PIC X(3); VALUE "...".
02 LO-PT PIC X(20).
02 FILLER PIC X(3); VALUE " : ".
02 LO-VLD PIC X(34).
01 VLD-NAME.
02 V-NAME PIC X(6).
02 FILLER PIC X(3); VALUE "VLD".
01 FMT-NAME.
02 F-NAME.
03 FN-1 PIC X(3).
03 FN-2 PIC X(3).
02 FILLER PIC X(3); VALUE "FMT".
01 OUT-NAME.
02 FILLER PIC X(3); VALUE "VLD".
02 O-NAME PIC X(3).
02 FILLER PIC X(3); VALUE "LPT".
PROCEDURE DIVISION.
SELECTING SECTION.
SS-CHOOSE.
ENTER MACRO NAMDAT.
DISPLAY "CSSDBM VALIDATION ROUTINE CSSVLD(V05-2)".
GET-FN.
DISPLAY " ".
DISPLAY "TYPE NAME OF FORMAT FILE: "; WITH NO ADVANCING.
ACCEPT F-NAME.
IF FN-1 NOT = "DBM" DISPLAY "ILLEGAL FORMAT FILE NAME"
,GO TO GET-FN.
MOVE FN-2 TO O-NAME.
MOVE F-NAME TO V-NAME.
OPEN INPUT FORMAT-FILE.
READ FORMAT-FILE; AT END DISPLAY "NO FORMAT RECORD"; STOP RUN.
IF SPC = "(" MOVE 0 TO REC-TYPE, ENTER MACRO UNSSCR USING REC-TYPE, FORMAT-RECORD.
SS-LOOP1.
DISPLAY "(NEW OR OLD) VALIDATION FILE: "; WITH NO ADVANCING.
ACCEPT N-O.
IF N-O = "N" GO TO SS-CONT2.
IF N-O = "O" GO TO SS-CONT1.
GO TO SS-LOOP1.
SS-CONT1.
OPEN INPUT VLD-FILE.
READ VLD-FILE; AT END DISPLAY "NO VALIDATION RECORD"
,CLOSE VLD-FILE, GO TO SS-CONT2.
MOVE VLD-RECORD TO VLD-ARRAY.
CLOSE VLD-FILE.
SS-CONT2.
MOVE ZERO TO PR-IND, VLD-IND, WRK-IND.
SS-LOOP2.
SET PR-IND UP BY 1.
IF PR-IND > 150 GO TO SS-CONT3.
IF LENGTH-OF-FIELD(PR-IND) = ZERO GO TO SS-CONT3.
MOVE PR-IND TO LINE-NUMBER.
PERFORM SHOW-SIZE.
ACCEPT WORK-RECORD.
IF WORK-RECORD = "SPACES" MOVE SPACES TO WORK-RECORD, GO TO NO-L.
IF WORK-RECORD = SPACES GO TO SS-LOOP2.
IF WORK-RECORD = "OVERLAY" PERFORM OL-SETUP, GO TO SS-CONT3.
IF WORK-RECORD = "F" GO TO SS-CONT3.
IF WORK-RECORD NOT = "L" GO TO NO-L.
SS-LOOP3.
DISPLAY "#"; WITH NO ADVANCING.
ACCEPT LINE-NUMBER.
IF LINE-NUMBER = ZERO DISPLAY "MUST BE A POSITIVE NUMBER" GO TO SS-LOOP3.
IF LINE-NUMBER > NUMBER-FIELDS DISPLAY "NO SUCH LINE", GO TO SS-LOOP3.
COMPUTE PR-IND = LINE-NUMBER - 1.
GO TO SS-LOOP2.
NO-L.
MOVE ZERO TO VLD-IND.
PERFORM TOTAL-UP VARYING PR-IND FROM 1 BY 1 UNTIL PR-IND = LINE-NUMBER.
PERFORM MOVE-BACK VARYING WRK-IND FROM 1 BY 1
,UNTIL WRK-IND > LENGTH-OF-FIELD(PR-IND).
GO TO SS-LOOP2.
SS-CONT3.
OPEN OUTPUT VLD-FILE.
MOVE VLD-ARRAY TO VLD-RECORD.
WRITE VLD-RECORD.
CLOSE VLD-FILE.
GO TO LISTING.
SHOW-SIZE.
MOVE SPACES TO WORK-RECORD.
MOVE ZERO TO VLD-IND, WRK-IND.
PERFORM TOTAL-UP VARYING PR-IND FROM 1 BY 1
,UNTIL PR-IND = LINE-NUMBER.
PERFORM MOVE-TO VARYING WRK-IND FROM 1 BY 1
,UNTIL WRK-IND > LENGTH-OF-FIELD(PR-IND).
MOVE ":" TO WR1(WRK-IND).
MOVE PR-IND TO BL-NUM.
MOVE PROMPT-TABLE(PR-IND) TO BL-PT.
DISPLAY BLANK-LINE, WORK-RECORD.
MOVE SPACES TO WORK-RECORD.
PERFORM SHOW-DASH VARYING WRK-IND FROM 1 BY 1
,UNTIL WRK-IND > LENGTH-OF-FIELD(PR-IND).
MOVE ":" TO WR1(WRK-IND).
DISPLAY BLANK-LINE, WORK-RECORD.
DISPLAY BLANK-LINE, WITH NO ADVANCING.
OL-SETUP.
MOVE OVER-LAY-PAGE TO T-OL.
MOVE TOP-LINE(T-OL) TO S-OL.
COMPUTE F-OL = S-OL + 1.
MOVE ZERO TO VLD-IND.
PERFORM TOTAL-UP VARYING PR-IND FROM 1 BY 1
,UNTIL PR-IND = S-OL.
MOVE VLD-IND TO S-OL.
MOVE ZERO TO X.
COMPUTE F-OL = T-OL + 1.
PERFORM TOTAL-UP VARYING PR-IND FROM PR-IND BY 1
,UNTIL PR-IND = TOP-LINE(F-OL).
MOVE VLD-IND TO F-OL.
COMPUTE T-OL = NUM-PAGES - T-OL.
MOVE ZERO TO Y.
PERFORM GET-OL THRU GO-EXIT T-OL TIMES.
GET-OL.
ADD 1 TO S-OL, F-OL, Y.
IF Y > X GO TO GO-EXIT.
MOVE VLD-BUFF(S-OL) TO VLD-BUFF(F-OL).
GO TO GET-OL.
GO-EXIT.
SET Y TO ZERO.
SUBTRACT 1 FROM S-OL, F-OL.
SHOW-DASH.
MOVE "-" TO WR1(WRK-IND).
MOVE-BACK.
SET VLD-IND UP BY 1.
MOVE WR1(WRK-IND) TO VLD-BUFF(VLD-IND).
TOTAL-UP.
COMPUTE VLD-IND = VLD-IND + LENGTH-OF-FIELD(PR-IND).
COMPUTE X = X + LENGTH-OF-FIELD(PR-IND).
MOVE-TO.
SET VLD-IND UP BY 1.
MOVE VLD-BUFF(VLD-IND) TO WR1(WRK-IND).
LISTING SECTION.
L1.
OPEN INPUT VLD-FILE, OUTPUT FILE-OUT.
READ VLD-FILE; AT END CLOSE VLD-FILE.
READ FORMAT-FILE; AT END CLOSE FORMAT-FILE.
MOVE VLD-RECORD TO VLD-ARRAY.
MOVE ZERO TO VLD-IND.
PERFORM WR-SETUP VARYING PR-IND FROM 1 BY 1
,UNTIL LENGTH-OF-FIELD(PR-IND) = ZERO.
STOP RUN.
WR-SETUP.
MOVE SPACES TO WORK-RECORD.
PERFORM VLD-MOVE VARYING WRK-IND FROM 1 BY 1
,UNTIL WRK-IND > LENGTH-OF-FIELD(PR-IND).
MOVE PROMPT-TABLE(PR-IND) TO LO-PT.
MOVE PR-IND TO LO-NUM.
MOVE WORK-RECORD TO LO-VLD.
MOVE LINE-OUT TO REC-OUT.
WRITE REC-OUT.
VLD-MOVE.
SET VLD-IND UP BY 1.
MOVE VLD-BUFF(VLD-IND) TO WR1(WRK-IND).