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