Google
 

Trailing-Edge - PDP-10 Archives - k20v7c - mfg/src/strcom.cbl
There are no other files named strcom.cbl in the archive.
IDENTIFICATION DIVISION.
PROGRAM-ID. STRCOM.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.

	SELECT MASTER-FILE ASSIGN TO DSK RECORDING MODE ASCII.
	SELECT SLAVE-FILE ASSIGN TO DSK RECORDING MODE ASCII.
	SELECT RPT-FILE ASSIGN TO DSK RECORDING MODE ASCII.

DATA DIVISION.

FILE SECTION.

FD 	MASTER-FILE
	LABEL RECORDS STANDARD
	VALUE OF ID MAST-NAME.
01	M-REC.
	05	M-rec-TEST.
		10	FILLER PIC X.
		10	M-str-TEST.
			15	M-BOG-TEST.
				20	M-F-TEST PIC X(3).
				20	FILLER PIC X(5).
			15 	FILLER PIC X(2).
	05	FILLER PIC X(59).

FD 	SLAVE-FILE
	LABEL RECORDS STANDARD
	VALUE OF ID S-NAME.
01	S-REC.
	05	FILLER PIC X.
	05	S-REC-TEST.
		10	S-BOG-TEST.
			15	S-F-TEST PIC X(3).
			15	FILLER PIC X(5).
		10	FILLER PIC X(2).
	05	FILLER PIC X(59).

FD 	RPT-FILE
	LABEL RECORDS STANDARD
	VALUE OF ID "STRCOMRPT".

01	RPT-REC DISPLAY-7.
	05	RPT-ITEM PIC X(20).
	05	FILLER PIC X.
	05	RPT-COM PIC X(10).

01	RPT-LONG-REC DISPLAY-7.
	05	RPT-L-ITEM PIC X(20).
	05	FILLER PIC X.
	05	RPT-L-COM PIC X(50).


WORKING-STORAGE SECTION.

01	MAST-NAME.
	05	M-STR PIC X(6).
	05	FILLER PIC X(3) VALUE "DIR".

01	M-DIR PIC X(40).


01	IN-STR PIC X(7).

01	STR-IN.
	05	FILLER PIC XXX.
	05	D-STR PIC X(6).

01	S-NAME.
	05	S-STR PIC X(6).
	05	FILLER PIC X(3) VALUE "DIR".

01	S-DIR PIC X(40).

01	SAVE-BUFF OCCURS 4 TIMES INDEXED BY SAVE-INDEX.
	05	SAVE-LINE PIC X(4).
	05	SAVE-MARK PIC X.

01	S-BUFF OCCURS 2999 TIMES INDEXED BY S-INDEX.
	05	S-LINE.
		10	S-STR-TEST PIC X(11).
		10	FILLER PIC X(59).
	05	S-MARK PIC X.

01	EOF-FLG PIC 9.
01	EOB-FLG PIC 9.
01	DIR-FLG PIC 9.
01	EOD-FLG PIC 9.
01	FILE-MISSING-FLG PIC 9.

01	BOGUS-FLG PIC 9.

01	D-FILE-IN.
	05	FILLER PIC X.
	05	D-FILE-NAME PIC X(35).

01	M-FILE-ATT.
	05	M-FILE-PROT PIC X(7).
	05	M-FILE-COMP PIC X(43).

01	S-FILE-ATT.
	05	S-FILE-PROT PIC X(7).
	05	S-FILE-COMP PIC X(43).


01	M-FILE-FULL PIC X(35).
01	M-FILE-NAME.
	05	M-FILE-QUICK PIC X(4).
	05	FILLER PIC X(26).
01	M-FILE-EXT PIC X(30).
01	M-FILE-GEN PIC X(4).


01	S-FILE-NAME.
	05	S-FILE-QUICK PIC X(4).
	05	FILLER PIC X(26).
01	S-FILE-EXT PIC X(30).
01	S-FILE-GEN PIC X(4).
01	FILE-DIFF-FLG PIC 9.

PROCEDURE DIVISION.

INIT.
	SET S-INDEX TO 1
	SET SAVE-INDEX TO 1.
	DISPLAY " ".
	DISPLAY "Structure Files compare routine".
	Display " ".
GET-M-STR.
	MOVE SPACES TO M-STR.
	Display "Master Structure: " with no advancing.
	accept IN-STR.
	UNSTRING IN-STR DELIMITED BY ":" INTO M-STR.
	IF M-STR = SPACES
		DISPLAY "? - Input error."
		GO TO GET-M-STR.

GET-S-STR.
	MOVE SPACES TO S-STR.
	DISPLAY "Slave Structure: " with no advancing.
	accept IN-STR.
	UNSTRING IN-STR DELIMITED BY ":" INTO S-STR.
	IF S-STR = SPACES
		DISPLAY "? - Input error."
		GO TO GET-S-STR.

