-- file Parser.Mesa -- last modified by Satterthwaite, January 8, 1980 10:43 AM DIRECTORY CharIO: FROM "chario" USING [CR, TAB, PutChar, PutDecimal, PutString], P1: FROM "p1" USING [ Token, AssignDescriptors, Atom, ErrorContext, ProcessQueue, ResetScanIndex, ScanInit, ScanReset, TokenValue], ParseTable: FROM "parsetable" USING [ ActionEntry, ActionTag, Handle, NTIndex, NTState, NTSymbol, Production, ProductionInfo, State, TIndex, TSymbol, DefaultMarker, EndMarker, InitialState, FinalState, InitialSymbol], StreamDefs: FROM "streamdefs" USING [StreamHandle], SystemDefs: FROM "systemdefs" USING [AllocateHeapNode, AllocateSegment, FreeHeapNode, FreeSegment]; Parser: PROGRAM IMPORTS CharIO, SystemDefs, P1 EXPORTS P1 = BEGIN -- Mesa parser with error recovery OPEN ParseTable; ErrorLimit: CARDINAL = 25; Scan: ActionTag = [FALSE, 0]; inputSymbol: TSymbol; input: PROCEDURE RETURNS [token: P1.Token]; inputLoc: CARDINAL; inputValue: UNSPECIFIED; lastToken: P1.Token; NullSymbol: TSymbol = 0; errorStream: StreamDefs.StreamHandle; s: DESCRIPTOR FOR ARRAY OF State; l: DESCRIPTOR FOR ARRAY OF CARDINAL; v: DESCRIPTOR FOR ARRAY OF UNSPECIFIED; top: CARDINAL; stackSize: CARDINAL; q: DESCRIPTOR FOR ARRAY OF ActionEntry; qI: CARDINAL; queueSize: CARDINAL; lalrTable: ParseTable.Handle; -- transition tables for terminal input symbols tStart: POINTER TO ARRAY State OF TIndex; tLength: POINTER TO ARRAY State OF CARDINAL; tSymbol: POINTER TO ARRAY TIndex OF TSymbol; tAction: POINTER TO ARRAY TIndex OF ActionEntry; -- transition tables for nonterminal input symbols nStart: POINTER TO ARRAY NTState OF NTIndex; nLength: POINTER TO ARRAY NTState OF CARDINAL; nSymbol: POINTER TO ARRAY NTIndex OF NTSymbol; nAction: POINTER TO ARRAY NTIndex OF ActionEntry; ntDefaults: POINTER TO ARRAY NTSymbol OF ActionEntry; -- production information prodData: POINTER TO ARRAY Production OF ProductionInfo; -- initialization/termination ParseInit: PROCEDURE [ sourceStream: StreamDefs.StreamHandle, messageStream: StreamDefs.StreamHandle, tablePtr: ParseTable.Handle] = BEGIN errorStream _ messageStream; lalrTable _ tablePtr; -- for error reporting P1.ScanInit[sourceStream, messageStream, tablePtr]; tStart _ @tablePtr.parseTable.tStart; tLength _ @tablePtr.parseTable.tLength; tSymbol _ @tablePtr.parseTable.tSymbol; tAction _ @tablePtr.parseTable.tAction; nStart _ @tablePtr.parseTable.nStart; nLength _ @tablePtr.parseTable.nLength; nSymbol _ @tablePtr.parseTable.nSymbol; nAction _ @tablePtr.parseTable.nAction; ntDefaults _ @tablePtr.parseTable.ntDefaults; prodData _ @tablePtr.parseTable.prodData; stackSize _ queueSize _ 0; ExpandStack[512]; ExpandQueue[256]; END; InputLoc: PUBLIC PROCEDURE RETURNS [CARDINAL] = BEGIN RETURN [inputLoc] END; -- * * * * Main Parsing Procedures * * * * -- Parse: PUBLIC PROCEDURE [ sourceStream: StreamDefs.StreamHandle, messageStream: StreamDefs.StreamHandle, table: ParseTable.Handle] RETURNS [complete: BOOLEAN, nTokens, nErrors: CARDINAL] = BEGIN currentState: State; lhs: NTSymbol; i, valid, k, m: CARDINAL; -- stack pointers tI: TIndex; nI: NTIndex; 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 _ 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 BEGIN IF qI > 0 THEN BEGIN FOR k IN (valid..i] DO s[k] _ s[top+(k-valid)] ENDLOOP; P1.ProcessQueue[qI, top]; qI _ 0; END; IF (top _ valid _ i _ i+1) >= stackSize THEN ExpandStack[256]; lastToken.class _ inputSymbol; v[i] _ inputValue; l[i] _ inputLoc; [inputSymbol, inputValue, inputLoc] _ input[].token; END; WHILE action.tag # Scan DO IF qI >= queueSize 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)]; lhs _ prodData[action.transition].lhs; BEGIN IF currentState <= LAST[NTState] THEN BEGIN nI _ nStart[currentState]; FOR nI IN [nI..nI+nLength[currentState]) DO IF lhs = nSymbol[nI] THEN BEGIN action _ nAction[nI]; GO TO nFound END; ENDLOOP; END; action _ ntDefaults[lhs]; EXITS nFound => NULL; END; i _ i+1; ENDLOOP; IF (m _ top+(i-valid)) >= stackSize THEN ExpandStack[256]; s[m] _ currentState _ action.transition; EXITS SyntaxError => BEGIN 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; END; ENDLOOP; P1.ProcessQueue[qI, top]; EraseQueue[]; EraseStack[]; BEGIN n: CARDINAL; [nTokens, n] _ P1.ScanReset[]; nErrors _ nErrors + n; END; RETURN END; ExpandStack: PROCEDURE [delta: CARDINAL] = BEGIN OPEN SystemDefs; i: CARDINAL; newS: DESCRIPTOR FOR ARRAY OF State; newL: DESCRIPTOR FOR ARRAY OF CARDINAL; newV: DESCRIPTOR FOR ARRAY OF UNSPECIFIED; newSize: CARDINAL = stackSize + delta; newS _ DESCRIPTOR[AllocateSegment[newSize*SIZE[State]], newSize]; newL _ DESCRIPTOR[AllocateSegment[newSize*SIZE[CARDINAL]], newSize]; newV _ DESCRIPTOR[AllocateSegment[newSize*SIZE[UNSPECIFIED]], newSize]; FOR i IN [0..stackSize) DO newS[i] _ s[i]; newL[i] _ l[i]; newV[i] _ v[i] ENDLOOP; EraseStack[]; s _ newS; l _ newL; v _ newV; stackSize _ newSize; P1.AssignDescriptors[qd:q, vd:v, ld:l, pp:prodData]; END; EraseStack: PROCEDURE = BEGIN IF stackSize # 0 THEN BEGIN OPEN SystemDefs; FreeSegment[BASE[v]]; FreeSegment[BASE[l]]; FreeSegment[BASE[s]]; END; END; ExpandQueue: PROCEDURE [delta: CARDINAL] = BEGIN OPEN SystemDefs; i: CARDINAL; newQ: DESCRIPTOR FOR ARRAY OF ActionEntry; newSize: CARDINAL = queueSize + delta; newQ _ DESCRIPTOR[AllocateSegment[newSize*SIZE[ActionEntry]], newSize]; FOR i IN [0..queueSize) DO newQ[i] _ q[i] ENDLOOP; EraseQueue[]; q _ newQ; queueSize _ newSize; P1.AssignDescriptors[qd:q, vd:v, ld:l, pp:prodData]; END; EraseQueue: PROCEDURE = BEGIN IF queueSize # 0 THEN SystemDefs.FreeSegment[BASE[q]]; END; -- * * * * 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 PROCEDURE RETURNS [STRING] = BEGIN RETURN [NIL] END; track: BOOLEAN = FALSE; DisplayNode: PROCEDURE [n: NodeIndex] = BEGIN OPEN CharIO; IF track THEN BEGIN 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[]; END; END; -- 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: PROCEDURE [parent, pred: NodeIndex, terminal: TSymbol, stateNo: State] RETURNS [index: NodeIndex] = BEGIN 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 END; HashSize: INTEGER = 256; -- should depend on state count ? hashTable: POINTER TO ARRAY [0..HashSize) OF NodeIndex; ParsingMode: TYPE = {ATree, BTree, Checking}; parseMode: ParsingMode; LinkHash: PROCEDURE [n: NodeIndex] = BEGIN htIndex: [0..HashSize) = tree[n].state MOD HashSize; tree[n].link _ hashTable[htIndex]; hashTable[htIndex] _ n; END; ExistingConfiguration: PROCEDURE [stack: StackRep] RETURNS [NodeIndex] = BEGIN 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 BEGIN 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; END; ENDLOOP; RETURN [NullIndex] END; FindNode: PROCEDURE [parent, pred: NodeIndex, stateNo: State] RETURNS [index: NodeIndex] = BEGIN index _ ExistingConfiguration[[leaf:parent, extension:stateNo]]; IF index = NullIndex THEN BEGIN index _ Allocate[parent, pred, 0, stateNo]; SELECT parseMode FROM ATree => BEGIN tree[index].aLeaf _ TRUE; LinkHash[index] END; BTree => BEGIN tree[index].bLeaf _ TRUE; LinkHash[index] END; ENDCASE => NULL; END; RETURN END; -- parsing simulation ExtState: TYPE = [FIRST[State] .. LAST[State]+1]; NullState: ExtState = LAST[ExtState]; StackRep: TYPE = RECORD[ leaf: NodeIndex, extension: ExtState]; GetNTEntry: PROCEDURE [state: State, lhs: NTSymbol] RETURNS [ActionEntry] = BEGIN nI: NTIndex; IF state <= LAST[NTState] THEN BEGIN nI _ nStart[state]; FOR nI IN [nI..nI+nLength[state]) DO IF lhs = nSymbol[nI] THEN RETURN [nAction[nI]] ENDLOOP; END; RETURN [ntDefaults[lhs]] END; ActOnStack: PROCEDURE [stack: StackRep, action: ActionEntry, nScanned: [0..1]] RETURNS [StackRep] = BEGIN currentNode, thread: NodeIndex; currentState: State; count: CARDINAL; currentNode _ thread _ stack.leaf; count _ nScanned; IF stack.extension = NullState THEN currentState _ tree[currentNode].state ELSE BEGIN currentState _ stack.extension; count _ count + 1 END; UNTIL action.tag = Scan DO IF count > action.tag.pLength -- can be one greater THEN BEGIN currentNode _ FindNode[currentNode, thread, currentState]; count _ count - 1; END; 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] END; ParseStep: PROCEDURE [stack: StackRep, input: TSymbol] RETURNS [StackRep] = BEGIN 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 BEGIN count _ 1; scanned _ TRUE END ELSE count _ 0; stack _ ActOnStack[stack, action, count]; currentState _ stack.extension; ENDLOOP; RETURN [stack] END; -- 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: PROCEDURE = BEGIN sourceText[scanLimit] _ input[]; scanLimit _ scanLimit + 1; END; Discard: PROCEDURE = BEGIN IF track THEN BEGIN OPEN CharIO; PutString[errorStream, "::discarding symbol: "L]; TypeSym[sourceText[scanBase].class]; NewLine[]; END; scanBase _ scanBase+1; END; UnDiscard: PROCEDURE = BEGIN scanBase _ scanBase-1; IF track THEN BEGIN OPEN CharIO; PutString[errorStream, "::recovering symbol: "L]; TypeSym[sourceText[scanBase].class]; NewLine[]; END; END; RecoverInput: PROCEDURE RETURNS [token: P1.Token] = BEGIN IF insertCount <= InsertLimit THEN BEGIN token _ newText[insertCount]; IF (insertCount _ insertCount+1) > InsertLimit THEN SystemDefs.FreeHeapNode[newText]; END ELSE BEGIN token _ sourceText[scanBase]; IF (scanBase _ scanBase+1) = scanLimit THEN BEGIN SystemDefs.FreeHeapNode[sourceText]; input _ P1.Atom END; END; RETURN END; -- acceptance checking best: RECORD [ nAccepted: CARDINAL, nPassed: [0..1], node: NodeIndex, mode: ParsingMode, nDiscards: CARDINAL]; RightScan: PROCEDURE [node: NodeIndex] RETURNS [stop: BOOLEAN] = BEGIN i: CARDINAL; 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 IN [scanBase .. scanLimit) DO IF state = FinalState THEN BEGIN nAccepted _ IF (sourceText[i].class = EndMarker) THEN scanLimit-scanBase ELSE 0; EXIT END; 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] END; -- strategy management RowRecord: TYPE = RECORD [ index, limit: CARDINAL, stack: StackRep, next: RowHandle]; RowHandle: TYPE = POINTER TO RowRecord; NextRow: PROCEDURE [list: RowHandle] RETURNS [row: RowHandle] = BEGIN r: RowHandle; s, t: TSymbol; row _ NIL; FOR r _ list, r.next UNTIL r = NIL DO IF r.index < r.limit THEN BEGIN s _ tSymbol[r.index]; IF row = NIL OR s < t THEN BEGIN row _ r; t _ s END; END; ENDLOOP; RETURN END; FreeRowList: PROCEDURE [list: RowHandle] = BEGIN r, next: RowHandle; FOR r _ list, next UNTIL r = NIL DO next _ r.next; SystemDefs.FreeHeapNode[r] ENDLOOP; END; Position: TYPE = {after, before}; Length: TYPE = CARDINAL [0..InsertLimit]; levelStart, levelEnd: ARRAY Position OF ARRAY Length OF NodeIndex; AddLeaf: PROCEDURE [stack: StackRep, s: TSymbol, thread: NodeIndex] RETURNS [stop: BOOLEAN] = BEGIN newLeaf: NodeIndex; saveNextNode: NodeIndex = nextNode; stack _ ParseStep[stack, s]; IF stack.leaf = NullIndex OR ExistingConfiguration[stack] # NullIndex THEN BEGIN nextNode _ saveNextNode; stop _ FALSE END ELSE BEGIN newLeaf _ 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]; END; RETURN END; GrowTree: PROCEDURE [p: Position, n: Length] RETURNS [stop: BOOLEAN] = BEGIN i: NodeIndex; tI, tLimit: TIndex; stack: StackRep; state: State; rowList, r: RowHandle; s: TSymbol; IF track THEN BEGIN OPEN CharIO; PutString[errorStream, "::generating length: "L]; PutDecimal[errorStream, n]; PutChar[errorStream, IF p = before THEN 'B ELSE 'A]; NewLine[]; END; rowList _ NIL; FOR i IN [levelStart[p][n-1] .. levelEnd[p][n-1]) DO IF tree[i].symbol # 0 OR n = 1 THEN BEGIN 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 _ SystemDefs.AllocateHeapNode[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; END; REPEAT found => stop _ TRUE; FINISHED => stop _ FALSE; ENDLOOP; FreeRowList[rowList]; rowList _ NIL; RETURN END; CheckTree: PROCEDURE [p: Position, n: Length] RETURNS [stop: BOOLEAN] = BEGIN i: NodeIndex; IF track THEN BEGIN OPEN CharIO; PutString[errorStream, "::checking length: "L]; PutDecimal[errorStream, n]; PutChar[errorStream, IF p = before THEN 'B ELSE 'A]; NewLine[]; END; FOR i 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 END; Accept: PROCEDURE = BEGIN j: CARDINAL; p: NodeIndex; s: TSymbol; discardBase: CARDINAL = best.nPassed; insertCount _ 1+InsertLimit; FOR p _ best.node, tree[p].last WHILE p > rTop DO IF (s _ tree[p].symbol) # 0 THEN BEGIN insertCount _ insertCount-1; newText[insertCount] _ P1.Token[s, P1.TokenValue[s], inputLoc]; END; ENDLOOP; scanBase _ discardBase; IF best.nDiscards # 0 THEN BEGIN OPEN CharIO; PutString[errorStream, "Text deleted is: "L]; FOR j IN [1 .. best.nDiscards] DO TypeSym[sourceText[scanBase].class]; scanBase _ scanBase + 1; ENDLOOP; END; IF insertCount <= InsertLimit THEN BEGIN OPEN CharIO; IF scanBase # discardBase THEN NewLine[]; PutString[errorStream, "Text inserted is: "L]; FOR j IN [insertCount .. InsertLimit] DO TypeSym[newText[j].class] ENDLOOP; END; IF discardBase = 1 THEN BEGIN insertCount _ insertCount-1; newText[insertCount] _ sourceText[0]; END; IF insertCount > InsertLimit THEN SystemDefs.FreeHeapNode[newText]; IF scanBase + best.nAccepted < scanLimit THEN P1.ResetScanIndex[sourceText[scanBase+best.nAccepted].index]; scanLimit _ scanBase + best.nAccepted; input _ RecoverInput; -- NewLine[]; END; TypeSym: PROCEDURE [sym: TSymbol] = BEGIN OPEN CharIO, lalrTable.scanTable; i: CARDINAL; vocab: STRING = LOOPHOLE[@vocabBody, STRING]; PutChar[errorStream, ' ]; IF sym ~IN [1..EndMarker) THEN PutDecimal[errorStream, sym] ELSE FOR i IN [vocabIndex[sym-1]..vocabIndex[sym]) DO PutChar[errorStream, vocab[i]] ENDLOOP; END; --stack node indices rTop: NodeIndex; Recover: PROCEDURE = BEGIN ModeMap: ARRAY Position OF ParsingMode = [ATree, BTree]; i: CARDINAL; place: Position; level: Length; inserts, discards: CARDINAL; stack: StackRep; threshold: CARDINAL; treeLimit _ TreeSize - CheckSize; FOR i IN [0 .. HashSize) DO hashTable[i] _ NullIndex ENDLOOP; 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 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 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 => BEGIN 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 BEGIN best.mode _ ATree; best.nPassed _ 1 END; ENDLOOP; END; ENDLOOP; END; SyntaxError: PROCEDURE [abort: BOOLEAN] RETURNS [success: BOOLEAN] = BEGIN IF abort THEN BEGIN OPEN CharIO; P1.ErrorContext["Syntax Error"L, inputLoc]; PutString[errorStream, "... Parse abandoned."L]; NewLine[]; success _ FALSE END ELSE BEGIN sourceText _ SystemDefs.AllocateHeapNode[SIZE[Buffer]]; newText _ SystemDefs.AllocateHeapNode[SIZE[Insert]]; tree _ SystemDefs.AllocateSegment[TreeSize*SIZE[StackNode]]; hashTable _ SystemDefs.AllocateSegment[HashSize*SIZE[NodeIndex]]; Recover[ ! TreeFull => CONTINUE]; SystemDefs.FreeSegment[hashTable]; P1.ErrorContext["Syntax Error"L, sourceText[IF best.mode=BTree THEN 0 ELSE 1].index]; IF (success _ best.nAccepted >= MinScanLimit) THEN Accept[] ELSE BEGIN CharIO.PutString[errorStream, "No recovery found."L]; SystemDefs.FreeHeapNode[newText]; SystemDefs.FreeHeapNode[sourceText]; END; SystemDefs.FreeSegment[tree]; NewLine[]; END; NewLine[]; RETURN END; NewLine: PROCEDURE = BEGIN CharIO.PutChar[errorStream, CharIO.CR] END; END.