<> <> <> <> <> <> DIRECTORY Ascii: TYPE USING [BS, CR, FF, LF, TAB], Basics: TYPE USING [charsPerWord, Word], ConvertUnsafe: TYPE USING [SubString], IO: TYPE USING [ card, EndOf, GetChar, GetIndex, Put, PutChar, rope, SetIndex, STREAM, UnsafeGetBlock], LiteralOps: TYPE USING [FindDescriptor, Find, FindString], P1: TYPE USING [Index, Token, Value, nullValue], ParseTable: TYPE USING [ HashIndex, HashTableRef, IndexTableRef, ScanTableRef, TableRef, TSymbol, VocabularyRef, endMarker, tokenARROW, tokenATOM, tokenCHAR, tokenDOT, tokenDOTS, tokenEQUAL, tokenGE, tokenGREATER, tokenID, tokenLE, tokenLESS, tokenFLNUM, tokenLNUM, tokenLSTR, tokenMINUS, tokenNE, tokenNUM, tokenSTR, tokenTILDE], Real: TYPE USING [RealException, PairToReal], RefText: TYPE USING [Append], Rope: TYPE USING [ROPE], SymbolOps: TYPE USING [EnterString], VM: TYPE USING [wordsPerPage]; Scanner: PROGRAM IMPORTS IO, LiteralOps, Real, RefText, SymbolOps EXPORTS P1 = { OPEN ParseTable; <> tablePtr: ParseTable.TableRef; hashTab: HashTableRef; scanTab: ScanTableRef; vocab: VocabularyRef; vocabIndex: IndexTableRef; InstallScanTable: PUBLIC PROC[base: ParseTable.TableRef] = { tablePtr _ base; hashTab _ @tablePtr[tablePtr.scanTable.hashTab]; scanTab _ @tablePtr[tablePtr.scanTable.scanTab]; vocab _ LOOPHOLE[@tablePtr[tablePtr.scanTable.vocabBody]]; vocabIndex _ @tablePtr[tablePtr.scanTable.vocabIndex]}; <> stream: IO.STREAM _ NIL; -- the input stream streamOrigin: P1.Index; -- FileStream.FileByteIndex Logger: PROC[PROC [log: IO.STREAM]] _ NIL; textPages: NAT ~ 6; textWords: NAT ~ textPages*VM.wordsPerPage; textChars: NAT ~ textWords*Basics.charsPerWord; charsPerPage: NAT ~ Basics.charsPerWord*VM.wordsPerPage; TextBuffer: TYPE ~ PACKED ARRAY [0..textChars) OF CHAR; tB: REF TextBuffer; tI, tMax: [0..textChars]; tOrigin, tLimit: P1.Index; tEnded: BOOL; FillBuffer: PROC ~ { tOrigin _ tLimit; IF tEnded THEN tMax _ 0 ELSE { tMax _ stream.UnsafeGetBlock[[LOOPHOLE[tB], 0, textChars]].nBytesRead; IF tMax < textChars THEN tEnded _ TRUE; tLimit _ tOrigin + tMax}; IF tMax = 0 THEN {tB[0] _ '\000; tMax _ 1}; tI _ 0}; buffer: REF TEXT _ NIL; -- token assembly area iMax: CARDINAL; -- iMax = buffer.maxLength desc: ConvertUnsafe.SubString; -- initial buffer segment nTokens: NAT; -- token count nErrors: NAT; -- lexical errors BufferOverflow: ERROR ~ CODE; ExpandBuffer: PROC ~ { oldBuffer: REF TEXT _ buffer; IF oldBuffer.length > 2000 THEN ERROR BufferOverflow; buffer _ NEW[TEXT[2*buffer.length]]; desc.base _ LOOPHOLE[buffer, LONG POINTER]; buffer _ RefText.Append[to~buffer, from~oldBuffer]; iMax _ buffer.length _ buffer.maxLength}; char: CHAR; -- current (most recently scanned) character qDot: BOOL; -- used to resolved decimal point vs. interval NextChar: PROC ~ { -- also expanded inline within Atom IF (tI_tI+1) = tMax THEN FillBuffer[]; char _ tB[tI]}; NextToken: PUBLIC PROC RETURNS[token: P1.Token] ~ { OPEN token; DO WHILE char IN ['\000..' ] DO SELECT char FROM '\000 => { -- ^@^@ is Tioga escape seq IF (tI_tI+1) = tMax THEN {IF tEnded THEN GO TO EndFile; FillBuffer[]}; char _ tB[tI]; IF char = '\000 THEN GO TO EndFile}; ENDCASE => { IF (tI_tI+1) = tMax THEN {IF tEnded THEN GO TO EndFile; FillBuffer[]}; char _ tB[tI]}; ENDLOOP; index _ tOrigin + tI; value _ P1.nullValue; SELECT char FROM 'a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k, 'l, 'm, 'n, 'o, 'p, 'q, 'r, 's, 't, 'u, 'v, 'w, 'x, 'y, 'z => { i: CARDINAL _ 0; DO buffer[i] _ char; IF (tI_tI+1) = tMax THEN FillBuffer[]; char _ tB[tI]; SELECT char FROM IN ['a..'z], IN ['A..'Z], IN ['0..'9] => IF (i _ i+1) >= iMax THEN ExpandBuffer[]; ENDCASE => EXIT; ENDLOOP; desc.length _ i+1; class _ tokenID; value.r _ SymbolOps.EnterString[desc]; GO TO GotNext}; 'A, 'B, 'C, 'D, 'E, 'F, 'G, 'H, 'I, 'J, 'K, 'L, 'M, 'N, 'O, 'P, 'Q, 'R, 'S, 'T, 'U, 'V, 'W, 'X, 'Y, 'Z => { i: CARDINAL _ 0; uId: BOOL _ TRUE; first, last: NAT _ char.ORD; DO buffer[i] _ char; IF (tI_tI+1) = tMax THEN FillBuffer[]; char _ tB[tI]; SELECT char FROM IN ['A..'Z] => { last _ char.ORD; IF (i _ i+1) >= iMax THEN ExpandBuffer[]}; IN ['a..'z], IN ['0..'9] => { uId _ FALSE; IF (i _ i+1) >= iMax THEN ExpandBuffer[]}; ENDCASE => EXIT; ENDLOOP; i _ i+1; IF uId THEN { h: HashIndex _ ((first*128-first) + last) MOD HashIndex.LAST + 1; j, s1, s2: CARDINAL; WHILE (j _ hashTab[h].symbol) # 0 DO IF vocabIndex[j]-(s2_vocabIndex[j-1]) = i THEN FOR s1 IN [0 .. i) DO IF buffer[s1] # vocab.text[s2] THEN EXIT; s2 _ s2+1; REPEAT FINISHED => {class _ j; GO TO GotNext}; ENDLOOP; IF (h _ hashTab[h].link) = 0 THEN EXIT; ENDLOOP}; desc.length _ i; class _ tokenID; value.r _ SymbolOps.EnterString[desc]; GO TO GotNext}; '0, '1, '2, '3, '4, '5, '6, '7, '8, '9 => { valid: BOOL; [class, value, valid] _ CollectNumber[i~0]; IF ~valid THEN ScanError[$number, index]; GO TO GotNext}; ',, ';, ':, '_, '#, '+, '*, '/, '^, '@, '!, '(, '), '[, '], '{, '} => { class _ scanTab[char]; GO TO GetNext}; '' => { c: CHAR; valid, advance: BOOL; NextChar[]; [c, valid, advance] _ Escape[]; IF ~valid THEN ScanError[$escape, index + 1]; class _ tokenCHAR; value.r _ LiteralOps.Find[c.ORD]; IF advance THEN GO TO GetNext ELSE GO TO GotNext}; '" => { i: CARDINAL _ 0; valid: BOOL; advance: BOOL _ TRUE; DO IF advance THEN { IF (tI_tI+1) = tMax THEN {IF tEnded THEN GO TO EOFEnd; FillBuffer[]}; char _ tB[tI]}; SELECT char FROM '" => { IF (tI_tI+1) = tMax THEN FillBuffer[]; char _ tB[tI]; IF char # '" THEN GO TO QuoteEnd}; ENDCASE; IF i >= iMax THEN ExpandBuffer[ ! BufferOverflow => {ScanError[$string, index]; i _ 0; CONTINUE}]; [buffer[i], valid, advance] _ Escape[]; i _ i+1; IF ~valid THEN ScanError[$escape, tOrigin + tI]; REPEAT QuoteEnd => NULL; EOFEnd => {ScanError[$string, index]; FillBuffer[]; char _ tB[tI]}; ENDLOOP; desc.length _ i; value.r _ LiteralOps.FindString[desc]; IF char = 'l OR char = 'L THEN {class _ tokenLSTR; GO TO GetNext} ELSE {class _ tokenSTR; GO TO GotNext}}; '$ => { i: CARDINAL; i _ 0; NextChar[]; SELECT char FROM IN ['a..'z], IN ['A..'Z] => NULL; ENDCASE => ScanError[$atom, index]; DO SELECT char FROM IN ['a..'z], IN ['A..'Z], IN ['0..'9] => { IF i >= iMax THEN ExpandBuffer[]; buffer[i] _ char; i _ i+1}; ENDCASE => EXIT; NextChar[]; ENDLOOP; desc.length _ i; class _ tokenATOM; value.r _ SymbolOps.EnterString[desc]; GO TO GotNext}; '- => { NextChar[]; IF char # '- THEN {class _ tokenMINUS; GO TO GotNext}; char _ '\000; DO pChar: CHAR ~ char; IF (tI_tI+1) = tMax THEN {IF tEnded THEN GO TO EndFile; FillBuffer[]}; char _ tB[tI]; SELECT char FROM '- => IF pChar = '- THEN EXIT; '\n => EXIT; ENDCASE; ENDLOOP; NextChar[]}; '. => { IF qDot THEN { qDot _ FALSE; index _ index-1; class _ tokenDOTS; GO TO GetNext}; NextChar[]; SELECT char FROM '. => {class _ tokenDOTS; GO TO GetNext}; IN ['0..'9] => { valid: BOOL; buffer[0] _ '.; [class, value, valid] _ CollectNumber[i~1, float~TRUE]; IF ~valid THEN ScanError[$number, index]; GO TO GotNext}; ENDCASE => {class _ tokenDOT; GO TO GotNext}}; '= => { NextChar[]; IF char = '> THEN {class _ tokenARROW; GO TO GetNext} ELSE {class _ tokenEQUAL; GO TO GotNext}}; '< => { NextChar[]; IF char = '= THEN {class _ tokenLE; GO TO GetNext} ELSE {class _ tokenLESS; GO TO GotNext}}; '> => { NextChar[]; IF char = '= THEN {class _ tokenGE; GO TO GetNext} ELSE {class _ tokenGREATER; GO TO GotNext}}; '~ => { NextChar[]; SELECT char FROM '= => {class _ tokenNE; GO TO GetNext}; '< => {class _ tokenGE; GO TO GetNext}; '> => {class _ tokenLE; GO TO GetNext} ENDCASE => {class _ tokenTILDE; GO TO GotNext}}; ENDCASE => { class _ scanTab[char]; IF class # 0 THEN GO TO GetNext; NextChar[]; ScanError[$char, index]}; REPEAT GetNext => {IF (tI_tI+1) = tMax THEN FillBuffer[]; char _ tB[tI]}; GotNext => NULL; EndFile => { class _ endMarker; index _ tOrigin + (tI-1); value _ P1.nullValue; UNTIL tEnded DO FillBuffer[] ENDLOOP; -- flush stream FillBuffer[]; char _ tB[tI]}; ENDLOOP; nTokens _ nTokens + 1; RETURN}; <> LongLit: TYPE ~ LONG UNSPECIFIED; endMark: CHAR ~ '\000; CollectNumber: PROC[i: CARDINAL, float: BOOL_FALSE] RETURNS[class: TSymbol, value: P1.Value, valid: BOOL] ~ { hexCount: NAT _ 0; hexSig: PACKED ARRAY CHAR['a..'h] OF {F, T} _ ALL[F]; v: LongLit; Accept: PROC ~ INLINE { buffer[i] _ char; IF (i _ i+1) >= iMax THEN ExpandBuffer[]; NextChar[]}; maxWord: LONG CARDINAL ~ Basics.Word.LAST; class _ tokenLNUM; DO SELECT char FROM IN ['0..'9] => Accept[]; 'e, 'E => { hexSig['e] _ T; hexCount _ hexCount + 1; Accept[]; IF hexCount = 1 AND char = '+ OR char = '- THEN { float _ TRUE; Accept[]}}; IN ['a..'f] => {hexSig[char] _ T; hexCount _ hexCount+1; Accept[]}; IN ['A..'F] => { hexSig[char+('a-'A)] _ T; hexCount _ hexCount+1; Accept[]}; 'h, 'H => {hexSig['h] _ T; hexCount _ hexCount+1; Accept[]}; '. => { IF hexCount # 0 OR float THEN EXIT; NextChar[]; IF char = '. THEN {qDot _ TRUE; EXIT}; float _ TRUE; buffer[i] _ '.; IF (i _ i+1) >= iMax THEN ExpandBuffer[]}; ENDCASE => EXIT; ENDLOOP; buffer[i] _ endMark; SELECT TRUE FROM float => {class _ tokenFLNUM; [v, valid] _ ScanFloating[buffer]}; (hexSig['h] = T) => [v, valid] _ ScanHex[buffer]; ENDCASE => SELECT hexCount FROM 0 => [v, valid] _ ScanDecimal[buffer]; 1 => SELECT hexSig FROM [F,T,F,F,F,F,F,F] => [v, valid] _ ScanOctal[buffer]; [F,F,T,F,F,F,F,F] => { class _ tokenCHAR; [v, valid] _ ScanOctalChar[buffer]}; [F,F,F,T,F,F,F,F] => [v, valid] _ ScanDecimal[buffer]; [F,F,F,F,T,F,F,F] => { class _ tokenFLNUM; [v, valid] _ ScanFloating[buffer]}; ENDCASE => [v, valid] _ ScanHex[buffer]; ENDCASE => [v, valid] _ ScanHex[buffer]; SELECT class FROM tokenCHAR => value _ EnterLit[v, FALSE]; tokenFLNUM => value _ EnterLit[v]; ENDCASE => IF LOOPHOLE[v, LONG CARDINAL] > maxWord THEN value _ EnterLit[v] ELSE {class _ tokenNUM; value _ EnterLit[v, FALSE]}; RETURN}; Digit: ARRAY CHAR ['0..'9] OF [0..9] ~ [0,1,2,3,4,5,6,7,8,9]; HexDigit: ARRAY CHAR ['A..'F] OF [0..15] ~ [10,11,12,13,14,15]; AppendDecimal: PROC[v: LONG CARDINAL, digit: CHAR ['0..'9]] RETURNS[newV: LONG CARDINAL, valid: BOOL] ~ { maxV: LONG CARDINAL ~ 429496729; -- (2**32-1)/10 maxD: NAT ~ 5; -- (2**32-1) MOD 10 d: [0..9] ~ Digit[digit]; valid _ v < maxV OR (v = maxV AND d <= maxD); newV _ 10*v + d; RETURN}; AppendOctal: PROC[v: LONG CARDINAL, digit: CHAR ['0..'7]] RETURNS[newV: LONG CARDINAL, valid: BOOL] ~ { maxV: LONG CARDINAL ~ 3777777777b; -- (2**32-1)/8 d: [0..7] ~ Digit[digit]; valid _ (v <= maxV); newV _ 8*v + d; RETURN}; AppendHex: PROC[v: LONG CARDINAL, digit: CHAR ['0..'F]] RETURNS[newV: LONG CARDINAL, valid: BOOL] ~ { maxV: LONG CARDINAL ~ 0FFFFFFFh; -- (2**32-1)/16 d: [0..15] ~ IF digit IN ['0..'9] THEN Digit[digit] ELSE HexDigit[digit]; valid _ (v <= maxV); newV _ 16*v + d; RETURN}; AppendToScale: PROC[v: CARDINAL, digit: CHAR ['0..'9]] RETURNS[newV: CARDINAL, valid: BOOL] ~ { maxV: NAT ~ 6553; -- (2**16-1)/10 maxD: NAT ~ 5; -- (2**16-1) MOD 10 d: [0..9] ~ Digit[digit]; valid _ v < maxV OR (v = maxV AND d <= maxD); newV _ 10*v + d; RETURN}; ValidFraction: PROC[v: LONG CARDINAL, digit: CHAR ['0..'9]] RETURNS[BOOL] ~ { maxV: LONG CARDINAL ~ 214748364; -- (2**31-1)/10 maxD: NAT ~ 7; -- (2**31-1) MOD 10 RETURN[v < maxV OR (v = maxV AND Digit[digit] <= maxD)]}; ScanDecimal: PROC[s: REF TEXT] RETURNS[value: LongLit, valid: BOOL_TRUE] ~ { c: CHAR; i: CARDINAL _ 0; v: LONG CARDINAL _ 0; IF s[i] NOT IN ['0..'9] THEN valid _ FALSE; WHILE (c _ s[i]) IN ['0..'9] DO IF valid THEN [v, valid] _ AppendDecimal[v, c]; i _ i+1; ENDLOOP; IF c = 'd OR c = 'D THEN { scale: CARDINAL _ 0; WHILE (c _ s[i_i+1]) IN ['0..'9] DO IF valid THEN [scale, valid] _ AppendToScale[scale, c]; ENDLOOP; THROUGH [1 .. scale] WHILE valid DO [v, valid] _ AppendDecimal[v, '0] ENDLOOP}; IF c # endMark THEN valid _ FALSE; value _ v; RETURN}; ScanOctal: PROC[s: REF TEXT] RETURNS[value: LongLit, valid: BOOL_TRUE] ~ { c: CHAR; i: CARDINAL _ 0; v: LONG CARDINAL _ 0; IF s[i] NOT IN ['0..'7] THEN valid _ FALSE; WHILE (c _ s[i]) IN ['0..'7] DO IF valid THEN [v, valid] _ AppendOctal[v, c]; i _ i+1; ENDLOOP; IF c = 'b OR c = 'B THEN { scale: CARDINAL _ 0; WHILE (c _ s[i_i+1]) IN ['0..'9] DO IF valid THEN [scale, valid] _ AppendToScale[scale, c]; ENDLOOP; THROUGH [1 .. scale] WHILE valid DO [v, valid] _ AppendOctal[v, '0] ENDLOOP}; IF c # endMark THEN valid _ FALSE; value _ v; RETURN}; ScanOctalChar: PROC[s: REF TEXT] RETURNS[value: LongLit, valid: BOOL_TRUE] ~ { c: CHAR; maxChar: NAT ~ 377b; i: CARDINAL _ 0; v: LONG CARDINAL _ 0; IF s[i] NOT IN ['0..'7] THEN valid _ FALSE; WHILE (c _ s[i]) IN ['0..'7] DO IF valid THEN [v, valid] _ AppendOctal[v, c]; i _ i+1; ENDLOOP; IF c = 'c OR c = 'C THEN c _ s[i_i+1] ELSE valid _ FALSE; IF c # endMark OR v NOT IN [0 .. maxChar] THEN valid _ FALSE; value _ v; RETURN}; ScanHex: PROC[s: REF TEXT] RETURNS[value: LongLit, valid: BOOL_TRUE] ~ { c: CHAR; i: CARDINAL _ 0; v: LONG CARDINAL _ 0; IF s[i] NOT IN ['0..'9] THEN valid _ FALSE; DO SELECT (c _ s[i]) FROM IN ['0..'9], IN ['A..'F] => IF valid THEN [v, valid] _ AppendHex[v, c]; IN ['a..'f] => IF valid THEN [v, valid] _ AppendHex[v, VAL[(c.ORD-'a.ORD)+'A.ORD]]; ENDCASE => EXIT; i _ i + 1; ENDLOOP; IF c = 'h OR c = 'H THEN { scale: CARDINAL _ 0; WHILE (c _ s[i_i+1]) IN ['0..'9] DO IF valid THEN [scale, valid] _ AppendToScale[scale, c]; ENDLOOP; THROUGH [1 .. scale] WHILE valid DO [v, valid] _ AppendHex[v, '0] ENDLOOP}; IF c # endMark THEN valid _ FALSE; value _ v; RETURN}; ScanFloating: PROC[s: REF TEXT] RETURNS[value: LongLit, valid: BOOL_TRUE] ~ { c: CHAR; i: CARDINAL _ 0; v: LONG CARDINAL _ 0; exp: INTEGER _ 0; WHILE (c _ s[i]) IN ['0..'9] DO valid _ valid AND ValidFraction[v, c]; IF valid THEN v _ AppendDecimal[v, c].newV ELSE exp _ exp + 1; -- should round i _ i+1; ENDLOOP; IF c = '. THEN { i _ i+1; IF s[i] NOT IN ['0..'9] THEN valid _ FALSE; WHILE (c _ s[i]) IN ['0..'9] DO valid _ valid AND ValidFraction[v, c]; IF valid THEN {[v, valid] _ AppendDecimal[v, c]; exp _ exp-1} ELSE NULL; -- should round i _ i+1; ENDLOOP}; valid _ TRUE; IF c = 'e OR c = 'E THEN { scale: INTEGER _ 0; op: {plus, minus} _ $plus; i _ i + 1; SELECT s[i] FROM '+ => i _ i+1; '- => {op _ $minus; i _ i+1}; ENDCASE; IF s[i] NOT IN ['0..'9] THEN valid _ FALSE; WHILE (c _ s[i]) IN ['0..'9] DO IF valid THEN [scale, valid] _ AppendToScale[scale, c]; i _ i+1; ENDLOOP; exp _ IF op = $plus THEN exp + scale ELSE exp - scale}; -- need overflow check IF c # endMark THEN valid _ FALSE; value _ Real.PairToReal[v, exp ! Real.RealException => {valid _ FALSE; RESUME}]; RETURN}; EnterLit: PROC[v: LongLit, long: BOOL_TRUE] RETURNS[P1.Value] ~ { vRep: ARRAY [0..LongLit.SIZE) OF WORD _ LOOPHOLE[v]; RETURN[[ref[IF long THEN LiteralOps.FindDescriptor[DESCRIPTOR[vRep]] ELSE LiteralOps.Find[vRep[0]]]]] }; <> escapeMark: CHAR ~ '\\; Escape: PROC RETURNS[c: CHAR, valid, advance: BOOL_TRUE] ~ { c _ char; IF c = escapeMark THEN { NextChar[]; SELECT char FROM 'n, 'N => c _ Ascii.CR; 'r, 'R => c _ Ascii.CR; 'l, 'L => c _ Ascii.LF; 't, 'T => c _ Ascii.TAB; 'b, 'B => c _ Ascii.BS; 'f, 'F => c _ Ascii.FF; '', '", escapeMark => c _ char; IN ['0 .. '7] => { nc, v: CARDINAL _ 0; DO IF ~(char IN ['0..'7]) THEN {valid _ advance _ FALSE; EXIT}; v _ 8*v + Digit[char]; IF (nc _ nc+1) = 3 THEN EXIT; NextChar[]; ENDLOOP; IF v > 377b THEN {valid _ FALSE; v _ 0}; c _ v + 0c}; ENDCASE => valid _ advance _ FALSE}; RETURN}; <> ScanInit: PUBLIC PROC[ source: IO.STREAM, logger: PROC [PROC[log: IO.STREAM]]] ~ { stream _ source; Logger _ logger; IF buffer = NIL THEN buffer _ NEW[TEXT[256]]; desc.base _ LOOPHOLE[buffer, LONG POINTER]; desc.offset _ 0; iMax _ buffer.length _ buffer.maxLength; streamOrigin _ stream.GetIndex[]; tB _ NEW[TextBuffer]; tOrigin _ tLimit _ 0; tMax _ 0; tEnded _ FALSE; FillBuffer[]; char _ tB[tI]; qDot _ FALSE; nTokens _ nErrors _ 0}; ScanStats: PUBLIC PROC RETURNS[NAT, NAT] ~ { RETURN[nTokens, nErrors]}; ScanReset: PUBLIC PROC ~ { IF buffer # NIL THEN FREE[@buffer]; IF tB # NIL THEN FREE[@tB]; stream _ NIL; Logger _ NIL}; <> ResetScanIndex: PUBLIC PROC[index: P1.Index] RETURNS[success: BOOL] ~ { IF ~(index IN [tOrigin .. tLimit)) THEN { page: CARDINAL ~ index/charsPerPage; tOrigin _ tLimit _ page*charsPerPage; tMax _ 0; tEnded _ FALSE; stream.SetIndex[streamOrigin + tOrigin]; FillBuffer[]}; tI _ index - tOrigin; IF tI >= tMax THEN FillBuffer[]; char _ tB[tI]; RETURN[TRUE]}; ErrorCode: TYPE ~ {number, string, char, atom, escape}; ScanError: PROC[code: ErrorCode, tokenIndex: P1.Index] ~ { Inner: PROC[log: IO.STREAM] ~ { ErrorContext[log, SELECT code FROM $number => "invalid number", $string => "string unterminated or too long", $char => "invalid character", $atom => "invalid atom", $escape => "invalid escape sequence", ENDCASE => NIL, tokenIndex]; log.PutChar['\n]}; nErrors _ nErrors + 1; Logger[Inner]}; ErrorContext: PUBLIC PROC[ to: IO.STREAM, message: Rope.ROPE, tokenIndex: P1.Index] ~ { saveIndex: P1.Index ~ stream.GetIndex[]; origin: P1.Index ~ streamOrigin + tokenIndex; start, lineIndex: P1.Index _ origin; char: CHAR; n: [1..100]; FOR n IN [1..100] UNTIL lineIndex = 0 DO lineIndex _ lineIndex - 1; stream.SetIndex[lineIndex]; IF stream.GetChar[] = '\n THEN EXIT; start _ lineIndex; ENDLOOP; stream.SetIndex[start]; FOR n IN [1..100] UNTIL stream.EndOf[] DO char _ stream.GetChar[]; SELECT char FROM '\n, '\032 => EXIT; ENDCASE => to.PutChar[char]; ENDLOOP; to.PutChar['\n]; stream.SetIndex[start]; UNTIL stream.GetIndex[] = origin OR stream.EndOf[] DO char _ stream.GetChar[]; to.PutChar[IF char = '\t THEN '\t ELSE ' ]; ENDLOOP; to.Put[IO.rope["^ "], IO.rope[message]]; to.Put[IO.rope[" ["], IO.card[tokenIndex]]; to.PutChar[']]; to.PutChar['\n]; stream.SetIndex[saveIndex]}; }.