FILE-INIT.
	OPEN INPUT SLAVE-FILE.
	MOVE 0 TO EOF-FLG.
	SET S-INDEX TO 1.
	PERFORM LOAD-S-BUFF THRU LOAD-S-BUFF-EXIT UNTIL EOF-FLG = 1
		OR S-INDEX = 2999.
	IF EOF-FLG NOT = 1
		DISPLAY "% - Buffer Overflow... Continue ? " with no advancing.
	Display " ".
	MOVE "Z" TO S-MARK (S-INDEX).

	OPEN OUTPUT RPT-FILE.

	MOVE 0 TO EOF-FLG.
	OPEN INPUT MASTER-FILE.

GET-FIRST-M-DIR.
	MOVE "***" TO D-STR
	PERFORM SEARCH-M-STR THRU SEARCH-M-STR-EXIT
		UNTIL EOF-FLG = 1 OR D-STR = M-STR.
	IF EOF-FLG = 1
		DISPLAY "? - Can't find structure name in master directory!"
		Stop run.
	DISPLAY M-DIR.
	PERFORM WRITE-M-DIR.
	SET S-INDEX TO 1.
	GO TO NXT-S-DIR.

GET-NXT-M-DIR.
	MOVE "***" TO D-STR
	PERFORM SEARCH-M-STR THRU SEARCH-M-STR-EXIT
		UNTIL EOF-FLG = 1 OR D-STR = M-STR.
	IF EOF-FLG = 1
		DISPLAY " "
		DISPLAY "Done!"
		Stop run.
	DISPLAY M-DIR.
	PERFORM WRITE-M-DIR.

NXT-S-DIR.
	MOVE 0 TO DIR-FLG.
	MOVE 0 TO EOB-FLG.
*	SET S-INDEX TO 1.
	MOVE "***" TO D-STR.
*	PERFORM READ-S-DIR VARYING S-INDEX FROM 1 BY 1
	PERFORM READ-S-DIR VARYING S-INDEX FROM S-INDEX BY 1
		UNTIL S-MARK (S-INDEX) = "Z"
		OR D-STR = S-STR AND S-DIR = M-DIR.
	IF S-MARK (S-INDEX) NOT = "Z"
		SET SAVE-INDEX TO S-INDEX
		GO TO NXT-M-FILE.
MISSING-DIRECTORY.
*	MOVE SPACES TO RPT-REC.
	MOVE M-DIR TO RPT-ITEM.
	MOVE " Missing!" to RPT-COM.
	WRITE RPT-REC.
	SET S-INDEX TO 1.
	GO TO GET-NXT-M-DIR.


NXT-M-FILE.
	IF EOF-FLG = 1 GO TO DONE-M-DIR.
	READ MASTER-FILE AT END MOVE 1 TO EOF-FLG
		GO TO DONE-M-DIR.
	PERFORM TEST-M-LINE.
	IF BOGUS-FLG = 1
		GO TO NXT-M-FILE.


*NEXT LINE???
	MOVE SPACES TO M-FILE-ATT.
	UNSTRING M-STR-TEST DELIMITED BY ":" INTO D-FILE-IN M-FILE-ATT.
	IF M-FILE-ATT NOT = SPACES
		GO TO DONE-M-DIR.

	MOVE SPACES TO M-FILE-ATT.
	UNSTRING M-REC DELIMITED BY ";" INTO D-FILE-IN M-FILE-ATT.
	MOVE D-FILE-NAME TO M-FILE-FULL.

	IF M-FILE-ATT = SPACES
		DISPLAY "? - Missing file attributes in Master directory!".

	UNSTRING D-FILE-NAME DELIMITED BY "." INTO
		M-FILE-NAME, M-FILE-EXT, M-FILE-GEN.

	MOVE 0 TO EOD-FLG.
	MOVE 0 TO EOB-FLG.
*
	MOVE "***" TO S-FILE-NAME.
	PERFORM SEARCH-S-FILE THRU SEARCH-S-FILE-EXIT
		UNTIL EOD-FLG = 1
		OR EOB-FLG = 1
*FOR SPEED
		OR M-FILE-NAME = S-FILE-NAME
		AND M-FILE-EXT = S-FILE-EXT.
	IF EOD-FLG = 1 OR EOB-FLG = 1
		GO TO FILE-MISSING.
S-FILE-FOUND.
*NEVER GO BACKWARDS FROM A FILE THAT'S FOUND.
	SET SAVE-INDEX TO S-INDEX.

FILE-COMP.
	IF M-FILE-COMP NOT = S-FILE-COMP
		MOVE 1 TO FILE-DIFF-FLG
		MOVE M-FILE-FULL TO RPT-L-ITEM
		MOVE M-FILE-ATT TO RPT-L-COM
		WRITE RPT-LONG-REC
		MOVE SPACES TO RPT-L-ITEM
		MOVE S-FILE-ATT TO RPT-L-COM
		WRITE RPT-LONG-REC.

