-- file PackParser.mesa
-- last modified by Satterthwaite, July 28, 1980  12:18 PM
-- last modified by Schmidt, September 23, 1980  8:31 PM
-- last modified by Lewis on  2-Apr-81 17:52:01
-- last modified by Levin and Satterthwaite on July 6, 1982 4:31 pm

DIRECTORY
  CharIO: TYPE USING [CR, TAB, PutChar, PutDecimal, PutString],
  P1: FROM "PackParseDefs" USING [
    Token,
    AssignDescriptors, Atom, ErrorContext, ProcessQueue, ResetScanIndex,
    ScanInit, ScanReset, TokenValue],
  ParseTable USING [
    ActionEntry, ActionTag, DefaultMarker, EndMarker, FinalState, 
    InitialState, InitialSymbol, NTIndex, NTState, NTSymbol,
    Production, ProductionInfo, State, TableRef, TIndex, TSymbol],
  Storage: TYPE USING [Free, FreeWords, Node, Words],
  Streams: TYPE USING [Handle];

Parser: PROGRAM
    IMPORTS CharIO, Storage, P1 
    EXPORTS P1 =
  BEGIN  -- Mesa parser with error recovery
  OPEN ParseTable;

  ErrorLimit: CARDINAL = 25;

  Scan: ActionTag = [FALSE, 0];

  inputSymbol: TSymbol;

  input: PROC RETURNS [token: P1.Token];
  inputLoc: CARDINAL;
  inputValue: UNSPECIFIED;

  lastToken: P1.Token;
  NullSymbol: TSymbol = 0;

  errorStream: Streams.Handle;

  s: DESCRIPTOR FOR ARRAY OF State;
  l: DESCRIPTOR FOR ARRAY OF CARDINAL;
  v: DESCRIPTOR FOR ARRAY OF UNSPECIFIED;
  top: CARDINAL;

  q: DESCRIPTOR FOR ARRAY OF ActionEntry;
  qI: CARDINAL;

  lalrTable: ParseTable.TableRef;

  -- transition tables for terminal input symbols

  tStart: LONG POINTER TO ARRAY State OF TIndex;
  tLength: LONG POINTER TO ARRAY State OF CARDINAL;
  tSymbol: LONG POINTER TO ARRAY TIndex OF TSymbol;
  tAction: LONG POINTER TO ARRAY TIndex OF ActionEntry;

  -- transition tables for nonterminal input symbols

  nStart: LONG POINTER TO ARRAY NTState OF NTIndex;
  nLength: LONG POINTER TO ARRAY NTState OF CARDINAL;
  nSymbol: LONG POINTER TO ARRAY NTIndex OF NTSymbol;
  nAction: LONG POINTER TO ARRAY NTIndex OF ActionEntry;
  ntDefaults: LONG POINTER TO ARRAY NTSymbol OF ActionEntry;

  -- production information

  prodData: LONG POINTER TO ARRAY Production OF ProductionInfo;


