-- file DIParser.Mesa
-- last modified by
-- Sandman, January 16, 1979 3:58 PM
-- Barbara, May 15, 1978 11:13 AM
-- Bruce, July 23, 1980 5:50 PM
DIRECTORY
CompilerUtil USING [parse, LockTableSegment, UnlockTableSegment],
DebugOps USING [],
Inline USING [COPY, LowHalf],
P1 USING [AssignDescriptors, Atom, lastntstate, ProcessQueue, ScanInit, ScanReset, Token],
ParseTable USING [ActionEntry, ActionTag, DefaultMarker, FinalState, Handle, InitialState, NTIndex, NTSymbol, ProductionInfo, State, TIndex, TSymbol],
Storage USING [FreePages, Pages, PagesForWords];
Parser: PROGRAM
IMPORTS CompilerUtil, P1, Inline, Storage
EXPORTS DebugOps, P1 =
BEGIN -- Debugger Interpreter parser with no error recovery
OPEN P1, ParseTable;
ParseError: PUBLIC SIGNAL [errorLoc: CARDINAL] = CODE;
SyntaxError: PUBLIC SIGNAL [errorLoc: CARDINAL] = CODE;
currentState: State;
inputSymbol, lhs: TSymbol;
input: PROCEDURE RETURNS [symbol: Token];
inputLoc: CARDINAL;
inputValue: UNSPECIFIED;
qI, top: CARDINAL;
stackSize: CARDINAL;
queueSize: CARDINAL;
q: DESCRIPTOR FOR ARRAY OF ActionEntry; --reduction rules
v: DESCRIPTOR FOR ARRAY OF UNSPECIFIED; --parse stack
l: DESCRIPTOR FOR ARRAY OF CARDINAL; --sourceline index
s: DESCRIPTOR FOR ARRAY OF State;
-- transition tables for terminal input symbols
tStart: DESCRIPTOR FOR ARRAY OF TIndex;
tLength: DESCRIPTOR FOR ARRAY OF CARDINAL;
tSymbol: DESCRIPTOR FOR ARRAY OF TSymbol;
tAction: DESCRIPTOR FOR ARRAY OF ActionEntry;
-- transition tables for nonterminal input symbols
nStart: DESCRIPTOR FOR ARRAY OF NTIndex;
nLength: DESCRIPTOR FOR ARRAY OF CARDINAL;
nSymbol: DESCRIPTOR FOR ARRAY OF NTSymbol;
nAction: DESCRIPTOR FOR ARRAY OF ActionEntry;
ntDefaults: DESCRIPTOR FOR ARRAY OF ActionEntry;
proddata: DESCRIPTOR FOR ARRAY OF ProductionInfo;
-- initialization/termination
refCount: CARDINAL ← 0;
table: ParseTable.Handle;
Initialize: PROCEDURE [s: STRING] =
BEGIN OPEN CompilerUtil;
refCount ← refCount + 1;
IF refCount > 1 THEN ParseInit[s, NIL]
ELSE {table ← Inline.LowHalf[LockTableSegment[parse]]; ParseInit[s, table]};
END;
Finalize: PROCEDURE =
BEGIN
EraseQueue[];
EraseStack[];
refCount ← refCount - 1;
IF refCount = 0 THEN CompilerUtil.UnlockTableSegment[CompilerUtil.parse];
END;
ParseInit: PROCEDURE [string: STRING, table: ParseTable.Handle] =
BEGIN OPEN table;
ScanInit[string, table];
stackSize ← queueSize ← 0; ExpandStack[64]; ExpandQueue[256];
IF table # NIL THEN
BEGIN
tStart ← DESCRIPTOR[parseTable.tStart];
tLength ← DESCRIPTOR[parseTable.tLength];
tSymbol ← DESCRIPTOR[parseTable.tSymbol];
tAction ← DESCRIPTOR[parseTable.tAction];
nStart ← DESCRIPTOR[parseTable.nStart];
nLength ← DESCRIPTOR[parseTable.nLength];
nSymbol ← DESCRIPTOR[parseTable.nSymbol];
nAction ← DESCRIPTOR[parseTable.nAction];
ntDefaults ← DESCRIPTOR[parseTable.ntDefaults];
proddata ← DESCRIPTOR[parseTable.prodData];
END;
RETURN
END;
InputLoc: PUBLIC PROCEDURE RETURNS [CARDINAL] =
BEGIN
RETURN [inputLoc]
END;
-- the main parsing procedures
DParse: PUBLIC PROCEDURE [string: STRING] RETURNS [complete: BOOLEAN] =
BEGIN
i, valid, k, m: CARDINAL; -- stack pointers
j, j0: CARDINAL;
tj: ActionEntry;
input ← Atom;
Initialize[string];
i ← top ← valid ← 0; qI ← 0;
s[0] ← currentState ← InitialState;
[inputSymbol, inputValue, inputLoc] ← input[].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 => GO TO 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;
AssignDescriptors[q,v,l,proddata];
ProcessQueue[qI, top !
ParseError => GO TO SyntaxError;
UNWIND => Finalize[]];
qI ← 0;
EXITS
SyntaxError =>
BEGIN
Finalize[];
SIGNAL SyntaxError[inputLoc];
END;
END;
top ← valid ← i ← i+1;
v[i] ← inputValue; l[i] ← inputLoc;
[inputSymbol,inputValue,inputLoc] ← input[].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 =>
BEGIN
Finalize[];
SIGNAL SyntaxError[inputLoc];
END;
END;
ENDLOOP;
BEGIN
AssignDescriptors[q,v,l,proddata];
ProcessQueue[qI, top !
ParseError => GOTO SyntaxError;
UNWIND => Finalize[]];
EXITS
SyntaxError =>
BEGIN
Finalize[];
SIGNAL SyntaxError[inputLoc];
END;
END;
Finalize[];
RETURN [ScanReset[]]
END;
ExpandStack: PROCEDURE [delta: CARDINAL] =
BEGIN
sS, sL, sV: CARDINAL;
p: POINTER;
newS: DESCRIPTOR FOR ARRAY OF State;
newL: DESCRIPTOR FOR ARRAY OF CARDINAL;
newV: DESCRIPTOR FOR ARRAY OF UNSPECIFIED;
newSize: CARDINAL = stackSize + delta;
sS ← newSize*SIZE[State];
sL ← newSize*SIZE[CARDINAL];
sV ← newSize*SIZE[UNSPECIFIED];
p ← Storage.Pages[Storage.PagesForWords[sS+sL+sV]];
newS ← DESCRIPTOR[p, newSize];
newL ← DESCRIPTOR[p+sS, newSize];
newV ← DESCRIPTOR[p+sS+sL, newSize];
IF stackSize # 0 THEN
BEGIN
Inline.COPY[from: BASE[s], nwords: stackSize, to: BASE[newS]];
Inline.COPY[from: BASE[l], nwords: stackSize, to: BASE[newL]];
Inline.COPY[from: BASE[v], nwords: stackSize, to: BASE[newV]];
EraseStack[];
END;
s ← newS; l ← newL; v ← newV; stackSize ← newSize;
RETURN
END;
EraseStack: PROCEDURE =
BEGIN
IF stackSize = 0 THEN RETURN;
stackSize ← 0;
Storage.FreePages[BASE[s]];
RETURN
END;
ExpandQueue: PROCEDURE [delta: CARDINAL] =
BEGIN
newQ: DESCRIPTOR FOR ARRAY OF ActionEntry;
newSize: CARDINAL = queueSize + delta;
newQ ← DESCRIPTOR[Storage.Pages[Storage.PagesForWords[
newSize*SIZE[ActionEntry]]], newSize];
IF queueSize # 0 THEN
BEGIN
Inline.COPY[from: BASE[q], nwords: newSize, to: BASE[newQ]];
EraseQueue[];
END;
q ← newQ; queueSize ← newSize;
RETURN
END;
EraseQueue: PROCEDURE =
BEGIN
IF queueSize = 0 THEN RETURN;
queueSize ← 0;
Storage.FreePages[BASE[q]];
RETURN
END;
END.