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.