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-INPUT-OUTPUT	VALUE "INPUT-OUTPUT".
	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", "BCD".
	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-INPUT-OUTPUT PERFORM PUT-WORD; GO TO CHECK-FOR-SPECIAL-NAMES.
	IF W-ASSIGN GO TO PROCESS-ASSIGN.
	IF W-DATA PERFORM PUT-WORD; GO TO PROCESS-DATA-DIVISION.
	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-ENVIRONMENT.
	PERFORM PROCESS-SPECIAL-NAMES-1.
	MOVE "INPUT-OUTPUT" TO THIS-WORD.
	PERFORM PUT-WORD.
	GO TO PROCESS-ENVIRONMENT.
*****************************************************************
*	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.
