PDP-10 Archive: 43,50211/cob300.cbl from decuslib10-01

Trailing-Edge - PDP-10 Archives - decuslib10-01 - 43,50211/cob300.cbl

There are 2 other files named cob300.cbl in the archive. Click here to see a list.

IDENTIFICATION DIVISION.
PROGRAM-ID. COB300.
AUTHOR. AL BLACKINGTON.
DATE-WRITTEN. APRIL 1970.
SECURITY. COPYRIGHT 1970 -- DIGITAL EQUIPMENT CORPORATION.

REMARKS. READS A COBOL PROGRAM WRITTEN FOR THE B300 AND CONVERTS
	IT TO A PDP-10 COBOL PROGRAM.  THE FOLLOWING ACTIONS ARE TAKEN:

	IN IDENTIFICATION DIVISION:
		EVERYTHING IGNORED UP TO "IDENTIFICATION", THEN ENTIRE DIVISION COPIED.
	IN ENVIRONMENT DIVISION:
		1) SOURCE-COMPUTER - PARAGRAPH DELETED AND REPLACED WITH "PDP-10."
		2) OBJECT-COMPUTER - PARAGRAPH DELETED AND REPLACED WITH
			"PDP-10. SEGMENT-LIMIT IS 01."
		3) "SUPERVISORY-PRINTER" CHANGED TO "CONSOLE"
		4) I-O-CONTROL - ALL "APPLY" STATEMENTS DELETED
	IN DATA DIVISION:
		1) "MD" CHANGED TO "FD"
		2) "SIZE N" CHANGED TO "PICTURE X(N)" AND LINE IS FLAGGED
		3) CONSTANT SECTION HEADER DELETED.
		4) THE FOLLOWING CLAUSES ARE FLAGGED:
			"FILE-LIMIT...", "FILE-LIMITS...", "ACTUAL...",
			"ACCESS...", "PROCESSING...", "CLASS...", "NUMERIC",
			"ALPHABETIC", "ALPHANUMERIC", "AN", "ZERO SUPPRESS...",
			"CHECK PROTECT...", "POINT LOCATION...", "SIGNED"
	IN PROCEDURE DIVISION:
		1) "AND" DELETED EXCEPT IN "IF" AND "NOTE"
		2) THE FOLLOWING WORDS ARE FLAGGED:  "ENTER", "PAGE", "COMPUTE"
		3) "UNEQUAL" CHANGED TO "NOT EQUAL" IN CONDITIONAL STATEMENTS


ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. PDP-10.
OBJECT-COMPUTER. PDP-10.
SPECIAL-NAMES. CHANNEL (1) IS TOP-OF-FORM.

INPUT-OUTPUT SECTION.
FILE-CONTROL.
	SELECT SOURCE-FILE ASSIGN TO CDR.
	SELECT OUTPUT-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 SOURCE-ID
	DATA RECORD IS SOURCE-RECORD.

01	SOURCE-RECORD; DISPLAY-7.
	02 COLS-1-6		PICTURE X(6).
	02 COLS-7-80.
	  03 COLS-7-71		PICTURE X(65).
	  03 FILLER		PICTURE X(9).
	02 DUMMY REDEFINES COLS-7-80.
	  03 THIS-CHARACTER	PICTURE X.
	  03 COLS-8-72		PICTURE X(65).
	  03 COLS-73-80		PICTURE X(8).

FD OUTPUT-FILE
	LABEL RECORDS ARE STANDARD
	VALUE OF IDENTIFICATION IS OUTPUT-ID;
	DATA RECORDS ARE SHORTEST-LINE, NEXT-SHORTEST-LINE,
		NEXT-LONGEST-LINE, LONGEST-LINE.

