-- Modified version of the Tool Driver's TDParser
DIRECTORY
Format USING [Decimal],
MStream USING [Handle],
ParseInterface USING [
ActionEntry, ActionTag, DefaultMarker, FinalState, InitialState,
NTIndex, NTState, NTSymbol, ProductionInfo, State,
TableRef, TIndex, TSymbol, EndMarker, tSEMICOLON],
Runtime USING [GetTableBase, GlobalFrame],
Storage USING [FreePages, Pages, PagesForWords],
ParseTables USING [],
ParseDefs USING [AssignDescriptors, Atom, ProcessQueue, ScanInit,
ScanFinal, Value, Value2, ErrorContext],
PrintingDefs USING [outProc, OutCode];
Parser: PROGRAM
IMPORTS Format, Runtime, Storage, ParseTables, ParseDefs, PrintingDefs EXPORTS ParseDefs = {
OPEN ParseInterface;
errorLimit: CARDINAL = 10;
currentState: State;
inputSymbol, lhs: TSymbol;
lastntstate: ParseInterface.State = LAST[ParseInterface.NTState];
inputValue: ParseDefs.Value;
inputLoc: CARDINAL;
stackSize: CARDINAL;
queueSize: CARDINAL;
q: LONG DESCRIPTOR FOR ARRAY OF ActionEntry; --reduction rules
qI: CARDINAL;
v: LONG DESCRIPTOR FOR ARRAY OF ParseDefs.Value; --parse stack
v2: LONG DESCRIPTOR FOR ARRAY OF ParseDefs.Value2; --parse stack
l: LONG DESCRIPTOR FOR ARRAY OF CARDINAL; -- source position
s: LONG DESCRIPTOR FOR ARRAY OF State;
top: CARDINAL;
-- transition tables for terminal input symbols
tStart: LONG DESCRIPTOR FOR ARRAY OF TIndex;
tLength: LONG DESCRIPTOR FOR ARRAY OF CARDINAL;
tSymbol: LONG DESCRIPTOR FOR ARRAY OF TSymbol;
tAction: LONG DESCRIPTOR FOR ARRAY OF ActionEntry;
-- transition tables for nonterminal input symbols
nStart: LONG DESCRIPTOR FOR ARRAY OF NTIndex;
nLength: LONG DESCRIPTOR FOR ARRAY OF CARDINAL;
nSymbol: LONG DESCRIPTOR FOR ARRAY OF NTSymbol;
nAction: LONG DESCRIPTOR FOR ARRAY OF ActionEntry;
ntDefaults: LONG DESCRIPTOR FOR ARRAY OF ActionEntry;
-- production information
proddata: LONG DESCRIPTOR FOR ARRAY OF ParseInterface.ProductionInfo;
-- initialization/termination
table: ParseInterface.TableRef;
ParseInit: PROCEDURE [stream: MStream.Handle] =
BEGIN
table ← Runtime.GetTableBase[Runtime.GlobalFrame[ParseTables]];
ParseDefs.ScanInit[stream, table];
stackSize ← queueSize ← 0;
s ← NIL; q ← NIL;
tStart ← DESCRIPTOR[table.parseTable.tStart];
tLength ← DESCRIPTOR[table.parseTable.tLength];
tSymbol ← DESCRIPTOR[table.parseTable.tSymbol];
tAction ← DESCRIPTOR[table.parseTable.tAction];
nStart ← DESCRIPTOR[table.parseTable.nStart];
nLength ← DESCRIPTOR[table.parseTable.nLength];
nSymbol ← DESCRIPTOR[table.parseTable.nSymbol];
nAction ← DESCRIPTOR[table.parseTable.nAction];
ntDefaults ← DESCRIPTOR[table.parseTable.ntDefaults];
proddata ← DESCRIPTOR[table.parseTable.prodData];
ExpandQueue[256];
ExpandStack[128];
END;
-- the main parsing procedures
Parse: PUBLIC PROCEDURE [stream: MStream.Handle] =
BEGIN
i, valid, k, m: CARDINAL; -- stack pointers
j, j0: CARDINAL;
nErrors: CARDINAL;
tj: ActionEntry;
ParseInit[stream];
i ← top ← valid ← 0; qI ← 0; nErrors ← 0;
s[0] ← currentState ← InitialState;
[inputSymbol, inputValue, inputLoc] ← ParseDefs.Atom[].symbol;
WHILE currentState # FinalState DO
BEGIN
j0 ← tStart[currentState];
FOR j IN [j0 .. j0 + tLength[currentState])
DO
SELECT tSymbol[j] FROM
inputSymbol, DefaultMarker => EXIT;
ENDCASE;
REPEAT
FINISHED => GOTO SyntaxError;
ENDLOOP;
tj ← tAction[j];
IF ~tj.tag.reduce -- scan or scan reduce entry
THEN
BEGIN
IF qI > 0
THEN
BEGIN
FOR k IN (valid..i] DO s[k] ← s[top+(k-valid)] ENDLOOP;
ParseDefs.ProcessQueue[qI, top];
qI ← 0;
END;
top ← valid ← i ← i+1;
v[i] ← inputValue;
[inputSymbol, inputValue, inputLoc] ← ParseDefs.Atom[].symbol;
END;
WHILE tj.tag # ActionTag[FALSE, 0] DO
IF qI >= queueSize THEN ExpandQueue[256];
q[qI] ← tj; qI ← qI + 1;
i ← i-tj.tag.pLength; -- pop 1 state per rhs symbol
currentState ← s[IF i > valid THEN top+(i-valid) ELSE (valid ← i)];
lhs ← proddata[tj.transition].lhs;
BEGIN
IF currentState <= lastntstate
THEN
BEGIN j ← nStart[currentState];
FOR j IN [j..j+nLength[currentState])
DO
IF lhs = nSymbol[j] THEN
BEGIN tj ← nAction[j]; GO TO nfound END;
ENDLOOP;
END;
tj ← ntDefaults[lhs];
EXITS
nfound => NULL;
END;
i ← i+1;
ENDLOOP;
IF (m ← top+(i-valid)) >= stackSize THEN ExpandStack[64];
s[m] ← currentState ← tj.transition;
EXITS
SyntaxError =>
{
PrintingDefs.OutCode["Syntax Error at "L, 0];
Format.Decimal[PrintingDefs.outProc↑, inputLoc];
PrintingDefs.OutCode[", error context '"L, 0];
ParseDefs.ErrorContext[];
PrintingDefs.OutCode["'\n"L, 0];
IF top > 0 THEN
i ← valid ← top ← top-1;
qI ← 0;
currentState ← s[i];
nErrors ← nErrors + 1;
IF nErrors > errorLimit THEN {
PrintingDefs.OutCode["Abandoning parse.\n"L, 0];
EXIT; };
-- on error scan to next '; or
-- to the end of file
DO
IF inputSymbol = tSEMICOLON OR
inputSymbol = ParseInterface.EndMarker
THEN EXIT;
[inputSymbol, inputValue, inputLoc]
← ParseDefs.Atom[].symbol;
ENDLOOP;
};
END;
ENDLOOP;
ParseDefs.ProcessQueue[qI, top];
EraseQueue[];
EraseStack[];
ParseDefs.ScanFinal[];
END;
ExpandStack: PROCEDURE [delta: CARDINAL] =
BEGIN
sS, sL, sV, sV2: CARDINAL;
p: LONG POINTER;
newS: LONG DESCRIPTOR FOR ARRAY OF State;
newL: LONG DESCRIPTOR FOR ARRAY OF CARDINAL;
newV: LONG DESCRIPTOR FOR ARRAY OF ParseDefs.Value;
newV2: LONG DESCRIPTOR FOR ARRAY OF ParseDefs.Value2;
newSize: CARDINAL = stackSize + delta;
sS ← newSize*SIZE[State];
sL ← newSize*SIZE[CARDINAL];
sV ← newSize*SIZE[ParseDefs.Value];
sV2 ← newSize*SIZE[ParseDefs.Value2];
p ← Storage.Pages[Storage.PagesForWords[sS+sL+sV+sV2]];
newS ← DESCRIPTOR[p, newSize];
newL ← DESCRIPTOR[p+sS, newSize];
newV ← DESCRIPTOR[p+sS+sL, newSize];
newV2 ← DESCRIPTOR[p+sS+sL+sV, newSize];
FOR i: CARDINAL IN [0..stackSize) DO
newS[i] ← s[i];
newL[i] ← l[i];
newV[i] ← v[i];
newV2[i] ← v2[i];
ENDLOOP;
EraseStack[];
s ← newS;
l ← newL;
v ← newV;
v2 ← newV2;
stackSize ← newSize;
ParseDefs.AssignDescriptors[q,v,v2,l,proddata];
END;
EraseStack: PROCEDURE =
{IF stackSize # 0 THEN {stackSize ← 0; Storage.FreePages[BASE[s]]}};
ExpandQueue: PROCEDURE [delta: CARDINAL] =
BEGIN
newQ: LONG DESCRIPTOR FOR ARRAY OF ActionEntry;
newSize: CARDINAL = queueSize + delta;
newQ ← DESCRIPTOR[Storage.Pages[Storage.PagesForWords[
newSize*SIZE[ActionEntry]]], newSize];
IF queueSize # 0 THEN
BEGIN
FOR i: CARDINAL IN [0..queueSize) DO
newQ[i] ← q[i];
ENDLOOP;
EraseQueue[];
END;
q ← newQ;
queueSize ← newSize;
END;
EraseQueue: PROCEDURE =
{IF queueSize # 0 THEN {queueSize ← 0; Storage.FreePages[BASE[q]]}};
}.