Trailing-Edge
-
PDP-10 Archives
-
decuslib10-02
-
43,50305/filter.cbl
There are 4 other files named filter.cbl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
PROGRAM-ID. FILTER.
AUTHOR. FRED SMITH FROM ORIGINAL IBMCOB.CBL BY BOB HOGAN.
DATE-WRITTEN. MARCH 1973.
DATE-COMPILED.
SECURITY. COPYRIGHT 1973 -- DIGITAL EQUIPMENT CORPORATION.
REMARKS.
READS A COBOL PROGRAM AND CONVERTS IT TO DECSYSTEM-10 COBOL FORMAT.
THE FOLLOWING ACTIONS ARE TAKEN:
GENERAL:
ALL INPUT SOURCE LINES ARE CONVERTED FROM "CONVENTIONAL"
COBOL FORMAT TO DEC "STANDARD" FORMAT BY ELIMINATING THE
COBOL PAGE AND LINE NUMBER FIELDS IN COLUMNS 1-6 AND THE
PROGRAM IDENTITY FIELD IN COLUMNS 73-80. THE CONTINUATION
LINE INDICATOR IN COLUMN 7 IS PRESERVED IF IT APPEARS
AS AN ASTERISK (*) OR DASH (-), OTHERWISE SOURCE LINES
ARE LEFT-JUSTIFIED AS APPROPRIATE IN THE "A AREA" OR
"B AREA" OF THE DEC "STANDARD" FORMAT.
THE SOURCE FILE IS WRITTEN WITH A MACRO
ROUTINE CALLED "PUTREC" TO ELIMINATE
TRAILING SPACES.
IDENTIFICATION DIVISION:
1) PROGRAM-ID. SUBSTITUTE VALUE ENTERED AT TTY.
2) REMARKS - REMARKS LINES ARE LEFT JUSTIFIED IN THE
DEC STANDARD B AREA IN ORDER FOR REMARKS TO APPEAR AS
A SINGLE PARAGRAPH AS REQUIRED FOR DECSYSTEM-10 COBOL.
ENVIRONMENT DIVISION:
1) SOURCE-COMPUTER - PARAGRAPH DELETED AND REPLACED WITH "DECSYSTEM-10."
2) OBJECT-COMPUTER - PARAGRAPH DELETED AND REPLACED WITH "DECSYSTEM-10."
3) SPECIAL-NAMES - INSERT PARAGRAPH NAME, FOLLOWED BY:
CHANNEL (1) IS TOP-OF-FORM
CONSOLE IS TTY.
4) SELECT....ASSIGN - DSKNNN SUBSTITUTED FOR ALL DEVICES.
DATA DIVISION:
1) COMPUTATIONAL-3 - SUBSTITUTE DISPLAY-6 AND FLAG LINE.
2) VALUE OF ID - INSERT VALUE OF ID CLAUSE FOR EACH FD
3) LABELS ARE OMITTED - SUBSTITUTE STANDARD.
4) RECORDING MODE - DELETE CLAUSE
PROCEDURE DIVISION:
1) CURRENT-DATE - FLAG-LINE.
2) INCLUDE - SUBSTITUTE COPY.
3) POSITIONING 0 LINES - SUBSTITUTE TOP-OF-FORM.
4) ENTER - FLAG FOR INDIVIDUAL ACTION.
5) TRANSFORM - FLAG FOR INDIVIDUAL ACTION.
OPERATION:
FROM THE TTY, THE PROGRAMMER ENTERS THE FILE NAME AND EXT
(PREFERABLY THE INPUT FILE WOULD HAVE AN EXTENSION OF OLD)
OF THE INPUT SOURCE PROGRAM FILE WHICH RESIDES ON DISK.
THE FILTER PROGRAM CREATES AN ALTERED OUTPUT SOURCE
FILE ON DISK AND A LISTING OF THE OUTPUT WITH
ERRORS FLAGGED.
THE PROGRAMMER SHOULD PRINT AND REVIEW THE OUTPUT LISTING
AND MAKE ANY CHANGES NECESSARY TO COMPILE.
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 SOURCE-FILE ASSIGN TO DSK.
SELECT LISTING-FILE ASSIGN TO DSK.
DATA DIVISION.
FILE SECTION.
FD SOURCE-FILE
LABEL RECORDS ARE STANDARD;
VALUE OF IDENTIFICATION IS INPUT-FILE
USER-NUMBER IS INPUT-USER-NUMBER
DATA RECORD IS SOURCE-RECORD.
01 SOURCE-RECORD; DISPLAY-7.
02 COLS-1-6 PICTURE X(6).
02 COLS-7-80 PICTURE X(74).
02 DUMMY REDEFINES COLS-7-80.
03 THIS-CHARACTER PICTURE X.
03 FILLER PICTURE X(73).
02 DUMMY-1 REDEFINES COLS-7-80.
03 CHARS PICTURE X OCCURS 72.
03 FILLER PICTURE XX.
FD LISTING-FILE
LABEL RECORDS ARE STANDARD;
VALUE OF IDENTIFICATION IS LIST-ID
USER-NUMBER IS OUTPUT-USER-NUMBER
DATA RECORD IS LIST-OUTPUT.
01 LIST-OUTPUT DISPLAY-7.
02 LISTING-FLAG PICTURE XXX.
02 FILLER PICTURE XXX.
02 LIST-SOURCE PICTURE X(103).
WORKING-STORAGE SECTION.
01 LONGEST-LINE DISPLAY-7.
02 LL-OCCURS.
03 OUTPUT-CHARACTER OCCURS 96 TIMES; PICTURE X.
01 LONGEST-LINE-SEQ DISPLAY-7.
02 LLS-SEQ PIC 9(6).
02 LLS-FILLER PIC X VALUE SPACE.
02 LLS-OCCURS PIC X(96).
77 SEQ-NUM PIC 9(6) COMP VALUE ZERO.
01 DEV-NAME.
02 DEV-N PICTURE XXX VALUE "DSK".
02 DEV-C PICTURE 999.
01 MISCELLANEOUS-STUFF.
02 NEXT-CHARACTER PICTURE X.
02 COLUMN-X PICTURE S99; COMP.
02 FIRST-COLUMN PICTURE S99; COMP.
02 I PICTURE S99; COMP.
02 J PICTURE S99; COMP.
02 K PICTURE S99; COMP.
02 TEMP-2 PICTURE S99; COMP.
02 HOLD-CHARACTER PICTURE X.
02 EOL-FLAG PICTURE X.
88 END-OF-LINE VALUE "X".
02 EOF-FLAG PICTURE X.
88 END-OF-SOURCE VALUE "X".
02 PUNCTUATION-CHARACTER PICTURE X.
88 PUNCTUATION VALUE ".", ";", ",".
02 SKIP-FLAG PICTURE X.
88 SKIPPING-STUFF VALUE "X".
02 DELETION-FLAG PICTURE X.
88 DELETING-STUFF VALUE "X".
02 REMARKS-FLAG PICTURE X.
88 WITHIN-REMARKS VALUE "X".
02 VALUE-FLAG PICTURE X.
88 VALUE-PRESENT VALUE "X".
01 TO-HOLD-A-WORD PICTURE X(72).
88 W-ASSIGN VALUE "ASSIGN".
88 W-SPECIAL-NAMES VALUE "SPECIAL-NAMES".
88 W-IDENTIFICATION VALUE "IDENTIFICATION".
88 W-ID VALUE "ID".
88 W-PROGRAM-ID VALUE "PROGRAM-ID".
88 W-ENVIRONMENT VALUE "ENVIRONMENT".
88 W-SOURCE-COMPUTER VALUE "SOURCE-COMPUTER".
88 W-OBJECT-COMPUTER VALUE "OBJECT-COMPUTER".
88 W-TO VALUE "TO".
88 W-DATA VALUE "DATA".
88 W-FD VALUE "FD".
88 W-PROCEDURE VALUE "PROCEDURE".
88 W-VALUE VALUE "VALUE".
88 W-OMITTED VALUE "OMITTED".
88 W-INCLUDE VALUE "INCLUDE".
88 W-COMPUTATIONAL-2 VALUE "COMPUTATIONAL-2".
88 W-COMP-2 VALUE "COMP-2".
88 W-COMPUTATIONAL-3 VALUE "COMPUTATIONAL-3".
88 W-COMP-3 VALUE "COMP-3".
88 W-DELETE-CLAUSE VALUE "RECORDING".
88 W-ZERO VALUE "0", "ZERO".
88 W-POSITIONING VALUE "POSITIONING".
88 PD-WORDS-FLAGGED VALUE "ENTER", "TRANSFORM".
88 W-CURRENT-DATE VALUE "CURRENT-DATE".
88 W-F-U-V VALUE "F", "U", "V".
88 W-REMARKS VALUE "REMARKS".
88 W-COMMENTS VALUE "COMMENTS".
88 W-LINES VALUE "LINE", "LINES".
88 W-DATE VALUES "DATE", "DATE WRITTEN".
88 W-OTHERWISE VALUE "OTHERWISE".
01 THIS-WORD REDEFINES TO-HOLD-A-WORD.
02 WORD-CHARACTER OCCURS 72 TIMES; PICTURE X.
01 LIST-ID.
02 LIST-ID-NAME PICTURE X(6).
02 LIST-ID-EXT PICTURE XXX.
01 PROGRAM-NAME-PERIOD.
02 PROGRAM-NAME-WORK PICTURE X(6).
02 FILLER PICTURE X VALUE ".".
01 VALUE-OF-ID-CLAUSE.
02 FILLER PICTURE X(32)
VALUE " VALUE OF IDENTIFICATION IS ".
02 FILLER PICTURE X
VALUE QUOTE.
02 VID-NAME PICTURE X(6).
02 VID-EXT PICTURE 999.
02 FILLER PICTURE X
VALUE QUOTE.
02 FILLER PICTURE X
VALUE ".".
01 OUTPUT-THINGS.
02 OUTPUT-FILE.
03 OUTPUT-NAME PIC X(6).
03 OUTPUT-EXTENSION PIC X(3).
02 OUTPUT-USER-NUMBER PIC 9(10) COMP.
02 OUTPUT-SWITCHES.
03 OUTPUT-SWITCH PIC X OCCURS 6.
01 INPUT-THINGS.
02 INPUT-FILE.
03 INPUT-NAME PIC X(6).
03 INPUT-EXTENSION PIC X(3).
02 INPUT-USER-NUMBER PIC 9(10) COMP.
02 INPUT-SWITCHES.
03 INPUT-SWITCH PIC X OCCURS 6.
PROCEDURE DIVISION.
MAIN SECTION.
DISPLAY "COBOL FILTER HERE".
START.
CALL SCANIT
USING OUTPUT-THINGS, INPUT-THINGS.
MOVE OUTPUT-FILE TO LIST-ID.
MOVE "LST" TO LIST-ID-EXT.
ENTER MACRO CHECK USING INPUT-FILE, INPUT-USER-NUMBER.
GO TO START.
OPEN-THIS-ONE-NOW.
OPEN INPUT SOURCE-FILE.
IF INPUT-SWITCH (2) EQUALS "2" OR
OUTPUT-SWITCH (2) EQUALS "2"
NEXT SENTENCE
ELSE
OPEN OUTPUT LISTING-FILE.
IF INPUT-SWITCH (3) EQUALS "3" OR
OUTPUT-SWITCH (3) EQUALS "3"
NEXT SENTENCE
ELSE
ENTER MACRO OPEFIL USING OUTPUT-FILE, OUTPUT-USER-NUMBER.
MOVE LOW-VALUES TO MISCELLANEOUS-STUFF.
MOVE ZEROS TO
DEV-C
VID-EXT.
MOVE SPACES TO LIST-OUTPUT.
IF INPUT-SWITCH (2) EQUALS "2" OR
OUTPUT-SWITCH (2) EQUALS "2"
NEXT SENTENCE
ELSE
WRITE LIST-OUTPUT BEFORE TOP-OF-FORM.
MOVE SPACES TO LONGEST-LINE.
MOVE SPACE TO NEXT-CHARACTER.
MOVE SPACES TO VALUE-FLAG.
READ SOURCE-FILE; AT END DISPLAY "?SOURCE FILE HAS NO DATA";
GO TO ALL-DONE-1.
MOVE 7 TO COLUMN-X.
MOVE THIS-CHARACTER TO NEXT-CHARACTER.
MOVE 1 TO J.
******************************************************************
* PROCESS THE IDENTIFICATION DIVISION
******************************************************************
PROCESS-IDENTIFICATION.
PERFORM GET-WORD; IF END-OF-SOURCE
DISPLAY "?NO IDENTIFICATION DIVISION"; GO TO ALL-DONE.
IF NOT W-IDENTIFICATION AND NOT W-ID GO TO PROCESS-IDENTIFICATION.
PROCESS-PROGRAM-ID.
IF W-ID MOVE "IDENTIFICATION" TO THIS-WORD.
PERFORM PUT-WORD.
PERFORM GET-WORD; IF END-OF-SOURCE DISPLAY "?NO PROGRAM-ID";
GO TO ALL-DONE.
IF NOT W-PROGRAM-ID GO TO PROCESS-PROGRAM-ID.
PERFORM PUT-WORD.
MOVE OUTPUT-NAME TO PROGRAM-NAME-WORK, VID-NAME.
MOVE PROGRAM-NAME-PERIOD TO THIS-WORD.
PERFORM PUT-WORD.
PERFORM WRITE-LINE; MOVE "X" TO SKIP-FLAG.
PROCESS-ID-0.
PERFORM GET-WORD. IF END-OF-SOURCE GO TO ALL-DONE.
IF FIRST-COLUMN
IS LESS THAN 12
MOVE SPACE TO SKIP-FLAG GO TO PROCESS-ID-1.
GO TO PROCESS-ID-0.
PROCESS-ID-1.
IF W-ENVIRONMENT PERFORM PUT-WORD GO TO PROCESS-ENVIRONMENT.
IF W-DATE MOVE "DATE-WRITTEN" TO THIS-WORD
PERFORM PUT-WORD.
IF W-REMARKS OR W-COMMENTS
MOVE "REMARKS" TO THIS-WORD
MOVE "X" TO REMARKS-FLAG.
PERFORM PUT-WORD.
PERFORM GET-WORD; IF END-OF-SOURCE DISPLAY "?NO ENVIRONMENT DIVISION";
GO TO ALL-DONE.
IF NOT W-ENVIRONMENT GO TO PROCESS-ID-1.
MOVE SPACE TO REMARKS-FLAG.
MOVE 7 TO FIRST-COLUMN.
PERFORM PUT-WORD.
******************************************************************
* PROCESS ENVIRONMENT DIVISION
******************************************************************
PROCESS-ENVIRONMENT SECTION 01.
PROCESS-ENV-0.
PERFORM GET-WORD; IF END-OF-SOURCE GO TO PROCESS-ENV-9.
PROCESS-ENV-1.
IF W-SOURCE-COMPUTER GO TO PROCESS-COMPUTER.
IF W-OBJECT-COMPUTER GO TO PROCESS-COMPUTER.
IF W-SPECIAL-NAMES GO TO PROCESS-SPECIAL-NAMES.
IF W-ASSIGN GO TO PROCESS-ASSIGN.
IF W-DATA PERFORM PUT-WORD; GO TO CHECK-FOR-SPECIAL-NAMES.
PERFORM PUT-WORD.
GO TO PROCESS-ENVIRONMENT.
* ASSIGN TO DSK001, DSK002, DSK003, ETC.
PROCESS-ASSIGN.
PERFORM PUT-WORD.
PERFORM GET-WORD.
IF W-TO PERFORM PUT-WORD PERFORM GET-WORD.
ADD 1 TO DEV-C.
MOVE DEV-NAME TO THIS-WORD.
PERFORM PUT-WORD.
GO TO PROCESS-ENVIRONMENT.
PROCESS-ENV-9.
DISPLAY "?NO DATA DIVISION"; GO TO ALL-DONE.
* SOURCE-COMPUTER/OBJECT-COMPUTER. REPLACE PARAGRAPH WITH <DECSYSTEM-10.>
PROCESS-COMPUTER.
PERFORM PUT-WORD.
MOVE "DECSYSTEM-10." TO THIS-WORD.
PERFORM PUT-WORD.
PROCESS-SC-0.
PERFORM WRITE-LINE; MOVE "X" TO SKIP-FLAG.
PROCESS-SC-1.
PERFORM GET-WORD; IF END-OF-SOURCE GO TO PROCESS-ENV-9.
IF FIRST-COLUMN IS LESS THAN 12
MOVE SPACE TO SKIP-FLAG; GO TO PROCESS-ENV-1.
GO TO PROCESS-SC-1.
* SPECIAL-NAMES. INSERT STANDARD SPECIAL-NAMES PARAGRAPH.
PROCESS-SPECIAL-NAMES.
MOVE "X" TO VALUE-FLAG.
PROCESS-SPECIAL-NAMES-1.
MOVE "SPECIAL-NAMES." TO LL-OCCURS.
PERFORM WRITE-LINE.
MOVE " CONSOLE IS TTY" TO LL-OCCURS.
PERFORM WRITE-LINE.
IF VALUE-PRESENT
MOVE " CHANNEL (1) IS TOP-OF-FORM" TO LL-OCCURS
ELSE
MOVE " CHANNEL (1) IS TOP-OF-FORM." TO LL-OCCURS.
PERFORM WRITE-LINE.
PROCESS-SPECIAL-NAMES-2.
MOVE SPACES TO THIS-WORD.
GO TO PROCESS-ENVIRONMENT.
CHECK-FOR-SPECIAL-NAMES.
IF VALUE-PRESENT GO TO PROCESS-DATA-DIVISION.
PERFORM PROCESS-SPECIAL-NAMES-1.
MOVE "DATA" TO THIS-WORD.
PERFORM PUT-WORD.
*****************************************************************
* PROCESS DATA DIVISION
*******************************************************************
PROCESS-DATA-DIVISION SECTION 02.
PROCESS-DD-0.
PERFORM GET-WORD; IF END-OF-SOURCE GO TO PROCESS-DD-9.
IF W-FD GO TO PROCESS-FD.
IF W-COMPUTATIONAL-2 OR W-COMP-2 OR
W-COMPUTATIONAL-3 OR W-COMP-3 GO TO PROCESS-COMP-2-3.
IF W-PROCEDURE GO TO PROCESS-PD-2.
PERFORM PUT-WORD.
GO TO PROCESS-DD-0.
PROCESS-DD-9.
DISPLAY "?NO PROCEDURE DIVISION"; GO TO ALL-DONE.
* COMPUTATIONAL-3. CHANGE TO DISPLAY-6 AND FLAG.
PROCESS-COMP-2-3.
MOVE "***" TO LISTING-FLAG.
MOVE "DISPLAY-6" TO THIS-WORD.
PERFORM PUT-WORD.
GO TO PROCESS-DD-0.
PROCESS-FD.
PERFORM PUT-WORD.
PERFORM GET-WORD.
PERFORM PUT-WORD.
PERFORM WRITE-LINE.
MOVE SPACE TO VALUE-FLAG.
PROCESS-FD-CONT.
PERFORM GET-WORD.
IF END-OF-SOURCE GO TO PROCESS-DD-9.
IF W-DELETE-CLAUSE GO TO DELETE-CLAUSE.
IF W-OMITTED MOVE "STANDARD" TO THIS-WORD.
IF W-VALUE MOVE "X" TO VALUE-FLAG.
IF PUNCTUATION-CHARACTER EQUALS "." GO TO PROCESS-VALUE.
PERFORM PUT-WORD.
GO TO PROCESS-FD-CONT.
DELETE-CLAUSE.
PERFORM GET-WORD.
IF END-OF-SOURCE GO TO PROCESS-DD-9.
IF W-F-U-V
MOVE "X" TO DELETION-FLAG
GO TO PROCESS-FD-CONT.
GO TO DELETE-CLAUSE.
PROCESS-VALUE.
IF VALUE-PRESENT PERFORM PUT-WORD GO TO PROCESS-DD-0.
MOVE SPACE TO PUNCTUATION-CHARACTER.
PERFORM PUT-WORD.
PERFORM WRITE-LINE.
ADD 1 TO VID-EXT.
MOVE VALUE-OF-ID-CLAUSE TO LL-OCCURS.
PERFORM WRITE-LINE.
GO TO PROCESS-DD-0.
*************************************************************
* PROCESS THE PROCEDURE DIVISION
*************************************************************
PROCESS-PROCEDURE SECTION 03.
PROCESS-PD-0.
PERFORM GET-WORD; IF END-OF-SOURCE GO TO ALL-DONE.
IF W-INCLUDE GO TO PROCESS-INCLUDE.
IF W-CURRENT-DATE GO TO PROCESS-CURRENT-DATE-PD.
IF W-POSITIONING GO TO PROCESS-POSITIONING.
IF W-OTHERWISE GO TO PROCESS-OTHERWISE.
PROCESS-PD-1.
IF PD-WORDS-FLAGGED MOVE "***" TO LISTING-FLAG.
PROCESS-PD-2.
PERFORM PUT-WORD; GO TO PROCESS-PD-0.
* INCLUDE. SUBSTITUTE COPY.
PROCESS-INCLUDE.
MOVE "COPY" TO THIS-WORD. PERFORM PUT-WORD.
GO TO PROCESS-PD-0.
* POSITIONING. IF 0 LINES, SUBSTITUTE TOP-OF-FORM.
PROCESS-POSITIONING.
MOVE "ADVANCING" TO THIS-WORD.
PERFORM PUT-WORD.
PERFORM GET-WORD.
IF NOT W-ZERO PERFORM PUT-WORD; GO TO PROCESS-PD-0.
PERFORM GET-WORD.
IF W-LINES MOVE "TOP-OF-FORM" TO THIS-WORD.
PERFORM PUT-WORD.
GO TO PROCESS-PD-0.
* CURRENT-DATE. FLAG LINE.
PROCESS-CURRENT-DATE-PD.
PERFORM PUT-WORD.
MOVE "***" TO LISTING-FLAG.
GO TO PROCESS-PD-0.
PROCESS-OTHERWISE.
MOVE "ELSE" TO THIS-WORD.
PERFORM PUT-WORD.
GO TO PROCESS-PD-0.
*******************************************************************
* PROCESSING COMPLETE FOR THAT PROGRAM
*******************************************************************
ALL-DONE.
IF THIS-WORD NOT EQUAL TO SPACES OR PUNCTUATION-CHARACTER NOT EQUAL TO SPACE
PERFORM PUT-WORD.
PERFORM WRITE-LINE.
ALL-DONE-1.
CLOSE SOURCE-FILE.
IF INPUT-SWITCH (2) EQUALS "2" OR
OUTPUT-SWITCH (2) EQUALS "2"
NEXT SENTENCE
ELSE
CLOSE LISTING-FILE.
IF INPUT-SWITCH (3) EQUALS "3" OR
OUTPUT-SWITCH (3) EQUALS "3"
NEXT SENTENCE
ELSE
ENTER MACRO CLOFIL.
STOP RUN.
ALL-DONE-2.
STOP RUN.
********************************************************************
* GET A WORD FROM THE SOURCE FILE
********************************************************************
GET-WORD SECTION.
GW-1.
IF END-OF-LINE PERFORM WRITE-LINE; PERFORM GET-CHARACTER THRU GC-EXIT;
ELSE
IF COLS-7-80 = SPACES AND NEXT-CHARACTER = SPACE
PERFORM WRITE-LINE; PERFORM GC-1 THRU GC-EXIT;
ELSE
PERFORM GET-CHARACTER THRU GC-EXIT.
IF THIS-CHARACTER EQUALS SPACE GO TO GW-1.
IF WITHIN-REMARKS
MOVE 12 TO FIRST-COLUMN ELSE
IF COLUMN-X EQUAL TO 8
MOVE 7 TO FIRST-COLUMN ELSE
MOVE COLUMN-X TO FIRST-COLUMN.
MOVE SPACES TO THIS-WORD; MOVE 0 TO I.
IF THIS-CHARACTER EQUALS QUOTE GO TO GW-7.
GW-5. ADD 1 TO I.
MOVE THIS-CHARACTER TO WORD-CHARACTER (I).
PERFORM GET-WORD-CHARACTER THRU GWC-EXIT.
IF THIS-CHARACTER IS NOT EQUAL TO SPACE GO TO GW-5.
IF I IS EQUAL TO ZERO NEXT SENTENCE ELSE
MOVE WORD-CHARACTER (I) TO PUNCTUATION-CHARACTER;
IF PUNCTUATION MOVE SPACE TO WORD-CHARACTER (I);
ELSE MOVE SPACE TO PUNCTUATION-CHARACTER.
GO TO GW-EXIT.
GW-7.
IF NOT SKIPPING-STUFF
MOVE THIS-CHARACTER TO OUTPUT-CHARACTER (J); ADD 1 TO J.
GW-8. PERFORM GET-CHARACTER THRU GC-EXIT.
IF THIS-CHARACTER EQUALS QUOTE
AND NOT SKIPPING-STUFF
MOVE QUOTE TO OUTPUT-CHARACTER (J);
ADD 1 TO J; GO TO GW-1.
IF THIS-CHARACTER EQUALS QUOTE
GO TO GW-1.
IF NOT END-OF-LINE GO TO GW-7.
GW-8A.
PERFORM WRITE-LINE.
IF THIS-CHARACTER IS NOT EQUAL TO "-" MOVE "***" TO LISTING-FLAG;
GO TO GW-1.
MOVE "-" TO OUTPUT-CHARACTER (1); MOVE 2 TO J.
GW-9.
PERFORM GET-CHARACTER THRU GC-EXIT.
IF END-OF-LINE GO TO GW-8A.
IF THIS-CHARACTER EQUALS SPACE ADD 1 TO J; GO TO GW-9.
IF THIS-CHARACTER IS NOT EQUAL TO QUOTE MOVE "***" TO LISTING-FLAG.
GO TO GW-7.
GW-EXIT. EXIT.
********************************************************************
* PUT CURRENT WORD ONTO OUTPUT LINE.
********************************************************************
PUT-WORD SECTION.
PW-0. IF THIS-WORD EQUALS SPACES GO TO PW-2.
IF J = 1 NEXT SENTENCE; ELSE
SUBTRACT 1 FROM J GIVING TEMP-2;
MOVE OUTPUT-CHARACTER (TEMP-2) TO HOLD-CHARACTER;
IF HOLD-CHARACTER = SPACE OR "(" NEXT SENTENCE;
ELSE ADD 1 TO J.
IF NOT DELETING-STUFF AND J + 6 IS LESS THAN FIRST-COLUMN
COMPUTE J = FIRST-COLUMN - 6.
PW-0-A-1.
MOVE 1 TO K.
PW-0-A.
IF WORD-CHARACTER (K) EQUALS SPACE
GO TO PW-0-A-EXIT.
MOVE WORD-CHARACTER (K) TO
OUTPUT-CHARACTER (J).
IF OUTPUT-CHARACTER (J) EQUALS "\"
MOVE "***" TO LISTING-FLAG.
ADD 1 TO J,K.
GO TO PW-0-A.
PW-0-A-EXIT.
EXIT.
PW-1.
MOVE SPACES TO THIS-WORD.
PW-2.
MOVE PUNCTUATION-CHARACTER TO OUTPUT-CHARACTER (J).
MOVE SPACE TO PUNCTUATION-CHARACTER.
ADD 1 TO J.
******************************************************************
* WRITE OUT A LINE.
******************************************************************
WRITE-LINE SECTION.
WL-1.
IF DELETING-STUFF AND LL-OCCURS EQUAL TO SPACES
GO TO WL-EXIT.
IF SKIPPING-STUFF OR DELETING-STUFF AND J = 1 GO TO WL-EXIT.
IF INPUT-SWITCH (4) EQUALS "4"
OR
OUTPUT-SWITCH (4) EQUALS "4"
ADD 10 TO SEQ-NUM
MOVE SEQ-NUM TO LLS-SEQ
MOVE LONGEST-LINE TO LLS-OCCURS
MOVE LONGEST-LINE-SEQ TO LIST-SOURCE
ELSE
MOVE LONGEST-LINE TO LIST-SOURCE.
IF INPUT-SWITCH (2) EQUALS "2" OR
OUTPUT-SWITCH (2) EQUALS "2"
NEXT SENTENCE
ELSE
WRITE LIST-OUTPUT BEFORE 1 LINE.
IF INPUT-SWITCH (3) EQUALS "3" OR
OUTPUT-SWITCH (3) EQUALS "3"
GO TO WL-2.
IF INPUT-SWITCH (4) EQUALS "4" OR
OUTPUT-SWITCH (4) EQUALS "4"
ENTER MACRO PUTREC USING LONGEST-LINE-SEQ
ELSE
ENTER MACRO PUTREC USING LONGEST-LINE.
WL-2.
MOVE SPACES TO LONGEST-LINE, LISTING-FLAG.
WL-EXIT. MOVE SPACE TO EOL-FLAG, DELETION-FLAG; MOVE 1 TO J.
*********************************************************************
* GET A CHARACTER FROM SOURCE LINE
*********************************************************************
GET-CHARACTER SECTION.
GC-0.
IF END-OF-SOURCE GO TO ALL-DONE.
IF NEXT-CHARACTER IS NOT EQUAL TO SPACE
MOVE NEXT-CHARACTER TO THIS-CHARACTER;
MOVE SPACE TO NEXT-CHARACTER;
GO TO GC-EXIT.
ADD 1 TO COLUMN-X.
IF COLUMN-X IS LESS THAN 73
MOVE CHARS (COLUMN-X - 6) TO THIS-CHARACTER
MOVE SPACE TO CHARS (COLUMN-X - 6)
GO TO GC-EXIT.
MOVE "X" TO EOL-FLAG.
GC-1.
MOVE 7 TO COLUMN-X.
READ SOURCE-FILE; AT END MOVE "X" TO EOF-FLAG;
MOVE SPACE TO COLS-7-80.
GC-EXIT. EXIT.
********************************************************************
* GET A CHARACTER FOR A WORD.
* IF NOT SPACE, RETURN.
* IF SPACE, SCAN UNTIL NON-SPACE OR CONTINUATION.
* IF CONTINUATION, SCAN UNTIL NON-SPACE.
* IF NOT CONTINUATION, RETURN A SPACE.
********************************************************************
GET-WORD-CHARACTER SECTION.
GWC-0.
PERFORM GET-CHARACTER THRU GC-EXIT.
IF COLUMN-X NOT EQUAL TO 7 AND THIS-CHARACTER NOT EQUAL TO SPACE
GO TO GWC-EXIT.
GWC-1. IF COLUMN-X EQUALS 7 GO TO GWC-3.
GWC-2.
PERFORM GET-CHARACTER THRU GC-EXIT.
IF THIS-CHARACTER EQUALS SPACE GO TO GWC-1.
MOVE THIS-CHARACTER TO NEXT-CHARACTER.
MOVE SPACE TO THIS-CHARACTER.
GO TO GWC-EXIT.
GWC-3. IF THIS-CHARACTER EQUALS SPACE GO TO GWC-EXIT.
IF THIS-CHARACTER NOT EQUAL TO "-" GO TO GWC-5.
GWC-4.
PERFORM GET-CHARACTER THRU GC-EXIT.
IF COLUMN-X EQUALS 7 GO TO GWC-3.
IF THIS-CHARACTER EQUALS SPACE GO TO GWC-4.
GO TO GWC-EXIT.
GWC-5. MOVE THIS-CHARACTER TO NEXT-CHARACTER; MOVE SPACE TO THIS-CHARACTER.
GWC-EXIT. EXIT.