-- file PGSParse.mesa
-- last modified by Satterthwaite, June 18, 1982 1:29 pm

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: BOOLEAN, 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 <= LAST[NTState] 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: BOOLEAN,
    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: BOOLEAN;
    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 = [FIRST[State] .. LAST[State]+1];
  NullState: ExtState = LAST[ExtState];

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


  GetNTEntry: PROC [state: State, lhs: NTSymbol] RETURNS [ActionEntry] = {
    nI: NTIndex;
    IF state <= LAST[NTState] 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: BOOLEAN ← 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: BOOLEAN] = {
    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: BOOLEAN] = {
    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: BOOLEAN] = {
    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: BOOLEAN] = {
    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 .. LAST[Length]] 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..LAST[Length]] 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: BOOLEAN] RETURNS [success: BOOLEAN] = {
    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};

  }.