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

  }.