Directory of image this file is from
This file as a plain text file
IDENTIFICATION DIVISION.
PROGRAM-ID. LEXCON.
AUTHOR. PETER MOLDAVE.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES. CONSOLE IS TTY.
CHANNEL (1) IS HEAD-OF-FORMS.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT OUT-FILE, ASSIGN TO LPT, RECORDING MODE IS ASCII.
SELECT IN-FILE, ASSIGN TO DSK, RECORDING MODE IS ASCII.
SELECT S-FILE, ASSIGN TO DSK, RECORDING MODE IS ASCII.
SELECT D-FILE, ASSIGN TO DSK, FILE-LIMITS ARE 0 THRU 1000,
ACCESS RANDOM, ACTUAL KEY IS BASE.
DATA DIVISION.
FILE SECTION.
FD IN-FILE, LABEL RECORDS ARE STANDARD,
VALUE OF ID IS IN-ID.
01 I-BUF.
02 I-CHAR, OCCURS 120 TIMES, PIC X.
FD OUT-FILE, LABEL RECORDS ARE STANDARD,
VALUE OF ID IS OUT-ID.
01 O-LINE, PIC X(120).
FD S-FILE, LABEL RECORDS ARE STANDARD, VALUE OF ID IS S-ID.
01 S-BUF.
02 S-CHAR, OCCURS 120 TIMES, PIC X.
FD D-FILE, LABEL RECORDS ARE STANDARD,
VALUE OF ID IS D-ID,
BLOCK CONTAINS 1 RECORDS, DATA RECORDS ARE D-BUF, BUF-OVLY.
01 D-BUF.
02 D-CHAR, OCCURS 760 TIMES, PIC X.
01 BUF-OVLY.
02 BUF-OVR, PIC X(6).
02 FILLER, PIC X(754).
WORKING-STORAGE SECTION.
01 HEADING-LINE.
02 FILLER, PIC X(70), VALUE "S.E.P. COMP REPORT ON GRAMMATICAL CONSTRUCTION".
01 S-PNT, PIC 9(4), USAGE COMP.
01 D-PNT, PIC 9(4), USAGE COMP.
01 FREVAR.
02 FREE-CHAR OCCURS 1000 TIMES, PIC X.
01 FREE-CORE REDEFINES FREVAR, PIC X(120).
01 LINE-CNT, PIC 9(5).
01 T-LINE-CNT, PIC 9(5).
01 R-TYPE-M, PIC X(100), VALUE "^ LINE RE-TYPED AS:".
01 REPLY.
02 REP-CHAR, OCCURS 120 TIMES, PIC X.
01 REPLY-2 REDEFINES REPLY.
02 REPL2, PIC X(6).
02 FILLER, PIC X(114).
01 IN-ID.
02 IN-NME, PIC X(6), VALUE "ESSAY".
02 IN-EXT, PIC X(3), VALUE "SA ".
01 OUT-ID, PIC X(9), VALUE "REPORTSEP", USAGE DISPLAY-7.
01 S-ID, PIC X(9), VALUE "SYNTAXSNX".
01 D-ID.
02 D-LTR, PIC X, VALUE "A".
02 D-NME, PIC X(5).
02 D-EXT, PIC X(3), VALUE "DIC".
01 IDENTITY-BUF.
02 ID-CHAR, OCCURS 120 TIMES, PIC X.
01 LINE-SV.
02 LINE-SV-CHR, OCCURS 120 TIMES, PIC X.
01 SPEL-LINE.
02 FILLER, PIC X(20), VALUE "SPELLING ERRORS".
02 SPEL-ERR, PIC 9(4).
02 FILLER, PIC X(20), VALUE " PUNC-ERRORS".
02 PUNC-ERR, PIC 9(4).
01 CAPTL-1.
02 FILLER, PIC X(10), VALUE "N(+PROP)#".
01 CAPTL-2, REDEFINES CAPTL-1.
02 CAPTL, OCCURS 10 TIMES, PIC X.
01 S-T-CHAR, PIC X.
01 LINE-TOTALS.
02 FILLER, PIC X(20), VALUE "TOTAL LINES".
02 LINE-NUMBER, PIC 9(5).
02 FILLER, PIC X(20), VALUE " TOTAL STRINGS".
02 STR-CNT, PIC 9(5).
01 F-T-CHAR, PIC X.
01 NUMB-DEF.
02 FILLER, PIC X(14), VALUE "ADJ,DET(+NUM)#".
01 NUM-DEF-2, REDEFINES NUMB-DEF.
02 NUMB-VAL, OCCURS 14 TIMES, PIC X.
01 LINE-STUFF.
02 LINE-NUM, PIC 9(5).
02 FILLER, PIC XX.
02 LINE-STF, PIC X(120).
01 LINE-STF-2, REDEFINES LINE-STUFF.
02 LINE-TO-OUTPUT, PIC X(120).
02 FILLER, PIC X(7).
77 S-PNT-SV, PIC 9(5), USAGE COMP.
77 S-INDX-SV, PIC 9(5), USAGE COMP.
77 CAP-PT, PIC 9(5), USAGE COMP.
77 SUBSCRPT, PIC 9(6), USAGE COMP.
77 S-LFT-LEN, PIC 9(5), USAGE COMP.
77 S-LEN, PIC 9(5), USAGE COMP.
77 S-INDX, PIC 9(4), USAGE COMP.
77 S-INDX2, PIC 9(4), USAGE COMP.
77 DELTA, PIC 9(5), USAGE COMP.
77 S-REP-LEN, PIC 9(4), USAGE COMP.
77 SIZ-DEF, PIC 9(4), USAGE COMP.
77 SIZ-D-BUF, PIC 9(4), USAGE COMP.
77 B-SAVE, PIC 9(6), USAGE COMP.
77 B2-SAVE, PIC 9(6), USAGE COMP.
77 N-BSAV, PIC 9(5), USAGE COMP.
77 N-DOTS, PIC 9(4), USAGE COMP.
77 MID-PNT, PIC 9(6), USAGE COMP.
77 FROM1, PIC 9(4), USAGE COMP.
77 ID-PTR, PIC 9(6), USAGE COMP.
77 ERR-PNT, PIC 9(6), USAGE COMP.
77 ERR-PNT-2, PIC 9(6), USAGE COMP.
77 FOUND, PIC 9, USAGE COMP.
77 SIZDEF, PIC 9(4), USAGE COMP.
77 ENTRING, PIC 9, USAGE COMP.
77 BASE, PIC 9(6), USAGE COMP.
77 SIZE-FILE, PIC 9(6), USAGE COMP.
77 INCREM, USAGE COMP-1.
77 SIGN, PIC S9, USAGE COMP.
77 SAVSIGN, PIC S99, USAGE COMP.
77 BASE2, PIC 9(6), USAGE COMP.
77 ILOOP, PIC 9(4), USAGE COMP.
77 FREPNT, PIC 9(4), USAGE COMP.
77 IN-PT, PIC 9(4), USAGE COMP.
77 OUT-PT, PIC 9(4), USAGE COMP.
PROCEDURE DIVISION.
INIT-PAR.
DISPLAY "S.E.P. COMP. LEXICON.".
INIT-1.
DISPLAY "DICTIONARY? ", WITH NO ADVANCING.
ACCEPT D-NME.
INIT-2.
DISPLAY "INPUT FILE NAME? ", WITH NO ADVANCING.
ACCEPT REPLY.
IF REPLY EQUALS SPACES, GO TO OPEN-PAR;
ELSE, MOVE REPL2 TO IN-NME.
OPEN-PAR.
OPEN INPUT IN-FILE, I-O D-FILE, OUTPUT
OUT-FILE.
MOVE 0 TO BASE, READ D-FILE; INVALID KEY GO TO
INV-KEY.
MOVE BUF-OVR TO SIZE-FILE.
WRITE-HEAD.
WRITE O-LINE FROM HEADING-LINE, AFTER HEAD-OF-FORMS.
MOVE ZERO TO SPEL-ERR, PUNC-ERR.
MOVE 1 TO LINE-NUM.
READ-LINE.
READ IN-FILE; AT END, GO TO WRAP-UP.
MOVE 1 TO ERR-PNT.
IF I-CHAR (1) = "$", PERFORM WRITE-HEAD, MOVE 1 TO LINE-NUMBER, GO TO CHK-ERR.
MOVE I-BUF TO LINE-STF.
MOVE LINE-NUMBER TO LINE-NUM.
WRITE O-LINE FROM LINE-TO-OUTPUT, AFTER ADVANCING 1 LINES.
MOVE SPACES TO LINE-NUM.
ADD 1 TO LINE-NUMBER.
CHK-ERR.
IF I-CHAR (ERR-PNT) = ".", GO TO READ-LINE-2;
ELSE IF I-CHAR (ERR-PNT) = "*",
MOVE SPACE TO I-CHAR (ERR-PNT);
IF I-CHAR (ERR-PNT + 1) IS ALPHABETIC,
ADD 1 TO SPEL-ERR;
ELSE ADD 1 TO PUNC-ERR;
ELSE IF I-CHAR (ERR-PNT) = "$", GO TO READ-ID;
ELSE IF ERR-PNT = 120, GO TO LINE-TOO-LONG.
ADD 1 TO ERR-PNT, GO TO CHK-ERR.
READ-LINE-2.
MOVE SPACES TO FREVAR.
MOVE 1 TO S-PNT, FREPNT, D-PNT.
LOOKUP-SYMBOL.
MOVE S-PNT TO ILOOP.
IF I-CHAR (ILOOP) = SPACE, ADD 1 TO S-PNT, GO TO LOOKUP-SYMBOL.
IF I-CHAR (ILOOP) IS NOT ALPHABETIC, GO TO NOT-ALPH.
IF I-CHAR (ILOOP) IS NOT = D-LTR, CLOSE D-FILE,
MOVE I-CHAR (ILOOP) TO D-LTR, OPEN INPUT D-FILE.
DIVIDE SIZE-FILE BY 2 GIVING BASE, MOVE BASE TO INCREM.
ADD 1 TO BASE.
READ D-FILE; INVALID KEY DISPLAY "DIC-2 ", GO TO INV-KEY.
MOVE 380 TO BASE2, MOVE 0 TO SAVSIGN, MOVE -1 TO SIGN.
GETSYMBOL.
********ROUTINE TO LOOK-UP A SYMBOL.
IF INCREM EQUALS 0, IF SIGN EQUALS -1 AND EQUALS
SAVSIGN, MOVE 0 TO FOUND, GO TO GETSYM9;
ELSE, COMPUTE SAVSIGN EQUALS -1 * SIGN, GO TO GETSYM3.
GETSYM2.
READ D-FILE; INVALID KEY, DISPLAY "DICTIONARY ",BASE, GO TO INV-KEY.
GETSYM3.
********LOOP UNTIL WE GET A SYMBOL ("[").
ADD SIGN TO BASE2.
IF BASE2 < 1, SUBTRACT 1 FROM BASE, MOVE 761 TO BASE2, GO TO GETSYM2.
IF BASE2 > 760 AND SIGN = 1,
ADD 1 TO BASE, MOVE 0 TO BASE2, GO TO GETSYM2.
IF D-CHAR (BASE2) NOT = "[", GO TO GETSYM3.
GETSYM4.
********GOT ONE - DOES IT FIT
MOVE S-PNT TO ILOOP.
SUBTRACT 1 FROM ILOOP.
GETSYM5.
ADD 1 TO BASE2, ILOOP.
IF BASE2 > 760 ADD 1 TO BASE, MOVE 1 TO BASE2, READ D-FILE; INVALID KEY GO TO INV-KEY.
IF D-CHAR (BASE2) EQUALS ":", IF I-CHAR (ILOOP)
IS NOT ALPHABETIC, IF ENTRING IS NOT = 1, GO TO GETSYM7;
ELSE IF ILOOP = SIZDEF, MOVE 1 TO FOUND, GO TO GETSYM9;
ELSE MOVE 1 TO SIGN, GO TO GETSYM6;
ELSE MOVE 1 TO SIGN, GO TO GETSYM6.
IF I-CHAR (ILOOP) IS NOT ALPHABETIC, MOVE -1 TO SIGN,
PERFORM CHK-FOR-CHAR UNTIL D-CHAR (BASE2) = "[",
GO TO GETSYM6.
IF I-CHAR (ILOOP) EQUALS D-CHAR (BASE2), GO TO GETSYM5;
ELSE IF I-CHAR (ILOOP) > D-CHAR (BASE2) MOVE 1 TO SIGN;
ELSE MOVE -1 TO SIGN, PERFORM CHK-FOR-CHAR UNTIL D-CHAR (BASE2) = "[".
GETSYM6.
DIVIDE 2 INTO INCREM.
IF INCREM > 1 OR = 1, MOVE 380 TO BASE2;
ELSE IF INCREM < 1 AND > 0, MOVE 0 TO INCREM, MOVE 380 TO
BASE2.
COMPUTE BASE EQUALS BASE + SIGN * INCREM.
IF INCREM > 0, MOVE -1 TO SIGN.
GO TO GETSYMBOL.
GETSYM7.
MOVE ILOOP TO S-PNT.
GETSYM8.
PERFORM GET-NEXT-CHAR.
IF D-CHAR (BASE2) = ":", PERFORM GET-NEXT-CHAR UNTIL D-CHAR (BASE2) = "," OR "]".
MOVE D-CHAR (BASE2) TO FREE-CHAR (FREPNT).
IF D-CHAR (BASE2) = "]", MOVE 1 TO FOUND,
GO TO GETSYM9.
ADD 1 TO FREPNT, GO TO GETSYM8.
NOT-ALPH.
IF I-CHAR (ILOOP) = SPACE, ADD 1 TO ILOOP, GO TO LOOKUP-SYMBOL;
ELSE IF I-CHAR (ILOOP) = "%", GO TO CAPITAL;
ELSE IF I-CHAR (ILOOP) IS NUMERIC AND I-CHAR (ILOOP) IS NOT = ".",
GO TO NUMBERIC.
MOVE I-CHAR (ILOOP) TO FREE-CHAR (FREPNT).
ADD 1 TO FREPNT, ILOOP, MOVE ILOOP TO S-PNT.
IF I-CHAR (ILOOP - 1) = "." GO TO PARSD;
ELSE, MOVE 1 TO FOUND, GO TO GETSYM9.
CAPITAL.
ADD 1 TO ILOOP.
IF I-CHAR (ILOOP) IS ALPHABETIC AND I-CHAR (ILOOP) IS NOT = SPACE,
GO TO CAPITAL;
ELSE MOVE 1 TO CAP-PT.
CAPLOP.
IF CAPTL (CAP-PT) = "#", MOVE 1 TO FOUND, MOVE ILOOP TO S-PNT, GO TO GETSYM9;
ELSE, MOVE CAPTL (CAP-PT) TO FREE-CHAR (FREPNT),
ADD 1 TO FREPNT, CAP-PT, GO TO CAPLOP.
NUMBERIC.
IF I-CHAR (ILOOP) IS NUMERIC, ADD 1 TO ILOOP, GO TO NUMBERIC.
MOVE 1 TO CAP-PT.
NUMBLOP.
IF NUMB-VAL (CAP-PT) = "#", MOVE 1 TO FOUND, MOVE ILOOP TO S-PNT, GO TO GETSYM9;
ELSE, MOVE NUMB-VAL (CAP-PT) TO FREE-CHAR (FREPNT),
ADD 1 TO FREPNT, CAP-PT, GO TO NUMBLOP.
GETSYM9.
EXIT.
GETSYM10.
IF FOUND = 0, GO TO NOT-FOUND;
ELSE ADD 1 TO STR-CNT, MOVE "#" TO FREE-CHAR (FREPNT),
ADD 1 TO FREPNT, MOVE FREPNT TO D-PNT, GO TO LOOKUP-SYMBOL.
PARSD.
ADD 1,FREPNT, GIVING D-PNT.
DISPLAY FREVAR.
DISPLAY "ENTERING S-LOOP".
OPEN INPUT S-FILE.
APPLY-LINE.
READ S-FILE; AT END CLOSE S-FILE, GO TO DONE-SNT.
APPL-LIN-2.
EXAMINE S-BUF, TALLYING UNTIL FIRST ">".
MOVE TALLY TO S-LFT-LEN, ADD 2 TO S-LFT-LEN.
EXAMINE S-BUF, TALLYING UNTIL FIRST "#".
MOVE TALLY TO S-LEN.
MOVE 1 TO S-PNT, S-INDX.
APPLY-LOOP.
SUBTRACT 1 FROM S-PNT, GIVING ILOOP, MOVE S-INDX TO S-INDX2.
APPLY-LOOP2.
MOVE S-CHAR (S-INDX) TO S-T-CHAR, MOVE FREE-CHAR (S-PNT) TO F-T-CHAR.
IF S-T-CHAR = F-T-CHAR, ADD 1 TO S-INDX, S-PNT, GO TO APPLY-LOOP2.
IF S-T-CHAR = "(" AND F-T-CHAR = "+" OR = "-", GO TO APPL-ATTRIB.
IF S-T-CHAR = "+" AND F-T-CHAR = "#" OR = ",", GO TO NXTWRD.
IF S-T-CHAR = ">" AND F-T-CHAR = "#" OR = ",", GO TO APPLY-IT.
APPLY-LOOP3.
IF ILOOP < 1, MOVE 1 TO ILOOP.
IF ILOOP > 1000, GO TO APPLY-LINE.
IF FREE-CHAR (ILOOP) = "#", GO TO APPLY-LOOP4;
ELSE ADD 1 TO ILOOP, GO TO APPLY-LOOP3.
APPLY-LOOP4.
ADD 1 TO ILOOP.
IF FREE-CHAR (ILOOP) = ".", GO TO APPLY-LINE.
MOVE ILOOP TO S-PNT, MOVE 1 TO S-INDX, S-INDX2, GO TO APPLY-LOOP.
NXTDEF.
MOVE S-INDX2 TO S-INDX, ADD 1 TO S-PNT, GO TO APPLY-LOOP2.
NXTWRD.
IF FREE-CHAR (S-PNT) = "#", GO TO NXTWR2;
ELSE, ADD 1 TO S-PNT, GO TO NXTWRD.
NXTWR2.
ADD 1 TO S-PNT, S-INDX, GO TO APPLY-LOOP2.
APPLY-IT.
COMPUTE DELTA = (S-PNT - ILOOP) - (S-LEN - S-LFT-LEN).
IF DELTA = 0, GO TO APPLY-MOVE;
ELSE IF DELTA > 0, IF DELTA = 1, MOVE 2 TO DELTA,
GO TO APPLY-LEFT; ELSE, GO TO APPLY-LEFT;
ELSE COMPUTE DELTA = -1 * DELTA;
GO TO APPLY-RIGHT.
APPLY-LEFT.
SUBTRACT DELTA FROM S-PNT, GIVING SUBSCRPT.
IF SUBSCRPT IS NOT = 0, MOVE FREE-CHAR (S-PNT) TO FREE-CHAR (SUBSCRPT).
ADD 1 TO S-PNT, IF S-PNT = D-PNT, GO TO APPLY-MOVE;
ELSE GO TO APPLY-LEFT.
APPLY-RIGHT.
ADD S-PNT, DELTA, GIVING SUBSCRPT.
MOVE FREE-CHAR (S-PNT) TO FREE-CHAR (SUBSCRPT).
ADD 1 TO S-PNT, IF S-PNT = D-PNT, COMPUTE D-PNT =
S-PNT + DELTA, GO TO APPLY-MOVE;
ELSE GO TO APPLY-RIGHT.
APPLY-MOVE.
COMPUTE S-REP-LEN = S-LEN + 1 - S-LFT-LEN.
APPL-MOVE-LOOP.
IF S-REP-LEN > 0,
MOVE S-CHAR (S-LFT-LEN) TO FREE-CHAR (ILOOP),
ADD 1 TO S-LFT-LEN, ILOOP,
SUBTRACT 1 FROM S-REP-LEN,
GO TO APPL-MOVE-LOOP.
APPLED.
GO TO APPL-LIN-2.
DONE-SNT.
MOVE 0 TO S-PNT.
DONE-LP.
ADD 1 TO S-PNT.
IF S-PNT > 1000, GO TO DONE-LP-2.
IF FREE-CHAR (S-PNT) NOT = ".", GO TO DONE-LP.
DONE-LP-2.
ADD 1 TO S-PNT.
IF S-PNT NOT > 1000, MOVE SPACE TO FREE-CHAR (S-PNT), GO TO DONE-LP-2.
MOVE FREE-CORE TO LINE-STF.
WRITE O-LINE FROM LINE-TO-OUTPUT, AFTER ADVANCING 1 LINES.
GO TO READ-LINE.
APPL-ATTRIB.
MOVE S-INDX TO S-INDX-SV, MOVE S-PNT TO S-PNT-SV.
APPL-AT-LOOP.
MOVE S-INDX-SV TO S-INDX.
APPL-AT-LOOP2.
IF FREE-CHAR (S-PNT) IS NOT ALPHABETIC, AND S-CHAR (S-INDX)
IS NOT ALPHABETIC, AND S-INDX > S-INDX-SV + 1, GO TO
APPL-AT-LOOP3.
IF FREE-CHAR (S-PNT) = S-CHAR (S-INDX),
ADD 1 TO S-PNT, S-INDX, GO TO APPL-AT-LOOP2;
ELSE, PERFORM INC-S-PNT UNTIL FREE-CHAR (S-PNT)
IS NOT ALPHABETIC,
IF FREE-CHAR (S-PNT) = "+" OR = "-", GO TO APPL-AT-LOOP;
ELSE GO TO APPLY-LOOP3.
APPL-AT-LOOP3.
PERFORM INC-S-INDX UNTIL S-CHAR (S-INDX) IS NOT
ALPHABETIC, MOVE S-PNT TO S-PNT-SV, MOVE S-INDX
TO S-INDX-SV, IF S-CHAR (S-INDX) IS
NOT = ")", GO TO APPL-AT-LOOP.
APPL-AT-RTN.
PERFORM INC-S-PNT UNTIL FREE-CHAR (S-PNT) = "#". ADD 1 TO S-INDX, GO TO APPLY-LOOP2.
ALREDY-DEF.
DISPLAY "ALREADY DEFINED".
GO TO NOTFND2.
NOT-FOUND.
DISPLAY I-BUF.
MOVE SPACES TO LINE-SV.
MOVE "^" TO LINE-SV-CHR (ILOOP).
DISPLAY LINE-SV.
DISPLAY "CANNOT FIND WORD OR PHRASE."
NOTFND2.
DISPLAY "LINE MISSPELLED? ", WITH NO ADVANCING.
ACCEPT REPLY.
IF REPLY = "YES", GO TO RE-TYPE.
DISPLAY "?LEXEIB WHAT DO YOU WANT, EGG IN YOUR BEER?".
DISPLAY " DEFINE THE PHRASE WITH TECO".
STOP RUN.
NOTFND3.
DISPLAY "MORE? ", WITH NO ADVANCING.
ACCEPT REPLY.
IF REPLY = "YES", GO TO NOTFND2;
ELSE GO TO READ-LINE-2.
RE-TYPE.
DISPLAY "REPLACMENT LINE?".
ACCEPT I-BUF.
DISPLAY "NEW LINE:".
DISPLAY I-BUF.
DISPLAY "OK? ", WITH NO ADVANCING.
ACCEPT REPLY.
IF REPLY = "YES", MOVE R-TYPE-M TO LINE-STF,
WRITE O-LINE FROM LINE-TO-OUTPUT, AFTER ADVANCING 1 LINE,
MOVE I-BUF TO LINE-STF,
WRITE O-LINE FROM LINE-TO-OUTPUT AFTER ADVANCING 1 LINE,
GO TO NOTFND3;
ELSE GO TO NOTFND3.
FND-CNTR.
ADD 1 TO MID-PNT.
IF D-CHAR (MID-PNT) = ".", ADD 1 TO N-DOTS.
GET-NEXT-CHAR.
ADD 1 TO BASE2.
IF BASE2 > 120, MOVE 1 TO BASE2, ADD 1 TO BASE, READ D-FILE; INVALID KEY, GO TO INV-KEY.
INV-KEY.
DISPLAY "?LEXINV INVALID KEY, FOR EXPLAINATIO", WITH NO ADVANCING.
STOP "N".
DISPLAY "ATTEMPT TO READ A NON-EXISTANT RECORD".
STOP RUN.
NO-ROOM.
DISPLAY "?LEXNRM NO ROOM IN DICTIONARY FILE, FOR EXPLAINATIO", WITH NO ADVANCING.
STOP "N".
DISPLAY "THE FILE LIMITS OF THE DICTIONARY FILE".
DISPLAY "HAVE BEEN EXCEEDED.".
STOP RUN.
WRAP-UP.
MOVE SPEL-LINE TO LINE-STF, WRITE O-LINE FROM LINE-TO-OUTPUT
AFTER ADVANCING 1 LINES.
MOVE LINE-TOTALS TO LINE-STF, WRITE O-LINE FROM LINE-TO-OUTPUT
AFTER ADVANCING 1 LINES.
END-PAR.
CLOSE IN-FILE, D-FILE, OUT-FILE.
DISPLAY "DONE".
STOP RUN.
CHK-FOR-CHAR.
ADD SIGN TO BASE2.
INC-S-PNT.
ADD 1 TO S-PNT.
INC-S-INDX.
ADD 1 TO S-INDX.
LINE-TOO-LONG.
DISPLAY I-BUF.
DISPLAY "^ LINE TOO LONG -- IGNORED."
GO TO READ-LINE.
READ-ID.
MOVE 1 TO ID-PTR.
IF ERR-PNT > 1, DISPLAY I-BUF, DISPLAY "^ LINE IGNORED, ID ACCEPTED".
MOVE ERR-PNT TO ERR-PNT-2
ADD 1 TO ERR-PNT-2.
READ-ID-LOOP.
IF ERR-PNT-2 > 120, DISPLAY I-BUF,
DISPLAY "^ NO CLOSING " QUOTE "$" QUOTE ".",
GO TO READ-LINE.
MOVE I-CHAR (ERR-PNT-2) TO I-CHAR (ERR-PNT)
IF I-CHAR (ERR-PNT) = "$", GO TO READ-LINE;
ELSE MOVE I-CHAR (ERR-PNT) TO ID-CHAR (ID-PTR),
ADD 1 TO ID-PTR, ERR-PNT-2, GO TO READ-ID-LOOP.