-- ModelScannerImpl.Mesa
-- derived from file Scanner.Mesa
-- Pilot 6.0/ Mesa 7.0
-- last modified by Satterthwaite, January 31, 1983 10:33 am
-- last modified by Schmidt,  5-Jan-82 18:16:13

DIRECTORY
  Ascii: TYPE USING [ControlZ, CR, NUL, TAB],
  CharIO: TYPE USING [Handle, PutChar, PutNumber, PutString],
  Environment: TYPE USING [charsPerWord, maxCARDINAL, wordsPerPage],
  FileStream: TYPE USING [EndOf, GetIndex, IndexOutOfRange, SetIndex],
  LongString: TYPE USING [AppendSubString, SubStringDescriptor],
  ModelParseTable: TYPE USING [
    endMarker, HashIndex, HashTableRef, IndexTableRef, ScanTableRef, 
    TableRef, tokenFILENAME, tokenID, tokenNUM, tokenSTR, VocabularyRef],
  P1: FROM "modelparsedefs" USING [
    AcquireStream, nullValue, ReleaseStream, Token, Value],
  Stream: TYPE USING [Delete, GetBlock, GetChar, Handle],
  Subr: TYPE USING [AllocateString, CopyString, FreeString, LongZone, strcpy];

ModelScannerImpl: PROGRAM
    IMPORTS
      CharIO, FileStream, LongString, P1, Stream, Subr 
    EXPORTS P1 = {
  OPEN ModelParseTable;

  TextPages: CARDINAL = 6;
  TextWords: CARDINAL = TextPages * Environment.wordsPerPage;
  TextChars: CARDINAL = TextWords * Environment.charsPerWord;
  
  LV: TYPE = LONG POINTER TO LVRecord;
  LVRecord: TYPE = RECORD[
  	stream: Stream.Handle _ NIL,	-- the input stream
	streamOrigin: LONG CARDINAL _ 0,
    	tB: LONG POINTER TO TBObject _ NIL,
  	tI: [0..TextChars] _ 0,
	tMax: [0..TextChars] _ 0,
  	tOrigin: CARDINAL _ 0, 
	tLimit: CARDINAL _ 0,
  	tEnded: BOOL _ FALSE,
  	char: CHAR _ '\000,	-- current (most recently scanned) character
 	nTokens: CARDINAL _ 0,			-- token count
  	nErrors: CARDINAL _ 0			-- # errors
	];
  TBObject: TYPE = PACKED ARRAY [0..TextChars) OF CHAR;

  NLEVELS: CARDINAL = 5;
  LevSeq: TYPE = LONG POINTER TO LevSeqRecord;
  LevSeqRecord: TYPE = RECORD[
  	size: CARDINAL _ 0,
	body: SEQUENCE maxsize: CARDINAL OF LVRecord
	];
	
-- !! MDS USAGE !!
  hashTab: HashTableRef;
  scanTab: ScanTableRef;
  vocab: VocabularyRef;
  vocabIndex: IndexTableRef;

  buffer: LONG STRING _ NIL;			-- token assembly area
  iMax: CARDINAL;			-- iMax = buffer.maxlength
  desc: LongString.SubStringDescriptor;	-- initial buffer segment

  qDot: BOOL;		-- used to resolved decimal point vs. interval
  levseq: LevSeq _ NIL;
 -- endof MDS usage


  FillBuffer: PROC = {
    lv: LV~@levseq[levseq.size-1];
    lv.tOrigin _ lv.tLimit;
    IF lv.tEnded
      THEN lv.tMax _ 0
      ELSE {
	[bytesTransferred: lv.tMax] _ Stream.GetBlock[lv.stream, [lv.tB, 0, TextChars]];
	IF lv.tMax < TextChars THEN lv.tEnded _ TRUE;
	lv.tLimit _ lv.tOrigin + lv.tMax;
	};
    IF lv.tMax = 0 THEN {lv.tB[0] _ Ascii.NUL; lv.tMax _ 1};
    lv.tI _ 0
    };


  BufferOverflow: ERROR = CODE;

  ExpandBuffer: PROC = {
    oldBuffer: LONG STRING _ buffer;
    IF oldBuffer.length > 2000 THEN ERROR BufferOverflow;
    buffer _ Subr.AllocateString[2*oldBuffer.length];
    Subr.strcpy[buffer, oldBuffer];
    iMax _ buffer.length _ buffer.maxlength;
    Subr.FreeString[oldBuffer];
    desc.base _ buffer
    };


  NextChar: PROC = INLINE {
    lv: LV~@levseq[levseq.size-1];
    IF (lv.tI_lv.tI+1) = lv.tMax THEN FillBuffer[]; lv.char _ lv.tB[lv.tI]
    };


  Atom: PUBLIC PROC RETURNS [token: P1.Token] = {
    OPEN token;
    lv: LV _ NIL;
    IF levseq.size = 0 THEN ERROR;
    lv _ @levseq[levseq.size-1];
    DO
      WHILE lv.char IN [Ascii.NUL..' ] DO
	SELECT lv.char FROM
	  Ascii.NUL => {		-- ^@^@ is Tioga escape seq
	    IF (lv.tI_lv.tI+1) = lv.tMax THEN {
			IF lv.tEnded THEN GO TO EndFile;
			FillBuffer[]};
	    lv.char _ lv.tB[lv.tI];
	    IF lv.char = Ascii.NUL THEN GO TO EndFile};
	  Ascii.ControlZ =>
	    UNTIL lv.char = Ascii.CR DO
	      IF (lv.tI_lv.tI+1) = lv.tMax THEN {
			IF lv.tEnded THEN GO TO EndFile; 
			FillBuffer[];
			};
	      lv.char _ lv.tB[lv.tI];
	      ENDLOOP;
	  ENDCASE;
	IF (lv.tI_lv.tI+1) = lv.tMax THEN {
		IF lv.tEnded THEN GO TO EndFile; 
		FillBuffer[];
		};
	lv.char _ lv.tB[lv.tI]
	ENDLOOP;
      index _ lv.tOrigin + lv.tI;  value _ P1.nullValue;
      SELECT lv.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;
	  str: STRING _ [40];
	  DO
	    buffer[i] _ lv.char;
	    NextChar[];
	    SELECT lv.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];
	  str.length _ 0;
	  LongString.AppendSubString[str,@desc];
	  value _ [ref[Subr.CopyString[str]]];
	  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;
	  str: STRING _ [40];
	  uId: BOOL _ TRUE;
	  first, last: CARDINAL _ lv.char-0C;
	  DO
	    buffer[i] _ lv.char;
	    NextChar[];
	    SELECT lv.char FROM
	      IN ['A..'Z] => {
		last _ lv.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];
	  str.length _ 0;
	  LongString.AppendSubString[str,@desc];
	  value _ [ref[Subr.CopyString[str]]];
	  GO TO GotNext};

	IN ['0..'9]  => {
	  v: LONG CARDINAL;
	  str: STRING _ [20];
	  valid: BOOL;
	  v10, v8: LONG CARDINAL _ 0;
	  valid10, valid8: BOOL _ TRUE;
	  exp: INTEGER _ 0;
	  point: BOOL _ FALSE;
	  MaxWord: CARDINAL = Environment.maxCARDINAL;
	  WHILE lv.char IN ['0..'9] DO
	    IF valid10 THEN [v10, valid10] _ AppendDigit10[v10, lv.char];
	    IF valid8 THEN [v8, valid8] _ AppendDigit8[v8, lv.char];
	    NextChar[];
	    ENDLOOP;
	  IF lv.char = '. THEN {
	    NextChar[];
	    IF lv.char = '.
	      THEN qDot _ TRUE
	      ELSE {point _ TRUE; [v10, exp, valid10] _ ScanFraction[v10, valid10]}};
	  SELECT lv.char FROM
	    'b, 'B => {
	      NextChar[];
	      v _ v8;  [exp, valid] _ ScanScaleFactor[valid8 AND ~point];
	      THROUGH [1 .. exp]  WHILE valid DO
		[v, valid] _ AppendDigit8[v, '0] ENDLOOP;
	      class _ tokenNUM};
	    'd, 'D => {
	      NextChar[];
	      v _ v10;  [exp, valid] _ ScanScaleFactor[valid10 AND ~point];
	      THROUGH [1 .. exp]  WHILE valid DO
		[v, valid] _ AppendDigit10[v, '0] ENDLOOP;
	      class _ tokenNUM};
	    ENDCASE => {
	      v _ v10; valid _ valid10; class _ IF point THEN tokenNUM ELSE tokenNUM};
	    IF v > MaxWord
		THEN value _ EnterLongLit[v]
		ELSE {class _ tokenNUM; value _ EnterLit[v]};
	  IF ~valid THEN ScanError[number, index];
          GO TO GotNext};

	'@ => {
		i: CARDINAL;
		str: STRING _ [100];
		rbseen: BOOL _ FALSE;	-- avoid parsing too far if ]
		i _ 0;
		DO 
			buffer[i] _ lv.char;
			NextChar[];
			-- check for [ after @
			IF i = 0 AND lv.char ~= '[ THEN rbseen _ TRUE;
			SELECT lv.char FROM
			IN ['a..'z], IN ['A..'Z], IN ['0..'9], 
			'>, '<, '., '*, '^, '~ => {
				IF (i _ i+1) >= iMax THEN ExpandBuffer[];
	      			IF lv.char = '< OR lv.char = '> THEN rbseen _ TRUE;
				};
			'[, '] => {
				IF ~rbseen THEN {
					IF (i _ i+1) >= iMax THEN ExpandBuffer[];
					IF lv.char = '] THEN rbseen _ TRUE
					}
				ELSE EXIT;
				};
			ENDCASE => EXIT;
			ENDLOOP;
		desc.length _ i + 1;
		class _ tokenFILENAME;
		str.length _ 0;
		LongString.AppendSubString[str, @desc];
		value _ [ref[Subr.CopyString[str]]];
		GOTO GotNext;
		};
		
	',, ';, ':, '_, '#, '~, '+, '*, '/, '^, '!,
	'(, '), '[, '], '{, '}  => {
	  class _ scanTab[lv.char]; GO TO GetNext};

	'" => {
	  i: CARDINAL _ 0;
	  str: STRING _ [40];
	  DO 
	    NextChar[];
	    IF lv.tEnded AND lv.tMax = 0 THEN GO TO EOFEnd;  
	    SELECT lv.char FROM
	      '" => {
		NextChar[];
		IF lv.char # '" THEN GO TO QuoteEnd};
	      ENDCASE;
	    IF i >= iMax
	      THEN ExpandBuffer[
		! BufferOverflow => {ScanError[string, index]; i _ 0; CONTINUE}];
	    buffer[i] _ lv.char;  i _ i+1;
	    REPEAT
	      QuoteEnd => NULL;
	      EOFEnd => {ScanError[string, index]; FillBuffer[];  lv.char _ lv.tB[lv.tI]};
	    ENDLOOP;
	  desc.length _ i;
	  str.length _ 0;
	  LongString.AppendSubString[str,@desc];
	  value _ [ref[Subr.CopyString[str]]];
	  class _ tokenSTR; 
	  GO TO GotNext
	  };

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

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

	ENDCASE => {
	  class _ scanTab[lv.char];
	  IF class # 0 THEN GO TO GetNext;
	  NextChar[];
	  ScanError[char, index]};

      REPEAT
	GetNext => {NextChar[];};
	GotNext => NULL;
	EndFile => {
	  FillBuffer[];  lv.char _ lv.tB[lv.tI];
	  class _ endMarker;  index _ lv.tOrigin;  value _ P1.nullValue;
	  };
      ENDLOOP;	-- the loop that gets chars
    lv.nTokens _ lv.nTokens + 1;
    RETURN};


  PushStream: PROC[sh: Stream.Handle] = {
  longzone: UNCOUNTED ZONE _ Subr.LongZone[];
  lvrec: LVRecord _ [];
  IF levseq.size > levseq.maxsize THEN {
  	ERROR;		-- CWF.WF0["Too many levels of nesting.\n"L];
	-- RETURN;
	}
  ELSE {
	lv: LV _ @levseq[levseq.size];
	lv^ _ lvrec;
	lv.tB _ longzone.NEW[TBObject];
	lv.streamOrigin _ FileStream.GetIndex[sh];
	lv.stream _ sh;
	levseq.size _ levseq.size + 1;
	FillBuffer[];
	lv.char _ lv.tB[lv.tI];
	};
  };
  
	
 -- numerical conversion

  Digit: ARRAY CHAR['0..'9] OF CARDINAL~[0,1,2,3,4,5,6,7,8,9];

  AppendDigit10: 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};

  AppendDigit8: PROC [v: LONG CARDINAL, digit: CHAR ['0..'9]]
      RETURNS [newV: LONG CARDINAL, valid: BOOL] = {
    MaxV: LONG CARDINAL~3777777777B;	-- (2**32-1)/8
    MaxD: CARDINAL~7B;		-- (2**32-1) MOD 8
    d: [0..9]~Digit[digit];
    valid _ (d < 8) AND (v < MaxV OR (v = MaxV AND d <= MaxD));
    newV _ 8*v + d;
    RETURN};

  ScanFraction: PROC [v: LONG CARDINAL, valid: BOOL]
      RETURNS [newV: LONG CARDINAL, exp: INTEGER, newValid: BOOL] = {
    newV _ v;  exp _ 0;  newValid _ valid AND levseq[levseq.size - 1].char IN ['0..'9];
    WHILE levseq[levseq.size - 1].char IN ['0..'9] DO
      IF newValid THEN [newV, newValid] _ AppendDigit10[newV, levseq[levseq.size - 1].char];
      exp _ exp-1;
      NextChar[];
      ENDLOOP;
    RETURN};

  ScanExponent: PROC [exp: INTEGER, valid: BOOL]
      RETURNS [newExp: INTEGER, newValid: BOOL] = {
    op: {plus, minus} _ plus;
    scale: INTEGER;
    SELECT levseq[levseq.size - 1].char FROM
      '+ => NextChar[];
      '- => {op _ minus; NextChar[]};
      ENDCASE;
    [scale, newValid] _ ScanScaleFactor[valid AND (levseq[levseq.size - 1].char IN ['0..'9])];
    newExp _ IF op = plus THEN exp + scale ELSE exp - scale;
    RETURN};

  ScanScaleFactor: PROC [valid: BOOL]
      RETURNS [scale: INTEGER, newValid: BOOL] = {
    Max: INTEGER~(32767-9)/10;	-- (2**15-10)/10
    newValid _ valid;  scale _ 0;
    WHILE levseq[levseq.size - 1].char IN ['0..'9] DO
      newValid _ valid AND scale <= Max;
      IF newValid THEN scale _ 10*scale + Digit[levseq[levseq.size - 1].char];
      NextChar[];
      ENDLOOP;
    RETURN};

  EnterLit: PROC [v: LONG CARDINAL] RETURNS [P1.Value] = {
    RETURN [[scalar[v]]]};

  EnterLongLit: PROC [v: LONG CARDINAL] RETURNS [P1.Value] = {
    RETURN [[scalar[v]]]};

  EnterFloating: PROC [v: LONG CARDINAL, exp: INTEGER, valid: BOOL]
      RETURNS [value: P1.Value, newValid: BOOL] = {
    RETURN};

 -- initialization/finalization

  ScanInit: PUBLIC PROC [table: ModelParseTable.TableRef] = {
    lv: LV;
    longzone: UNCOUNTED ZONE _ Subr.LongZone[];
    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 _ Subr.AllocateString[256];
    iMax _ buffer.length _ buffer.maxlength;
    desc.base _ buffer;  desc.offset _ 0;
    IF levseq = NIL THEN levseq _ longzone.NEW[LevSeqRecord[NLEVELS]];
    PushStream[P1.AcquireStream[source]];
    qDot _ FALSE;
    lv _ @levseq[levseq.size-1];
    lv.nTokens _ lv.nErrors _ 0
    };

  -- this closes the input stream and frees all the memory
  -- may be called by a nested parser
  ScanReset: PUBLIC PROC RETURNS [nTokens, nErrors: CARDINAL] = {
    longzone: UNCOUNTED ZONE _ Subr.LongZone[];
    IF levseq.size > 0 THEN {
    	lv: LV;
	levseq.size _ levseq.size-1;
	lv _ @levseq[levseq.size];
	nTokens _ lv.nTokens;
    	nErrors _ lv.nErrors;
    	longzone.FREE[@lv.tB];
    	Stream.Delete[lv.stream];
    	lv.stream _ NIL;
    	};
    IF levseq.size = 0 THEN GuaranteeScannerCleanedUp[];
    };

  GuaranteeScannerCleanedUp: PUBLIC PROC = {
  longzone: UNCOUNTED ZONE _ Subr.LongZone[];
  IF buffer # NIL THEN {
	Subr.FreeString[buffer];	-- may give address faults
	buffer _ NIL
	};
  IF levseq ~= NIL THEN longzone.FREE[@levseq];
  };
  
 -- error handling

  StreamIndex: TYPE = LONG CARDINAL;

  ResetScanIndex: PUBLIC PROC [index: CARDINAL] RETURNS [success: BOOL] = {
    lv: LV~@levseq[levseq.size - 1];
    IF index NOT IN [lv.tOrigin .. lv.tLimit)
      THEN {
	page: CARDINAL = index/(Environment.wordsPerPage*Environment.charsPerWord);
	lv.tOrigin _ lv.tLimit _ page*(Environment.wordsPerPage*Environment.charsPerWord);
	lv.tMax _ 0;  lv.tEnded _ FALSE;
	FileStream.SetIndex[lv.stream, lv.streamOrigin + lv.tOrigin];
	FillBuffer[]};
    lv.tI _ index - lv.tOrigin;
    IF lv.tI >= lv.tMax THEN FillBuffer[];  lv.char _ lv.tB[lv.tI];
    RETURN [TRUE]
    };


  ScanError: PROC [code: {number, string, char, atom}, tokenIndex: CARDINAL] = {
    errorStream: Stream.Handle _ P1.AcquireStream[log];
    lv: LV~@levseq[levseq.size-1];
    lv.nErrors _ lv.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,
	ENDCASE => NIL,
      tokenIndex];
    CharIO.PutChar[errorStream, Ascii.CR];
    P1.ReleaseStream[log]
    };


  ErrorContext: PUBLIC PROC [
      to: Stream.Handle, message: LONG STRING, tokenIndex: CARDINAL] = {
    lv: LV~@levseq[IF levseq.size > 0 THEN levseq.size - 1 ELSE 0];
    saveIndex: StreamIndex = FileStream.GetIndex[lv.stream];
    origin: StreamIndex = lv.streamOrigin + tokenIndex;
    start, lineIndex: StreamIndex _ origin;
    char: CHAR;
    n: [1..100];
    skip: BOOL;
    FOR n IN [1..100] UNTIL lineIndex = 0 DO
      skip _ FALSE;
      lineIndex _ lineIndex - 1;
      FileStream.SetIndex[lv.stream, lineIndex
      	! FileStream.IndexOutOfRange => {
		skip _ TRUE;
		CONTINUE;
		}
	];
      IF ~skip AND Stream.GetChar[lv.stream] = Ascii.CR THEN EXIT;
      start _ lineIndex;
      ENDLOOP;
    FileStream.SetIndex[lv.stream, start];
    FOR n IN [1..100] UNTIL FileStream.EndOf[lv.stream] DO
      char _ Stream.GetChar[lv.stream];
      SELECT char FROM
	Ascii.CR, Ascii.ControlZ => EXIT;
	ENDCASE => CharIO.PutChar[to, char];
      ENDLOOP;
    CharIO.PutChar[to, Ascii.CR];
    FileStream.SetIndex[lv.stream, start];
    UNTIL FileStream.GetIndex[lv.stream] = origin OR FileStream.EndOf[lv.stream] DO
      char _ Stream.GetChar[lv.stream];
      CharIO.PutChar[to, IF char = Ascii.TAB THEN Ascii.TAB ELSE ' ];
      ENDLOOP;
    CharIO.PutString[to, "^ "L];  CharIO.PutString[to, message];  CharIO.PutString[to, " ["L];
    CharIO.PutNumber[to, tokenIndex, [base:10, zerofill:FALSE, unsigned:TRUE, columns:0]];
    CharIO.PutChar[to, ']];   CharIO.PutChar[to, Ascii.CR];
    FileStream.SetIndex[lv.stream, saveIndex]
    };

  }.