01	NEXT-LONGEST-LINE	PICTURE X(82); DISPLAY-7.
01	NEXT-SHORTEST-LINE	PICTURE X(74); DISPLAY-7.
01	SHORTEST-LINE		PICTURE X(66); DISPLAY-7.
01	LONGEST-LINE; DISPLAY-7.
	02 LL-BREAKDOWN.
	  03 FILLER		PICTURE X(66).
	  03 COLS-73-102.
	    04 FILLER		PICTURE X(8).
	    04 COLS-81-102.
	      05 FILLER		PICTURE X(8).
	      05 COLS-89-102	PICTURE X(14).
	02 LL-OCCURS REDEFINES LL-BREAKDOWN.
	  03 OUTPUT-CHARACTER OCCURS 96 TIMES; PICTURE X.

FD LISTING-FILE
	LABEL RECORDS ARE STANDARD;
	VALUE OF IDENTIFICATION IS "COB300LST"
	DATA RECORD IS LIST-OUTPUT.

01	LIST-OUTPUT; DISPLAY-7.
	02 LISTING-FLAG		PICTURE XXX.
	02 FILLER		PICTURE XXX.
	02 LIST-SOURCE		PICTURE X(96).

WORKING-STORAGE SECTION.

01	MISCELLANEOUS-STUFF.
	02 NEXT-CHARACTER	PICTURE X.
	02 COLUMN		PICTURE S99; COMP.
	02 FIRST-COLUMN		PICTURE S99; COMP.
	02 I			PICTURE S99; COMP.
	02 J			PICTURE S99; COMP.
	02 TEMP-2		PICTURE S99; COMP.
	02 HOLD-CHARACTER	PICTURE X.
	02 LAST-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".

01	PROGRAM-NAME.
	02 PN-CHAR PICTURE X OCCURS 9 TIMES.
01	TEMPORARY-NAME.
	02 TN-CHAR PICTURE X OCCURS 10 TIMES.

*****************************************************************
*CONVERSION TABLE FOR 029 CARD MODE TO B300 CHARACTERS

01	CONVERSION-TABLE-029-B300; DISPLAY-7.
	02 FILLER	PICTURE X(16); VALUE " :\#$%&:()*<,-./".
	02 FILLER	PICTURE X(15); VALUE "0123456789\;[>]".
	02 FILLER	PICTURE X; VALUE QUOTE.
	02 FILLER	PICTURE X(16); VALUE "@ABCDEFGHIJKLMNO".
	02 FILLER	PICTURE X(16); VALUE "PQRSTUVWXYZ+\\_=".

*CONVERSION TABLE FOR STANDARD CARD MODE TO B300 CHARACTERS

01	CONVERSION-TABLE-026-B300;	DISPLAY-7.
	02 FILLER	PICTURE X(5);  VALUE " _=]$".
	02 FILLER	PICTURE X; VALUE QUOTE.
	02 FILLER	PICTURE X(10); VALUE "\>%[*&,-./".
	02 FILLER	PICTURE X(16); VALUE "0123456789:\<#;+".
	02 FILLER	PICTURE X(16); VALUE "@ABCDEFGHIJKLMNO".
	02 FILLER	PICTURE X(16); VALUE "PQRSTUVWXYZ)\(:\".

