-- file Scanner.mesa
-- last modified by Satterthwaite, August 25, 1982 4:11 pm

DIRECTORY
  Ascii: TYPE USING [BS, ControlZ, CR, FF, LF, NUL, TAB],
  CharIO: TYPE USING [PutChar, PutNumber, PutString],
  CompilerUtil: TYPE USING [
    AcquireStream, AcquireZone, ReleaseStream, ReleaseZone],
  Environment: TYPE USING [charsPerWord, charsPerPage, Word, wordsPerPage],
  FileStream: TYPE USING [FileByteIndex, EndOf, GetIndex, SetIndex],
  LiteralOps: TYPE USING [FindDescriptor, Find, FindString],
  P1: TYPE USING [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: FROM "IeeeFloat" USING [RealException, PairToReal],
  Stream: TYPE USING [Handle, GetBlock, GetChar],
  Strings: TYPE USING [String, SubStringDescriptor, AppendString],
  SymbolOps: TYPE USING [EnterString];

Scanner: PROGRAM
    IMPORTS
      CharIO, CompilerUtil, FileStream, LiteralOps, Real, Stream, Strings, SymbolOps 
    EXPORTS P1 = {
  OPEN ParseTable;

  zone: UNCOUNTED ZONE ← NIL;
  
  hashTab: HashTableRef;
  scanTab: ScanTableRef;
  vocab: VocabularyRef;
  vocabIndex: IndexTableRef;

  stream: Stream.Handle ← NIL;	-- the input stream
  streamOrigin: FileStream.FileByteIndex;

  TextPages: CARDINAL = 6;
  TextWords: CARDINAL = TextPages*Environment.wordsPerPage;
  TextChars: CARDINAL = TextWords*Environment.charsPerWord;
  TextBuffer: TYPE = PACKED ARRAY [0..TextChars) OF CHARACTER;
  
  tB: LONG POINTER TO TextBuffer;
  tI, tMax: [0..TextChars];
  tOrigin, tLimit: CARDINAL;
  tEnded: BOOLEAN;


  FillBuffer: PROC = {
    tOrigin ← tLimit;
    IF tEnded THEN tMax ← 0
    ELSE {
      tMax ← stream.GetBlock[[LOOPHOLE[tB], 0, TextChars]].bytesTransferred;
      IF tMax < TextChars THEN tEnded ← TRUE;
      tLimit ← tOrigin + tMax};
    IF tMax = 0 THEN {tB[0] ← Ascii.NUL; tMax ← 1};
    tI ← 0};


  buffer: Strings.String ← NIL;		-- token assembly area
  iMax: CARDINAL;			-- iMax = buffer.maxlength
  desc: Strings.SubStringDescriptor;	-- initial buffer segment

  nTokens: CARDINAL;			-- token count
  nErrors: CARDINAL;			-- lexical errors

  BufferOverflow: ERROR = CODE;

  ExpandBuffer: PROC = {
    oldBuffer: Strings.String ← buffer;
    IF oldBuffer.length > 2000 THEN ERROR BufferOverflow;
    buffer ← zone.NEW[StringBody[2*oldBuffer.length]];
    Strings.AppendString[buffer, oldBuffer];
    iMax ← buffer.length ← buffer.maxlength;
    zone.FREE[@oldBuffer];
    desc.base ← buffer};


  char: CHARACTER;	-- current (most recently scanned) character
  qDot: BOOLEAN;	-- used to resolved decimal point vs. interval

  NextChar: PROC = {	-- also expanded inline within Atom
    IF (tI←tI+1) = tMax THEN FillBuffer[]; char ← tB[tI]};


  Atom: PUBLIC PROC RETURNS [token: P1.Token] = {
    OPEN token;
    DO
      WHILE char IN [Ascii.NUL..' ] DO
	SELECT char FROM
	  Ascii.NUL => {		-- ↑@↑@ is Tioga escape seq
	    IF (tI←tI+1) = tMax THEN {IF tEnded THEN GO TO EndFile; FillBuffer[]};
	    char ← tB[tI];
	    IF char = Ascii.NUL THEN GO TO EndFile};
	  Ascii.ControlZ =>		-- ↑Z is Bravo escape char
	    UNTIL char = Ascii.CR DO
	      IF (tI←tI+1) = tMax THEN {IF tEnded THEN GO TO EndFile; FillBuffer[]};
	      char ← tB[tI];
	      ENDLOOP;
	  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: BOOLEAN ← TRUE;
	  first, last: CARDINAL ← char-0c;
	  DO
	    buffer[i] ← char;
	    IF (tI←tI+1) = tMax THEN FillBuffer[];
	    char ← tB[tI];
	    SELECT char FROM
	      IN ['A..'Z] => {
		last ← char-0c; 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 LAST[HashIndex] + 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: BOOLEAN;
	  [class, value, valid] ← CollectNumber[i: 0];
	  IF ~valid THEN ScanError[number, index];
	  GO TO GotNext};

	',, ';, ':, '←, '#, '+, '*, '/, '↑, '@, '!,
	'(, '), '[, '], '{, '}  => {
	  class ← scanTab[char]; GO TO GetNext};

	'' => {
	  c: CHARACTER;
	  valid, advance: BOOLEAN;
	  NextChar[];
	  [c, valid, advance] ← Escape[];
	  IF ~valid THEN ScanError[escape, index + 1];
	  class ← tokenCHAR;  value.r ← LiteralOps.Find[c-0c];
	  IF advance THEN GO TO GetNext ELSE GO TO GotNext};

	'" => {
	  i: CARDINAL ← 0;
	  valid: BOOLEAN;
	  advance: BOOLEAN ← 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 ← Ascii.NUL;
	  DO
	    pChar: CHARACTER = char;
	    IF (tI←tI+1) = tMax THEN {IF tEnded THEN GO TO EndFile;  FillBuffer[]};
	    char ← tB[tI];
	    SELECT char FROM
	      '- => IF pChar = '- THEN EXIT;
	      Ascii.CR => 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: BOOLEAN;
	      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};


 -- numerical conversion

  LongLit: TYPE = LONG UNSPECIFIED;
  endMark: CHAR = Ascii.NUL;
  
  CollectNumber: PROC [i: CARDINAL, float: BOOL←FALSE]
      RETURNS [class: TSymbol, value: P1.Value, valid: BOOL] = {
    hexCount: CARDINAL ← 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 = LAST[Environment.Word];
    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 CARDINAL = [0,1,2,3,4,5,6,7,8,9];
  HexDigit: ARRAY CHAR ['A..'F] OF CARDINAL = [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: CARDINAL = 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 = 1777777777b;	-- (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: CARDINAL = 6553;		-- (2**16-1)/10
    maxD: CARDINAL = 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: CARDINAL = 7;			-- (2**31-1) MOD 10
    RETURN [v < maxV OR (v = maxV AND Digit[digit] <= maxD)]};

 
  ScanDecimal: PROC [s: Strings.String] 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: Strings.String] 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: Strings.String] RETURNS [value: LongLit, valid: BOOL←TRUE] = {
    c: CHAR;
    maxChar: CARDINAL = 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: Strings.String] 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, c-('a-'A)];
        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: Strings.String] 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..SIZE[LongLit]) OF WORD ← LOOPHOLE[v];
    RETURN [[ref[IF long
      THEN LiteralOps.FindDescriptor[DESCRIPTOR[vRep]]
      ELSE LiteralOps.Find[vRep[0]]]]]};


 -- character and string constants
 
  EscapeMark: CHARACTER = 134c;		-- '\
  
  Escape: PROC RETURNS [c: CHARACTER, valid, advance: BOOLEAN ← 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 + (char - '0);
	    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};
    
     
 -- initialization/finalization

  ScanInit: PUBLIC PROC [table: ParseTable.TableRef] = {
    zone ← CompilerUtil.AcquireZone[];
    stream ← CompilerUtil.AcquireStream[source];
    hashTab ← @table[table.scanTable.hashTab];
    scanTab ← @table[table.scanTable.scanTab];
    vocab ← LOOPHOLE[@table[table.scanTable.vocabBody]];
    vocabIndex ← @table[table.scanTable.vocabIndex];
    IF buffer = NIL THEN buffer ← zone.NEW[StringBody[256]];
    iMax ← buffer.length ← buffer.maxlength;
    desc.base ← buffer;  desc.offset ← 0;
    streamOrigin ← FileStream.GetIndex[stream];
    tB ← zone.NEW[TextBuffer];
    tOrigin ← tLimit ← 0;  tMax ← 0;  tEnded ← FALSE;
    FillBuffer[];  char ← tB[tI];  qDot ← FALSE;
    nTokens ← nErrors ← 0};

  ScanReset: PUBLIC PROC RETURNS [CARDINAL, CARDINAL] = {
    CompilerUtil.ReleaseStream[source];
    zone.FREE[@tB];
    IF buffer # NIL THEN zone.FREE[@buffer];
    CompilerUtil.ReleaseZone[zone]; zone ← NIL;
    RETURN [nTokens, nErrors]};


 -- error handling

  StreamIndex: TYPE = FileStream.FileByteIndex;

  ResetScanIndex: PUBLIC PROC [index: CARDINAL] RETURNS [success: BOOLEAN] = {
    IF ~(index IN [tOrigin .. tLimit)) THEN {
      page: CARDINAL = index/Environment.charsPerPage;
      tOrigin ← tLimit ← page*Environment.charsPerPage;
      tMax ← 0;  tEnded ← FALSE;
      FileStream.SetIndex[stream, 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: CARDINAL] = {
    errorStream: Stream.Handle ← CompilerUtil.AcquireStream[log];
    nErrors ← nErrors + 1;
    ErrorContext[errorStream,
      SELECT code FROM
	number => "invalid number"L,
	string => "string unterminated or too long"L,
	char => "invalid character"L,
	atom => "invalid atom"L,
	escape => "invalid escape sequence"L,
	ENDCASE => NIL,
      tokenIndex];
    CharIO.PutChar[errorStream, Ascii.CR];
    CompilerUtil.ReleaseStream[log]};


  ErrorContext: PUBLIC PROC [
      to: Stream.Handle, message: Strings.String, tokenIndex: CARDINAL] = {
    OPEN CharIO;
    saveIndex: StreamIndex = FileStream.GetIndex[stream];
    origin: StreamIndex = streamOrigin + tokenIndex;
    start, lineIndex: StreamIndex ← origin;
    char: CHARACTER;
    n: [1..100];
    FOR n IN [1..100] UNTIL lineIndex = 0 DO
      lineIndex ← lineIndex - 1;
      FileStream.SetIndex[stream, lineIndex];
      IF stream.GetChar[] = Ascii.CR THEN EXIT;
      start ← lineIndex;
      ENDLOOP;
    FileStream.SetIndex[stream, start];
    FOR n IN [1..100] UNTIL FileStream.EndOf[stream] DO
      char ← stream.GetChar[];
      SELECT char FROM
	Ascii.CR, Ascii.ControlZ => EXIT;
	ENDCASE => PutChar[to, char];
      ENDLOOP;
    CharIO.PutChar[to, Ascii.CR];
    FileStream.SetIndex[stream, start];
    UNTIL FileStream.GetIndex[stream] = origin OR FileStream.EndOf[stream] DO
      char ← stream.GetChar[];
      PutChar[to, IF char = Ascii.TAB THEN Ascii.TAB ELSE ' ];
      ENDLOOP;
    PutString[to, "↑ "L];  PutString[to, message];  PutString[to, " ["L];
    PutNumber[to, tokenIndex, [base:10, zerofill:FALSE, unsigned:TRUE, columns:0]];
    PutChar[to, ']];   CharIO.PutChar[to, Ascii.CR];
    FileStream.SetIndex[stream, saveIndex]};

  }.