*IN CASE OF MULTIPLE GENS
*	SET S-INDEX DOWN BY 1.

	GO TO NXT-M-FILE.

FILE-MISSING.
	MOVE 1 TO FILE-MISSING-FLG.
	MOVE M-FILE-FULL TO RPT-ITEM.
	MOVE " Missing" TO RPT-COM.
	WRITE RPT-REC.
	SET S-INDEX TO SAVE-INDEX.
	GO TO NXT-M-FILE.

DONE-M-DIR.
	IF FILE-MISSING-FLG = 0 AND FILE-DIFF-FLG = 0
		MOVE M-DIR TO RPT-ITEM
		MOVE " Same " to RPT-COM
		WRITE RPT-REC.
	MOVE 0 TO FILE-MISSING-FLG.
	MOVE 0 TO FILE-DIFF-FLG.
	IF EOF-FLG = 1
		GO TO FINI.
	UNSTRING M-REC DELIMITED BY ":" INTO STR-IN M-DIR.
	PERFORM WRITE-M-DIR.
	DISPLAY M-DIR.
	GO TO NXT-S-DIR.
		

FINI.
	CLOSE MASTER-FILE.
	MOVE SPACES TO RPT-REC. WRITE RPT-REC.
	CLOSE RPT-FILE.
	DISPLAY "Done!".
	STOP RUN.

******************************

SEARCH-M-STR.
	IF EOF-FLG = 1
		GO TO SEARCH-M-STR-EXIT.
	READ MASTER-FILE AT END MOVE 1 TO EOF-FLG.
	PERFORM TEST-M-LINE.
	IF BOGUS-FLG = 1
		GO TO SEARCH-M-STR.
	MOVE SPACES TO M-DIR.
	UNSTRING M-STR-TEST DELIMITED BY ":" INTO STR-IN M-DIR.
	IF M-DIR NOT = SPACES
		UNSTRING M-REC DELIMITED BY ":" INTO STR-IN M-DIR.

SEARCH-M-STR-EXIT. EXIT.

READ-S-DIR.
	UNSTRING S-LINE (S-INDEX) DELIMITED BY ":" INTO STR-IN S-DIR.

LOAD-S-BUFF.
	READ SLAVE-FILE AT END MOVE 1 TO EOF-FLG
		GO TO LOAD-S-BUFF-EXIT.
	IF S-F-TEST = SPACES
		GO TO LOAD-S-BUFF-EXIT.
	IF S-BOG-TEST = ("TOTAL OF" OR "GRAND TO")
		GO TO LOAD-S-BUFF-EXIT.
	MOVE S-REC TO S-LINE (S-INDEX).
	MOVE "G" TO S-MARK (S-INDEX).
	SET S-INDEX UP BY 1.

LOAD-S-BUFF-EXIT. EXIT.


SEARCH-S-FILE.

*	DISPLAY S-INDEX.

	IF S-MARK (S-INDEX) = "Z"
		MOVE 1 TO EOB-FLG
		GO TO SEARCH-S-FILE-EXIT.
	MOVE SPACES TO S-FILE-ATT.
	UNSTRING S-STR-TEST (S-INDEX) DELIMITED BY ":" INTO
		D-FILE-IN S-FILE-ATT.
	IF S-FILE-ATT NOT = SPACES
		MOVE 1 TO EOD-FLG
		GO TO SEARCH-S-FILE-EXIT.
	UNSTRING S-LINE (S-INDEX) DELIMITED BY ";" INTO
		D-FILE-IN S-FILE-ATT.

	IF S-FILE-ATT = SPACES
		DISPLAY "? - Missing file attributes in Slave directory!".

	UNSTRING D-FILE-NAME DELIMITED BY "." INTO
		S-FILE-NAME, S-FILE-EXT, S-FILE-GEN.

*SINCE DIR ALPHABETICALLY SORTED USE EOD FLAG IF GONE PAST.

	IF M-FILE-QUICK < S-FILE-QUICK
		MOVE 1 TO EOD-FLG
		GO TO SEARCH-S-FILE-EXIT.

	SET S-INDEX UP BY 1.

SEARCH-S-FILE-EXIT. EXIT.


TEST-M-LINE.
	MOVE 0 TO BOGUS-FLG.
	IF M-F-TEST = SPACES
		GO TO NXT-M-FILE.
	IF M-BOG-TEST = ("GRAND TO" OR "TOTAL OF")
		MOVE 1 TO BOGUS-FLG.

WRITE-M-DIR.
	MOVE SPACES TO RPT-REC. WRITE RPT-REC.
	MOVE M-DIR TO RPT-REC. WRITE RPT-REC.

FOO.
	DISPLAY "FOO".