-- PGSScan.pgs
-- Copyright (C) 1985, 1986 by Xerox Corporation.  All rights reserved.
-- DO NOT CONVERT TO TIOGA FORMAT!  (PGS requires the mesa-style comments)
-- Last Edited by: Maxwell, August 10, 1983 10:32 am
-- Russ Atkinson (RRA) March 19, 1985 10:03:11 am PST
-- last modified by Satterthwaite, May 22, 1986 10:39:31 am PDT
-- Doug Wyatt, May 15, 1986 5:36:01 pm PDT

-- PGS [defs: PGSParseTable, grammar: PGS] ← PGSScan.pgs

DIRECTORY
  IO: TYPE USING [STREAM],
  P1: TYPE USING [
    ActionStack, Index, LinkStack, Token, Value, ValueStack, nullValue, InputLoc],
  ParseTable: TYPE USING [
    endMarker, HashIndex, HashTableRef, IndexTableRef, ProdDataRef,
    ScanTableRef, TableRef, TSymbol, VocabularyRef,
    tokenID, tokenNUM, tokenTAB3, tokenTAB4],
  PGSConDefs: TYPE,
  PGSTypes: TYPE,
  Rope: TYPE USING [ROPE];
  
PGSScan: PROGRAM
  IMPORTS P1, PGSConDefs 
  EXPORTS P1, PGSConDefs = {
  OPEN  P1, ParseTable, PGSConDefs;
  
-- TreeBuild: interpreter section

  -- interpreter state
  
    check: NAT = 3;
    warning: NAT = 0;
    specErrorCases: NAT = 5;
    
    token, numRhsChars: CARDINAL;
    lineWidth: INTEGER;
    insertFlag: CARDINAL;
    
    HashChainArray: TYPE = ARRAY [1..symTabSize/4] OF CARDINAL;
    hashChain: REF HashChainArray;
    
  -- local data base (supplied by parser)
  
    v: P1.ValueStack;
    l: P1.LinkStack;
    
    q: P1.ActionStack;
    
    prodData: ProdDataRef;
    
  -- initialization/termination
  
    AssignDescriptors: PUBLIC PROC[
      qd: P1.ActionStack, vd: P1.ValueStack, ld: P1.LinkStack, pp: ProdDataRef] = {
      q ← qd;  v ← vd;  l ← ld;  prodData ← pp};
      
    OutToken: PUBLIC PROC[symbol: CARDINAL] RETURNS[CARDINAL] = {
      IF symbol = 0 THEN {outstring["* * *"]; 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"]; outchar[c,1]; outeol[1]}};
          
        SetRuleChain: PROC [rule: CARDINAL, chain: BOOL] = {
          FixLastProd[];
          IF prix=prodInfo.length THEN --production table overflow
            prodInfo ← ExpandProdInfo[prodInfo, prodInfo.length/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-eofMark].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>eofMark THEN {
            IF tokenInfo[lhsDef-eofMark].count=alternateLim THEN {
              Error[check+1, lhsDef,InputLoc[]];  --too many alternatives
            tokenInfo[lhsDef-eofMark].count ←1};
            tokenInfo[lhsDef-eofMark].count ← tokenInfo[lhsDef-eofMark].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 " ELSE "   "];
            outnum[prodInfo[prix].rule,3]; outchar[' ,2];
            outchar[' ,tokenSize-(IF new THEN OutToken[lhsDef] ELSE 0)];
            outstring[IF new THEN " ::= " ELSE "   | "]};
          prix ← prix+1};
          
        LhsSymbol: PROC [symbol: CARDINAL] = {
          lhsDef ← symbol;
          IF lhsDef<=eofMark THEN Error[check+4,lhsDef,InputLoc[]]
            -- undefined or terminal symbol before ::=
          ELSE
          IF tokenInfo[lhsDef-eofMark].index = 0 THEN tokenInfo[lhsDef-eofMark].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[]];
              hashChain ← NIL;
              WHILE symInfo[i].used AND i<=totalTokens DO
                IF i>eofMark AND tokenInfo[i-eofMark].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 > eofMark AND tokenInfo[i-eofMark].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] <= eofMark THEN {
                    Error[warning+2, -(i+specErrorCases), InputLoc[]];
                    prodInfo[i].chain ← FALSE};
                ENDLOOP;
              FinishInput[];
              END;
              
       1  => -- head           ::= directives terminals nonterminals "||TABLE4"
              -- head           ::= directives terminals nonterminals aliases "||TABLE4"
              BEGIN totalTokens ← lastSymbol; PrintTableHead['4];
              tokenInfo ← MakeTokenInfo[totalTokens-eofMark+1];
              numRules ← 0;
              prodInfo ← MakeProdInfo[maxProd+1];
              rhsChar ← MakeRhsChar[maxRhsSymbols+1];
              FOR i IN [0..totalTokens-eofMark] 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 ::= "];
                [] ← OutToken[eofMark+1]; outchar[' ,1]; [] ← OutToken[eofMark]};
              rhsChar[0] ← eofMark+1; rhsChar[1] ← eofMark;
              symInfo[eofMark+1].used ← symInfo[eofMark].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"]};
              
       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 ",
                    chain => "||CHAIN ",
                    lists => "||LISTS ",
                    printLR => "||PRINTLR ",
                    printLALR => "||PRINTLALR ",
                    first => "||FIRST ",
                    ENDCASE => "||IDS "];
                ENDLOOP};
            PrintTableHead['1];
            END;
            
      11  => -- terminals      ::= terminals discard symbol
            -- nonterminals   ::= nonterminals discard symbol 
            BEGIN lastSymbol ← v[top+2].s;
            IF flags[echo] THEN {
              outnum[lastSymbol, 3]; outchar[' , 2];
              [] ← OutToken[lastSymbol];
              outeol[1]};
            END;
            
      12  => -- nonterminals   ::= "||TABLE2"
            BEGIN PrintTableHead['2]; eofMark ← lastSymbol;
            nextAlias ← 0;  -- assert TABLE3 empty in case it is omitted
            aliases ← NIL;
            END;
            
      13  => -- aliases        ::= "||TABLE3"
            BEGIN PrintTableHead['3];
            aliases ← MakeAliases[64];
            END;
            
      14  => -- aliases        ::= aliases symbol symbol
            BEGIN IF v[top+1].s>eofMark THEN Error[check+7,v[top+1].s,InputLoc[]];
            IF v[top+2].s<=eofMark THEN Error[check+8,v[top+2].s,InputLoc[]];
            IF nextAlias=aliases.length THEN
              aliases ← ExpandAliases[aliases, aliases.length/8];
            aliases[nextAlias] ← [v[top+1].s,v[top+2].s]; nextAlias ← nextAlias+1;
            IF flags[echo] THEN {
              outchar[' ,tokenSize+1-OutToken[v[top+1].s]]; outchar[' ,1];
              j ← v[top+2].s*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].s]};
            
      17  => -- rulegroup      ::= prefix symbol "::="
            LhsSymbol[v[top+1].s];
            
      18  => -- rulegroup      ::= rulegroup symbol "::="
            {SetRuleChain[prix, FALSE]; LhsSymbol[v[top+1].s]};
            
      19  => -- rulegroup      ::= rulegroup prefix symbol "::="
            LhsSymbol[v[top+2].s];
            
      20  => -- rulegroup      ::= rulegroup '|
            {SetRuleChain[prix, FALSE]; ProdHeader[FALSE]};
            
      21  => -- rulegroup      ::= rulegroup prefix '|
            ProdHeader[FALSE];
            
      22  => -- rulegroup      ::= rulegroup symbol
            BEGIN i ← v[top+1].s; symInfo[i].used ← TRUE;
            IF i=eofMark OR i=eofMark+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=rhsChar.length THEN
              rhsChar ← ExpandRhsChar[rhsChar, rhsChar.length/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].s, FALSE];
            
      24  => -- prefix         ::= num num
            -- prefix         ::= '? num
            SetRuleChain[v[top+1].s, FALSE];
            
      25  => -- prefix         ::= discard 'C
            SetRuleChain[prix, TRUE];
            
      26  => -- prefix         ::= discard 'C num
            SetRuleChain[v[top+2].s, 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-eofMark] 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]<=eofMark OR ~tokenInfo[rhsChar[chix]-eofMark].empty THEN EXIT;
            REPEAT FINISHED => {tokenInfo[i].empty ← emptyFlag ← TRUE; EXIT};
            ENDLOOP
          ENDLOOP
        ENDLOOP
      ENDLOOP};
      
    -- 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"];
      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<=eofMark THEN outchar[' ,11] ELSE {
            outnum[tokenInfo[i-eofMark].count,3];
            outchar[IF tokenInfo[i-eofMark].empty THEN 'E ELSE ' ,1];
            outnum[tokenInfo[i-eofMark].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"]; 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[P1.Value] = {RETURN [P1.nullValue]};
    
    
    
-- Scanner: text input and error routines

  -- table installation
  
    tablePtr: ParseTable.TableRef;
    hashTab: HashTableRef;
    scanTab: ScanTableRef;
    vocab: VocabularyRef;
    vocabIndex: IndexTableRef;
    
    InstallScanTable: PUBLIC PROC[base: ParseTable.TableRef] = {
      tablePtr ← base;
      hashTab ← @tablePtr[tablePtr.scanTable.hashTab];
      scanTab ← @tablePtr[tablePtr.scanTable.scanTab];
      vocab ← LOOPHOLE[@tablePtr[tablePtr.scanTable.vocabBody]];
      vocabIndex ← @tablePtr[tablePtr.scanTable.vocabIndex]};
      
-- scanner state

  stream: IO.STREAM ← NIL;    -- the input stream (a dummy for now)
  Logger: PROC[PROC[log: IO.STREAM]] ← NIL;
  
  NUL: CHAR = '\000;
  
  buffer: REF TEXT ← 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[]};
    
    
  NextToken: PUBLIC PROC RETURNS[t: Token] = {
    OPEN t;
    
    LocateToken: PROC[string: REF TEXT] RETURNS[CARDINAL] = {
      -- returns token corresponding to string
      i, j: CARDINAL;
      j ← hashChain[(string.length*256+(string[0].ORD)) 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: REF TEXT, 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].ORD)) 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 HashIndex.LAST + 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 ← [scalar[LocateToken[buffer]]];
      SELECT insertFlag FROM
        1 =>
        -- reading terminals and nonterminals
          IF value # P1.nullValue THEN Error[check+2,value.s,index]  -- multiply defined symbol
          ELSE {
            IF token=symTab.length THEN {
              symTab ← ExpandSymTab[symTab, symTab.length/16];
              symTab ← ExpandSymTab[symTab, symInfo.length/16];
              };
            TokenToSymTab[buffer, token]; value ← [scalar[token]]; token ← token+1};
        2 =>
        -- processing aliases
        IF value=P1.nullValue THEN {
          s1 ← token*tokenSize;
          IF token=symTab.length THEN
            symTab ← ExpandSymTab[symTab, symTab.length/16];
          FOR j IN [0..buffer.length) DO symTab[s1+j] ← buffer[j] ENDLOOP;
          value ← [scalar[token]]; token ← token+1};
        3 =>
        -- processing productions
          IF value = P1.nullValue THEN Error[check+3,-3,index];  --symbol not defined
        ENDCASE};
        
    DO
      WHILE char IN [NUL..' ] DO 
        SELECT char FROM
          '\032 --↑Z-- =>
            UNTIL char = '\n DO
              IF eof THEN GO TO EndFile;
              NextChar[];
            ENDLOOP;
          ENDCASE;
        IF eof THEN GO TO EndFile;
        NextChar[];
        ENDLOOP;
      index ← tI;  value ← P1.nullValue;
      
      SELECT char FROM
        IN ['0..'9] => {
          val: CARDINAL ← 0;
          valid: BOOL ← TRUE;
          maxVal: CARDINAL = CARDINAL.LAST;
          WHILE char IN ['0..'9] DO
            IF valid THEN {
              d: [0..9] = char.ORD-'0.ORD;
              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 ← [scalar[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 ← P1.nullValue};
      ENDLOOP;
    nTokens ← nTokens + 1;
    RETURN};
    
    
  -- initialization/finalization
  
    ScanInit: PUBLIC PROC[
        source: IO.STREAM, logger: PROC[PROC[log: IO.STREAM]]] = {
      stream ← source;  Logger ← logger;
      buffer ← NEW[TEXT[tokenSize]];
      tI ← 0;  [char, eof] ← inchar[];
      nTokens ← nErrors ← 0; buffer.length ← tokenSize;
      
      -- initialise symbol table
      token ← 1; insertFlag ← 1;
      symTab ← MakeSymTab[(symTabSize+1)*tokenSize];
      symInfo ← MakeSymInfo[symTabSize+1];
      FOR i: CARDINAL IN [1..symTabSize] DO
        symInfo[i] ← [link:0, length:0, used:FALSE] ENDLOOP;
      hashChain ← NEW[HashChainArray ← ALL[0]]
      };
      
    ScanReset: PUBLIC PROC = {
      stream ← NIL;  Logger ← NIL;
      CheckOut[];
      buffer ← NIL};
      
    ScanStats: PUBLIC PROC RETURNS[CARDINAL, CARDINAL] = {
      RETURN [nTokens, nErrors]};
      
      
  -- error handling
  
    ResetScanIndex: PUBLIC PROC[index: CARDINAL] RETURNS[success: BOOL←TRUE] = {
      IF index = tI THEN RETURN;
      setindex[index];
      [char, eof] ← inchar[];  tI ← index};
      
    PrintTextLine: PROC[origin: CARDINAL] RETURNS[start: CARDINAL] = {
      lineIndex: CARDINAL;
      char: CHAR;
      n: [1..100];
      start ← lineIndex ← origin;
      FOR n IN [1..100] UNTIL lineIndex = 0 DO
        lineIndex ← lineIndex - 1;
        setindex[lineIndex];
        IF inchar[].c = '\n THEN EXIT;
        start ← lineIndex;
        ENDLOOP;
      setindex[start];
      FOR n IN [1..100] UNTIL ([c: char] ← inchar[]).end DO
        SELECT char FROM
          '\n, '\032 --↑Z-- => EXIT;
          ENDCASE => outchar[char,1];
        ENDLOOP;
      outeol[1];  RETURN};
      
    ErrorContext: PUBLIC PROC[
        to: IO.STREAM,  -- a dummy for now, to match ProtoP1
        message: Rope.ROPE, tokenIndex: CARDINAL] = {
      saveIndex: CARDINAL = getindex[];
      origin: CARDINAL = tokenIndex;
      char: CHAR;
      setindex[PrintTextLine[origin]];
      UNTIL getindex[] = origin OR ([c: char] ← inchar[]).end DO
        outchar[IF char = '\n THEN '\n ELSE ' ,1];
        ENDLOOP;
      outstring["↑ ["]; outnum[tokenIndex,1];
      outchar['],1];  outeol[1];  outstring[message];
      setindex[saveIndex]};
      
      
    Error: PROC[code: CARDINAL, control: INTEGER, index: CARDINAL] = {
    
      Inner: PROC[log: IO.STREAM -- a dummy for now--] ~ {
        ErrorContext[log,
          SELECT code FROM
            1  => "WARNING - Overlength symbol (increase TOKENSIZE?) truncated to - ",
            2  => "WARNING - Not a chain production - ",
            3  => "WARNING - Unused(U) or undefined(D)symbols (refer to TABLE1 and 2)",
            4  => "ERROR - Nonterminal with too many rules (increase ALTERNATELIM?) - ",
            5  => "ERROR - Multiple definitions of symbol - ",
            6  => "ERROR - Symbol not defined - ",
            7  => "ERROR - Terminal precedes ::= - ",
            8  => "ERROR - Too many rhs symbols in production (increase RHSLIM?) - ",
            9  => "ERROR - Internal field will overflow - increase PSSLIM",
            10 => "ERROR - Aliased symbol not a terminal symbol - ",
            11 => "ERROR - Aliases must not be terminal symbols - ",
            12 => "ERROR - Goal symbols used in rhs",
            13 => "ERROR - Number greater than ",
            ENDCASE => NIL,
          index];
        SELECT -control FROM
          <0 => [] ← OutToken[control];
          0 => NULL;
          1 => outstring[LOOPHOLE[buffer]];
          2 => outstring["see previous message"];
          3 => {outstring[LOOPHOLE[buffer]]; outstring[" not in TABLE1 or 2"]};
          4 => NULL;  -- not used
          5 => outstring["MAXRULE"];
          ENDCASE => outnum[-control-specErrorCases, 5];
        outeol[2]};
        
      Logger[Inner];
      IF code>check THEN nErrors ← nErrors+1 ELSE warningsLogged ← TRUE};
      
    }.