
    <<SMParserImpl.mesa - Cedar/Mesa parser with error recovery>>
        <<Copyright  1985 by Xerox Corporation.  All rights reserved.>>
        <<Derived from ProtoParser.mesa; also copied to CtoSParserImpl>>
        <<last edit by Satterthwaite, September 5, 1985 12:25:24 pm PDT>>

    DIRECTORY
        IO: TYPE USING [int, Put, PutChar, PutRope, STREAM],
        P1: TYPE USING [
            ActionSeq, AssignDescriptors, ErrorContext, Index, InstallScanTable,
            LinkSeq,  LinkStack, NextToken, nullTValue, ProcessQueue,
            ResetScanIndex, ScanInit, ScanReset, StateSeq, StateStack,
            Token, TokenValue, TValue, ValueSeq, ValueStack],
        ParseTable: TYPE USING [
            ActionEntry, ActionTag, defaultMarker, endMarker, finalState, initialState,
            initialSymbol, NActionsRef, NLengthsRef, NStartsRef, NSymbolsRef, NTDefaultsRef,
            NTIndex, NTState, NTSymbol, ProdDataRef, State, TableRef, TActionsRef, TIndex,
            TLengthsRef, TStartsRef, TSymbol, TSymbolsRef],
        SMOps: TYPE USING [MS];

    SMParserImpl: PROGRAM
          IMPORTS IO, P1 
          EXPORTS P1 = {
        OPEN ParseTable;

    <<table installation>>

        tablePtr: 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;


        InstallParseTable: PUBLIC SAFE PROC [base: ParseTable.TableRef] = TRUSTED {
            tablePtr _ base;
            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];
            P1.InstallScanTable[base]};


    <<parser state>>

        ms: SMOps.MS;

        errorLimit: NAT = 25;

        scanTag: ActionTag = [FALSE, 0];

        inputSymbol: TSymbol;

        Input: PROC RETURNS [token: P1.Token];
        inputLoc: P1.Index;
        inputValue: P1.TValue;

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

        zone: ZONE _ NIL;

        s: P1.StateStack;
        l: P1.LinkStack;
        v: REF  P1.ValueSeq;
        top: CARDINAL;

        q: REF P1.ActionSeq;
        qI: CARDINAL;


    <<initialization/termination>>

        ParseInit: PROC [scratchZone: ZONE] = INLINE {
            zone _ scratchZone;
            s _ NIL;  q _ NIL;  ExpandStack[500];  q _ NIL;  ExpandQueue[250];
            scanBuffer _ NIL};


        ParseReset: PROC = INLINE {
            EraseQueue[];  EraseStack[];
            IF scanBuffer  # NIL THEN zone.FREE[@scanBuffer];
            zone _ NIL};


        InputLoc: PUBLIC SAFE PROC RETURNS [P1.Index] = CHECKED {
            RETURN [inputLoc]};


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

        Parse: PUBLIC PROC [model: SMOps.MS, source: IO.STREAM, prefixOk: BOOL]
               RETURNS [complete: BOOL, nTokens, nErrors: CARDINAL] = {
            currentState: State;
            i, valid, m: CARDINAL;        -- stack pointers
            action: ActionEntry;

            ms _ model;
            ParseInit[ms.z];
            P1.ScanInit[ms, source];  Input _ P1.NextToken;
            nErrors _ 0;  complete _ TRUE;
            i _ top _ valid _ 0;  qI _ 0;
            s[0] _ currentState _ initialState;  lastToken.class _ nullSymbol;
            inputSymbol _ initialSymbol;  inputValue _ P1.nullTValue;  inputLoc _ 0;

            UNTIL currentState = finalState AND (prefixOk OR (inputSymbol = endMarker)) 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 THEN {    -- scan or scan reduce entry
                    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) >= s.length THEN ExpandStack[256];
                    lastToken.class _ inputSymbol; v[i] _ [t: inputValue]; l[i] _ inputLoc;
                    [[inputSymbol, inputValue, inputLoc]]  _ Input[]};

                WHILE action.tag # scanTag DO
                    IF qI >= q.length 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 <= NTState.LAST 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)) >= s.length THEN ExpandStack[256];
                s[m] _ currentState _ action.transition;
                EXITS
                    SyntaxError => {
                        lastToken.value _ v[top].t;  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];
            nErrors _ nErrors + ([nTokens: nTokens] _ P1.ScanReset[]).nErrors;
            ParseReset[];
            RETURN};


        ExpandStack: PROC [delta: NAT] = {
            oldSize: NAT = (IF s = NIL THEN 0 ELSE s.length);
            newSize: NAT = oldSize + delta;
            newS: P1.StateStack = zone.NEW[P1.StateSeq[newSize]];
            newL: P1.LinkStack = zone.NEW[P1.LinkSeq[newSize]];
            newV: P1.ValueStack = zone.NEW[P1.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;
            P1.AssignDescriptors[qd:q, vd:v, ld:l, pp:prodData, model:ms]};

        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: REF P1.ActionSeq = zone.NEW[P1.ActionSeq[newSize]];
            FOR i: NAT IN [0..oldSize) DO newQ[i] _ q[i] ENDLOOP;
            q _ newQ;
            P1.AssignDescriptors[qd:q, vd:v, ld:l, pp:prodData, model:ms]};

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


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

        <<parameters of error recovery>>

            minScanLimit: NAT = 4;
            maxScanLimit: NAT = 12;
            insertLimit: NAT = 2;
            discardLimit: NAT = 10;
            treeSize: NAT = 250;
            checkSize: NAT = maxScanLimit+insertLimit+2;

        <<tree management>>

            NodeIndex: TYPE = NAT [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: REF TreeSpace;
            nextNode: NAT [0..treeSize];
            maxNode: NodeIndex;
            treeLimit: NAT [0..treeSize];
            TreeFull: ERROR = CODE;


            Allocate: PROC [parent, pred: NodeIndex, terminal: TSymbol, stateNo: State]
                RETURNS [index: NodeIndex] = {
                IF (index _ nextNode) >= treeLimit THEN ERROR 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: NAT = 250;    -- should depend on state count ?
            HashIndex: TYPE = [0..hashSize);
            HashSpace: TYPE = ARRAY HashIndex OF NodeIndex;
            hashTable: REF 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] = {
                htIndex: HashIndex;
                aTree: BOOL;
                SELECT parseMode FROM
                    $aTree => aTree _ TRUE;
                    $bTree => aTree _ FALSE;
                    ENDCASE => RETURN [nullIndex];
                htIndex _ HashValue[stack.extension];
                FOR i: NodeIndex _ hashTable[htIndex], tree[i].link UNTIL i = nullIndex DO
                    IF (IF aTree THEN tree[i].aLeaf ELSE tree[i].bLeaf) THEN {
                        s1: State _ stack.extension;
                        s2: State _ tree[i].state;
                        n1: NodeIndex _ stack.leaf;
                        n2: NodeIndex _ tree[i].father;
                        DO
                            IF s1 # s2 THEN EXIT;
                            IF n1 = n2 THEN RETURN [i];
                            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] = {
                IF state <= NTState.LAST 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: NAT _ nScanned;
                currentState: State;
                IF stack.extension = nullState THEN currentState _ tree[currentNode].state
                ELSE {currentState _ stack.extension; count _ count + 1};
                UNTIL action.tag = scanTag 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 _ (IF stack.extension = nullState
                    THEN tree[stack.leaf].state
                    ELSE stack.extension);
                scanned: BOOL _ FALSE;
                UNTIL scanned OR currentState = finalState 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: REF Insert;
            insertCount: NAT;

            Buffer: TYPE = ARRAY [0 .. 1+discardLimit+(maxScanLimit+insertLimit)) OF P1.Token;
            scanBuffer: REF Buffer;
            scanBase, scanLimit: NAT;


            Advance: PROC = {scanBuffer[scanLimit] _ Input[]; scanLimit _ scanLimit+1};

            Discard: PROC = INLINE {scanBase _ scanBase+1};

            UnDiscard: PROC = INLINE {scanBase _ scanBase-1};

            RecoverInput: PROC RETURNS [token: P1.Token] = {
                IF insertCount <= insertLimit THEN {
                    token _ newText[insertCount];
                    IF (insertCount _ insertCount+1) > insertLimit THEN zone.FREE[@newText]}
                ELSE {
                    token _ scanBuffer[scanBase];
                    IF (scanBase _ scanBase+1) = scanLimit THEN {
                        zone.FREE[@scanBuffer]; Input _ P1.NextToken}};
                RETURN};


        <<acceptance checking>>

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

            RightScan: PROC [node: NodeIndex] RETURNS [stop: BOOL] = {
                savedNextNode: NodeIndex = nextNode;
                savedMode: ParsingMode = parseMode;
                savedLimit: NAT = treeLimit;
                stack: StackRep _ [leaf:node, extension:nullState];
                state: State _ tree[node].state;
                nAccepted: NAT _ 0;
                parseMode _ $checking;  treeLimit _ treeSize;
                FOR i: NAT IN [scanBase .. scanLimit) DO
                    IF state = finalState THEN {
                        nAccepted _ (IF scanBuffer[i].class = endMarker
                            THEN scanLimit-scanBase
                            ELSE 0);
                        EXIT};
                    stack _ ParseStep[stack, scanBuffer[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: NAT,
                stack: StackRep,
                next: RowHandle];

            RowHandle: TYPE = REF 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] RETURNS [row: RowHandle] = {
                r: RowHandle _ NIL;
                UNTIL  r = NIL DO
                    next: RowHandle = r.next;
                    zone.FREE[@r];  r _ r.next;
                    ENDLOOP;
                RETURN [NIL]};

            Position: TYPE = {after, before};
            Length: TYPE = NAT [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] = {
                rowList: RowHandle _ 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 => {rowList _ FreeRowList[rowList]};
                        stack: StackRep _ [leaf:i, extension:nullState];
                        state: State _ tree[i].state;
                        r: RowHandle;
                        DO
                            tI: TIndex = tStart[state];
                            tLimit: NAT = tI + tLength[state];
                            r _ zone.NEW[RowRecord];
                            r^ _ RowRecord[index:tI, limit:tLimit, stack:stack, next:rowList];
                            rowList _ r;
                            IF tI = tLimit OR tSymbol[tLimit-1] # 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;
                        rowList _ FreeRowList[rowList]};
                    REPEAT
                        found => stop _ TRUE;
                        FINISHED => stop _ FALSE;
                    ENDLOOP;
                rowList _ FreeRowList[rowList];  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 RETURNS [success: BOOL] = {
                s: TSymbol;
                discardBase: NAT = 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 {
                    (ms.out).PutRope["Text deleted is: "];
                    FOR j: NAT IN [1 .. best.nDiscards] DO
                        TypeSym[scanBuffer[scanBase].class];  scanBase _ scanBase + 1;
                        ENDLOOP};
                IF insertCount <= insertLimit THEN {
                    IF scanBase # discardBase THEN (ms.out).PutChar['\n];
                    (ms.out).PutRope["Text inserted is: "];
                    FOR j: NAT IN [insertCount .. insertLimit] DO
                        TypeSym[newText[j].class] ENDLOOP};
                IF discardBase = 1 THEN {insertCount _ insertCount-1; newText[insertCount] _ scanBuffer[0]};
                IF insertCount > insertLimit THEN zone.FREE[@newText];
                IF scanBase + best.nAccepted < scanLimit THEN
                    success _ P1.ResetScanIndex[scanBuffer[scanBase+best.nAccepted].index]
                ELSE success _ TRUE;
                scanLimit _ scanBase + best.nAccepted;
                Input _ RecoverInput};

            TypeSym: PROC [sym: TSymbol] = {
                OPEN t: tablePtr.scanTable;
                vocab: LONG STRING = LOOPHOLE[@tablePtr[t.vocabBody]];
                (ms.out).PutChar[' ];
                IF sym IN [1..endMarker) THEN
                    FOR i: NAT IN [tablePtr[t.vocabIndex][sym-1]..tablePtr[t.vocabIndex][sym]) DO
                        (ms.out).PutChar[vocab[i]] ENDLOOP
                ELSE (ms.out).Put[IO.int[sym]]};


    <<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;
            scanBuffer[0] _ lastToken;
            scanBuffer[1] _ P1.Token[inputSymbol, inputValue, inputLoc];
            scanBase _ 1;  scanLimit _ 2;
            THROUGH [1 .. maxScanLimit) DO Advance[] ENDLOOP;
            FOR i: NAT 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: Length IN [1 .. Length.LAST] 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: NAT 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: NAT _ (minScanLimit+maxScanLimit)/2;
                        THROUGH [1..Length.LAST] DO Discard[]; Advance[] ENDLOOP;
                        UNTIL scanBase > discardLimit DO
                            IF best.nAccepted >= threshold THEN GO TO found;
                            Discard[];
                            FOR inserts: NAT 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: BOOL] RETURNS [success: BOOL] = {
            IF abort THEN {
                P1.ErrorContext["Syntax Error", inputLoc];
                (ms.out).PutRope["... Parse abandoned."];  (ms.out).PutChar['\n];
                success _ FALSE}
            ELSE {
                scanBuffer _ zone.NEW[Buffer];
                newText _ zone.NEW[Insert];
                tree _ zone.NEW[TreeSpace];
                hashTable _ zone.NEW[HashSpace];
                Recover[ ! TreeFull => {CONTINUE}];
                zone.FREE[@hashTable];
                P1.ErrorContext["Syntax Error",
                    scanBuffer[IF best.mode=$bTree THEN 0 ELSE 1].index];
                IF ~(success _ best.nAccepted >= minScanLimit AND Accept[]) THEN {
                    (ms.out).PutRope["No recovery found."];
                    zone.FREE[@newText];  zone.FREE[@scanBuffer]};
                zone.FREE[@tree];
                (ms.out).PutChar['\n]};
            (ms.out).PutChar['\n];
            RETURN};

        }.

