-- file PGSScan.mesa rewritten by PGS, October 25, 1985 9:33:52 am PDT
-- PGSScan.pgs
-- Copyright (C) 1985 by Xerox Corporation.  All rights reserved.
-- DO NOT CONVERT TO TIOGA FORMAT!  (PGS requires the mesa-style comments)
-- last modified by Satterthwaite, October 16, 1985 4:06:50 pm PDT
-- Last Edited by: Maxwell, August 10, 1983 10:32 am
-- Last Edited by: Wyatt, March 20, 1984 5:04:08 pm PST
-- Russ Atkinson (RRA) March 19, 1985 10:03:11 am PST

-- 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];
  
Scanner: 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 RETURNS[CARDINAL, CARDINAL] = {
      stream _ NIL;  Logger _ NIL;
      CheckOut[];
      buffer _ NIL;
      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};
      
    }.