-- File PackScanner.mesa
-- Last modified by Satterthwaite on May 30, 1980  11:32 AM
-- Last modified by Schmidt on September 18, 1980  1:59 PM
-- Last modified by Lewis on  2-Apr-81 19:11:27
-- Last modified by Levin and Satterthwaite on July 6, 1982 4:32 pm
-- Derived from Compiler>Scanner.Mesa

DIRECTORY
  CharIO USING [CR, TAB, PutChar, PutNumber, PutString],
  Inline USING [LowHalf],
  PackEnviron USING [CharsPerWord, PageSize],
  P1: FROM "PackParseDefs" USING [Token],
  ParseTable USING [
    HashIndex, TSymbol, VocabHashEntry, TableRef, tokenID, TrueEndOfFile],
  Streams USING [Ended, Handle, GetIndex, GetBlock, SetIndex, GetByte, End],
  LongStorage USING [FreeString, FreePages, Pages, Prune, String],
  Strings USING [AppendString, SubStringDescriptor, String],
  SymTabOps USING [EnterString];

Scanner: PROGRAM
    IMPORTS CharIO, Inline, Streams, LongStorage, Strings, SymTabOps 
    EXPORTS P1 =
  BEGIN
  OPEN ParseTable;

  hashTab: LONG POINTER TO ARRAY HashIndex OF VocabHashEntry;
  scanTab: LONG POINTER TO ARRAY CHARACTER [40C..177C] OF TSymbol;
  vocab: Strings.String;
  vocabIndex: LONG POINTER TO ARRAY TSymbol OF CARDINAL;

  NUL: CHARACTER = 0C;
  CR: CHARACTER = CharIO.CR;
  ControlZ: CHARACTER = 32C;		-- Bravo escape char

  stream: Streams.Handle;	-- the input stream
  streamOrigin: LONG CARDINAL;

  errorStream: Streams.Handle;	-- the error stream

  TextPages: CARDINAL = 6;
  TextWords: CARDINAL = TextPages * PackEnviron.PageSize;
  TextChars: CARDINAL = TextWords * PackEnviron.CharsPerWord;

  tB: LONG POINTER TO PACKED ARRAY [0..TextChars) OF CHARACTER;
  tI, tMax: [0..TextChars];
  tOrigin, tLimit: CARDINAL;
  tEnded: BOOLEAN;

  FillBuffer: PROC = {
    words: [0..TextWords];
    bytes: [0..PackEnviron.CharsPerWord);
    tOrigin _ tLimit;
    IF tEnded
      THEN tMax _ 0
      ELSE {
	words _ Streams.GetBlock[stream, tB, TextWords];
	bytes _ Inline.LowHalf[Streams.GetIndex[stream]]
          MOD PackEnviron.CharsPerWord;
	IF bytes # 0 THEN words _ words-1;
	tMax _ words*PackEnviron.CharsPerWord + bytes;
	IF tMax < TextChars THEN tEnded _ TRUE;
	tLimit _ tOrigin + tMax};
    IF tMax = 0 THEN {tB[0] _ 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 _ LongStorage.String[2*oldBuffer.length];
    Strings.AppendString[buffer, oldBuffer];
    iMax _ buffer.length _ buffer.maxlength;
    LongStorage.FreeString[oldBuffer];
    desc.base _ buffer};


  char: CHARACTER;	-- current (most recently scanned) character

  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 [NUL..' ] 
	DO
	SELECT char FROM
	  ControlZ =>
	    UNTIL char = 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 _ 0;
      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;
	  i _ 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 _ SymTabOps.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  => {
	  first, last: CARDINAL;
	  uId: BOOLEAN;
	  i, j: CARDINAL;
	  h: HashIndex;
	  s1, s2: CARDINAL;
	  i _ 0;  uId _ TRUE;  first _ last _ 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 _ ((first*128-first) + last) MOD LAST[HashIndex] + 1;
	      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[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 _ SymTabOps.EnterString[@desc];
	  GO TO GotNext};

	',, ';, ':, '=, '., '[, '], '{, '}  => {
	  class _ scanTab[char]; GO TO GetNext};

	'- => {
	  pChar: CHARACTER;
	  NextChar[];
	  IF char # '- THEN {class _ scanTab['-]; GO TO GotNext};
	  char _ NUL;
	    DO
	    pChar _ char;
	    IF (tI_tI+1) = tMax THEN {IF tEnded THEN GO TO EndFile;  FillBuffer[]};
	    char _ tB[tI];
	    SELECT char FROM
	      '- =>  IF pChar = '- THEN EXIT;
	      CR =>  EXIT;
	      ENDCASE;
	    ENDLOOP;
	  NextChar[]};

	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 => {
	  FillBuffer[];  char _ tB[tI];
	  class _ TrueEndOfFile;  index _ tOrigin;  value _ 0};
      ENDLOOP;
    nTokens _ nTokens + 1;
    RETURN};


 -- initialization/finalization

  ScanInit: PUBLIC PROC [
      sourceStream, messageStream: Streams.Handle,
      table: ParseTable.TableRef] = {
    hashTab _ @table[table.scanTable.hashTab];
    scanTab _ @table[table.scanTable.scanTab];
    vocab _ LOOPHOLE[@table[table.scanTable.vocabBody], Strings.String];
    vocabIndex _ @table[table.scanTable.vocabIndex];
    IF buffer = NIL THEN buffer _ LongStorage.String[256];
    iMax _ buffer.length _ buffer.maxlength;
    desc.base _ buffer;  desc.offset _ 0;
    stream _ sourceStream;  errorStream _ messageStream;
    streamOrigin _ Streams.GetIndex[stream];
    tB _ LongStorage.Pages[TextPages];
    tOrigin _ tLimit _ 0;  tMax _ 0;  tEnded _ FALSE;
    FillBuffer[];  char _ tB[tI];
    nTokens _ nErrors _ 0};

  ScanReset: PUBLIC PROC RETURNS [CARDINAL, CARDINAL] = {
    LongStorage.FreePages[tB];
    IF buffer # NIL THEN {LongStorage.FreeString[buffer]; buffer _ NIL};
    [] _ LongStorage.Prune[];
    RETURN [nTokens, nErrors]};


 -- error handling

  StreamIndex: TYPE = LONG CARDINAL;

  NewLine: PROC = INLINE {CharIO.PutChar[errorStream, CR]};

  PrintTextLine: PROC [origin: LONG CARDINAL] RETURNS [start: LONG CARDINAL] = {
    OPEN CharIO;
    lineIndex: LONG CARDINAL;
    char: CHARACTER;
    n: [1..100];
    start _ lineIndex _ origin;
    FOR n IN [1..100] UNTIL lineIndex = 0
      DO
      lineIndex _ lineIndex - 1;
      Streams.SetIndex[stream, lineIndex];
      IF Streams.GetByte[stream] = CR THEN EXIT;
      start _ lineIndex;
      ENDLOOP;
    Streams.SetIndex[stream, start];
    FOR n IN [1..100] UNTIL Streams.Ended[stream] 
      DO
      char _ Streams.GetByte[stream !  Streams.End[] => GOTO out];
      SELECT char FROM
	CR, ControlZ => EXIT;
	ENDCASE => PutChar[errorStream, char];
      REPEAT
        out => NULL;
      ENDLOOP;
    NewLine[];  RETURN};


  ResetScanIndex: PUBLIC PROC [index: CARDINAL] = {
    page: CARDINAL;
    IF ~(index IN [tOrigin .. tLimit))
      THEN {
	page _ index/(PackEnviron.PageSize * PackEnviron.CharsPerWord);
	tOrigin _ tLimit _ page*(PackEnviron.PageSize * PackEnviron.CharsPerWord);
	tMax _ 0;  tEnded _ FALSE;
	Streams.SetIndex[stream, streamOrigin + index];
	FillBuffer[]};
    tI _ index - tOrigin;
    IF tI >= tMax THEN FillBuffer[];  char _ tB[tI]};


  ScanError: PROC [code: {number, string, char, atom}, tokenIndex: CARDINAL] = {
    nErrors _ nErrors + 1;
    ErrorContext[
      SELECT code FROM
	number => "invalid number"L,
	string => "string too long"L,
	char => "invalid character"L,
	atom => "invalid atom"L,
	ENDCASE => NIL,
      tokenIndex];
    NewLine[]};


  ErrorContext: PUBLIC PROC [message: STRING, tokenIndex: CARDINAL] = {
    OPEN CharIO;
    saveIndex: LONG CARDINAL = Streams.GetIndex[stream];
    origin: LONG CARDINAL = streamOrigin+tokenIndex;
    char: CHARACTER;
    Streams.SetIndex[stream, PrintTextLine[origin]];
    UNTIL Streams.GetIndex[stream] = origin DO
      char _ Streams.GetByte[stream ! Streams.End[] => GOTO out];
      PutChar[errorStream, IF char = TAB THEN TAB ELSE ' ];
      REPEAT
        out => NULL;
      ENDLOOP;
    PutString[errorStream, "^ "L];  PutString[errorStream, message];
    PutString[errorStream, " ["L];
    PutNumber[errorStream, tokenIndex,
	[base:10, zerofill:FALSE, unsigned:TRUE, columns:0]];
    PutChar[errorStream, ']];   NewLine[];
    Streams.SetIndex[stream, saveIndex]};

  END.