-- file PGSScan.Mesa rewritten by PGS, 29-Aug-80  9:27
-- file PGSScan.Mesa
-- syntax last modified by Satterthwaite,  7-Jan-80 11:31 
-- code   last modified by Satterthwaite, July 14, 1980  2:53 PM

DIRECTORY
  PGS1: TYPE USING [ErrorContext, InputLoc, locateindex, Token],
  ParseTable: FROM "PGSParseTable" USING [
    ActionEntry, EndMarker, Handle, HashIndex, Production, ProductionInfo,
    tokenID, tokenNUM, tokenTAB3, tokenTAB4, TSymbol, VocabHashEntry],
  PGScondefs: TYPE;

Scanner: PROGRAM
    IMPORTS PGS1, PGScondefs 
    EXPORTS PGS1, PGScondefs =
  BEGIN OPEN  PGS1, ParseTable, PGScondefs;

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

  check: CARDINAL = 3;
  warning: CARDINAL = 0;
  specErrorCases: CARDINAL = 5;

  token, numRhsChars: CARDINAL;
  lineWidth: INTEGER;
  insertFlag: CARDINAL;

  hashChain: DESCRIPTOR FOR ARRAY [1..symtabsize/4] OF CARDINAL;

  ProductionArray: TYPE = ARRAY Production OF ProductionInfo;

 -- local data base (supplied by parser)

  v: DESCRIPTOR FOR ARRAY OF UNSPECIFIED;
  l: DESCRIPTOR FOR ARRAY OF CARDINAL;

  q: DESCRIPTOR FOR ARRAY OF ActionEntry;

  prodData: POINTER TO ProductionArray;

 -- initialization/termination

  AssignDescriptors: PUBLIC PROC [
	qd: DESCRIPTOR FOR ARRAY OF ActionEntry,
	vd: DESCRIPTOR FOR ARRAY OF UNSPECIFIED,
	ld: DESCRIPTOR FOR ARRAY OF CARDINAL,
	pp: POINTER TO ProductionArray] =
    {q _ qd;  v _ vd;  l _ ld;  prodData _ pp};

  outtoken: PUBLIC PROC [symbol:CARDINAL] RETURNS [CARDINAL] =
    BEGIN
    IF symbol=0 THEN {outstring["* * *"]; RETURN[5]};
    FOR i:CARDINAL IN [0..syminfo[symbol].length)
      DO outchar[symtab[symbol*tokensize+i],1] ENDLOOP;
    RETURN [syminfo[symbol].length]
    END;


 -- the interpretation rules

  prix, chix: CARDINAL; --indexes into prodinfo and rhschar
  rhsFlag: BOOLEAN; 
  lastSymbol, lhsDef: CARDINAL;

  ProcessQueue: PUBLIC PROC [qI, top: CARDINAL] =
    BEGIN qj,i,j,k: CARDINAL;
    opt: Options;

   -- local procedures
    PrintTableHead: PROC [c: CHARACTER]=
      BEGIN IF flags[echo] THEN
	{outeol[2];outstring["||TABLE"]; outchar[c,1]; outeol[1]}
      END;

    SetRuleChain: PROC [rule: CARDINAL, chain: BOOLEAN] =
      BEGIN
      FixLastProd[];
      IF prix=LENGTH[prodinfo] THEN --production table overflow
	prodinfo _ LOOPHOLE[expand[prodinfo,SIZE[prodrecord],LENGTH[prodinfo]/8]];
      prodinfo[prix].chain _ chain;
      IF rule>maxrule THEN Error[check+10,-5,InputLoc[]] ELSE prodinfo[prix].rule _ rule
      END;

    FixLastProd: PROC =
      BEGIN prodinfo[prix-1].lhs _ lhsDef;
      IF prodinfo[prix-1].count=0 THEN tokeninfo[lhsDef-eofile].empty _ TRUE;
      IF rhsFlag THEN  -- too many rhschars
	{rhsFlag _ FALSE; Error[check+5, (prix-1+specErrorCases), InputLoc[]]};
      END;

    ProdHeader: PROC [new:BOOLEAN] =
      BEGIN
      prodinfo[prix].index _ chix;
      IF lhsDef>eofile THEN
	BEGIN IF tokeninfo[lhsDef-eofile].count=alternatelim THEN
	  BEGIN Error[check+1, lhsDef,InputLoc[]];  --too many alternatives
	  tokeninfo[lhsDef-eofile].count _1
	  END;
	tokeninfo[lhsDef-eofile].count _ tokeninfo[lhsDef-eofile].count + 1;
	END;
      IF flags[echo] THEN
	BEGIN lineWidth _ outbuflim-tokensize-14;
         outeol[IF new THEN 2 ELSE 1];outnum[prix,3];
	outstring[IF prodinfo[prix].chain THEN " C " ELSE "   "];
	outnum[prodinfo[prix].rule,3]; outchar[' ,2];
	outchar[' ,tokensize-(IF new THEN outtoken[lhsDef] ELSE 0)];
	outstring[IF new THEN " ::= " ELSE "   | "];
	END;
      prix _ prix+1
      END;

    LhsSymbol: PROC [symbol:CARDINAL] =
      BEGIN lhsDef _ symbol;
      IF lhsDef<=eofile THEN Error[check+4,lhsDef,InputLoc[]]
	-- undefined or terminal symbol before ::=
      ELSE
      IF tokeninfo[lhsDef-eofile].index = 0 THEN tokeninfo[lhsDef-eofile].index _ prix
      ELSE Error[check+2,lhsDef,InputLoc[]]; --multiple definitions
      ProdHeader[TRUE];
      END;
   -- end of local procedures

    FOR qj IN [0..qI)
      DO top _ top-q[qj].tag.pLength+1;
      SELECT prodData[q[qj].transition].rule FROM

       0  => -- TYPE: ParseTable    MODULE: PGSParseTable.mesa
	     -- BINARY: PGSParseData.bcd    INTERFACE: SELF
	     -- GOAL: grammar
	     -- TERMINALS:
	     --   symbol num '? '| "::=" 'C "||TABLE1" "||TABLE2" "||TABLE3"
	     --   "||TABLE4" "||INPUT" "||CHAIN" "||LISTS" "||PRINTLR"
	     --   "||PRINTLALR" "||FIRST" "||IDS" "GOAL"
	     -- ALIASES: symbol tokenID  num tokenNUM  '? tokenQUERY
	     --   "||TABLE3" tokenTAB3  "||TABLE4" tokenTAB4  '? InitialSymbol
	     -- PRODUCTIONS:
	     -- grammar        ::= '? head ruleset
	  BEGIN FixLastProd[]; numprod _ prix-1; numRhsChars _ chix-1; i _ 1;
	  IF flags[echo] THEN outeol[1];
	  IF numprod > psslim OR totaltokens > psslim THEN Error[check+6,0,InputLoc[]];
	  FreeSegment[BASE[hashChain]];
	  WHILE syminfo[i].used AND i<=totaltokens
	    DO IF i>eofile AND tokeninfo[i-eofile].index = 0 THEN EXIT; i _ i+1;
	    ENDLOOP;
	  IF i <= totaltokens THEN
	    BEGIN defflag:BOOLEAN _ FALSE;
	    lineWidth _ 0; Error[warning+3,0,InputLoc[]]; seterrstream[];
	    FOR i IN [i..totaltokens]
	      DO j _ 0; IF ~syminfo[i].used THEN j _ j+1;
	      IF i > eofile AND tokeninfo[i-eofile].index = 0 THEN j _ j+2;
	      IF j # 0 THEN
	        BEGIN
		IF (lineWidth _ lineWidth+(k_(11+j)/2)) > outbuflim
		  THEN {outeol[1]; lineWidth _ k};
		outnum[i,5];
		IF j#2 THEN outchar['U,1] ELSE defflag _ TRUE;
		IF j>1 THEN outchar['D,1]
	        END;
	      ENDLOOP;
	    outeol[1]; resetoutstream[];
	    IF defflag THEN
	      Error[check+3,-2,InputLoc[]]; -- nonterminal used but not defined
	    END;
	  FOR i IN [1..numprod]
	    DO IF prodinfo[i].chain THEN
	    IF prodinfo[i].count # 1 OR rhschar[prodinfo[i].index] <= eofile THEN
	      BEGIN Error[warning+2, -(i+specErrorCases), InputLoc[]];
	      prodinfo[i].chain _ FALSE;
	      END;
	    ENDLOOP;
	  END;

       1  => -- head           ::= directives terminals nonterminals "||TABLE4"
	     -- head           ::= directives terminals nonterminals aliases "||TABLE4"
	  BEGIN totaltokens _ lastSymbol; PrintTableHead['4];
	  tokeninfo _ LOOPHOLE[makearray[totaltokens-eofile+1,SIZE[tokenrecord]]];
	  prodinfo _ LOOPHOLE[makearray[maxprod+1,SIZE[prodrecord]]];
	  rhschar _ LOOPHOLE[makearray[maxrhssymbols+1,SIZE[CARDINAL]]];
	  FOR i IN [0..totaltokens-eofile]
	    DO tokeninfo[i] _ [count:0, empty:FALSE, index:0] ENDLOOP;
	  prodinfo[0] _ [count:2, rule:0, chain:FALSE, lhs:0, index:0];
	  FOR i IN [1..maxprod]
	    DO prodinfo[i] _ [count:0, rule:0, chain:FALSE, lhs:0, index:0];
	    ENDLOOP;
	  IF flags[echo] THEN
	    BEGIN outeol[1]; outchar[' ,20]; outstring["GOAL ::= "];
	    [] _ outtoken[eofile+1]; outchar[' ,1]; [] _ outtoken[eofile]
	    END;
	  rhschar[0] _ eofile+1; rhschar[1] _ eofile;
	  syminfo[eofile+1].used _ syminfo[eofile].used _ TRUE;
	  prix _ 1; chix _ 2; lhsDef _ 0; rhsFlag _ FALSE;
	  END;

       2  => -- directives     ::=
	  BEGIN FOR opt IN [FIRST[Options]..LAST[Options]]
	    DO flags[opt] _ FALSE ENDLOOP;
	  l[top] _ InputLoc[];
	  END;

       3  => -- directive      ::= "||INPUT"
	  {flags[echo] _ TRUE; setoutstream[".echo"]};

       4  => -- directive      ::= "||CHAIN"
	  flags[chain] _ TRUE;

       5  => -- directive      ::= "||LISTS"
	  flags[lists] _ TRUE;

       6  => -- directive      ::= "||PRINTLR"
 	  flags[printlr] _ TRUE;

       7  => -- directive      ::= "||PRINTLALR"
	  flags[printlalr] _ TRUE;

       8  => -- directive      ::= "||FIRST"
	  flags[first] _ TRUE;

       9  => -- directive      ::= "||IDS"
	  flags[ids] _ TRUE;

      10  => -- terminals      ::= "||TABLE1"
	  BEGIN
	  IF flags[echo] THEN
	    BEGIN outeol[1];
	    FOR opt IN [FIRST[Options]..LAST[Options]]
	      DO IF flags[opt] THEN outstring[
	        SELECT opt FROM
	          echo => "||INPUT "L,
	          chain => "||CHAIN "L,
	          lists => "||LISTS "L,
	          printlr => "||PRINTLR "L,
	          printlalr => "||PRINTLALR "L,
	          first => "||FIRST "L,
	          ENDCASE => "||IDS "L];
	      ENDLOOP;
	    END;
	  PrintTableHead['1];
	  END;

      11  => -- terminals      ::= terminals discard symbol
	     -- nonterminals   ::= nonterminals discard symbol 
	  BEGIN lastSymbol _ v[top+2];
	  IF flags[echo] THEN
	    BEGIN outnum[lastSymbol, 3]; outchar[' , 2];
	    [] _ outtoken[lastSymbol];
	    outeol[1]
	    END;
	  END;

      12  => -- nonterminals   ::= "||TABLE2"
	  BEGIN PrintTableHead['2]; eofile _ lastSymbol;
	  nextalias _ 0; -- assert TABLE3 empty in case it is omitted
	  END;

      13  => -- aliases        ::= "||TABLE3"
	  BEGIN PrintTableHead['3];
	  aliases _ LOOPHOLE[makearray[64,SIZE[aliasrecord]]];
	  END;

      14  => -- aliases        ::= aliases symbol symbol
	  BEGIN IF v[top+1]>eofile THEN Error[check+7,v[top+1],InputLoc[]];
	  IF v[top+2]<=eofile THEN Error[check+8,v[top+2],InputLoc[]];
	  IF nextalias=LENGTH[aliases] THEN
		aliases _ LOOPHOLE[expand[aliases,SIZE[aliasrecord],LENGTH[aliases]/8]];
	  aliases[nextalias] _ [v[top+1],v[top+2]]; nextalias _ nextalias+1;
	  IF flags[echo] THEN
	    BEGIN outchar[' ,tokensize+1-outtoken[v[top+1]]]; outchar[' ,1];
	    j _ v[top+2]*tokensize;
	    FOR i IN [j..j+tokensize) WHILE symtab[i]#0C DO outchar[symtab[i],1] ENDLOOP;
	    outeol[1];
	    END;
	  END;

      15  => -- discard        ::=
	  l[top] _ InputLoc[]; -- keep the parser error recovery happy

      16  => -- rulegroup      ::= symbol "::="
	  {SetRuleChain[prix, FALSE]; LhsSymbol[v[top]]};

      17  => -- rulegroup      ::= prefix symbol "::="
	  LhsSymbol[v[top+1]];

      18  => -- rulegroup      ::= rulegroup symbol "::="
	  {SetRuleChain[prix, FALSE]; LhsSymbol[v[top+1]]};

      19  => -- rulegroup      ::= rulegroup prefix symbol "::="
	  LhsSymbol[v[top+2]];

      20  => -- rulegroup      ::= rulegroup '|
	  {SetRuleChain[prix, FALSE]; ProdHeader[FALSE]};

      21  => -- rulegroup      ::= rulegroup prefix '|
	  ProdHeader[FALSE];

      22  => -- rulegroup      ::= rulegroup symbol
	  BEGIN i _ v[top+1]; syminfo[i].used _ TRUE;
	  IF i=eofile OR i=eofile+1 THEN Error[check+9,0,InputLoc[]]; --goal symbols
	  IF flags[echo] THEN
	    BEGIN IF lineWidth<syminfo[i].length THEN
	      BEGIN outeol[1]; outchar[' ,tokensize+18];
	      lineWidth _ outbuflim - tokensize-18;
	      END;
	    IF (lineWidth _ (lineWidth-outtoken[i]-1)) > 0 THEN outchar[' , 1];
	    END;
	  IF chix=LENGTH[rhschar] THEN
	    rhschar _ LOOPHOLE[expand[rhschar,SIZE[CARDINAL],LENGTH[rhschar]/8]];
	  rhschar[chix]_i; chix _ chix +1;
	  IF prodinfo[prix-1].count = rhslim
	    THEN {prodinfo[prix-1].count _ 1; rhsFlag _ TRUE};
	  prodinfo[prix-1].count _ prodinfo[prix-1].count+1;
	  END;

      23  => -- prefix         ::= num
	  SetRuleChain[v[top], FALSE];

      24  => -- prefix         ::= num num
              -- prefix         ::= '? num
	  SetRuleChain[v[top+1], FALSE];

      25  => -- prefix         ::= discard 'C
	  SetRuleChain[prix, TRUE];

      26  => -- prefix         ::= discard 'C num
	  SetRuleChain[v[top+2], TRUE];

      27  => -- prefix         ::= '?
	  SetRuleChain[prix, FALSE];

      28  => -- directives     ::= directives directive
	     -- discard        ::= num
	     -- discard        ::= '?
	     -- ruleset        ::=C rulegroup
	     -- ruleset        ::= goalrule rulegroup
	     -- goalrule       ::= "GOAL" "::=" symbol symbol
	  NULL;
	ENDCASE => ERROR;
       ENDLOOP;
    END;
 
-- the following procedure is called from the ScanReset if no errors

  FinishInput: PROCEDURE =
    BEGIN emptyflag: BOOLEAN _ TRUE;
    i,j,k,prix,chix: CARDINAL;
    -- compute nonterminals deriving empty
    WHILE emptyflag
      DO emptyflag _ FALSE;
      FOR i IN [1..totaltokens-eofile]  -- each nonterminal
        DO IF tokeninfo[i].empty THEN LOOP;  --which does not derive empty
        j _ tokeninfo[i].index;
        FOR prix IN [j..j+tokeninfo[i].count)
            -- each production of the nonterminal
	DO k _ prodinfo[prix].index;
	FOR chix IN [k..k+prodinfo[prix].count)   -- each rhs character
	  DO
           IF rhschar[chix]<=eofile OR  ~tokeninfo[rhschar[chix]-eofile].empty THEN EXIT;
	  REPEAT FINISHED =>
	    {tokeninfo[i].empty _ emptyflag _ TRUE; EXIT};
	  ENDLOOP
	ENDLOOP
        ENDLOOP
      ENDLOOP;
    checkout[];
    END;

    -- the following procedure outputs the data structure contents in the tables:
    --          PRODUCTIONINFO            TOKENINFO             SYMINFO
    -- num count rule chain lhs index   count empty index   link used length   symbol
    --  4 1  3    5    1    4    5   2   3     1     5   2   4   1     3    1  ...

  checkout: PUBLIC PROC =
    BEGIN i: CARDINAL;
    IF flags[ids] THEN
      BEGIN seterrstream[]; outeol[1];
      outstring["       PRODUCTIONINFO     TOKENINFO    SYMINFO"];
      FOR i IN [0..MAX[numprod,totaltokens]]
        DO outeol[1]; outnum[i,4]; outchar[' ,1];
        IF i>numprod THEN outchar[' ,20] ELSE
	BEGIN outnum[prodinfo[i].count,3]; outnum[prodinfo[i].rule,5];
	outchar[IF prodinfo[i].chain THEN 'C ELSE ' , 1];
	outnum[prodinfo[i].lhs,4]; outnum[prodinfo[i].index,5]; outchar[' ,2];
	END;
        IF i<=totaltokens AND i>0 THEN
	BEGIN IF i<=eofile THEN outchar[' ,11] ELSE
	  BEGIN outnum[tokeninfo[i-eofile].count,3];
           outchar[IF tokeninfo[i-eofile].empty THEN 'E ELSE ' ,1];
	  outnum[tokeninfo[i-eofile].index,5]; outchar[' ,2]
	  END;
	outnum[syminfo[i].link,4]; outchar[IF syminfo[i].used THEN 'U ELSE ' ,1];
	outnum[syminfo[i].length,3]; outchar[' ,1]; [] _ outtoken[i];
	END
        ENDLOOP;
      outeol[1]; outstring["RHSCHAR"]; lineWidth _ outbuflim;
      FOR i IN [0..numRhsChars]
        DO lineWidth _ lineWidth+tokensize+1;
        IF lineWidth > outbuflim THEN {outeol[1]; outnum[i,4]; lineWidth _ 4};
        outchar[' ,1]; [] _ outtoken[rhschar[i]];
        ENDLOOP;
      outeol[1]; resetoutstream[];
      END;
    END;


 -- error recovery

  TokenValue: PUBLIC PROC [s: TSymbol] RETURNS [UNSPECIFIED] = {RETURN [0]};

-- text input and error routines

  NUL: CHARACTER = 0C;

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

  FillTextBuffer: PROC =
    BEGIN tOrigin _ tLimit;
    IF tEnded THEN  tMax _ 0 ELSE
	{[tB, tMax, tEnded] _ nextbuffer[]; tLimit _ tOrigin + tMax};
    IF tMax = 0 THEN {tB[0] _ NUL;  tMax _ 1};
    tI _ 0;
    END;


  buffer: STRING = [tokensize];		-- token assembly area

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


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

  NextChar: PROC =	-- also expanded inline within Atom
    BEGIN IF (tI_tI+1) = tMax THEN FillTextBuffer[];
    char _ tB[tI];
    END;


  Atom: PUBLIC PROC RETURNS [t: Token] =
    BEGIN OPEN t;

    LocateToken: PROC [string: STRING] RETURNS [CARDINAL] =
      BEGIN -- returns token corresponding to string
      i,j,k: CARDINAL;
      j _ hashChain[(string.length*256+LOOPHOLE[string[0],CARDINAL])
		MOD (symtabsize/4) + 1];
      WHILE j # 0
        DO IF syminfo[j].length = string.length THEN
	 BEGIN i _ j*tokensize;
	 FOR k IN [0..string.length)
	   DO IF symtab[i+k]#string[k] THEN EXIT
	   REPEAT FINISHED => RETURN[j]
	   ENDLOOP;
	 END;
        j _ syminfo[j].link;
        ENDLOOP;
      RETURN [0]
      END;

    TokenToSymTab: PROC [string: STRING, token: CARDINAL] =
      BEGIN i,j: CARDINAL;
      i _ token*tokensize;
      FOR j IN [0..string.length) DO symtab[i+j] _ string[j] ENDLOOP;
      syminfo[token].length _ string.length; syminfo[token].used _ FALSE;
      j _ (string.length*256+LOOPHOLE[string[0],CARDINAL])
		MOD (symtabsize/4) + 1;
      syminfo[token].link _ hashChain[j]; hashChain[j] _ token;
      END;

    TokenOrId: PROC [sub:CARDINAL]=
      BEGIN j, s1, s2: CARDINAL;
      h: HashIndex;
      WHILE char ~IN [NUL..' ]
        DO IF sub<tokensize THEN buffer[sub] _ char;
        sub _ sub + 1; NextChar[];
        ENDLOOP;
      IF sub>tokensize
        THEN {buffer.length_sub_tokensize; Error[1,-1,index]}; --overlength
      IF sub = 1 THEN
        BEGIN class _ scanTab[buffer[0]];
        IF class # 0 THEN RETURN
        END;
      j _ buffer[0] - 0C;
      h _ ((j*128-j) + CARDINAL[buffer[sub-1]-0C]) MOD LAST[HashIndex] + 1;
      WHILE (j _ hashTab[h].symbol) # 0 
        DO IF vocabIndex[j]-(s2_vocabIndex[j-1]) = sub THEN
          FOR s1 IN [0 .. sub) 
	   DO IF buffer[s1] # vocab[s2] THEN EXIT;
	   s2 _ s2+1;
	   REPEAT FINISHED =>
	     BEGIN IF j = tokenTAB3 THEN insertFlag _ 2 ELSE
	       IF j = tokenTAB4 THEN insertFlag _ 3;
	     IF j<=tokenNUM THEN EXIT;
	     class _ j; RETURN 
	     END;
	   ENDLOOP;
        IF (h _ hashTab[h].link) = 0 THEN EXIT;
        ENDLOOP;
      buffer.length_sub; class_tokenID; value_LocateToken[buffer];
      SELECT insertFlag FROM
        1 =>
	-- reading terminals and nonterminals
	IF value # 0 THEN Error[check+2,value,index]  -- multiply defined symbol
	  ELSE
	    BEGIN IF token=LENGTH[symtab] THEN
	      BEGIN symtab _ LOOPHOLE[
		       expand[LOOPHOLE[symtab],wordsfortoken,LENGTH[symtab]/16]];
	      syminfo _ LOOPHOLE[expand[syminfo,SIZE[symtabrecord],LENGTH[syminfo]/16]];
	      END;
	    TokenToSymTab[buffer, token]; value _ token; token _ token+1;
	    END;
        2 =>
	-- processing aliases
	IF value=0 THEN
	  BEGIN s1 _ token*tokensize;
	  IF token=LENGTH[symtab] THEN
	    symtab _ LOOPHOLE[
		       expand[LOOPHOLE[symtab],wordsfortoken,LENGTH[symtab]/16]];
	  FOR j IN [0..buffer.length) DO symtab[s1+j] _ buffer[j] ENDLOOP;
	  value _ token; token _ token+1;
	  END;
        3 =>
	-- processing productions
          IF value = 0 THEN Error[check+3,-3,index];  --symbol not defined
        ENDCASE;
      END;

    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; FillTextBuffer[]};
	    char _ tB[tI];
	    ENDLOOP;
         ENDCASE;
      IF (tI_tI+1) = tMax
        THEN {IF tEnded THEN GO TO EndFile; FillTextBuffer[]};
      char _ tB[tI];
      ENDLOOP;
    index _ tOrigin + tI;  value _ 0;

    SELECT char FROM
      IN ['0..'9] =>
        BEGIN val:CARDINAL; valid:BOOLEAN;
        maxval:CARDINAL=6553; maxd:CARDINAL = 5;
        valid _ TRUE; val _ 0;
        WHILE char IN ['0..'9]
	  DO IF valid THEN
	    BEGIN d:[0..9];
	    d _ char-'0; val _ 10*val +d;
	    valid _ val<maxval OR (val=maxval AND d<=maxd);
	    END;
	  NextChar[];
	  ENDLOOP;
        IF ~valid THEN val _maxval*10+maxd;
        class _ tokenNUM; value _ val; GO TO GotNext;
        END;
      '- =>
        BEGIN pChar: CHARACTER;
        NextChar[];
        IF char # '- THEN {buffer[0] _ '-; TokenOrId[1]; GO TO GotNext};
        char _ NUL;
	  DO  pChar _ char;
	  IF (tI_tI+1) = tMax
	    THEN {IF tEnded THEN GO TO EndFile; FillTextBuffer[]};
	  char _ tB[tI];
	  SELECT char FROM
	    '- =>  IF pChar = '- THEN EXIT;
	    CR =>  EXIT;
	    ENDCASE;
	  ENDLOOP;
        NextChar[];
        END;
      ENDCASE => {TokenOrId[0]; GO TO GotNext};
    REPEAT
      GotNext =>  NULL;
      EndFile =>
        BEGIN
        FillTextBuffer[];  char _ tB[tI];
        class _ EndMarker;  index _ tOrigin;  value _ 0;
        END;
    ENDLOOP;
    nTokens _ nTokens + 1;
    RETURN
    END;


 -- initialization/finalization

  ScanInit: PUBLIC PROC [tablePtr: ParseTable.Handle] =
    BEGIN i: CARDINAL;
    hashTab _ @tablePtr.scanTable.hashTab;
    scanTab _ @tablePtr.scanTable.scanTab;
    vocab _ LOOPHOLE[@tablePtr.scanTable.vocabBody, STRING];
    vocabIndex _ @tablePtr.scanTable.vocabIndex;
    tLimit _ 0;  tMax _ 0;  tEnded _ FALSE;
    FillTextBuffer[];  char _ tB[tI];
    nTokens _ nErrors _ 0; buffer.length _ tokensize;

    -- initialise symbol table
    token _ 1; insertFlag _ 1;
    symtab _ LOOPHOLE[makearray[symtabsize+1,wordsfortoken]];
    syminfo _ LOOPHOLE[makearray[symtabsize+1,SIZE[symtabrecord]]];
    FOR i IN [1..symtabsize]
      DO syminfo[i] _ [link:0, length:0, used:FALSE] ENDLOOP;
    hashChain _ DESCRIPTOR[AllocateSegment[symtabsize/4],symtabsize/4];
    FOR i IN [1..symtabsize/4] DO hashChain[i] _ 0 ENDLOOP;
    END;

  ScanReset: PUBLIC PROC [pErrors: CARDINAL] RETURNS [CARDINAL, CARDINAL] =
    BEGIN
    IF (pErrors+nErrors)=0 THEN FinishInput[]; RETURN [nTokens, nErrors]
    END;

 -- error handling

  ResetScanIndex: PUBLIC PROC [index: CARDINAL] =
    BEGIN 
    IF index = tLimit THEN {FillTextBuffer[]; char _ tB[tI]; RETURN};
    IF index < tOrigin THEN
	BEGIN tLimit _ locateindex[index]; tMax _ 0;  tEnded _ FALSE;
	FillTextBuffer[];
	END;
    tI _ index - tOrigin; char _ tB[tI];
    END;

  Error: PROC [code: CARDINAL, control: INTEGER, index: CARDINAL]=
    BEGIN
    ErrorContext[ SELECT code FROM
      1  => "WARNING - Overlength symbol (increase TOKENSIZE?) truncated to - "L,
      2  => "WARNING - Not a chain production - "L,
      3  => "WARNING - Unused(U) or undefined(D)symbols (refer to TABLE1 and 2)"L,
      4  => "ERROR - Nonterminal with too many rules (increase ALTERNATELIM?) - "L,
      5  => "ERROR - Multiple definitions of symbol - "L,
      6  => "ERROR - Symbol not defined - "L,
      7  => "ERROR - Terminal precedes ::= - "L,
      8  => "ERROR - Too many rhs symbols in production (increase RHSLIM?) - "L,
      9  => "ERROR - Internal field will overflow - increase PSSLIM"L,
      10 => "ERROR - Aliased symbol not a terminal symbol - "L,
      11 => "ERROR - Aliases must not be terminal symbols - "L,
      12 => "ERROR - Goal symbols used in rhs"L,
      13 => "ERROR - Number greater than "L,
      ENDCASE => NIL,
      index];
    IF code>check THEN nErrors _ nErrors+1;
    SELECT -control FROM
      <0 => [] _ outtoken[control];
       0 => NULL;
       1 => outstring[buffer];
       2 => outstring["see previous message"L];
       3 => {outstring[buffer]; outstring[" not in TABLE1 or 2"L]};
       4 => NULL;  -- not used
       5 => outstring["MAXRULE"L];
       ENDCASE => outnum[-control-specErrorCases, 5];
    outeol[2];
    IF code<=check THEN warningslogged _ TRUE;
    resetoutstream[];
    END;

  END.