-- file PGSScan.mesa rewritten by PGS,  6-Jul-82 11:02
-- file PGSScan.mesa
-- syntax last modified by Satterthwaite,  7-Jan-80 11:31 
-- code   last modified by Satterthwaite, July 6, 1982 11:00 am

DIRECTORY
  PGS1: TYPE USING [
    ActionStack, LinkStack, Value, ValueStack,
    ErrorContext, InputLoc, LocateIndex, Token],
  ParseTable: FROM "PGSParseTable" USING [
    EndMarker, HashIndex, HashTableRef, IndexTableRef, ProdDataRef,
    ScanTableRef, TableRef, TSymbol, VocabularyRef,
    tokenID, tokenNUM, tokenTAB3, tokenTAB4],
  PGSConDefs: TYPE USING [
    ControlZ,
    alternateLim, maxProd, maxRhsSymbols, maxRule, outbufLim, pssLim, rhsLim,
    symTabSize, tokenSize, wordsForToken,
    aliases, eofile, flags, nextAlias, numprod, prodinfo, numrules, rhschar,
    syminfo, symtab, tokeninfo, totalTokens, warningsLogged,
    AcquireZone, Expand, MakeArray, ReleaseZone,
    inchar, outchar, outeol, outnum, outstring,
    resetoutstream, setoutstream, seterrstream],
  PGSTypes: TYPE USING [AliasEntry, Options, ProdEntry, SymTabEntry, TokenEntry];

