-- file PGSParse.mesa
-- last modified by Satterthwaite, November 2, 1982 10:37 am

DIRECTORY
PGSConDefs: TYPE USING [
AcquireZone, ReleaseZone, outchar, outeol, outnum, outstring, resetoutstream],
PGS1: TYPE USING [
ActionSeq, ActionStack, LinkSeq, LinkStack, StateSeq, StateStack, Token,
Value, ValueSeq, ValueStack,
AssignDescriptors, Atom, ErrorContext, ProcessQueue,
ResetScanIndex, ScanInit, ScanReset, TokenValue],
ParseTable: FROM "PGSParseTable" USING [
ActionEntry, ActionTag, NActionsRef, NLengthsRef, NStartsRef, NSymbolsRef,
NTIndex, NTState, NTSymbol, NTDefaultsRef, ProdDataRef, State, TableRef,
TActionsRef, TIndex, TLengthsRef, TStartsRef, TSymbol, TSymbolsRef, VocabularyRef,
DefaultMarker, EndMarker, FinalState, InitialState, InitialSymbol];

Parser: PROGRAM
IMPORTS PGSConDefs, PGS1
EXPORTS PGS1 = {
-- Mesa parser with error recovery
OPEN ParseTable, PGS1;

ErrorLimit: CARDINAL = 25;

Scan: ActionTag = [FALSE, 0];

inputSymbol: TSymbol;

input: PROC RETURNS [token: Token];
inputLoc: CARDINAL;
inputValue: PGS1.Value;

lastToken: Token;
NullSymbol: TSymbol = 0;

zone: UNCOUNTED ZONE ← NIL;

s: PGS1.StateStack;
l: PGS1.LinkStack;
v: PGS1.ValueStack;
top: CARDINAL;

q: PGS1.ActionStack;
qI: CARDINAL;

lalrTable: ParseTable.TableRef;

-- transition tables for terminal input symbols

tStart: TStartsRef;
tLength: TLengthsRef;
tSymbol: TSymbolsRef;
tAction: TActionsRef;

-- transition tables for nonterminal input symbols

nStart: NStartsRef;
nLength: NLengthsRef;
nSymbol: NSymbolsRef;
nAction: NActionsRef;
ntDefaults: NTDefaultsRef;

-- production information

prodData: ProdDataRef;


-- initialization/termination

ParseInit: PROC [tablePtr: ParseTable.TableRef] = {
zone ← PGSConDefs.AcquireZone[];
lalrTable ← tablePtr;  -- for error reporting
PGS1.ScanInit[tablePtr];
tStart ← @tablePtr[tablePtr.parseTable.tStart];
tLength ← @tablePtr[tablePtr.parseTable.tLength];
tSymbol ← @tablePtr[tablePtr.parseTable.tSymbol];
tAction ← @tablePtr[tablePtr.parseTable.tAction];
nStart ← @tablePtr[tablePtr.parseTable.nStart];
nLength ← @tablePtr[tablePtr.parseTable.nLength];
nSymbol ← @tablePtr[tablePtr.parseTable.nSymbol];
nAction ← @tablePtr[tablePtr.parseTable.nAction];
ntDefaults ← @tablePtr[tablePtr.parseTable.ntDefaults];
prodData ← @tablePtr[tablePtr.parseTable.prodData];
s ← NIL; q ← NIL; ExpandStack[100]; ExpandQueue[50]};

ParseReset: PROC = INLINE {
EraseQueue[]; EraseStack[];
PGSConDefs.ReleaseZone[zone]; zone ← NIL};

InputLoc: PUBLIC PROC RETURNS [CARDINAL] = {RETURN [inputLoc]};


-- * * * * Main Parsing Procedures * * * * --

Parse: PUBLIC PROC [table: ParseTable.TableRef]
RETURNS [complete: BOOL, nTokens, nErrors: CARDINAL] = {
currentState: State;
lhs: NTSymbol;
i, valid, k, m: CARDINAL;  -- stack pointers
tI: TIndex;
nI: NTIndex;
action: ActionEntry;

ParseInit[table]; input ← PGS1.Atom;
nErrors ← 0; complete ← TRUE;
i ← top ← valid ← 0; qI ← 0;
s[0] ← currentState ← InitialState; lastToken.class ← NullSymbol;
inputSymbol ← InitialSymbol; inputValue ← 0; inputLoc ← 0;

WHILE currentState # FinalState DO
BEGIN
tI ← tStart[currentState];
FOR tI IN [tI .. tI + tLength[currentState]) DO
 SELECT tSymbol[tI] FROM
  inputSymbol, DefaultMarker => EXIT;
  ENDCASE;
 REPEAT
  FINISHED => GO TO SyntaxError;
 ENDLOOP;

action ← tAction[tI];
IF ~action.tag.reduce THEN { -- scan or scan reduce entry
 IF qI > 0 THEN {
  FOR k IN (valid..i] DO s[k] ← s[top+(k-valid)] ENDLOOP;
  PGS1.ProcessQueue[qI, top]; qI ← 0};
 IF (top ← valid ← i ← i+1) >= s.length THEN ExpandStack[25];
 lastToken.class ← inputSymbol; v[i] ← inputValue; l[i] ← inputLoc;
 [inputSymbol, inputValue, inputLoc] ← input[].token};

WHILE action.tag # Scan DO
IF qI >= q.length THEN ExpandQueue[25];
q[qI] ← action; qI ← qI + 1;
i ← i-action.tag.pLength;
currentState ← s[IF i > valid THEN top+(i-valid) ELSE (valid ← i)];
lhs ← prodData[action.transition].lhs;
  BEGIN
  IF currentState <= NTState.LAST THEN {
  nI ← nStart[currentState];
  FOR nI IN [nI..nI+nLength[currentState]) DO
  IF lhs = nSymbol[nI] THEN {
  action ← nAction[nI]; GO TO nFound};
  ENDLOOP};
  action ← ntDefaults[lhs];
  EXITS
  nFound => NULL;
  END;
i ← i+1;
ENDLOOP;
IF (m ← top+(i-valid)) >= s.length THEN ExpandStack[25];
s[m] ← currentState ← action.transition;
EXITS
 SyntaxError => {
  lastToken.value ← v[top]; lastToken.index ← l[top];
  top ← top - 1;
  complete ← SyntaxError[(nErrors←nErrors+1)>ErrorLimit];
  i ← valid ← top; qI ← 0; lastToken.class ← NullSymbol;
  currentState ← s[i];
  [inputSymbol, inputValue, inputLoc] ← input[].token;
  IF ~complete THEN EXIT};
END;
ENDLOOP;

PGS1.ProcessQueue[qI, top];
nErrors ← nErrors + ([nTokens: nTokens] ← PGS1.ScanReset[nErrors]).nErrors;
ParseReset[];
RETURN};


ExpandStack: PROC [delta: CARDINAL] = {
oldSize: NAT = IF s = NIL THEN 0 ELSE s.length;
newSize: NAT = oldSize + delta;
newS: PGS1.StateStack = zone.NEW[PGS1.StateSeq[newSize]];
newL: PGS1.LinkStack = zone.NEW[PGS1.LinkSeq[newSize]];
newV: PGS1.ValueStack = zone.NEW[PGS1.ValueSeq[newSize]];
FOR i: NAT IN [0..oldSize) DO
newS[i] ← s[i]; newL[i] ← l[i]; newV[i] ← v[i] ENDLOOP;
EraseStack[];
s ← newS; l ← newL; v ← newV;
PGS1.AssignDescriptors[qd:q, vd:v, ld:l, pp:prodData]};

EraseStack: PROC = {
IF s # NIL THEN {zone.FREE[@v]; zone.FREE[@l]; zone.FREE[@s]}};

ExpandQueue: PROC [delta: NAT] = {
oldSize: NAT = IF q = NIL THEN 0 ELSE q.length;
newSize: NAT = oldSize + delta;
newQ: PGS1.ActionStack = zone.NEW[PGS1.ActionSeq[newSize]];
FOR i: NAT IN [0..oldSize) DO newQ[i] ← q[i] ENDLOOP;
EraseQueue[];
q ← newQ;
PGS1.AssignDescriptors[qd:q, vd:v, ld:l, pp:prodData]};

EraseQueue: PROC = {IF q # NIL THEN zone.FREE[@q]};



-- * * * * Error Recovery Section * * * * --

-- parameters of error recovery

MinScanLimit: CARDINAL = 4;
MaxScanLimit: CARDINAL = 12;
InsertLimit: CARDINAL = 2;
DiscardLimit: CARDINAL = 10;
TreeSize: CARDINAL = 256;
CheckSize: CARDINAL = MaxScanLimit+InsertLimit+2;


-- tree management

NodeIndex: TYPE = CARDINAL [0..TreeSize);
NullIndex: NodeIndex = 0;

StackNode: TYPE = RECORD[
father: NodeIndex,
last: NodeIndex,
state: State,
symbol: TSymbol,
aLeaf, bLeaf: BOOL,
link: NodeIndex];

TreeSpace: TYPE = ARRAY [0..TreeSize) OF StackNode;
tree: LONG POINTER TO TreeSpace;
nextNode: CARDINAL [0..TreeSize];
maxNode: NodeIndex;
treeLimit: CARDINAL [0..TreeSize];
TreeFull: SIGNAL = CODE;


Allocate: PROC [parent, pred: NodeIndex, terminal: TSymbol, stateNo: State]
RETURNS [index: NodeIndex] = {
IF (index ← nextNode) >= treeLimit THEN SIGNAL TreeFull;
maxNode ← MAX[index, maxNode];
tree[index] ← StackNode[
 father: parent,
 last: pred,
 state: stateNo,
 symbol: terminal,
 aLeaf: FALSE,
 bLeaf: FALSE,
 link: NullIndex];
nextNode ← nextNode+1; RETURN};


HashSize: INTEGER = 256; -- should depend on state count ?
HashIndex: TYPE = [0..HashSize);
HashSpace: TYPE = ARRAY HashIndex OF NodeIndex;
hashTable: LONG POINTER TO HashSpace;

HashValue: PROC [s: State] RETURNS [HashIndex] = INLINE {
RETURN [s MOD HashSize]};

ParsingMode: TYPE = {ATree, BTree, Checking};
parseMode: ParsingMode;

LinkHash: PROC [n: NodeIndex] = {
htIndex: HashIndex = HashValue[tree[n].state];
tree[n].link ← hashTable[htIndex]; hashTable[htIndex] ← n};

DelinkHash: PROC [n: NodeIndex] = {
htIndex: HashIndex = HashValue[tree[n].state];
p: NodeIndex ← NullIndex;
FOR i: NodeIndex ← hashTable[htIndex], tree[i].link UNTIL i = NullIndex DO
IF i = n THEN GO TO delete;
p ← i;
REPEAT
delete =>
  IF p = NullIndex THEN hashTable[htIndex] ← tree[n].link
  ELSE tree[p].link ← tree[n].link;
ENDLOOP};

ExistingConfiguration: PROC [stack: StackRep] RETURNS [NodeIndex] = {
n1, n2: NodeIndex;
s1, s2: State;
htIndex: HashIndex;
aTree: BOOL;
SELECT parseMode FROM
ATree => aTree ← TRUE;
BTree => aTree ← FALSE;
ENDCASE => RETURN [NullIndex];
htIndex ← HashValue[stack.extension];
FOR n: NodeIndex ← hashTable[htIndex], tree[n].link UNTIL n = NullIndex DO
IF (IF aTree THEN tree[n].aLeaf ELSE tree[n].bLeaf) THEN {
 s1 ← stack.extension; s2 ← tree[n].state;
 n1 ← stack.leaf; n2 ← tree[n].father;
 DO
  IF s1 # s2 THEN EXIT;
  IF n1 = n2 THEN RETURN [n];
  s1 ← tree[n1].state; s2 ← tree[n2].state;
  n1 ← tree[n1].father; n2 ← tree[n2].father;
  ENDLOOP};
ENDLOOP;
RETURN [NullIndex]};

FindNode: PROC [parent, pred: NodeIndex, stateNo: State] RETURNS [index: NodeIndex] = {
index ← ExistingConfiguration[[leaf:parent, extension:stateNo]];
IF index = NullIndex THEN {
index ← Allocate[parent, pred, 0, stateNo];
SELECT parseMode FROM
 ATree => {tree[index].aLeaf ← TRUE; LinkHash[index]};
 BTree => {tree[index].bLeaf ← TRUE; LinkHash[index]};
 ENDCASE => NULL};
RETURN};

TrimTree: PROC [newNext: NodeIndex] = {
WHILE nextNode > newNext DO
nextNode ← nextNode-1; DelinkHash[nextNode] ENDLOOP};


-- parsing simulation

ExtState: TYPE = [State.FIRST .. State.LAST+1];
NullState: ExtState = ExtState.LAST;

StackRep: TYPE = RECORD [
leaf: NodeIndex,
extension: ExtState];


GetNTEntry: PROC [state: State, lhs: NTSymbol] RETURNS [ActionEntry] = {
nI: NTIndex;
IF state <= NTState.LAST THEN {
nI ← nStart[state];
FOR nI IN [nI..nI+nLength[state]) DO
IF lhs = nSymbol[nI] THEN RETURN [nAction[nI]] ENDLOOP};
RETURN [ntDefaults[lhs]]};

ActOnStack: PROC [stack: StackRep, action: ActionEntry, nScanned: [0..1]]
RETURNS [StackRep] = {
currentNode, thread: NodeIndex;
currentState: State;
count: CARDINAL;
currentNode ← thread ← stack.leaf; count ← nScanned;
IF stack.extension = NullState THEN currentState ← tree[currentNode].state
ELSE {currentState ← stack.extension; count ← count + 1};
UNTIL action.tag = Scan DO
IF count > action.tag.pLength THEN { -- can be one greater
 currentNode ← FindNode[currentNode, thread, currentState];
 count ← count - 1};
UNTIL count = action.tag.pLength DO
 currentNode ← tree[currentNode].father; count ← count + 1;
 ENDLOOP;
currentState ← tree[currentNode].state; count ← 1;
action ← GetNTEntry[currentState, prodData[action.transition].lhs];
ENDLOOP;
IF count > 1 THEN currentNode ← FindNode[currentNode, thread, currentState];
stack.leaf ← currentNode; stack.extension ← action.transition;
RETURN [stack]};


ParseStep: PROC [stack: StackRep, input: TSymbol] RETURNS [StackRep] = {
currentState: State;
tI: TIndex;
action: ActionEntry;
count: [0..1];
scanned: BOOL ← FALSE;
currentState ← IF stack.extension = NullState
 THEN tree[stack.leaf].state
 ELSE stack.extension;
WHILE ~scanned DO
tI ← tStart[currentState];
FOR tI IN [tI..tI+tLength[currentState]) DO
 SELECT tSymbol[tI] FROM
  input, DefaultMarker => EXIT;
  ENDCASE;
 REPEAT
  FINISHED => RETURN [[NullIndex, NullState]];
 ENDLOOP;
action ← tAction[tI];
IF ~action.tag.reduce THEN { -- shift or shift reduce
 count ← 1; scanned ← TRUE}
ELSE count ← 0;
stack ← ActOnStack[stack, action, count];
currentState ← stack.extension;
ENDLOOP;
RETURN [stack]};


-- text buffer management

Insert: TYPE = ARRAY [0 .. 1+InsertLimit) OF Token;
newText: LONG POINTER TO Insert;
insertCount: CARDINAL;

Buffer: TYPE =
ARRAY [0 .. 1 + DiscardLimit + (MaxScanLimit+InsertLimit)) OF Token;
sourceText: LONG POINTER TO Buffer;
scanBase, scanLimit: CARDINAL;


Advance: PROC = {
sourceText[scanLimit] ← input[]; scanLimit ← scanLimit + 1};

Discard: PROC = {scanBase ← scanBase+1};

UnDiscard: PROC = {scanBase ← scanBase-1};

RecoverInput: PROC RETURNS [token: Token] = {
IF insertCount <= InsertLimit THEN {
token ← newText[insertCount];
IF (insertCount ← insertCount+1) > InsertLimit THEN zone.FREE[@newText]}
ELSE {
token ← sourceText[scanBase];
IF (scanBase ← scanBase+1) = scanLimit THEN {
zone.FREE[@sourceText]; input ← PGS1.Atom}};
RETURN};


-- acceptance checking

best: RECORD [
nAccepted: CARDINAL,
nPassed: [0..1],
node: NodeIndex,
mode: ParsingMode,
nDiscards: CARDINAL];

RightScan: PROC [node: NodeIndex] RETURNS [stop: BOOL] = {
stack: StackRep;
state: State;
nAccepted: CARDINAL;
savedNextNode: NodeIndex = nextNode;
savedMode: ParsingMode = parseMode;
savedLimit: CARDINAL = treeLimit;
parseMode ← Checking; treeLimit ← TreeSize;
nAccepted ← 0;
state ← tree[node].state; stack ← [leaf:node, extension:NullState];
FOR i: CARDINAL IN [scanBase .. scanLimit) DO
IF state = FinalState THEN {
 nAccepted ← IF (sourceText[i].class = EndMarker)
  THEN scanLimit-scanBase
  ELSE 0;
 EXIT};
stack ← ParseStep[stack, sourceText[i].class];
IF stack.leaf = NullIndex THEN EXIT;
nAccepted ← nAccepted + 1; state ← stack.extension;
ENDLOOP;
TrimTree[savedNextNode]; treeLimit ← savedLimit;
SELECT (parseMode ← savedMode) FROM
ATree =>
 IF nAccepted + 1 > best.nAccepted + best.nPassed THEN
  best ← [nAccepted, 1, node, ATree, scanBase-1];
BTree =>
 IF nAccepted > best.nAccepted + best.nPassed THEN
  best ← [nAccepted, 0, node, BTree, scanBase];
ENDCASE;
RETURN [nAccepted >= MaxScanLimit]};


-- strategy management

RowRecord: TYPE = RECORD [
index, limit: CARDINAL,
stack: StackRep,
next: RowHandle];

RowHandle: TYPE = LONG POINTER TO RowRecord;

NextRow: PROC [list: RowHandle] RETURNS [row: RowHandle] = {
s, t: TSymbol;
row ← NIL;
FOR r: RowHandle ← list, r.next UNTIL r = NIL DO
IF r.index < r.limit THEN {
 s ← tSymbol[r.index];
 IF row = NIL OR s < t THEN {row ← r; t ← s}};
ENDLOOP;
RETURN};

FreeRowList: PROC [list: RowHandle] = {
r: RowHandle ← list;
UNTIL r = NIL DO
next: RowHandle ← r.next;
zone.FREE[@r]; r ← next;
ENDLOOP};


Position: TYPE = {after, before};
Length: TYPE = CARDINAL [0..InsertLimit];

levelStart, levelEnd: ARRAY Position OF ARRAY Length OF NodeIndex;


AddLeaf: PROC [stack: StackRep, s: TSymbol, thread: NodeIndex] RETURNS [stop: BOOL] = {
saveNextNode: NodeIndex = nextNode;
stack ← ParseStep[stack, s];
IF stack.leaf = NullIndex OR ExistingConfiguration[stack] # NullIndex THEN {
TrimTree[saveNextNode]; stop ← FALSE}
ELSE {
newLeaf: NodeIndex = Allocate[stack.leaf, thread, s, stack.extension];
SELECT parseMode FROM
 ATree => tree[newLeaf].aLeaf ← TRUE;
 BTree => tree[newLeaf].bLeaf ← TRUE;
 ENDCASE => ERROR;
LinkHash[newLeaf];
stop ← RightScan[newLeaf]};
RETURN};


GrowTree: PROC [p: Position, n: Length] RETURNS [stop: BOOL] = {
tI: TIndex;
tLimit: CARDINAL;
stack: StackRep;
state: State;
rowList, r: RowHandle;
s: TSymbol;
rowList ← NIL;
FOR i: NodeIndex IN [levelStart[p][n-1] .. levelEnd[p][n-1]) DO
IF tree[i].symbol # 0 OR n = 1 THEN {
 ENABLE UNWIND => FreeRowList[rowList];
 rowList ← NIL;
 stack ← [leaf:i, extension:NullState]; state ← tree[i].state;
 DO
  tI ← tStart[state]; tLimit ← tI + tLength[state];
  s ← tSymbol[tLimit-1];
  r ← zone.NEW[RowRecord];
  r^ ← RowRecord[index:tI, limit:tLimit, stack:stack, next:rowList];
  rowList ← r;
  IF s # DefaultMarker THEN EXIT;
  r.limit ← r.limit - 1;
  stack ← ActOnStack[stack, tAction[tLimit-1], 0];
  state ← stack.extension;
  ENDLOOP;
 UNTIL (r ← NextRow[rowList]) = NIL DO
  IF AddLeaf[r.stack, tSymbol[r.index], i] THEN GO TO found;
  r.index ← r.index + 1;
  ENDLOOP};
REPEAT
 found => stop ← TRUE;
 FINISHED => stop ← FALSE;
ENDLOOP;
FreeRowList[rowList]; rowList ← NIL; RETURN};

CheckTree: PROC [p: Position, n: Length] RETURNS [stop: BOOL] = {
FOR i: NodeIndex IN [levelStart[p][n] .. levelEnd[p][n]) DO
ENABLE TreeFull => CONTINUE;
IF RightScan[i] THEN GO TO found;
REPEAT
 found => stop ← TRUE;
 FINISHED => stop ← FALSE;
ENDLOOP;
RETURN};


Accept: PROC = {
s: TSymbol;
discardBase: CARDINAL = best.nPassed;
insertCount ← 1+InsertLimit;
FOR p: NodeIndex ← best.node, tree[p].last WHILE p > rTop DO
IF (s ← tree[p].symbol) # 0 THEN {
 insertCount ← insertCount-1;
 newText[insertCount] ← Token[s, PGS1.TokenValue[s], inputLoc]};
ENDLOOP;
scanBase ← discardBase;
IF best.nDiscards # 0 THEN {
OPEN PGSConDefs;
outstring["Text deleted is: "L];
FOR j: CARDINAL IN [1 .. best.nDiscards] DO
 TypeSym[sourceText[scanBase].class]; scanBase ← scanBase + 1;
 ENDLOOP};
