Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0037/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 THIS-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 THIS-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 THIS-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 THIS-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 THIS-COLUMN.
IF THIS-COLUMN IS NOT EQUAL TO 73
ENTER MACRO GETKAR USING THIS-COLUMN; GO TO GC-EXIT.
MOVE "X" TO EOL-FLAG.
GC-1.
MOVE 7 TO THIS-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 THIS-COLUMN NOT EQUAL TO 7 AND THIS-CHARACTER NOT EQUAL TO SPACE
GO TO GWC-EXIT.
GWC-1. IF THIS-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 THIS-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.