01	TO-HOLD-A-WORD		PICTURE X(36).
	88 W-LINE-PRINTER	VALUE "LINE-PRINTER".
	88 W-CARD-READER	VALUE "CARD-READER".
	88 W-DISK-FILE		VALUE "DISK-FILE".
	88 W-CARD-PUNCH		VALUE "CARD-PUNCH".
	88 W-TAPE-UNIT		VALUE "TAPE-UNIT", "TSU".
	88 W-IDENTIFICATION	VALUE "IDENTIFICATION".
	88 W-ENVIRONMENT	VALUE "ENVIRONMENT".
	88 W-SOURCE-COMPUTER	VALUE "SOURCE-COMPUTER".
	88 W-OBJECT-COMPUTER	VALUE "OBJECT-COMPUTER".
	88 W-SUPERVISORY	VALUE "SUPERVISORY-PRINTER".
	88 W-I-O-CONTROL	VALUE "I-O-CONTROL".
	88 W-DATA		VALUE "DATA".
	88 W-PROCEDURE		VALUE "PROCEDURE".
	88 W-APPLY		VALUE "APPLY".
	88 W-RERUN		VALUE "RERUN".
	88 W-SAME		VALUE "SAME".
	88 W-MULTIPLE		VALUE "MULTIPLE".
	88 W-MD			VALUE "MD".
	88 W-SIZE		VALUE "SIZE".
	88 W-IS			VALUE "IS".
	88 W-UNEQUAL		VALUE "UNEQUAL".
	88 MD-CLAUSE		VALUE "FILE-LIMIT", "FILE-LIMITS", "ACTUAL",
					"ACCESS", "PROCESSING".
	88 OBSOLETE-CLAUSE	VALUE "NUMERIC", "ALPHABETIC", "ALPHANUMERIC", "AN",
					"ZERO", "CHECK", "POINT", "SIGNED", "CLASS".
	88 W-BLANK		VALUE "BLANK".
	88 W-ZERO		VALUE "ZERO".
	88 W-CONSTANT		VALUE "CONSTANT".
	88 W-IF			VALUE "IF".
	88 W-AND		VALUE "AND".
	88 W-NOTE		VALUE "NOTE".
	88 PD-WORDS-FLAGGED	VALUE "ENTER", "PAGE", "COMPUTE".

01	THIS-WORD REDEFINES TO-HOLD-A-WORD.
	02 WORD-CHARACTER OCCURS 36 TIMES; PICTURE X.

01	SOURCE-ID.
	02 FILLER		PICTURE X(6).
	02 SOURCE-ID-EXT	PICTURE XXX.

01	OUTPUT-ID.
	02 FILLER		PICTURE X(6).
	02 OUTPUT-ID-EXT	PICTURE XXX.

PROCEDURE DIVISION.

MAIN SECTION.

START. OPEN OUTPUT LISTING-FILE.

RESTART. MOVE SPACES TO LIST-OUTPUT; WRITE LIST-OUTPUT BEFORE TOP-OF-FORM.
	MOVE LOW-VALUES TO MISCELLANEOUS-STUFF.

RESTART-1. DISPLAY "*"; ACCEPT TEMPORARY-NAME.
	MOVE 0 TO I; MOVE SPACES TO PROGRAM-NAME.
	PERFORM CONVERT-ID VARYING J FROM 1 BY 1 UNTIL J > 10.
	IF I > 9 DISPLAY "?NAME TOO LONG"; GO TO RESTART-1.
	IF PROGRAM-NAME = "EXIT" CLOSE LISTING-FILE; STOP RUN.

	MOVE PROGRAM-NAME TO SOURCE-ID, OUTPUT-ID.
	IF SOURCE-ID-EXT IS EQUAL TO SPACES MOVE "ASC" TO SOURCE-ID-EXT.
	MOVE "CBL" TO OUTPUT-ID-EXT.

	OPEN INPUT SOURCE-FILE; OPEN OUTPUT OUTPUT-FILE.
	MOVE SPACES TO LONGEST-LINE, LIST-OUTPUT.
	MOVE SPACE TO NEXT-CHARACTER.
	READ SOURCE-FILE; AT END DISPLAY "?SOURCE FILE HAS NO DATA";
			GO TO ALL-DONE-1.

	MOVE 7 TO COLUMN.
	PERFORM CONVERSION THRU GC-EXIT.
	MOVE THIS-CHARACTER TO NEXT-CHARACTER.
	IF THIS-CHARACTER IS EQUAL TO SPACE MOVE 2 TO J; ELSE 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 GO TO PROCESS-IDENTIFICATION.
	PERFORM PUT-WORD.