-- initialization/termination

  ParseInit: PROC [
      sourceStream: Streams.Handle,
      messageStream:  Streams.Handle,
      tablePtr: ParseTable.TableRef] = {
    errorStream _ messageStream; lalrTable _ tablePtr;	-- for error reporting
    P1.ScanInit[sourceStream, messageStream, 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[512];  ExpandQueue[256]};

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


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

  Parse: PUBLIC PROC [
	sourceStream: Streams.Handle,
	messageStream:  Streams.Handle,
	table: ParseTable.TableRef]
      RETURNS [complete: BOOLEAN, nTokens, nErrors: CARDINAL] = {
    currentState: State;
    i, valid, m: CARDINAL;		-- stack pointers
    action: ActionEntry;

    ParseInit[sourceStream, messageStream, table];  input _ P1.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: TIndex _ 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	-- scan or scan reduce entry
	THEN {
	  IF qI > 0 
	    THEN {
	      FOR k: CARDINAL IN (valid..i] DO s[k] _ s[top+(k-valid)] ENDLOOP;
	      P1.ProcessQueue[qI, top];  qI _ 0};
	  IF (top _ valid _ i _ i+1) >= LENGTH[s] THEN ExpandStack[256];
	  lastToken.class _ inputSymbol; v[i] _ inputValue; l[i] _ inputLoc;
	  [[inputSymbol, inputValue, inputLoc]]  _ input[]};

      WHILE action.tag # Scan 
        DO
        IF qI >= LENGTH[q] THEN ExpandQueue[256];
        q[qI] _ action;  qI _ qI + 1;
        i _ i-action.tag.pLength;
        currentState _ s[IF i > valid THEN top+(i-valid) ELSE (valid _ i)];
	  BEGIN
	  lhs: NTSymbol = prodData[action.transition].lhs;
	  IF currentState <= LAST[NTState] 
	    THEN {
	      nI: NTIndex _ 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)) >= LENGTH[s] THEN ExpandStack[256];
      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[];
	  IF ~complete THEN EXIT};
      END;
    ENDLOOP;

    P1.ProcessQueue[qI, top];
    EraseQueue[];  EraseStack[];
    {n: CARDINAL;  [nTokens, n] _ P1.ScanReset[];  nErrors _ nErrors + n};
    RETURN};


  ExpandStack: PROC [delta: CARDINAL] = {
    newS: DESCRIPTOR FOR ARRAY OF State;
    newL: DESCRIPTOR FOR ARRAY OF CARDINAL;
    newV: DESCRIPTOR FOR ARRAY OF UNSPECIFIED;
    newSize: CARDINAL = LENGTH[s] + delta;
    newS _ DESCRIPTOR[Storage.Words[newSize*SIZE[State]], newSize];
    newL _ DESCRIPTOR[Storage.Words[newSize*SIZE[CARDINAL]], newSize];
    newV _ DESCRIPTOR[Storage.Words[newSize*SIZE[UNSPECIFIED]], newSize];
    FOR i: CARDINAL IN [0..LENGTH[s])
      DO  newS[i] _ s[i];  newL[i] _ l[i];  newV[i] _ v[i]  ENDLOOP;
    EraseStack[];
    s _ newS;  l _ newL;  v _ newV;
    P1.AssignDescriptors[qd:q, vd:v, ld:l, pp:prodData]};

  EraseStack: PROC = {
    IF s # NIL THEN {
      Storage.FreeWords[BASE[v]]; Storage.FreeWords[BASE[l]]; Storage.FreeWords[BASE[s]]}};

  ExpandQueue: PROC [delta: CARDINAL] = {
    newQ: DESCRIPTOR FOR ARRAY OF ActionEntry;
    newSize: CARDINAL = LENGTH[q] + delta;
    newQ _ DESCRIPTOR[Storage.Words[newSize*SIZE[ActionEntry]], newSize];
    FOR i: CARDINAL IN [0..LENGTH[q])  DO  newQ[i] _ q[i]  ENDLOOP;
    EraseQueue[];
    q _ newQ;
    P1.AssignDescriptors[qd:q, vd:v, ld:l, pp:prodData]};

  EraseQueue: PROC = {IF q # NIL THEN Storage.FreeWords[BASE[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;


 -- debugging

  ParserID: PUBLIC PROC RETURNS [STRING] = {RETURN [NIL]};

  track: BOOLEAN = FALSE;

  DisplayNode: PROC [n: NodeIndex] = {
    IF track
      THEN {
	OPEN CharIO;
	PutString[errorStream, "::new node::"L];
	PutChar[errorStream, TAB]; PutDecimal[errorStream, n];
	PutChar[errorStream, TAB]; PutDecimal[errorStream, tree[n].father]; 
	PutChar[errorStream, TAB]; PutDecimal[errorStream, tree[n].last];
	PutChar[errorStream, TAB]; PutDecimal[errorStream, tree[n].state];
	PutChar[errorStream, TAB]; TypeSym[tree[n].symbol]; NewLine[]}};


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

  tree: POINTER TO ARRAY [0..TreeSize) OF StackNode;
  nextNode: NodeIndex;
  maxNode: NodeIndex;
  treeLimit: CARDINAL;
  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 ?
  hashTable: POINTER TO ARRAY [0..HashSize) OF NodeIndex;

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

  LinkHash: PROC [n: NodeIndex] = {
    htIndex: [0..HashSize) = tree[n].state MOD HashSize;
    tree[n].link _ hashTable[htIndex];  hashTable[htIndex] _ n};

  ExistingConfiguration: PROC [stack: StackRep] RETURNS [NodeIndex] = {
    n, n1, n2: NodeIndex;
    s1, s2: State;
    htIndex: [0..HashSize);
    aTree: BOOLEAN;
    SELECT parseMode FROM
      ATree =>  aTree _ TRUE;
      BTree =>  aTree _ FALSE;
      ENDCASE => RETURN [NullIndex];
    htIndex _ stack.extension MOD HashSize;
    FOR n _ 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};


 -- 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] = {
    IF state <= LAST[NTState]
      THEN {
	nI: NTIndex _ 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 _ stack.leaf;
    count: CARDINAL _ nScanned;
    currentState: State;
    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  -- can be one greater
	THEN {
	  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 _ IF stack.extension = NullState
	THEN tree[stack.leaf].state
	ELSE stack.extension;
    scanned: BOOLEAN _ FALSE;
    WHILE ~scanned 
      DO
      action: ActionEntry;
      count: [0..1];
      tI: TIndex _ 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 {count _ 1;  scanned _ TRUE}	-- shift or shift reduce
	ELSE count _ 0;
      stack _ ActOnStack[stack, action, count];
      currentState _ stack.extension;
      ENDLOOP;
    RETURN [stack]};


 -- text buffer management

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

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


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

  Discard: PROC = {
    IF track
      THEN {
	CharIO.PutString[errorStream, "::discarding symbol: "L];
	TypeSym[sourceText[scanBase].class];  NewLine[]};
    scanBase _ scanBase+1};

  UnDiscard: PROC = {
    scanBase _ scanBase-1;
    IF track
      THEN {
	CharIO.PutString[errorStream, "::recovering symbol: "L];
	TypeSym[sourceText[scanBase].class];  NewLine[]}};

  RecoverInput: PROC RETURNS [token: P1.Token] = {
    IF insertCount <= InsertLimit 
      THEN {
	token _ newText[insertCount];
	IF (insertCount _ insertCount+1) > InsertLimit THEN Storage.Free[newText]}
      ELSE {
	token _ sourceText[scanBase];
	IF (scanBase _ scanBase+1) = scanLimit
	  THEN {Storage.Free[sourceText]; input _ P1.Atom}};
    RETURN};


 -- acceptance checking

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

  RightScan: PROC [node: NodeIndex] RETURNS [stop: BOOLEAN] = {
    savedNextNode: NodeIndex = nextNode;
    savedMode: ParsingMode = parseMode;
    savedLimit: CARDINAL = treeLimit;
    stack: StackRep _ [leaf:node, extension:NullState];
    state: State _ tree[node].state;
    nAccepted: CARDINAL _ 0;
    parseMode _ Checking;  treeLimit _ TreeSize;
    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;
    nextNode _ 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 = POINTER TO RowRecord;

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

  FreeRowList: PROC [list: RowHandle] = {
    r, next: RowHandle;
    FOR r _ list, next UNTIL r = NIL DO next _ r.next;  Storage.Free[r]  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 {nextNode _ 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];
	IF track THEN DisplayNode[newLeaf];
	stop _ RightScan[newLeaf]};
    RETURN};


  GrowTree: PROC [p: Position, n: Length] RETURNS [stop: BOOLEAN] = {
    tI, tLimit: TIndex;
    stack: StackRep;
    state: State;
    rowList, r: RowHandle;
    s: TSymbol;
    IF track
      THEN {
	CharIO.PutString[errorStream, "::generating length: "L];
	CharIO.PutDecimal[errorStream, n];
	CharIO.PutChar[errorStream, IF p = before THEN 'B ELSE 'A];  NewLine[]};
    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 _ Storage.Node[SIZE[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] = {
    IF track
      THEN {
	CharIO.PutString[errorStream, "::checking length: "L];
	CharIO.PutDecimal[errorStream, n];
	CharIO.PutChar[errorStream, IF p = before THEN 'B ELSE 'A];  NewLine[]};
    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] _ P1.Token[s, P1.TokenValue[s], inputLoc]};
      ENDLOOP;
    scanBase _ discardBase;
    IF best.nDiscards # 0 
      THEN {
	CharIO.PutString[errorStream, "Text deleted is: "L];
	FOR j: CARDINAL IN [1 .. best.nDiscards]
	  DO
	  TypeSym[sourceText[scanBase].class];  scanBase _ scanBase + 1;
	  ENDLOOP};
    IF insertCount <= InsertLimit 
      THEN {
	IF scanBase # discardBase THEN NewLine[];
	CharIO.PutString[errorStream, "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 Storage.Free[newText];
    IF scanBase + best.nAccepted < scanLimit
      THEN P1.ResetScanIndex[sourceText[scanBase+best.nAccepted].index];
    scanLimit _ scanBase + best.nAccepted;
    input _ RecoverInput};

  TypeSym: PROC [sym: TSymbol] = {
    OPEN CharIO, t: lalrTable.scanTable;
    vocab: LONG STRING = LOOPHOLE[@lalrTable[t.vocabBody], LONG STRING];
    PutChar[errorStream, ' ];
    IF ~(sym IN [1..EndMarker))
      THEN PutDecimal[errorStream, sym]
      ELSE
	FOR i: CARDINAL IN [lalrTable[t.vocabIndex][sym-1]..lalrTable[t.vocabIndex][sym])
	  DO  PutChar[errorStream, vocab[i]]  ENDLOOP};


--stack node indices
  rTop: NodeIndex;


  Recover: PROC = {
    ModeMap: ARRAY Position OF ParsingMode = [ATree, BTree];
    stack: StackRep;

    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] _ P1.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]];
      IF track THEN DisplayNode[rTop];
      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;
    IF track THEN DisplayNode[rTop];

    FOR level: Length IN [1 .. LAST[Length]]
      DO
      FOR place: Position 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
	THROUGH [1 .. level)
	  DO Discard[]; IF CheckTree[place, level] THEN GO TO found ENDLOOP;
	Discard[];
	IF place = after THEN Advance[];
	FOR inserts: CARDINAL IN [0 .. level]
	  DO IF CheckTree[place, inserts] THEN GO TO found ENDLOOP;
	-- undo discards at this level
	THROUGH [1..level] DO UnDiscard[] ENDLOOP;
	IF place = before THEN Discard[];
	ENDLOOP;
      REPEAT
	found =>  NULL;
	FINISHED => {
	  threshold: CARDINAL _ (MinScanLimit+MaxScanLimit)/2;
	  THROUGH [1..LAST[Length]] DO Discard[]; Advance[] ENDLOOP;
	  UNTIL scanBase > DiscardLimit
	    DO
	    IF best.nAccepted >= threshold THEN GO TO found;
	    Discard[];
	    FOR inserts: CARDINAL IN Length
	      DO
	      FOR place: Position 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] = {
    IF abort
      THEN {
	P1.ErrorContext["Syntax Error"L, inputLoc];
	CharIO.PutString[errorStream, "... Parse abandoned."L];  NewLine[];
	success _ FALSE}
      ELSE {
	sourceText _ Storage.Node[SIZE[Buffer]];
	newText _ Storage.Node[SIZE[Insert]];
	tree _ Storage.Words[TreeSize*SIZE[StackNode]];
	hashTable _ Storage.Words[HashSize*SIZE[NodeIndex]];
	Recover[ ! TreeFull => CONTINUE];
	Storage.FreeWords[hashTable];
	P1.ErrorContext["Syntax Error"L,
	  sourceText[IF best.mode=BTree THEN 0 ELSE 1].index];
	IF (success _ best.nAccepted >= MinScanLimit)
	  THEN  Accept[]
	  ELSE {
	    CharIO.PutString[errorStream, "No recovery found."L];
	    Storage.Free[newText];  Storage.Free[sourceText]};
	Storage.FreeWords[tree];
	NewLine[]};
    NewLine[];  RETURN};

  NewLine: PROC = {CharIO.PutChar[errorStream, CharIO.CR]};

END.