DIRECTORY
ConvertUnsafe: TYPE USING [ToRope],
IO: TYPE USING [STREAM],
P1: TYPE USING [
ActionStack, LinkStack, Token, Value, ValueStack, nullValue,
InputLoc],
ParseTable: FROM "PGSParseTable" USING [
endMarker, HashIndex, HashTableRef, IndexTableRef, ProdDataRef,
ScanTableRef, TableRef, TSymbol, VocabularyRef,
tokenID, tokenNUM, tokenTAB3, tokenTAB4],
PGSConDefs: TYPE USING [
alternateLim, maxProd, maxRhsSymbols, maxRule, outbufLim, pssLim, rhsLim,
symTabSize, tokenSize, wordsForToken,
aliases, eofMark, flags, nextAlias, numProd, prodInfo, numRules, rhsChar,
symInfo, symTab, tokenInfo, totalTokens, warningsLogged,
Expand, MakeArray,
getindex, inchar, outchar, outeol, outnum, outstring,
resetoutstream, setindex, setoutstream, seterrstream],
PGSTypes: TYPE USING [AliasEntry, Options, ProdEntry, SymTabEntry, TokenEntry];

Scanner: PROGRAM
IMPORTS ConvertUnsafe, P1, PGSConDefs 
EXPORTS P1, PGSConDefs = {
OPEN  P1, ParseTable, PGSConDefs;



check: CARDINAL = 3;
warning: CARDINAL = 0;
specErrorCases: CARDINAL = 5;

token, numRhsChars: CARDINAL;
lineWidth: INTEGER;
insertFlag: CARDINAL;

hashChain: LONG POINTER TO ARRAY [1..symTabSize/4] OF CARDINAL;


v: P1.ValueStack;
l: P1.LinkStack;

q: P1.ActionStack;

prodData: ProdDataRef;


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]};



prix, chix: CARDINAL; --indexes into prodInfo and rhsChar
rhsFlag: BOOL; 
lastSymbol, lhsDef: CARDINAL;

ProcessQueue: PUBLIC PROC [qI, top: CARDINAL] = {
i, j, k: CARDINAL;

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 _ LOOPHOLE[
Expand[prodInfo,PGSTypes.ProdEntry.SIZE,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[]]
ELSE
IF tokenInfo[lhsDef-eofMark].index = 0 THEN tokenInfo[lhsDef-eofMark].index _ prix
ELSE Error[check+2,lhsDef,InputLoc[]]; --multiple definitions
ProdHeader[TRUE]};

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
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[]];
scratch.FREE[@hashChain];
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"
BEGIN totalTokens _ lastSymbol; PrintTableHead['4];
tokenInfo _ LOOPHOLE[
MakeArray[totalTokens-eofMark+1,PGSTypes.TokenEntry.SIZE]];
numRules _ 0;
prodInfo _ LOOPHOLE[MakeArray[maxProd+1,PGSTypes.ProdEntry.SIZE]];
rhsChar _ LOOPHOLE[MakeArray[maxRhsSymbols+1,CARDINAL.SIZE]];
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
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 _ LOOPHOLE[MakeArray[64,PGSTypes.AliasEntry.SIZE]];
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 _ LOOPHOLE[Expand[aliases,PGSTypes.AliasEntry.SIZE,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 _ LOOPHOLE[Expand[rhsChar,CARDINAL.SIZE,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
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
NULL;
ENDCASE => ERROR;
ENDLOOP};


FinishInput: PROC = {
emptyFlag: BOOL _ TRUE;
j, k: CARDINAL;
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
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};


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[]}};



TokenValue: PUBLIC PROC [s: TSymbol] RETURNS [P1.Value] = {RETURN [P1.nullValue]};





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]};


stream: IO.STREAM _ NIL;		-- the input stream (a dummy for now)
Logger: PROC [PROC [log: IO.STREAM]] _ NIL;

scratch: UNCOUNTED ZONE _ NIL;

NUL: CHAR = '\000;

buffer: LONG STRING _ 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[]};