PROCESS-ID-1.
	PERFORM GET-WORD; IF END-OF-SOURCE DISPLAY "?NO ENVIRONMENT DIVISION";
		GO TO ALL-DONE.
	IF NOT W-ENVIRONMENT PERFORM PUT-WORD; GO TO PROCESS-ID-1.
	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-SOURCE-COMPUTER.
	IF W-SUPERVISORY GO TO PROCESS-CONSOLE.
	IF W-OBJECT-COMPUTER GO TO PROCESS-OBJECT-COMPUTER.
	IF W-I-O-CONTROL GO TO PROCESS-I-O-CONTROL.

	IF W-LINE-PRINTER MOVE "LPT" TO THIS-WORD; GO TO PROCESS-ENV-5.
	IF W-CARD-READER  MOVE "CDR" TO THIS-WORD; GO TO PROCESS-ENV-5.
	IF W-DISK-FILE    MOVE "DSK" TO THIS-WORD; GO TO PROCESS-ENV-5.
	IF W-CARD-PUNCH   MOVE "CDP" TO THIS-WORD; GO TO PROCESS-ENV-5.
	IF W-TAPE-UNIT    GO TO PROCESS-TAPE.

PROCESS-ENV-2.
	IF W-DATA PERFORM PUT-WORD; GO TO PROCESS-DATA-DIVISION.
	PERFORM PUT-WORD.
	GO TO PROCESS-ENVIRONMENT.

PROCESS-ENV-5.
	IF PUNCTUATION PERFORM PUT-WORD; GO TO PROCESS-ENVIRONMENT.
	PERFORM PUT-WORD THRU PW-1.
	PERFORM GET-WORD; IF END-OF-SOURCE GO TO PROCESS-ENV-9.
	IF WORD-CHARACTER (1) = "(" PERFORM PW-1 THRU PW-2; GO TO PROCESS-ENVIRONMENT.

	ADD 1 TO J.
	PERFORM PUT-WORD; GO TO PROCESS-ENVIRONMENT.

PROCESS-ENV-9.
	DISPLAY "?NO DATA DIVISION"; GO TO ALL-DONE.

*	"SUPERVISORY-PRINTER" CONVERTED TO "CONSOLE".

PROCESS-CONSOLE.
	MOVE "CONSOLE" TO THIS-WORD; PERFORM PUT-WORD.
	MOVE "X" TO DELETION-FLAG; GO TO PROCESS-ENVIRONMENT.

*	SOURCE-COMPUTER. REPLACE PARAGRAPH WITH <PDP-10.>

PROCESS-SOURCE-COMPUTER.
	PERFORM PUT-WORD.
	MOVE "PDP-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.

*	OBJECT-COMPUTER. REPLACE PARAGRAPH WITH <PDP-10. SEGMENT-LIMIT IS 01.>

PROCESS-OBJECT-COMPUTER.
	PERFORM PUT-WORD.
	MOVE "PDP-10." TO THIS-WORD; PERFORM PUT-WORD.
	MOVE "SEGMENT-LIMIT" TO THIS-WORD; PERFORM PUT-WORD.
	MOVE "IS" TO THIS-WORD; PERFORM PUT-WORD.
	MOVE "01." TO THIS-WORD; PERFORM PUT-WORD.
	GO TO PROCESS-SC-0.

*	I-O-CONTROL. DELETE ALL "APPLY" CLAUSES

PROCESS-I-O-CONTROL.
	PERFORM PUT-WORD.
I-O-CONTROL-1.
	PERFORM GET-WORD; IF END-OF-SOURCE GO TO PROCESS-ENV-9.
	IF W-APPLY GO TO I-O-CONTROL-2.
	IF W-DATA PERFORM PUT-WORD; GO TO PROCESS-DATA-DIVISION.
	PERFORM PUT-WORD.
	GO TO I-O-CONTROL-1.

I-O-CONTROL-2.
	MOVE "X" TO DELETION-FLAG.
	PERFORM GET-WORD; IF END-OF-SOURCE GO TO PROCESS-ENV-9.
	IF W-RERUN OR W-SAME OR W-MULTIPLE
		PERFORM PUT-WORD; GO TO I-O-CONTROL-1.
	IF W-DATA PERFORM PUT-WORD; GO TO PROCESS-DATA-DIVISION.
	GO TO I-O-CONTROL-2.

