[Cyan]<CedarLang>Nucleus>PGS>PGSScan.mesa!1

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

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;

TreeBuild: interpreter section

interpreter state

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;

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 ← 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 𡤁};

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

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"

head ::= directives terminals nonterminals aliases "||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

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

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

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;

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] = {

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: 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 =>

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 ← 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 =>

processing aliases

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

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,

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;

initialise symbol table

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

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

}.