Scanner: PROGRAM
    IMPORTS PGS1, PGSConDefs 
    EXPORTS PGS1, PGSConDefs = {
  OPEN  PGS1, ParseTable, PGSConDefs;

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

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

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

  hashChain: LONG POINTER TO ARRAY [1..symTabSize/4] OF CARDINAL;

 -- local data base (supplied by parser)

  v: PGS1.ValueStack;
  l: PGS1.LinkStack;

  q: PGS1.ActionStack;

  prodData: ProdDataRef;

 -- initialization/termination

  AssignDescriptors: PUBLIC PROC [
      qd: PGS1.ActionStack, vd: PGS1.ValueStack, ld: PGS1.LinkStack, pp: ProdDataRef] = {
    q _ qd;  v _ vd;  l _ ld;  prodData _ pp};

  OutToken: PUBLIC PROC [symbol: CARDINAL] RETURNS [CARDINAL] = {
    IF symbol = 0 THEN {outstring["* * *"L]; RETURN[("* * *"L).length]};
    FOR i: CARDINAL IN [0..syminfo[symbol].length) DO
      outchar[symtab[symbol*tokenSize+i],1] ENDLOOP;
    RETURN [syminfo[symbol].length]};


 -- the interpretation rules

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

  ProcessQueue: PUBLIC PROC [qI, top: CARDINAL] = {
    i, j, k: CARDINAL;

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

    SetRuleChain: PROC [rule: CARDINAL, chain: BOOL] = {
      FixLastProd[];
      IF prix=LENGTH[prodinfo] THEN --production table overflow
	prodinfo _ LOOPHOLE[
	  Expand[prodinfo,SIZE[PGSTypes.ProdEntry],LENGTH[prodinfo]/8]];
      prodinfo[prix].chain _ chain;
      numrules _ MAX[numrules, rule];
      IF rule>maxRule THEN Error[check+10,-5,InputLoc[]] ELSE prodinfo[prix].rule _ rule};

    FixLastProd: PROC = {
      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[]]}};

    ProdHeader: PROC [new: BOOL] = {
      prodinfo[prix].index _ chix;
      IF lhsDef>eofile THEN {
	IF tokeninfo[lhsDef-eofile].count=alternateLim THEN {
	  Error[check+1, lhsDef,InputLoc[]];  --too many alternatives
	tokeninfo[lhsDef-eofile].count _1};
	tokeninfo[lhsDef-eofile].count _ tokeninfo[lhsDef-eofile].count + 1};
      IF flags[echo] THEN {
	lineWidth _ outbufLim-tokenSize-14;
         outeol[IF new THEN 2 ELSE 1];outnum[prix,3];
	outstring[IF prodinfo[prix].chain THEN " C "L ELSE "   "L];
	outnum[prodinfo[prix].rule,3]; outchar[' ,2];
	outchar[' ,tokenSize-(IF new THEN OutToken[lhsDef] ELSE 0)];
	outstring[IF new THEN " ::= "L ELSE "   | "L]};
      prix _ prix+1};

    LhsSymbol: PROC [symbol: CARDINAL] = {
      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 of local procedures

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

       0  => -- TABLE: PGSParseData  TYPE: ParseTable  EXPORTS: 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[]];
	  zone.FREE[@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 {
	    defflag: BOOL _ 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 {
		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]};
	      ENDLOOP;
	    outeol[1]; resetoutstream[];
	    IF defflag THEN
	      Error[check+3,-2,InputLoc[]]}; -- nonterminal used but not defined
	  FOR i IN [1..numprod] DO
	    IF prodinfo[i].chain THEN
	      IF prodinfo[i].count # 1 OR rhschar[prodinfo[i].index] <= eofile THEN {
		Error[warning+2, -(i+specErrorCases), InputLoc[]];
		prodinfo[i].chain _ FALSE};
	    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[PGSTypes.TokenEntry]]];
	  numrules _ 0;
	  prodinfo _ LOOPHOLE[MakeArray[maxProd+1,SIZE[PGSTypes.ProdEntry]]];
	  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 {
	    outeol[1]; outchar[' ,20]; outstring["GOAL ::= "L];
	    [] _ OutToken[eofile+1]; outchar[' ,1]; [] _ OutToken[eofile]};
	  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     ::=
	  {flags _ ALL[FALSE];  l[top] _ InputLoc[]};

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

       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 {
	    outeol[1];
	    FOR opt: PGSTypes.Options IN PGSTypes.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};
	  PrintTableHead['1];
	  END;

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

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

      13  => -- aliases        ::= "||TABLE3"
	  BEGIN PrintTableHead['3];
	  aliases _ LOOPHOLE[MakeArray[64,SIZE[PGSTypes.AliasEntry]]];
	  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[PGSTypes.AliasEntry],LENGTH[aliases]/8]];
	  aliases[nextAlias] _ [v[top+1],v[top+2]]; nextAlias _ nextAlias+1;
	  IF flags[echo] THEN {
	    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;

      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 {
	    IF lineWidth<syminfo[i].length THEN {
	      outeol[1]; outchar[' ,tokenSize+18]; lineWidth _ outbufLim - tokenSize-18};
	    IF (lineWidth _ (lineWidth-OutToken[i]-1)) > 0 THEN outchar[' , 1]};
	  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};
 
-- the following procedure is called from the ScanReset if no errors

  FinishInput: PROC = {
    emptyFlag: BOOL _ TRUE;
    j, k: CARDINAL;
    -- compute nonterminals deriving empty
    WHILE emptyFlag DO
      emptyFlag _ FALSE;
      FOR i: CARDINAL IN [1..totalTokens-eofile] DO  -- each nonterminal
        IF tokeninfo[i].empty THEN LOOP;  --which does not derive empty
        j _ tokeninfo[i].index;
        FOR prix: CARDINAL IN [j..j+tokeninfo[i].count) DO
            -- each production of the nonterminal
	  k _ prodinfo[prix].index;
	  FOR chix: CARDINAL IN [k..k+prodinfo[prix].count) DO   -- each rhs character
	    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[]};

    -- 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 = {
    IF flags[ids] THEN {
      seterrstream[]; outeol[1];
      outstring["       PRODUCTIONINFO     TOKENINFO    SYMINFO"L];
      FOR i: CARDINAL IN [0..MAX[numprod,totalTokens]] DO
	outeol[1]; outnum[i,4]; outchar[' ,1];
	IF i>numprod THEN outchar[' ,20]
	ELSE {
	  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]};
	IF i IN (0..totalTokens] THEN {
	  IF i<=eofile THEN outchar[' ,11] ELSE {
	    outnum[tokeninfo[i-eofile].count,3];
	    outchar[IF tokeninfo[i-eofile].empty THEN 'E ELSE ' ,1];
	    outnum[tokeninfo[i-eofile].index,5]; outchar[' ,2]};
	  outnum[syminfo[i].link,4]; outchar[IF syminfo[i].used THEN 'U ELSE ' ,1];
	  outnum[syminfo[i].length,3]; outchar[' ,1]; [] _ OutToken[i]}
        ENDLOOP;
      outeol[1]; outstring["RHSCHAR"L]; lineWidth _ outbufLim;
      FOR i: CARDINAL 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[]}};


 -- error recovery

  TokenValue: PUBLIC PROC [s: TSymbol] RETURNS [PGS1.Value] = {RETURN [0]};

-- text input and error routines

  NUL: CHAR = 0c;

  buffer: LONG STRING _ NIL;		-- token assembly area

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

  char: CHAR;	-- current (most recently scanned) character
  tI: CARDINAL;	-- its (stream) index
  eof: BOOL;

  NextChar: PROC = {	-- also expanded inline within Atom
    tI _ tI + 1;  [char, eof] _ inchar[]};


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

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

    TokenToSymTab: PROC [string: LONG STRING, token: CARDINAL] = {
      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+(string[0]-0c)) MOD (symTabSize/4) + 1;
      syminfo[token].link _ hashChain[j]; hashChain[j] _ token};

    TokenOrId: PROC [sub: CARDINAL] = {
      j, s1, s2: CARDINAL;
      h: HashIndex;
      WHILE char NOT 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 {
	class _ scanTab[buffer[0]];
        IF class # 0 THEN RETURN};
      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.text[s2] THEN EXIT;
	   s2 _ s2+1;
	   REPEAT FINISHED => {
	     IF j = tokenTAB3 THEN insertFlag _ 2 ELSE
	       IF j = tokenTAB4 THEN insertFlag _ 3;
	     IF j<=tokenNUM THEN EXIT;
	     class _ j; RETURN};
	   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 {
	    IF token=LENGTH[symtab] THEN {
	      symtab _ LOOPHOLE[Expand[LOOPHOLE[symtab],wordsForToken,
			    LENGTH[symtab]/16]];
	      syminfo _ LOOPHOLE[Expand[syminfo,SIZE[PGSTypes.SymTabEntry],
			    LENGTH[syminfo]/16]]};
	    TokenToSymTab[buffer, token]; value _ token; token _ token+1};
        2 =>
	-- processing aliases
	IF value=0 THEN {
	  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};
        3 =>
	-- processing productions
          IF value = 0 THEN Error[check+3,-3,index];  --symbol not defined
        ENDCASE};

    DO
      WHILE char IN [NUL..' ] DO 
	SELECT char FROM
	  ControlZ =>
	    UNTIL char = '\n DO
	      IF eof THEN GO TO EndFile;
	      NextChar[];
	    ENDLOOP;
	  ENDCASE;
	IF eof THEN GO TO EndFile;
	NextChar[];
	ENDLOOP;
      index _ tI;  value _ 0;

      SELECT char FROM
	IN ['0..'9] => {
	  val: CARDINAL _ 0;
	  valid: BOOL _ TRUE;
	  maxVal: CARDINAL = LAST[CARDINAL];
	  WHILE char IN ['0..'9] DO
	    IF valid THEN {
	      d: [0..9] = char-'0;
	      valid _ val<maxVal/10 OR (val=maxVal/10 AND d<=(maxVal MOD 10));
	      IF valid THEN val _ 10*val+d};
	    NextChar[];
	    ENDLOOP;
	  IF ~valid THEN val _ maxVal;
	  class _ tokenNUM; value _ val; GO TO GotNext};
	'- => {
	  NextChar[];
	  IF char # '- THEN {buffer[0] _ '-; TokenOrId[1]; GO TO GotNext};
	  char _ NUL;
	  DO
	    pChar: CHAR = char;
	    IF eof THEN GO TO EndFile;
	    NextChar[];
	    SELECT char FROM
	      '- =>  IF pChar = '- THEN EXIT;
	      '\n =>  EXIT;
	      ENDCASE;
	    ENDLOOP;
	  NextChar[]};
	ENDCASE => {TokenOrId[0]; GO TO GotNext};
      REPEAT
      GotNext =>  NULL;
      EndFile => {class _ EndMarker; index _ tI; value _ 0};
      ENDLOOP;
    nTokens _ nTokens + 1;
    RETURN};


 -- initialization/finalization

  ScanInit: PUBLIC PROC [tablePtr: ParseTable.TableRef] = {
    i: CARDINAL;
    zone _ PGSConDefs.AcquireZone[];
    hashTab _ @tablePtr[tablePtr.scanTable.hashTab];
    scanTab _ @tablePtr[tablePtr.scanTable.scanTab];
    vocab _ LOOPHOLE[@tablePtr[tablePtr.scanTable.vocabBody]];
    vocabIndex _ @tablePtr[tablePtr.scanTable.vocabIndex];
    buffer _ zone.NEW[StringBody[tokenSize]];
    tI _ 0;  [char, eof] _ inchar[];
    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[PGSTypes.SymTabEntry]]];
    FOR i IN [1..symTabSize] DO syminfo[i] _ [link:0, length:0, used:FALSE] ENDLOOP;
    hashChain _ zone.NEW[ARRAY [1..symTabSize/4] OF CARDINAL _ ALL[0]]};

  ScanReset: PUBLIC PROC [pErrors: CARDINAL] RETURNS [CARDINAL, CARDINAL] = {
    IF (pErrors+nErrors)=0 THEN FinishInput[];
    zone.FREE[@buffer];
    PGSConDefs.ReleaseZone[zone]; zone _ NIL;
    RETURN [nTokens, nErrors]};

 -- error handling

  ResetScanIndex: PUBLIC PROC [index: CARDINAL] = {
    IF index = tI THEN RETURN;
    [] _ LocateIndex[index];
    [char, eof] _ inchar[];  tI _ index};

  Error: PROC [code: CARDINAL, control: INTEGER, index: CARDINAL] = {
    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[]};

  }.