*	TAPE-UNIT. CHANGE TO MTA AND GET TAPE NUMBER

PROCESS-TAPE.
	MOVE "MTA" TO THIS-WORD.
	PERFORM PUT-WORD.
	SUBTRACT 1 FROM J.

	PERFORM GET-WORD; IF END-OF-SOURCE GO TO PROCESS-ENV-9.
	MOVE WORD-CHARACTER (2) TO OUTPUT-CHARACTER (J); ADD 1 TO J.
	PERFORM PW-2; 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-MD MOVE "FD" TO THIS-WORD; GO TO PROCESS-DD-1.
	IF MD-CLAUSE GO TO PUT-OUT-FLAG.
	IF W-BLANK GO TO PROCESS-BWZ.
	IF OBSOLETE-CLAUSE GO TO PUT-OUT-FLAG.
	IF W-SIZE GO TO PROCESS-SIZE.
	IF W-CONSTANT GO TO DELETE-CONSTANT-SECTION.

PROCESS-DD-1.
	IF W-PROCEDURE PERFORM PUT-WORD; GO TO PROCESS-PROCEDURE.
	PERFORM PUT-WORD.
	GO TO PROCESS-DD-0.

PROCESS-DD-9.
	DISPLAY "?NO PROCEDURE DIVISION"; GO TO ALL-DONE.

*	SIZE CLAUSE. CHANGE TO A PICTURE CLAUSE.

PROCESS-SIZE.
	MOVE "***" TO LISTING-FLAG.
	MOVE "PICTURE" TO THIS-WORD; PERFORM PUT-WORD.
	PERFORM GET-WORD; IF END-OF-SOURCE GO TO PROCESS-DD-9.
	IF W-IS PERFORM PUT-WORD; PERFORM GET-WORD; IF END-OF-SOURCE GO TO PROCESS-DD-9.

	MOVE "X" TO OUTPUT-CHARACTER (J); ADD 1 TO J.
	MOVE "(" TO OUTPUT-CHARACTER (J); ADD 1 TO J.
	IF WORD-CHARACTER (I) IS NOT EQUAL TO SPACE ADD 1 TO I.
	MOVE ")" TO WORD-CHARACTER (I).
	PERFORM PUT-WORD.
	GO TO PROCESS-DD-0.

PUT-OUT-FLAG. MOVE "***" TO LISTING-FLAG; GO TO PROCESS-DD-1.

*	"BLANK WHEN ZERO". COPY SO THAT IT WON'T LOOK LIKE "ZERO SUPPRESS".

PROCESS-BWZ.
	PERFORM PUT-WORD; PERFORM GET-WORD; IF END-OF-SOURCE GO TO PROCESS-DD-9.
	IF NOT W-ZERO GO TO PROCESS-BWZ.
	GO TO PROCESS-DD-1.

*	CONSTANT SECTION. DELETE IT.

DELETE-CONSTANT-SECTION.
	MOVE SPACE TO NEXT-CHARACTER.
	MOVE 72 TO COLUMN; 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-NOTE GO TO PROCESS-PD-6.
	IF W-IF GO TO PROCESS-PD-4.
	IF W-AND MOVE "X" TO DELETION-FLAG;  GO TO PROCESS-PD-0.
PROCESS-PD-1.
	IF PD-WORDS-FLAGGED MOVE "***" TO LISTING-FLAG.
PROCESS-PD-2.
	PERFORM PUT-WORD; GO TO PROCESS-PD-0.

*	"IF"

