PDP-10 Archive: 43,50534/cssvld.cbl from decuslib10-11

Trailing-Edge - PDP-10 Archives - decuslib10-11 - 43,50534/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).