IF insertCount <= InsertLimit THEN {
OPEN PGSConDefs;
IF scanBase # discardBase THEN outeol[1];
outstring["Text inserted is: "L];
FOR j: CARDINAL IN [insertCount .. InsertLimit] DO TypeSym[newText[j].class] ENDLOOP};
IF discardBase = 1 THEN {
insertCount ← insertCount-1; newText[insertCount] ← sourceText[0]};
IF insertCount > InsertLimit THEN zone.FREE[@newText];
IF scanBase + best.nAccepted < scanLimit THEN
PGS1.ResetScanIndex[sourceText[scanBase+best.nAccepted].index];
scanLimit ← scanBase + best.nAccepted;
input ← RecoverInput;
-- outeol[1]--};

TypeSym: PROC [sym: TSymbol] = {
OPEN PGSConDefs, t: lalrTable.scanTable;
vocab: VocabularyRef = @lalrTable[t.vocabBody];
outchar[' ,1];
IF sym IN [1..EndMarker) THEN
FOR i: CARDINAL IN [lalrTable[t.vocabIndex][sym-1]..lalrTable[t.vocabIndex][sym]) DO
 outchar[vocab.text[i],1] ENDLOOP
ELSE outnum[sym,1]};


--stack node indices
rTop: NodeIndex;


Recover: PROC = {
ModeMap: ARRAY Position OF ParsingMode = [ATree, BTree];
place: Position;
level: Length;
inserts, discards: CARDINAL;
stack: StackRep;
threshold: CARDINAL;

treeLimit ← TreeSize - CheckSize;
hashTable^ ← ALL[NullIndex];
rTop ← NullIndex; nextNode ← maxNode ← 1;

best.nAccepted ← 0; best.nPassed ← 1; best.mode ← ATree;
sourceText[0] ← lastToken;
sourceText[1] ← Token[inputSymbol, inputValue, inputLoc];
scanBase ← 1; scanLimit ← 2;
THROUGH [1 .. MaxScanLimit) DO Advance[] ENDLOOP;
FOR i: CARDINAL IN [0 .. top) DO
rTop ← Allocate[rTop, rTop, 0, s[i]];
ENDLOOP;
parseMode ← BTree;
levelStart[before][0] ← rTop ← FindNode[rTop, rTop, s[top]];
tree[rTop].bLeaf ← TRUE;
levelEnd[before][0] ← nextNode;
parseMode ← ATree;
stack ← ParseStep[[leaf:rTop, extension:NullState], lastToken.class];
rTop ← FindNode[stack.leaf, rTop, stack.extension];
tree[rTop].symbol ← lastToken.class;
tree[rTop].aLeaf ← tree[rTop].bLeaf ← TRUE;
levelStart[after][0] ← rTop; levelEnd[after][0] ← nextNode;

FOR level IN [1 .. Length.LAST] DO
FOR place IN Position DO
 parseMode ← ModeMap[place];
 IF place = before THEN UnDiscard[];
 -- try simple insertion (inserts=level)
 levelStart[place][level] ← nextNode;
 IF GrowTree[place, level !TreeFull => CONTINUE] THEN GO TO found;
 levelEnd[place][level] ← nextNode;
 -- try discards followed by 0 or more insertions
 FOR discards IN [1 .. level) DO
  Discard[];
  IF CheckTree[place, level] THEN GO TO found;
  ENDLOOP;
 Discard[];
 IF place = after THEN Advance[];
 FOR inserts IN [0 .. level] DO
  IF CheckTree[place, inserts] THEN GO TO found;
  ENDLOOP;
 -- undo discards at this level
 FOR discards DECREASING IN [1..level] DO UnDiscard[] ENDLOOP;
 IF place = before THEN Discard[];
 ENDLOOP;
REPEAT
 found => NULL;
 FINISHED => {
  threshold ← (MinScanLimit+MaxScanLimit)/2;
  FOR discards IN [1..Length.LAST] DO Discard[]; Advance[] ENDLOOP;
  UNTIL scanBase > DiscardLimit DO
  IF best.nAccepted >= threshold THEN GO TO found;
  Discard[];
  FOR inserts IN Length DO
  FOR place IN Position DO
  parseMode ← ModeMap[place];
  IF place = before THEN UnDiscard[];
  IF CheckTree[place, inserts] THEN GO TO found;
  IF place = before THEN Discard[];
  ENDLOOP;
  ENDLOOP;
  Advance[];
  threshold ← IF threshold > MinScanLimit THEN threshold-1 ELSE MinScanLimit;
  REPEAT
  found => NULL;
  FINISHED =>
  IF best.nAccepted < MinScanLimit THEN {
   best.mode ← ATree; best.nPassed ← 1};
  ENDLOOP};
ENDLOOP};

SyntaxError: PROC [abort: BOOL] RETURNS [success: BOOL] = {
OPEN PGSConDefs;
IF abort THEN {
PGS1.ErrorContext["Syntax Error"L, inputLoc];
outstring["... Parse abandoned."L]; outeol[1];
success ← FALSE}
ELSE {
sourceText ← zone.NEW[Buffer];
newText ← zone.NEW[Insert];
tree ← zone.NEW[TreeSpace];
hashTable ← zone.NEW[HashSpace];
Recover[ ! TreeFull => CONTINUE];
zone.FREE[@hashTable];
PGS1.ErrorContext["Syntax Error"L,
  sourceText[IF best.mode=BTree THEN 0 ELSE 1].index]; outeol[1];
IF (success ← best.nAccepted >= MinScanLimit) THEN Accept[]
ELSE {
 outstring["No recovery found."L];
 zone.FREE[@newText]; zone.FREE[@sourceText]};
zone.FREE[@tree];
outeol[1]};
outeol[1]; resetoutstream[]; RETURN};

}.