PROCESS-PD-4.
	IF PD-WORDS-FLAGGED MOVE "***" TO LISTING-FLAG.
	PERFORM PUT-WORD.
	PERFORM GET-WORD; IF END-OF-SOURCE GO TO ALL-DONE.

	IF W-UNEQUAL
		MOVE "NOT" TO THIS-WORD; PERFORM PUT-WORD;
		MOVE "EQUAL" TO THIS-WORD.
	IF PUNCTUATION-CHARACTER EQUALS "." GO TO PROCESS-PD-1.
	GO TO PROCESS-PD-4.

*	"NOTE"

PROCESS-PD-6.
	PERFORM PUT-WORD.
	PERFORM GET-WORD; IF END-OF-SOURCE GO TO ALL-DONE.
	IF PUNCTUATION-CHARACTER EQUALS "." GO TO PROCESS-PD-2.
	GO TO PROCESS-PD-6.

*******************************************************************
*	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, OUTPUT-FILE.
	GO TO RESTART.

********************************************************************
*	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.

	MOVE COLUMN 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 THIS-CHARACTER EQUALS "\" MOVE "***" TO LISTING-FLAG.
	MOVE THIS-CHARACTER TO OUTPUT-CHARACTER (J); ADD 1 TO J.

GW-8. PERFORM GET-CHARACTER THRU GC-EXIT.
	IF THIS-CHARACTER EQUALS QUOTE
		MOVE QUOTE TO OUTPUT-CHARACTER (J);
		ADD 1 TO J; 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.

	ENTER MACRO PUTWRD USING THIS-WORD, OUTPUT-CHARACTER (J), J, LISTING-FLAG.

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 SKIPPING-STUFF OR DELETING-STUFF AND J = 1 GO TO WL-EXIT.

	MOVE LONGEST-LINE TO LIST-SOURCE.
	WRITE LIST-OUTPUT BEFORE 1 LINE.
	IF COLS-73-102 OF LONGEST-LINE EQUAL SPACES
		WRITE SHORTEST-LINE BEFORE 1 LINE; ELSE
	IF COLS-81-102 OF LONGEST-LINE EQUAL SPACES
		WRITE NEXT-SHORTEST-LINE BEFORE 1 LINE; ELSE
	IF COLS-89-102 OF LONGEST-LINE EQUAL SPACES
		WRITE NEXT-LONGEST-LINE BEFORE 1 LINE; ELSE
		WRITE LONGEST-LINE BEFORE 1 LINE.

	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 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.
	IF COLUMN IS NOT EQUAL TO 73
		ENTER MACRO GETKAR USING COLUMN; GO TO GC-EXIT.

	MOVE "X" TO EOL-FLAG.
GC-1.
	MOVE 7 TO COLUMN.
	READ SOURCE-FILE; AT END MOVE "X" TO EOF-FLAG;
		MOVE SPACE TO COLS-7-80.

CONVERSION.
	ENTER MACRO CONVRT USING COLS-7-80, CONVERSION-TABLE-029-B300, 66.

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 NOT EQUAL TO 7 AND THIS-CHARACTER NOT EQUAL TO SPACE
		GO TO GWC-EXIT.

GWC-1. IF COLUMN 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 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.

*****************************************************************
*	SCAN PROGRAM-NAME, LOOKING FOR THE "." DELIMITER
*****************************************************************

CONVERT-ID SECTION 49.

CONVERT-ID-1.
	MOVE TN-CHAR (J) TO TN-CHAR (1).
	IF TN-CHAR (1) IS NOT EQUAL TO "." GO TO CONVERT-ID-2.

	IF I IS GREATER THAN 6 MOVE 10 TO I, J;
		ELSE MOVE 6 TO I.
	GO TO CONVERT-ID-EXIT.

CONVERT-ID-2.
	IF TN-CHAR (1) IS EQUAL TO SPACE NEXT SENTENCE; ELSE
	IF I IS GREATER THAN 8 MOVE 10 TO I, J;
		ELSE ADD 1 TO I; MOVE TN-CHAR (1) TO PN-CHAR (I).

CONVERT-ID-EXIT. EXIT.