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

  }.