Atom: PUBLIC PROC RETURNS [t: Token] = {
OPEN t;

LocateToken: PROC [string: LONG STRING] RETURNS [CARDINAL] = {
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: LONG STRING, 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 =>
IF value # P1.nullValue THEN Error[check+2,value.s,index]  -- multiply defined symbol
ELSE {
IF token=symTab.LENGTH THEN {
symTab _ LOOPHOLE[Expand[LOOPHOLE[symTab],wordsForToken,
symTab.LENGTH/16]];
symInfo _ LOOPHOLE[Expand[symInfo,PGSTypes.SymTabEntry.SIZE,
symInfo.LENGTH/16]]};
TokenToSymTab[buffer, token]; value _ [scalar[token]]; token _ token+1};
2 =>
IF value=P1.nullValue THEN {
s1 _ token*tokenSize;
IF token=symTab.LENGTH THEN
symTab _ LOOPHOLE[Expand[LOOPHOLE[symTab],wordsForToken,
symTab.LENGTH/16]];
FOR j IN [0..buffer.length) DO symTab[s1+j] _ buffer[j] ENDLOOP;
value _ [scalar[token]]; token _ token+1};
3 =>
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};



ScanInit: PUBLIC PROC [
source: IO.STREAM,
scratchZone: UNCOUNTED ZONE,
logger: PROC [PROC [log: IO.STREAM]]] = {
scratch _ scratchZone;
stream _ source;  Logger _ logger;
buffer _ scratch.NEW[StringBody[tokenSize]];
tI _ 0;  [char, eof] _ inchar[];
nTokens _ nErrors _ 0; buffer.length _ tokenSize;

token _ 1; insertFlag _ 1;
symTab _ LOOPHOLE[MakeArray[symTabSize+1,wordsForToken]];
symInfo _ LOOPHOLE[MakeArray[symTabSize+1,PGSTypes.SymTabEntry.SIZE]];
FOR i: CARDINAL IN [1..symTabSize] DO
symInfo[i] _ [link:0, length:0, used:FALSE] ENDLOOP;
hashChain _ scratch.NEW[ARRAY [1..symTabSize/4] OF CARDINAL _ ALL[0]]};

ScanReset: PUBLIC PROC RETURNS [CARDINAL, CARDINAL] = {
stream _ NIL;  Logger _ NIL;
CheckOut[];
scratch.FREE[@buffer];
scratch _ NIL;
RETURN [nTokens, nErrors]};


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: LONG STRING, 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[ConvertUnsafe.ToRope[buffer]];
2 => outstring["see previous message"];
3 => {outstring[ConvertUnsafe.ToRope[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};

}.

¶file PGSScan.mesa rewritten by PGS, 10-Jan-83 15:29
last modified by Satterthwaite, January 10, 1983 4:28 pm
Last Edited by: Maxwell, August 10, 1983 10:32 am
TreeBuild: interpreter section
interpreter state
local data base (supplied by parser)
initialization/termination
the interpretation rules
local procedures
undefined or terminal symbol before ::=
end of local procedures
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
head           ::= directives terminals nonterminals aliases "||TABLE4"
nonterminals   ::= nonterminals discard symbol 
prefix         ::= '? num
discard        ::= num
discard        ::= '?
ruleset        ::=C rulegroup
ruleset        ::= goalrule rulegroup
goalrule       ::= "GOAL" "::=" symbol symbol
the following procedure is called from the ScanReset if no errors
compute nonterminals deriving empty
each production of the nonterminal
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  ...
error recovery
Scanner: text input and error routines
table installation
scanner state
returns token corresponding to string
reading terminals and nonterminals
processing aliases
processing productions
initialization/finalization
initialise symbol table
error handling
�Ê$˜Jš
œ3™3Jš
œ8™8J™1J˜š
Ïk	˜	Jšœ�œ
�œ
˜#Jš�œ�œ
�œ�œ˜šœ�œ
�œ˜J˜<J˜
—šœ�œ�œ˜(J˜?J˜/J˜)—šœ�œ
�œ˜J˜IJ˜%J˜IJ˜8J˜J˜5J˜6—Jšœ
�œ
�œ;˜OJ˜—šœ	�˜Jš�œ˜&Jš�œ˜Jš�œ˜!J˜—Jš
œ™˜Jš
œ™˜Jšœ�œ˜Jšœ	�œ˜Jšœ�œ˜J˜Jšœ�œ
˜Jšœ�œ
˜Jšœ�œ
˜J˜Jš
œ�œ
�œ
�œ
�œ�œ
�œ
˜?J˜—Jš
œ$™$˜J˜J˜J˜J˜J˜J˜J˜—Jš
œ™˜šÏnœ�œ
�œ˜ J˜MJ˜*J˜—šžœ�œ
�œ
�œ�œ�œ˜?Jš�œ�œ�œ˜Cš�œ�œ
�œ�˜1Jšœ&�œ
˜.—Jš�œ˜!J˜J˜——Jš
œ™˜Jšœ�œÏc#˜9Jšœ	�œ˜Jšœ�œ
˜J˜šžœ�œ
�œ�œ˜1Jšœ	�œ
˜J˜š
œ™šžœ�œ�œ˜"Jš�œ
�œ=˜PJ˜—šžœ�œ�œ	�œ˜4J˜š�œ�œ
�œ
Ÿ˜8šœ�œ
˜Jšœ#�œ
�œ˜<——J˜Jšœ�œ˜Jš�œ�œ�œ˜TJ˜—šžœ�œ˜J˜Jš�œ�œ#�œ
˜Hš�œ	�œŸ˜'Jšœ
�œ8˜GJ˜——šž
œ�œ�œ˜ J˜š�œ�œ˜š�œ.�œ˜6Jšœ$Ÿ˜;—J˜$J˜G—š�œ
�œ˜˜#Jšœ�œ�œ�œ˜,—Jšœ
�œ�œ�œ˜9J˜-Jšœ�œ�œ�œ˜<Jšœ
�œ�œ	�œ˜-—J˜J˜—šž	œ�œ
�œ˜&J˜š�œ�œ!˜8Jš
œ'™'—Jš
�˜Jš�œ%�œ'˜RJš�œ#Ÿ˜=Jšœ�œ˜——Jš
œ™˜š�œ�œ
�œ	�˜J˜Jš�œ!�˜+˜šœŸ7˜=Jš
œ
™
Jš
œ
™
Jš
œ:™:Jš
œ4™4Jš
œ&™&Jš
œ4™4Jš
œ<™<Jš
œ™Jš
œ"™"Jš�œ>˜CJš�œ
�œ˜Jš�œ�œ�œ˜MJšœ�œ
˜š�œ�œ�˜+Jš�œ�œ �œ
�œ
˜CJš�œ
˜—š�œ�œ˜Jšœ	�œ�œ
˜J˜=š�œ�œ�˜Jšœ�œ�œ	˜(Jš�œ
�œ �œ	˜?š�œ�œ˜š�œ2�œ˜:J˜—J˜Jš�œ�œ�œ�œ
˜.Jš�œ�œ˜—Jš�œ
˜—J˜š�œ	�˜JšœŸ#˜B——š�œ�œ�˜š�œ�˜š�œ�œ'�œ˜HJ˜2Jšœ�œ˜——Jš�œ
˜—J˜Jš�œ
˜J˜—šœŸB˜HJš
œG™GJš�œ.˜3šœ�œ
˜Jšœ4�œ˜;—J˜
Jšœ�œ(�œ˜BJšœ
�œ�œ
�œ˜=š�œ�œ�˜$Jšœ�œ�œ
˜7—Jšœ&�œ˜=š�œ�œ�˜Jšœ&�œ�œ
˜E—š�œ
�œ˜J˜2J˜A—J˜-Jšœ2�œ
˜7Jšœ*�œ
˜0Jš�œ
˜J˜—šœŸ˜Jšœ	�œ
�œ˜+J˜—šœŸ˜%Jšœ�œ˜,J˜—šœŸ˜%Jšœ�œ
˜J˜—šœŸ˜%Jšœ�œ
˜J˜—šœŸ!˜'Jšœ�œ
˜J˜—šœŸ#˜)Jšœ�œ
˜J˜—šœŸ˜%Jšœ�œ
˜J˜—šœŸ˜#Jšœ
�œ
˜J˜——šœŸ ˜'Jš
�˜š�œ
�œ˜J˜
š�œ�œ�˜0š�œ�œ˜š�œ�˜J˜J˜J˜J˜J˜J˜Jš�œ˜——Jš�œ˜	——J˜Jš�œ
˜J˜—šœŸ.˜5Jš
œ/™/Jš�œ˜š�œ
�œ˜J˜&J˜J˜—Jš�œ
˜J˜—šœŸ ˜'Jš�œ*˜/JšœŸ,˜<Jšœ
�œ
˜Jš�œ
˜J˜—šœŸ ˜'Jš�œ˜Jšœ
�œ"�œ˜;Jš�œ
˜J˜—šœŸ+˜2Jš�œ
�œ�œ&˜FJš�œ�œ&˜Aš�œ�œ
�˜ Jšœ
�œ$�œ	�œ˜N—J˜Fš�œ
�œ˜J˜<J˜Jš
�œ�œ�œ�œ�œ
˜MJ˜—Jš�œ
˜J˜—šœŸ˜JšœŸ'˜<J˜—šœŸ"˜)Jšœ�œ˜1J˜—šœŸ)˜0J˜J˜—šœŸ,˜3Jšœ�œ˜3J˜—šœŸ3˜:J˜J˜—šœŸ"˜)Jšœ�œ�œ˜/J˜—šœŸ)˜0Jšœ�œ˜J˜—šœŸ&˜-Jš�œ#�œ
˜-Jš�œ�œ
�œŸ˜Lš�œ
�œ˜š�œ�œ˜%J˜K—Jš�œ-�œ˜D—š�œ�œ
�˜Jš	œ
�œ�œ
�œ	�œ˜C—J˜ š�œ!�œ˜)Jšœ&�œ˜,—J˜2Jš�œ
˜J˜—šœŸ˜ Jšœ�œ˜J˜—šœŸ˜$Jš
œ™Jšœ�œ˜ J˜—šœŸ ˜'Jšœ�œ˜J˜—šœŸ$˜+Jšœ�œ˜J˜—šœŸ˜Jšœ�œ˜J˜—šœŸ*˜1Jš
œ™Jš
œ™Jš
œ™Jš
œ%™%Jš
œ-™-Jš�œ
˜Jš�œ�œ
˜Jš�œ˜	J˜——————Jš
œA™A˜šžœ�œ˜Jšœ�œ�œ
˜Jšœ�œ
˜Jš
œ#™#š�œ�˜Jšœ�œ
˜š	�œ�œ
�œ�œŸ˜CJš�œ�œ
�œŸ˜?J˜š�œ�œ
�œ�˜2Jš
œ"™"J˜š	�œ�œ
�œ�œŸ˜LJš�œ�œ)�œ
�œ
˜OJš�œ
�œ&�œ�œ˜AJš
�˜—Jš
�˜—Jš
�˜—Jš�œ˜	J˜—Jš
œJ™JJš
œ7™7Jš
œN™NJš
œJ™JJ˜—šžœ�œ
�œ˜š�œ�œ˜J˜J˜<š	�œ�œ
�œ�œ�˜3J˜&Jš�œ�œ˜ š�œ˜J˜8Jšœ�œ�œ�œ˜1J˜G—š�œ�œ�œ˜š�œ�œ�œ˜(J˜%Jšœ�œ�œ�œ˜9J˜5—Jšœ#�œ�œ�œ˜IJ˜=—Jš�œ
˜—J˜7š�œ�œ
�œ�˜&J˜"Jš�œ�œ)˜FJ˜)Jš�œ
˜—J˜J˜J˜——Jš
œ™˜Jš
ž
œ�œ
�œ�œ�œ˜RJ˜J˜J˜——Jš
œ&™&˜Jš
œ™˜J˜J˜J˜J˜J˜J˜šžœ�œ
�œ ˜=J˜J˜0J˜0Jšœ�œ*˜:J˜7J˜———Jš
œ
™
˜Jšœ�œ
�œ�œŸ%˜?Jšžœ�œ�œ�œ
�œ�œ
˜+J˜Jšœ	�	œ
�œ�œ
˜J˜Jš�œ�œ	˜J˜Jšœ�œ
�œ�œŸ˜2J˜Jšœ	�œŸ˜#Jšœ	�œŸ˜&J˜Jšœ�œŸ,˜8Jšœ�œŸ˜#Jšœ�œ
˜
J˜šžœ�œŸ#˜6J˜&J˜J˜—šžœ�œ
�œ
�œ˜(Jš�œ˜J˜šžœ�œ
�œ
�œ�œ�œ˜>Jš
œ%™%Jšœ�œ
˜Jšœ,�œ�œ˜Jš�œ�˜š�œ#�œ˜+J˜š�œ�œ
�œ�˜(Jš�œ�œ
�˜"Jš�œ
�œ�œ˜Jš�œ˜	——J˜Jš�œ
˜—Jš�œ˜J˜—š
ž
œ�œ
�œ
�œ	�œ˜>Jšœ�œ
˜J˜Jš�œ�œ�œ�œ
˜?Jšœ=�œ
˜CJšœ"�œ�œ˜?J˜:J˜—šž	œ�œ�œ˜#Jšœ�œ
˜J˜
š	�œ�œ
�œ�œ�˜Jš�œ�œ˜)J˜Jš�œ
˜—š�œ�œ˜Jšœ5Ÿ˜A—š�œ	�œ˜J˜Jš�œ�œ
�œ˜—J˜Jšœ�œ�œ�œ˜Dš�œ�œ
˜%š�œ*�˜0š�œ�œ�œ
˜Jš�œ�œ
�œ
˜)J˜
š�œ
�œ˜š�œ�œ�˜)Jš�œ�œ˜%—Jš�œ
�œ
�œ
˜Jšœ�œ˜—Jš�œ
˜——Jš�œ�œ
�œ
˜'Jš�œ
˜—J˜Lš�œ�˜J˜š
œ"™"Jš�œ�œŸ˜Uš�œ˜š�œ�œ
�œ˜šœ	�œ�œ˜8Jšœ�œ˜—šœ
�œ%�œ
˜<Jšœ�œ˜——J˜H——J˜Jš
œ™š�œ�œ˜J˜š�œ�œ
�˜šœ	�œ�œ˜8Jšœ�œ˜——Jš�œ�œ�œ�œ
˜@J˜*—J˜š
œ™Jš�œ�œŸ˜K—Jš�œ˜	J˜——š
�˜š�œ�œ�œ�œ
˜š�œ�˜šœŸœ˜š�œ�˜Jš�œ�œ
�œ
�œ	˜J˜—Jš�œ
˜—Jš�œ
˜—Jš�œ�œ
�œ
�œ	˜J˜Jš�œ
˜—J˜"J˜š�œ�˜š�œ˜Jšœ�œ˜Jšœ�œ�œ
˜Jšœ�œ�œ
�œ
˜!š�œ�œ
�˜š�œ�œ˜Jšœ�œ�œ
˜Jšœ�œ�œ�œ˜@Jš�œ�œ˜—J˜Jš�œ
˜—Jš�œ�œ˜Jšœ)�œ
�œ
˜8—˜J˜Jš�œ�œ �œ
�œ
˜@Jšœ�œ
˜š
�˜Jšœ�œ˜Jš�œ�œ
�œ
�œ	˜J˜š�œ�˜Jšœ�œ�œ
�œ
˜Jšœ�œ
˜
Jš�œ
˜—Jš�œ
˜—J˜—Jš�œ�œ
�œ
˜)—Jš
�˜Jšœ�œ
˜J˜AJš�œ
˜—J˜Jš�œ˜J˜J˜—Jš
œ™˜šžœ�œ
�œ˜Jšœ�œ
�œ
˜Jšœ
�	œ
�œ
˜Jš	œ�œ�œ�œ
�œ˜)J˜J˜"Jšœ�œ˜,J˜ J˜1J˜Jš
œ™J˜Jšœ	�œ(˜9Jšœ
�œ-�œ˜Fš�œ�œ
�œ�˜%Jšœ%�œ�œ
˜4—Jšœ�œ
�œ�œ
�œ�œ˜GJ˜—šž	œ�œ
�œ
�œ�œ�œ˜7Jšœ	�œ�œ
˜J˜Jšœ�œ
˜Jšœ
�œ
˜Jš�œ˜J˜——Jš
œ™˜šžœ�œ
�œ	�œ�œ�œ
�œ˜NJš�œ�œ
�œ
˜J˜J˜%J˜—š
ž
œ�œ
�œ�œ	�œ˜DJšœ�œ
˜Jšœ�œ
˜J˜J˜š�œ�œ
�œ�˜(J˜J˜Jš�œ�œ
�œ
˜J˜Jš�œ
˜—J˜š�œ�œ
�œ�˜5š�œ�˜JšœŸœ�œ
˜Jš�œ˜—Jš�œ
˜—Jšœ�œ˜J˜—šžœ�œ
�œ˜Jšœ�œ
�œŸ$˜3Jšœ	�œ
�œ�œ˜/Jšœ�œ˜!Jšœ�œ˜Jšœ�œ
˜J˜ š�œ�œ�˜:Jšœ�œ�œ�œ˜*Jš�œ
˜—J˜'J˜/J˜J˜J˜—Jš
žœ�œ�œ�œ	�œ˜C˜š
žœ�œ�œ
�œ
Ÿœ˜5˜š�œ�˜J˜JJ˜,J˜KJ˜LJ˜2J˜&J˜)J˜IJ˜?J˜8J˜8J˜)J˜%Jš�œ�œ
˜—J˜—š�œ
�˜J˜Jšœ�œ
˜
J˜-J˜'J˜QJšœ�œŸ˜J˜Jš�œ'˜.—J˜J˜—J˜Jš�œ�œ�œ�œ˜CJ˜—J˜J˜———…—HîgÈ