-- PGSScan.pgs
-- Copyright (C) 1985, 1986 by Xerox Corporation. All rights reserved.
-- DO NOT CONVERT TO TIOGA FORMAT! (PGS requires the mesa-style comments)
-- Last Edited by: Maxwell, August 10, 1983 10:32 am
-- Russ Atkinson (RRA) March 19, 1985 10:03:11 am PST
-- last modified by Satterthwaite, May 22, 1986 10:39:31 am PDT
-- Doug Wyatt, May 15, 1986 5:36:01 pm PDT
-- PGS [defs: PGSParseTable, grammar: PGS] ← PGSScan.pgs
DIRECTORY
IO: TYPE USING [STREAM],
P1: TYPE USING [
ActionStack, Index, LinkStack, Token, Value, ValueStack, nullValue, InputLoc],
ParseTable: TYPE USING [
endMarker, HashIndex, HashTableRef, IndexTableRef, ProdDataRef,
ScanTableRef, TableRef, TSymbol, VocabularyRef,
tokenID, tokenNUM, tokenTAB3, tokenTAB4],
PGSConDefs: TYPE,
PGSTypes: TYPE,
Rope: TYPE USING [ROPE];
PGSScan: PROGRAM
IMPORTS P1, PGSConDefs
EXPORTS P1, PGSConDefs = {
OPEN P1, ParseTable, PGSConDefs;
-- TreeBuild: interpreter section
-- interpreter state
check: NAT = 3;
warning: NAT = 0;
specErrorCases: NAT = 5;
token, numRhsChars: CARDINAL;
lineWidth: INTEGER;
insertFlag: CARDINAL;
HashChainArray: TYPE = ARRAY [1..symTabSize/4] OF CARDINAL;
hashChain: REF HashChainArray;
-- local data base (supplied by parser)
v: P1.ValueStack;
l: P1.LinkStack;
q: P1.ActionStack;
prodData: ProdDataRef;
-- initialization/termination
AssignDescriptors: PUBLIC PROC[
qd: P1.ActionStack, vd: P1.ValueStack, ld: P1.LinkStack, pp: ProdDataRef] = {
q ← qd; v ← vd; l ← ld; prodData ← pp};
OutToken: PUBLIC PROC[symbol: CARDINAL] RETURNS[CARDINAL] = {
IF symbol = 0 THEN {outstring["* * *"]; RETURN[("* * *"L).length]};
FOR i: CARDINAL IN [0..symInfo[symbol].length) DO
outchar[symTab[symbol*tokenSize+i],1] ENDLOOP;
RETURN [symInfo[symbol].length]};
-- the interpretation rules
prix, chix: CARDINAL; --indexes into prodInfo and rhsChar
rhsFlag: BOOL;
lastSymbol, lhsDef: CARDINAL;
ProcessQueue: PUBLIC PROC[qI, top: CARDINAL] = {
i, j, k: CARDINAL;
-- local procedures
PrintTableHead: PROC [c: CHAR] = {
IF flags[echo] THEN {outeol[2]; outstring["||TABLE"]; outchar[c,1]; outeol[1]}};
SetRuleChain: PROC [rule: CARDINAL, chain: BOOL] = {
FixLastProd[];
IF prix=prodInfo.length THEN --production table overflow
prodInfo ← ExpandProdInfo[prodInfo, prodInfo.length/8];
prodInfo[prix].chain ← chain;
numRules ← MAX[numRules, rule];
IF rule>maxRule THEN Error[check+10,-5,InputLoc[]] ELSE prodInfo[prix].rule ← rule};
FixLastProd: PROC = {
prodInfo[prix-1].lhs ← lhsDef;
IF prodInfo[prix-1].count=0 THEN tokenInfo[lhsDef-eofMark].empty ← TRUE;
IF rhsFlag THEN { -- too many rhsChars
rhsFlag ← FALSE; Error[check+5, (prix-1+specErrorCases), InputLoc[]]}};
ProdHeader: PROC [new: BOOL] = {
prodInfo[prix].index ← chix;
IF lhsDef>eofMark THEN {
IF tokenInfo[lhsDef-eofMark].count=alternateLim THEN {
Error[check+1, lhsDef,InputLoc[]]; --too many alternatives
tokenInfo[lhsDef-eofMark].count ←1};
tokenInfo[lhsDef-eofMark].count ← tokenInfo[lhsDef-eofMark].count + 1};
IF flags[echo] THEN {
lineWidth ← outbufLim-tokenSize-14;
outeol[IF new THEN 2 ELSE 1];outnum[prix,3];
outstring[IF prodInfo[prix].chain THEN " C " ELSE " "];
outnum[prodInfo[prix].rule,3]; outchar[' ,2];
outchar[' ,tokenSize-(IF new THEN OutToken[lhsDef] ELSE 0)];
outstring[IF new THEN " ::= " ELSE " | "]};
prix ← prix+1};
LhsSymbol: PROC [symbol: CARDINAL] = {
lhsDef ← symbol;
IF lhsDef<=eofMark THEN Error[check+4,lhsDef,InputLoc[]]
-- undefined or terminal symbol before ::=
ELSE
IF tokenInfo[lhsDef-eofMark].index = 0 THEN tokenInfo[lhsDef-eofMark].index ← prix
ELSE Error[check+2,lhsDef,InputLoc[]]; --multiple definitions
ProdHeader[TRUE]};
-- end of local procedures
FOR qj: CARDINAL IN [0..qI) DO
top ← top-q[qj].tag.pLength+1;
SELECT prodData[q[qj].transition].rule FROM
0 => -- TABLE: PGSParseData TYPE: ParseTable EXPORTS: SELF
-- GOAL: grammar
-- TERMINALS:
-- symbol num '? '| "::=" 'C "||TABLE1" "||TABLE2" "||TABLE3"
-- "||TABLE4" "||INPUT" "||CHAIN" "||LISTS" "||PRINTLR"
-- "||PRINTLALR" "||FIRST" "||IDS" "GOAL"
-- ALIASES: symbol tokenID num tokenNUM '? tokenQUERY
-- "||TABLE3" tokenTAB3 "||TABLE4" tokenTAB4 '? initialSymbol
-- PRODUCTIONS:
-- grammar ::= '? head ruleset
BEGIN FixLastProd[]; numProd ← prix-1; numRhsChars ← chix-1; i ← 1;
IF flags[echo] THEN outeol[1];
IF numProd > pssLim OR totalTokens > pssLim THEN Error[check+6,0,InputLoc[]];
hashChain ← NIL;
WHILE symInfo[i].used AND i<=totalTokens DO
IF i>eofMark AND tokenInfo[i-eofMark].index = 0 THEN EXIT; i ← i+1;
ENDLOOP;
IF i <= totalTokens THEN {
defflag: BOOL ← FALSE;
lineWidth ← 0; Error[warning+3,0,InputLoc[]]; seterrstream[];
FOR i IN [i..totalTokens] DO
j ← 0; IF ~symInfo[i].used THEN j ← j+1;
IF i > eofMark AND tokenInfo[i-eofMark].index = 0 THEN j ← j+2;
IF j # 0 THEN {
IF (lineWidth ← lineWidth+(k←(11+j)/2)) > outbufLim THEN {
outeol[1]; lineWidth ← k};
outnum[i,5];
IF j#2 THEN outchar['U,1] ELSE defflag ← TRUE;
IF j>1 THEN outchar['D,1]};
ENDLOOP;
outeol[1]; resetoutstream[];
IF defflag THEN
Error[check+3,-2,InputLoc[]]}; -- nonterminal used but not defined
FOR i IN [1..numProd] DO
IF prodInfo[i].chain THEN
IF prodInfo[i].count # 1 OR rhsChar[prodInfo[i].index] <= eofMark THEN {
Error[warning+2, -(i+specErrorCases), InputLoc[]];
prodInfo[i].chain ← FALSE};
ENDLOOP;
FinishInput[];
END;
1 => -- head ::= directives terminals nonterminals "||TABLE4"
-- head ::= directives terminals nonterminals aliases "||TABLE4"
BEGIN totalTokens ← lastSymbol; PrintTableHead['4];
tokenInfo ← MakeTokenInfo[totalTokens-eofMark+1];
numRules ← 0;
prodInfo ← MakeProdInfo[maxProd+1];
rhsChar ← MakeRhsChar[maxRhsSymbols+1];
FOR i IN [0..totalTokens-eofMark] DO
tokenInfo[i] ← [count:0, empty:FALSE, index:0] ENDLOOP;
prodInfo[0] ← [count:2, rule:0, chain:FALSE, lhs:0, index:0];
FOR i IN [1..maxProd] DO
prodInfo[i] ← [count:0, rule:0, chain:FALSE, lhs:0, index:0] ENDLOOP;
IF flags[echo] THEN {
outeol[1]; outchar[' ,20]; outstring["GOAL ::= "];
[] ← OutToken[eofMark+1]; outchar[' ,1]; [] ← OutToken[eofMark]};
rhsChar[0] ← eofMark+1; rhsChar[1] ← eofMark;
symInfo[eofMark+1].used ← symInfo[eofMark].used ← TRUE;
prix ← 1; chix ← 2; lhsDef ← 0; rhsFlag ← FALSE;
END;
2 => -- directives ::=
{flags ← ALL[FALSE]; l[top] ← InputLoc[]};
3 => -- directive ::= "||INPUT"
{flags[echo] ← TRUE; setoutstream[".echo"]};
4 => -- directive ::= "||CHAIN"
flags[chain] ← TRUE;
5 => -- directive ::= "||LISTS"
flags[lists] ← TRUE;
6 => -- directive ::= "||PRINTLR"
flags[printLR] ← TRUE;
7 => -- directive ::= "||PRINTLALR"
flags[printLALR] ← TRUE;
8 => -- directive ::= "||FIRST"
flags[first] ← TRUE;
9 => -- directive ::= "||IDS"
flags[ids] ← TRUE;
10 => -- terminals ::= "||TABLE1"
BEGIN
IF flags[echo] THEN {
outeol[1];
FOR opt: PGSTypes.Options IN PGSTypes.Options DO
IF flags[opt] THEN outstring[
SELECT opt FROM
echo => "||INPUT ",
chain => "||CHAIN ",
lists => "||LISTS ",
printLR => "||PRINTLR ",
printLALR => "||PRINTLALR ",
first => "||FIRST ",
ENDCASE => "||IDS "];
ENDLOOP};
PrintTableHead['1];
END;
11 => -- terminals ::= terminals discard symbol
-- nonterminals ::= nonterminals discard symbol
BEGIN lastSymbol ← v[top+2].s;
IF flags[echo] THEN {
outnum[lastSymbol, 3]; outchar[' , 2];
[] ← OutToken[lastSymbol];
outeol[1]};
END;
12 => -- nonterminals ::= "||TABLE2"
BEGIN PrintTableHead['2]; eofMark ← lastSymbol;
nextAlias ← 0; -- assert TABLE3 empty in case it is omitted
aliases ← NIL;
END;
13 => -- aliases ::= "||TABLE3"
BEGIN PrintTableHead['3];
aliases ← MakeAliases[64];
END;
14 => -- aliases ::= aliases symbol symbol
BEGIN IF v[top+1].s>eofMark THEN Error[check+7,v[top+1].s,InputLoc[]];
IF v[top+2].s<=eofMark THEN Error[check+8,v[top+2].s,InputLoc[]];
IF nextAlias=aliases.length THEN
aliases ← ExpandAliases[aliases, aliases.length/8];
aliases[nextAlias] ← [v[top+1].s,v[top+2].s]; nextAlias ← nextAlias+1;
IF flags[echo] THEN {
outchar[' ,tokenSize+1-OutToken[v[top+1].s]]; outchar[' ,1];
j ← v[top+2].s*tokenSize;
FOR i IN [j..j+tokenSize) WHILE symTab[i]#0C DO outchar[symTab[i],1] ENDLOOP;
outeol[1]};
END;
15 => -- discard ::=
l[top] ← InputLoc[]; -- keep the parser error recovery happy
16 => -- rulegroup ::= symbol "::="
{SetRuleChain[prix, FALSE]; LhsSymbol[v[top].s]};
17 => -- rulegroup ::= prefix symbol "::="
LhsSymbol[v[top+1].s];
18 => -- rulegroup ::= rulegroup symbol "::="
{SetRuleChain[prix, FALSE]; LhsSymbol[v[top+1].s]};
19 => -- rulegroup ::= rulegroup prefix symbol "::="
LhsSymbol[v[top+2].s];
20 => -- rulegroup ::= rulegroup '|
{SetRuleChain[prix, FALSE]; ProdHeader[FALSE]};
21 => -- rulegroup ::= rulegroup prefix '|
ProdHeader[FALSE];
22 => -- rulegroup ::= rulegroup symbol
BEGIN i ← v[top+1].s; symInfo[i].used ← TRUE;
IF i=eofMark OR i=eofMark+1 THEN Error[check+9,0,InputLoc[]]; --goal symbols
IF flags[echo] THEN {
IF lineWidth<symInfo[i].length THEN {
outeol[1]; outchar[' ,tokenSize+18]; lineWidth ← outbufLim - tokenSize-18};
IF (lineWidth ← (lineWidth-OutToken[i]-1)) > 0 THEN outchar[' , 1]};
IF chix=rhsChar.length THEN
rhsChar ← ExpandRhsChar[rhsChar, rhsChar.length/8];
rhsChar[chix]←i; chix ← chix +1;
IF prodInfo[prix-1].count = rhsLim THEN {
prodInfo[prix-1].count ← 1; rhsFlag ← TRUE};
prodInfo[prix-1].count ← prodInfo[prix-1].count+1;
END;
23 => -- prefix ::= num
SetRuleChain[v[top].s, FALSE];
24 => -- prefix ::= num num
-- prefix ::= '? num
SetRuleChain[v[top+1].s, FALSE];
25 => -- prefix ::= discard 'C
SetRuleChain[prix, TRUE];
26 => -- prefix ::= discard 'C num
SetRuleChain[v[top+2].s, TRUE];
27 => -- prefix ::= '?
SetRuleChain[prix, FALSE];
28 => -- directives ::= directives directive
-- discard ::= num
-- discard ::= '?
-- ruleset ::=C rulegroup
-- ruleset ::= goalrule rulegroup
-- goalrule ::= "GOAL" "::=" symbol symbol
NULL;
ENDCASE => ERROR;
ENDLOOP};
-- the following procedure is called from the ScanReset if no errors
FinishInput: PROC = {
emptyFlag: BOOL ← TRUE;
j, k: CARDINAL;
-- compute nonterminals deriving empty
WHILE emptyFlag DO
emptyFlag ← FALSE;
FOR i: CARDINAL IN [1..totalTokens-eofMark] DO -- each nonterminal
IF tokenInfo[i].empty THEN LOOP; --which does not derive empty
j ← tokenInfo[i].index;
FOR prix: CARDINAL IN [j..j+tokenInfo[i].count) DO
-- each production of the nonterminal
k ← prodInfo[prix].index;
FOR chix: CARDINAL IN [k..k+prodInfo[prix].count) DO -- each rhs character
IF rhsChar[chix]<=eofMark OR ~tokenInfo[rhsChar[chix]-eofMark].empty THEN EXIT;
REPEAT FINISHED => {tokenInfo[i].empty ← emptyFlag ← TRUE; EXIT};
ENDLOOP
ENDLOOP
ENDLOOP
ENDLOOP};
-- the following procedure outputs the data structure contents in the tables:
-- PRODUCTIONINFO TOKENINFO SYMINFO
-- num count rule chain lhs index count empty index link used length symbol
-- 4 1 3 5 1 4 5 2 3 1 5 2 4 1 3 1 ...
CheckOut: PUBLIC PROC = {
IF flags[ids] THEN {
seterrstream[]; outeol[1];
outstring[" PRODUCTIONINFO TOKENINFO SYMINFO"];
FOR i: CARDINAL IN [0..MAX[numProd,totalTokens]] DO
outeol[1]; outnum[i,4]; outchar[' ,1];
IF i>numProd THEN outchar[' ,20]
ELSE {
outnum[prodInfo[i].count,3]; outnum[prodInfo[i].rule,5];
outchar[IF prodInfo[i].chain THEN 'C ELSE ' , 1];
outnum[prodInfo[i].lhs,4]; outnum[prodInfo[i].index,5]; outchar[' ,2]};
IF i IN (0..totalTokens] THEN {
IF i<=eofMark THEN outchar[' ,11] ELSE {
outnum[tokenInfo[i-eofMark].count,3];
outchar[IF tokenInfo[i-eofMark].empty THEN 'E ELSE ' ,1];
outnum[tokenInfo[i-eofMark].index,5]; outchar[' ,2]};
outnum[symInfo[i].link,4]; outchar[IF symInfo[i].used THEN 'U ELSE ' ,1];
outnum[symInfo[i].length,3]; outchar[' ,1]; [] ← OutToken[i]}
ENDLOOP;
outeol[1]; outstring["RHSCHAR"]; lineWidth ← outbufLim;
FOR i: CARDINAL IN [0..numRhsChars] DO
lineWidth ← lineWidth+tokenSize+1;
IF lineWidth > outbufLim THEN {outeol[1]; outnum[i,4]; lineWidth ← 4};
outchar[' ,1]; [] ← OutToken[rhsChar[i]];
ENDLOOP;
outeol[1]; resetoutstream[]}};
-- error recovery
TokenValue: PUBLIC PROC[s: TSymbol] RETURNS[P1.Value] = {RETURN [P1.nullValue]};
-- Scanner: text input and error routines
-- table installation
tablePtr: ParseTable.TableRef;
hashTab: HashTableRef;
scanTab: ScanTableRef;
vocab: VocabularyRef;
vocabIndex: IndexTableRef;
InstallScanTable: PUBLIC PROC[base: ParseTable.TableRef] = {
tablePtr ← base;
hashTab ← @tablePtr[tablePtr.scanTable.hashTab];
scanTab ← @tablePtr[tablePtr.scanTable.scanTab];
vocab ← LOOPHOLE[@tablePtr[tablePtr.scanTable.vocabBody]];
vocabIndex ← @tablePtr[tablePtr.scanTable.vocabIndex]};
-- scanner state
stream: IO.STREAM ← NIL; -- the input stream (a dummy for now)
Logger: PROC[PROC[log: IO.STREAM]] ← NIL;
NUL: CHAR = '\000;
buffer: REF TEXT ← NIL; -- token assembly area
nTokens: CARDINAL; -- token count
nErrors: CARDINAL; -- lexical errors
char: CHAR; -- current (most recently scanned) character
tI: CARDINAL; -- its (stream) index
eof: BOOL;
NextChar: PROC = { -- also expanded inline within Atom
tI ← tI + 1; [char, eof] ← inchar[]};
NextToken: PUBLIC PROC RETURNS[t: Token] = {
OPEN t;
LocateToken: PROC[string: REF TEXT] RETURNS[CARDINAL] = {
-- returns token corresponding to string
i, j: CARDINAL;
j ← hashChain[(string.length*256+(string[0].ORD)) MOD (symTabSize/4) + 1];
WHILE j # 0 DO
IF symInfo[j].length = string.length THEN {
i ← j*tokenSize;
FOR k: CARDINAL IN [0..string.length) DO
IF symTab[i+k]#string[k] THEN EXIT
REPEAT FINISHED => RETURN [j]
ENDLOOP};
j ← symInfo[j].link;
ENDLOOP;
RETURN [0]};
TokenToSymTab: PROC[string: REF TEXT, token: CARDINAL] = {
i, j: CARDINAL;
i ← token*tokenSize;
FOR j IN [0..string.length) DO symTab[i+j] ← string[j] ENDLOOP;
symInfo[token].length ← string.length; symInfo[token].used ← FALSE;
j ← (string.length*256+(string[0].ORD)) MOD (symTabSize/4) + 1;
symInfo[token].link ← hashChain[j]; hashChain[j] ← token};
TokenOrId: PROC[sub: CARDINAL] = {
j, s1, s2: CARDINAL;
h: HashIndex;
WHILE char NOT IN [NUL..' ] DO
IF sub<tokenSize THEN buffer[sub] ← char;
sub ← sub + 1; NextChar[];
ENDLOOP;
IF sub>tokenSize THEN {
buffer.length ← sub ← tokenSize; Error[1,-1,index]}; --overlength
IF sub = 1 THEN {
class ← scanTab[buffer[0]];
IF class # 0 THEN RETURN};
j ← buffer[0] - 0C;
h ← ((j*128-j) + CARDINAL[buffer[sub-1]-0C]) MOD HashIndex.LAST + 1;
WHILE (j ← hashTab[h].symbol) # 0 DO
IF vocabIndex[j]-(s2←vocabIndex[j-1]) = sub THEN
FOR s1 IN [0 .. sub) DO
IF buffer[s1] # vocab.text[s2] THEN EXIT;
s2 ← s2+1;
REPEAT FINISHED => {
IF j = tokenTAB3 THEN insertFlag ← 2 ELSE
IF j = tokenTAB4 THEN insertFlag ← 3;
IF j<=tokenNUM THEN EXIT;
class ← j; RETURN};
ENDLOOP;
IF (h ← hashTab[h].link) = 0 THEN EXIT;
ENDLOOP;
buffer.length ← sub; class ← tokenID; value ← [scalar[LocateToken[buffer]]];
SELECT insertFlag FROM
1 =>
-- reading terminals and nonterminals
IF value # P1.nullValue THEN Error[check+2,value.s,index] -- multiply defined symbol
ELSE {
IF token=symTab.length THEN {
symTab ← ExpandSymTab[symTab, symTab.length/16];
symTab ← ExpandSymTab[symTab, symInfo.length/16];
};
TokenToSymTab[buffer, token]; value ← [scalar[token]]; token ← token+1};
2 =>
-- processing aliases
IF value=P1.nullValue THEN {
s1 ← token*tokenSize;
IF token=symTab.length THEN
symTab ← ExpandSymTab[symTab, symTab.length/16];
FOR j IN [0..buffer.length) DO symTab[s1+j] ← buffer[j] ENDLOOP;
value ← [scalar[token]]; token ← token+1};
3 =>
-- processing productions
IF value = P1.nullValue THEN Error[check+3,-3,index]; --symbol not defined
ENDCASE};
DO
WHILE char IN [NUL..' ] DO
SELECT char FROM
'\032 --↑Z-- =>
UNTIL char = '\n DO
IF eof THEN GO TO EndFile;
NextChar[];
ENDLOOP;
ENDCASE;
IF eof THEN GO TO EndFile;
NextChar[];
ENDLOOP;
index ← tI; value ← P1.nullValue;
SELECT char FROM
IN ['0..'9] => {
val: CARDINAL ← 0;
valid: BOOL ← TRUE;
maxVal: CARDINAL = CARDINAL.LAST;
WHILE char IN ['0..'9] DO
IF valid THEN {
d: [0..9] = char.ORD-'0.ORD;
valid ← val<maxVal/10 OR (val=maxVal/10 AND d<=(maxVal MOD 10));
IF valid THEN val ← 10*val+d};
NextChar[];
ENDLOOP;
IF ~valid THEN val ← maxVal;
class ← tokenNUM; value ← [scalar[val]]; GO TO GotNext};
'- => {
NextChar[];
IF char # '- THEN {buffer[0] ← '-; TokenOrId[1]; GO TO GotNext};
char ← NUL;
DO
pChar: CHAR = char;
IF eof THEN GO TO EndFile;
NextChar[];
SELECT char FROM
'- => IF pChar = '- THEN EXIT;
'\n => EXIT;
ENDCASE;
ENDLOOP;
NextChar[]};
ENDCASE => {TokenOrId[0]; GO TO GotNext};
REPEAT
GotNext => NULL;
EndFile => {class ← endMarker; index ← tI; value ← P1.nullValue};
ENDLOOP;
nTokens ← nTokens + 1;
RETURN};
-- initialization/finalization
ScanInit: PUBLIC PROC[
source: IO.STREAM, logger: PROC[PROC[log: IO.STREAM]]] = {
stream ← source; Logger ← logger;
buffer ← NEW[TEXT[tokenSize]];
tI ← 0; [char, eof] ← inchar[];
nTokens ← nErrors ← 0; buffer.length ← tokenSize;
-- initialise symbol table
token ← 1; insertFlag ← 1;
symTab ← MakeSymTab[(symTabSize+1)*tokenSize];
symInfo ← MakeSymInfo[symTabSize+1];
FOR i: CARDINAL IN [1..symTabSize] DO
symInfo[i] ← [link:0, length:0, used:FALSE] ENDLOOP;
hashChain ← NEW[HashChainArray ← ALL[0]]
};
ScanReset: PUBLIC PROC = {
stream ← NIL; Logger ← NIL;
CheckOut[];
buffer ← NIL};
ScanStats: PUBLIC PROC RETURNS[CARDINAL, CARDINAL] = {
RETURN [nTokens, nErrors]};
-- error handling
ResetScanIndex: PUBLIC PROC[index: CARDINAL] RETURNS[success: BOOL←TRUE] = {
IF index = tI THEN RETURN;
setindex[index];
[char, eof] ← inchar[]; tI ← index};
PrintTextLine: PROC[origin: CARDINAL] RETURNS[start: CARDINAL] = {
lineIndex: CARDINAL;
char: CHAR;
n: [1..100];
start ← lineIndex ← origin;
FOR n IN [1..100] UNTIL lineIndex = 0 DO
lineIndex ← lineIndex - 1;
setindex[lineIndex];
IF inchar[].c = '\n THEN EXIT;
start ← lineIndex;
ENDLOOP;
setindex[start];
FOR n IN [1..100] UNTIL ([c: char] ← inchar[]).end DO
SELECT char FROM
'\n, '\032 --↑Z-- => EXIT;
ENDCASE => outchar[char,1];
ENDLOOP;
outeol[1]; RETURN};
ErrorContext: PUBLIC PROC[
to: IO.STREAM, -- a dummy for now, to match ProtoP1
message: Rope.ROPE, tokenIndex: CARDINAL] = {
saveIndex: CARDINAL = getindex[];
origin: CARDINAL = tokenIndex;
char: CHAR;
setindex[PrintTextLine[origin]];
UNTIL getindex[] = origin OR ([c: char] ← inchar[]).end DO
outchar[IF char = '\n THEN '\n ELSE ' ,1];
ENDLOOP;
outstring["↑ ["]; outnum[tokenIndex,1];
outchar['],1]; outeol[1]; outstring[message];
setindex[saveIndex]};
Error: PROC[code: CARDINAL, control: INTEGER, index: CARDINAL] = {
Inner: PROC[log: IO.STREAM -- a dummy for now--] ~ {
ErrorContext[log,
SELECT code FROM
1 => "WARNING - Overlength symbol (increase TOKENSIZE?) truncated to - ",
2 => "WARNING - Not a chain production - ",
3 => "WARNING - Unused(U) or undefined(D)symbols (refer to TABLE1 and 2)",
4 => "ERROR - Nonterminal with too many rules (increase ALTERNATELIM?) - ",
5 => "ERROR - Multiple definitions of symbol - ",
6 => "ERROR - Symbol not defined - ",
7 => "ERROR - Terminal precedes ::= - ",
8 => "ERROR - Too many rhs symbols in production (increase RHSLIM?) - ",
9 => "ERROR - Internal field will overflow - increase PSSLIM",
10 => "ERROR - Aliased symbol not a terminal symbol - ",
11 => "ERROR - Aliases must not be terminal symbols - ",
12 => "ERROR - Goal symbols used in rhs",
13 => "ERROR - Number greater than ",
ENDCASE => NIL,
index];
SELECT -control FROM
<0 => [] ← OutToken[control];
0 => NULL;
1 => outstring[LOOPHOLE[buffer]];
2 => outstring["see previous message"];
3 => {outstring[LOOPHOLE[buffer]]; outstring[" not in TABLE1 or 2"]};
4 => NULL; -- not used
5 => outstring["MAXRULE"];
ENDCASE => outnum[-control-specErrorCases, 5];
outeol[2]};
Logger[Inner];
IF code>check THEN nErrors ← nErrors+1 ELSE warningsLogged ← TRUE};
}.