Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0081/congen.cbl
There is 1 other file named congen.cbl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
PROGRAM-ID. CONGEN.
AUTHOR. GEORGE NEWTON.
DATE-WRITTEN. 14-APR-72.
DATE-COMPILED.
REMARKS. CONGEN GENERATES A COBOL SOURCE PROGRAM THAT WILL CONTROL
A FILE ON ANY DEVICE (BASED ON PARAMETERS GIVEN TO CONGEN)
- PARAMETERS ARE GIVEN OVER TTY
- CONGEN IS SELF DOCUMENTING AT RUN TIME.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT FILE-OUT ASSIGN TO DSK.
I-O-CONTROL.
DATA DIVISION.
FILE SECTION.
FD FILE-OUT
VALUE OF IDENTIFICATION IS OUT-FILE-NAME.
01 OUT-REC PIC X(80) USAGE IS DISPLAY-7.
01 OUT-REC-A PIC X USAGE IS DISPLAY-7.
WORKING-STORAGE SECTION.
77 ANSWER PIC X.
77 NO-SUM PIC X.
01 MONTH-TABLE PIC X(36) VALUE IS
"JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC".
01 THE-MONTH-REDEF REDEFINES MONTH-TABLE.
02 THE-MONTH OCCURS 12 TIMES PIC X(3).
01 RECORD-SIZE PIC 9(4).
01 SUM-SIZE PIC 9(4).
01 OUT-FILE-NAME.
02 OFN-FN PIC X(6).
02 OFN-EXT PIC X(3) VALUE "CBL".
01 TODAYS-DATE.
02 TD-DATE.
03 TD-YY PIC 99.
03 TD-MM PIC 99.
03 TD-DD PIC 99.
02 TD-TIME PIC X(6).
01 LINE-01 PIC X(24) VALUE "IDENTIFICATION DIVISION.".
01 LINE-02.
02 02-FILLER PIC X(13) VALUE "PROGRAM-ID. ".
02 02-ID PIC X(6).
02 02-PER PIC X(1) VALUE ".".
01 LINE-03 PIC X(42) VALUE "AUTHOR. CONGEN VERSION #02.".
01 LINE-04.
02 04-FILLER PIC X(15) VALUE "DATE-WRITTEN. ".
02 04-DD PIC 99.
02 04-DUMMY PIC X VALUE "-".
02 04-MM PIC X(3).
02 04-DUMMY PIC X VALUE "-".
02 04-YY PIC 99.
02 04-PER PIC X(1) VALUE ".".
01 LINE-05 PIC X(14) VALUE "DATE-COMPILED.".
01 LINE-06 PIC X(68) VALUE "REMARKS. THIS PROGRAM WRITTEN BY -CONGEN-.".
01 LINE-07 PIC X(21) VALUE "ENVIRONMENT DIVISION.".
01 LINE-08 PIC X(22) VALUE "INPUT-OUTPUT SECTION. ".
01 LINE-09 PIC X(13) VALUE "FILE-CONTROL.".
01 LINE-10.
02 10-FILLER PIC X(37) VALUE " SELECT FILE-IN ASSIGN TO ".
02 10-DEVICE PIC X(3).
02 10-PER PIC X(1) VALUE ".".
01 LINE-10-A.
02 10-A-FILLER PIC X(37) VALUE " SELECT FILE-OUT ASSIGN TO ".
02 10-A-DEVICE PIC X(6) VALUE IS "DEVOUT".
02 10-A-PER PIC X(1) VALUE ".".
01 LINE-11 PIC X(14) VALUE "DATA DIVISION.".
01 LINE-11-A PIC X(13) VALUE "FILE SECTION.".
01 LINE-12 PIC X(12) VALUE "FD FILE-IN".
01 LINE-12-A PIC X(13) VALUE "FD FILE-OUT".
01 LINE-13.
02 13-FILLER PIC X(20) VALUE " BLOCK CONTAINS ".
02 13-BLOCKING PIC 9(3).
02 13-FILLER PIC X(8) VALUE " RECORDS".
01 13-A-BLOCKING PIC 9(3).
01 LINE-14 PIC X(40) VALUE " VALUE OF IDENTIFICATION IS IN-NAME.".
01 LINE-14-A PIC X(41) VALUE " VALUE OF IDENTIFICATION IS OUT-NAME.".
01 LINE-15.
02 15-FILLER PIC X(29) VALUE"01 IN-REC USAGE IS DISPLAY-".
02 15-MODE PIC X.
02 15-PER PIC X VALUE ".".
01 LINE-15-A.
02 15-A-FILLER PIC X(29) VALUE "01 OUT-REC USAGE IS DISPLAY-".
02 15-A-MODE PIC X.
02 15-A-FILLER PIC X(8) VALUE " PIC X(".
02 15-A-REC-SIZE PIC 9(4).
02 15-A-FILLER PIC X(2) VALUE ").".
01 LINE-16.
02 16-FILLER PIC X(24) VALUE " 02 FILLER PIC X(".
02 16-CHAR PIC 9(4).
02 16-FILLER PIC X(2) VALUE ").".
01 LINE-17.
02 17-FILLER PIC X(24) VALUE " 02 IR-SUM PIC S9(".
02 17-CON-CHAR PIC 9(4).
02 17-FILLER PIC X(2) VALUE ").".
01 LINE-18 PIC X(24) VALUE "WORKING-STORAGE SECTION.".
01 LINE-19.
02 19-FILLER PIC X(33) VALUE "77 IN-NAME PIC X(9) VALUE ".
02 19-FILLER PIC X VALUE QUOTE.
02 19-IN-NAME PIC X(9).
02 19-FILLER PIC X VALUE QUOTE.
02 19-FILLER PIC X(1) VALUE ".".
01 LINE-19-A.
02 19-A-FILLER PIC X(33) VALUE "77 OUT-NAME PIC X(9) VALUE ".
02 19-A-FILLER PIC X VALUE QUOTE.
02 19-A-OUT-NAME PIC X(9).
02 19-A-FILLER PIC X VALUE QUOTE.
02 19-A-FILLER PIC X VALUE ".".
01 LINE-20 PIC X(23) VALUE "77 NO-RECS INDEX.".
01 LINE-22 PIC X(19) VALUE "PROCEDURE DIVISION.".
01 LINE-21 PIC X(42) VALUE "77 CONTROL-TOTAL PIC S9(18) USAGE IS COMP.".
01 LINE-23 PIC X(6) VALUE "START.".
01 LINE-24 PIC X(25) VALUE " OPEN INPUT FILE-IN.".
01 LINE-24-A PIC X(26) VALUE " OPEN OUTPUT FILE-OUT.".
01 LINE-25 PIC X(25) VALUE " SET NO-RECS TO ZERO.".
01 LINE-26 PIC X(31) VALUE " SET CONTROL-TOTAL TO ZERO.".
01 LINE-27 PIC X(5) VALUE "LOOP.".
01 LINE-28 PIC X(40) VALUE " READ FILE-IN AT END GO TO ALL-DONE.".
01 LINE-28-A PIC X(28) VALUE " MOVE IN-REC TO OUT-REC.".
01 LINE-28-B PIC X(19) VALUE " WRITE OUT-REC.".
01 LINE-29 PIC X(25) VALUE " SET NO-RECS UP BY 1.".
01 LINE-30 PIC X(36) VALUE " SET CONTROL-TOTAL UP BY IR-SUM.".
01 LINE-31 PIC X(16) VALUE " GO TO LOOP.".
01 LINE-32 PIC X(9) VALUE "ALL-DONE.".
01 LINE-33 PIC X(19) VALUE " CLOSE FILE-IN.".
01 LINE-33-A PIC X(20) VALUE " CLOSE FILE-OUT.".
01 LINE-34.
02 34-FILLER PIC X(22) VALUE " DISPLAY NO-RECS, ".
02 34-FILLER PIC X VALUE QUOTE.
02 34-FILLER PIC X(8) VALUE " RECORDS".
02 34-FILLER PIC X VALUE QUOTE.
02 34-FILLER PIC X VALUE ".".
01 LINE-35.
02 35-FILLER PIC X(28) VALUE " DISPLAY CONTROL-TOTAL, ".
02 35-FILLER PIC X VALUE QUOTE.
02 35-FILLER PIC X(7) VALUE " TOTAL ".
02 35-TOTAL-DESCR PIC X(25).
02 35-FILLER PIC X VALUE QUOTE.
02 35-FILLER PIC X VALUE ".".
01 LINE-36 PIC X(14) VALUE " STOP RUN.".
PROCEDURE DIVISION.
START.
DISPLAY " ".
MOVE TODAY TO TODAYS-DATE.
MOVE TD-YY TO 04-YY.
MOVE TD-DD TO 04-DD.
IF TD-MM IS GREATER THAN 12 OR LESS THAN 1
MOVE "QQQ" TO 04-MM
ELSE
MOVE THE-MONTH(TD-MM) TO 04-MM.
MOVE TD-TIME TO 02-ID.
MOVE TD-TIME TO OFN-FN.
DISPLAY " ".
DISPLAY " * BEGIN BUILD COBOL PROGRAM * (V2)".
DISPLAY " ".
BACK-A.
DISPLAY "INPUT FILE IS ON DSK, SYS, OR MTA ? ", WITH NO ADVANCING.
ACCEPT 10-DEVICE.
IF 10-DEVICE = "DSK", OR "SYS", OR "MTA" NEXT SENTENCE
ELSE DISPLAY "?" GO TO BACK-A.
BACK-AA.
DISPLAY "FILE NAME: (ALL 9 CHAR NO PERIOD) ? ", WITH NO ADVANCING.
ACCEPT 19-IN-NAME.
BACK-B.
DISPLAY "MODE IS: A = ASCII, S = SIXBIT ? ", WITH NO ADVANCING.
ACCEPT 15-MODE.
IF 15-MODE = "A" OR "S" NEXT SENTENCE
ELSE DISPLAY "?" GO TO BACK-B.
IF 15-MODE = "A" MOVE "7" TO 15-MODE.
IF 15-MODE = "S" MOVE "6" TO 15-MODE.
BACK-C.
DISPLAY "BLOCKING FACTOR: 0-999 (0 = UNBLOCKED) ? ", WITH NO ADVANCING.
ACCEPT 13-BLOCKING.
BACK-D.
DISPLAY "RECORD LENGTH: (CHARACTERS) ?", WITH NO ADVANCING.
ACCEPT RECORD-SIZE.
MOVE RECORD-SIZE TO 15-A-REC-SIZE.
DISPLAY "DO YOU WANT TO COPY THE ABOVE FILE? (Y-N) ", WITH NO ADVANCING.
ACCEPT ANSWER.
DISPLAY " ".
IF ANSWER = "N"
MOVE SPACE TO 15-A-MODE
GO TO BACK-DA.
BACK-D1.
DISPLAY "OUTPUT FILE NAME: (ALL 9 CHAR NO PERIOD) ? ", WITH NO ADVANCING.
ACCEPT 19-A-OUT-NAME.
BACK-D2.
DISPLAY "MODE IS : A = ASCII, S = SIXBIT ? ", WITH NO ADVANCING.
ACCEPT 15-A-MODE.
IF 15-A-MODE = "A" OR "S" NEXT SENTENCE
ELSE DISPLAY "?" GO TO BACK-D2.
IF 15-A-MODE = "A" MOVE "7" TO 15-A-MODE
ELSE MOVE "6" TO 15-A-MODE.
BACK-D3.
DISPLAY "BLOCKING FACTOR: 0-999 (0 = UNBLOCKED) ? ", WITH NO ADVANCING.
ACCEPT 13-A-BLOCKING.
BACK-DA.
DISPLAY " ".
DISPLAY "RECORD COUNT IS AUTOMATIC; HOWEVER, IN ADDITION, ".
DISPLAY "DO YOU WANT TO CONTROL ON SPECIFIC FIELD (Y-N) ? ", WITH NO ADVANCING.
ACCEPT ANSWER.
IF ANSWER = "N" MOVE "N" TO NO-SUM GO TO OPEN-IT.
DISPLAY "DESCRIBE THE FIELD TO BE ACCUMULATED (IN 25 CHAR OR LESS)".
DISPLAY "*", WITH NO ADVANCING.
ACCEPT 35-TOTAL-DESCR.
MOVE SPACE TO NO-SUM.
BACK-E.
DISPLAY "LEFT POSITION OF FIELD TO BE CONTROLLED ? ", WITH NO ADVANCING.
ACCEPT 16-CHAR.
IF 16-CHAR IS GREATER THAN RECORD-SIZE
DISPLAY "? OUT-SIDE OF RECORD ?"
GO TO BACK-E.
SUBTRACT 1 FROM 16-CHAR.
BACK-F.
DISPLAY "NUMBER OF POSITIONS IN FIELD ? ", WITH NO ADVANCING.
ACCEPT 17-CON-CHAR.
ADD 17-CON-CHAR, 16-CHAR GIVING SUM-SIZE.
IF SUM-SIZE IS GREATER THAN RECORD-SIZE
DISPLAY "? CONTROL FIELD GOES OFF END OF RECORD?"
GO TO BACK-F.
OPEN-IT.
OPEN OUTPUT FILE-OUT.
MOVE LINE-01 TO OUT-REC.
WRITE OUT-REC.
MOVE LINE-02 TO OUT-REC.
WRITE OUT-REC.
MOVE LINE-03 TO OUT-REC.
WRITE OUT-REC.
MOVE LINE-04 TO OUT-REC.
WRITE OUT-REC.
MOVE LINE-05 TO OUT-REC.
WRITE OUT-REC.
MOVE LINE-06 TO OUT-REC.
WRITE OUT-REC.
MOVE LINE-07 TO OUT-REC.
WRITE OUT-REC.
MOVE LINE-08 TO OUT-REC.
WRITE OUT-REC.
MOVE LINE-09 TO OUT-REC.
WRITE OUT-REC.
MOVE SPACES TO OUT-REC.
WRITE OUT-REC-A.
MOVE LINE-10 TO OUT-REC.
WRITE OUT-REC.
IF 15-A-MODE IS NOT EQUAL SPACE
MOVE LINE-10-A TO OUT-REC
WRITE OUT-REC.
MOVE SPACES TO OUT-REC.
WRITE OUT-REC-A.
MOVE LINE-11 TO OUT-REC.
WRITE OUT-REC.
MOVE LINE-11-A TO OUT-REC.
WRITE OUT-REC.
MOVE SPACES TO OUT-REC.
WRITE OUT-REC-A.
MOVE LINE-12 TO OUT-REC.
WRITE OUT-REC.
IF 13-BLOCKING = ZEROES GO TO S-A.
MOVE LINE-13 TO OUT-REC.
WRITE OUT-REC.
S-A.
MOVE LINE-14 TO OUT-REC.
WRITE OUT-REC.
MOVE SPACES TO OUT-REC.
WRITE OUT-REC-A.
MOVE LINE-15 TO OUT-REC.
WRITE OUT-REC.
IF NO-SUM = "N"
MOVE RECORD-SIZE TO 16-CHAR
MOVE LINE-16 TO OUT-REC
WRITE OUT-REC
GO TO S-C.
IF 16-CHAR = ZEROES GO TO S-B.
MOVE LINE-16 TO OUT-REC.
WRITE OUT-REC.
S-B.
MOVE LINE-17 TO OUT-REC.
WRITE OUT-REC.
ADD 16-CHAR, 17-CON-CHAR GIVING SUM-SIZE.
SUBTRACT SUM-SIZE FROM RECORD-SIZE GIVING 16-CHAR.
IF 16-CHAR = ZEROES GO TO S-C.
MOVE LINE-16 TO OUT-REC.
WRITE OUT-REC.
S-C.
MOVE SPACES TO OUT-REC.
WRITE OUT-REC-A.
IF 15-A-MODE = SPACE GO TO S-D.
MOVE LINE-12-A TO OUT-REC.
WRITE OUT-REC.
IF 13-A-BLOCKING = ZEROES NEXT SENTENCE
ELSE
MOVE 13-A-BLOCKING TO 13-BLOCKING
MOVE LINE-13 TO OUT-REC
WRITE OUT-REC.
MOVE LINE-14-A TO OUT-REC.
WRITE OUT-REC.
MOVE SPACES TO OUT-REC.
WRITE OUT-REC-A.
MOVE LINE-15-A TO OUT-REC.
WRITE OUT-REC.
MOVE SPACES TO OUT-REC
WRITE OUT-REC-A.
S-D.
MOVE LINE-18 TO OUT-REC.
WRITE OUT-REC.
MOVE SPACES TO OUT-REC.
WRITE OUT-REC-A.
MOVE LINE-19 TO OUT-REC.
WRITE OUT-REC.
IF 15-A-MODE IS NOT EQUAL TO SPACE
MOVE LINE-19-A TO OUT-REC
WRITE OUT-REC.
MOVE LINE-20 TO OUT-REC.
WRITE OUT-REC.
MOVE LINE-21 TO OUT-REC.
WRITE OUT-REC.
MOVE SPACES TO OUT-REC.
WRITE OUT-REC-A.
MOVE LINE-22 TO OUT-REC.
WRITE OUT-REC.
MOVE SPACES TO OUT-REC.
WRITE OUT-REC-A.
MOVE LINE-23 TO OUT-REC.
WRITE OUT-REC.
MOVE LINE-24 TO OUT-REC.
WRITE OUT-REC.
IF 15-A-MODE IS NOT EQUAL TO SPACE
MOVE LINE-24-A TO OUT-REC
WRITE OUT-REC.
MOVE LINE-25 TO OUT-REC.
WRITE OUT-REC.
IF NO-SUM = "N"
NEXT SENTENCE ELSE
MOVE LINE-26 TO OUT-REC
WRITE OUT-REC.
MOVE SPACE TO OUT-REC.
WRITE OUT-REC-A.
MOVE LINE-27 TO OUT-REC.
WRITE OUT-REC.
MOVE LINE-28 TO OUT-REC.
WRITE OUT-REC.
IF 15-A-MODE IS NOT EQUAL TO SPACE
MOVE LINE-28-A TO OUT-REC
WRITE OUT-REC
MOVE LINE-28-B TO OUT-REC
WRITE OUT-REC.
MOVE LINE-29 TO OUT-REC.
WRITE OUT-REC.
IF NO-SUM = "N"
NEXT SENTENCE ELSE
MOVE LINE-30 TO OUT-REC
WRITE OUT-REC.
MOVE LINE-31 TO OUT-REC.
WRITE OUT-REC.
MOVE SPACES TO OUT-REC.
WRITE OUT-REC-A.
MOVE LINE-32 TO OUT-REC.
WRITE OUT-REC.
MOVE LINE-33 TO OUT-REC.
WRITE OUT-REC.
IF 15-A-MODE IS NOT EQUAL TO SPACE
MOVE LINE-33-A TO OUT-REC
WRITE OUT-REC.
MOVE LINE-34 TO OUT-REC.
WRITE OUT-REC.
IF NO-SUM = "N"
NEXT SENTENCE ELSE
MOVE LINE-35 TO OUT-REC
WRITE OUT-REC.
MOVE LINE-36 TO OUT-REC.
WRITE OUT-REC.
CLOSE FILE-OUT.
IF 10-DEVICE = "MTA"
DISPLAY " "
DISPLAY "NOTE: INPUT FILE WILL BE ON MTA"
DISPLAY " ".
IF 15-A-MODE IS NOT EQUAL TO SPACE
DISPLAY " "
DISPLAY "NOTE: OUTPUT FILE WILL GO TO DEVOUT"
DISPLAY " ".
DISPLAY "EXECUTE ", OFN-FN.
DISPLAY "- - - - WHEN JOB IS DONE - - - DELETE ", OFN-FN, ".*".
STOP RUN.