-- NPGSScan.pgs
-- Copyright Ó 1985, 1986, 1988, 1990 by Xerox Corporation.  All rights reserved.
-- DO NOT CONVERT TO TIOGA FORMAT!  (NPGS requires the mesa-style comments)
-- Russ Atkinson (RRA) March 17, 1988 10:14:22 am PST
-- Doug Wyatt, May 15, 1986 5:36:01 pm PDT
-- JKF May 24, 1990 10:02:00 am PDT

-- NPGS [defs: NPGSParseTable, grammar: NPGS] _ NPGSScan.pgs

DIRECTORY
	IO USING [STREAM],
	NPGS1 USING [
		ActionStack, Index, LinkStack, Token, Value, ValueStack, nullValue, InputLoc],
	NPGSParseTable USING [
		endMarker, HashIndex, HashTableRef, IndexTableRef,
		InitHashTable, InitIndexTable, InitScanTable, InitVocabulary,
		ProdDataRef, ScanTableRef, TSymbol, VocabularyRef, tokenID, tokenNUM,
		tokenTAB3, tokenTAB4],
	NPGSConDefs USING [
		aliases, alternateLim, 
		CuspPreSetPriorityTokenArray, -- new for CUSP
		eofMark, ExpandAliases, ExpandProdInfo, ExpandRhsChar,
		ExpandSymTab, flags, getindex, inchar, MakeAliases, MakeProdInfo,
		MakeRhsChar, MakeSymInfo, MakeSymTab, MakeTokenInfo, maxProd,
		maxRhsSymbols, maxRule, nextAlias, numProd, numRules, outbufLim,
		outchar, outeol, outnum, outstring, prodInfo, pssLim, resetoutstream,
		rhsChar, rhsLim, seterrstream, setindex, setoutstream, symInfo, symTab,
		symTabSize, tokenInfo, tokenSize, totalTokens, warningsLogged],
	NPGSTypes USING [Options],
	Rope USING [FromRefText, Length, ROPE];
	
NPGSScan: CEDAR PROGRAM
	IMPORTS NPGS1, NPGSConDefs, NPGSParseTable, Rope 
	EXPORTS NPGS1, NPGSConDefs
	= { OPEN NPGS1, NPGSParseTable, NPGSConDefs;
	
	ROPE: TYPE = Rope.ROPE;
	STREAM: TYPE = IO.STREAM;
	
-- TreeBuild: interpreter section

	-- interpreter state
	
		check: NAT = 3;
		warning: NAT = 0;
		specErrorCases: NAT = 5;
		
		token, numRhsChars: CARDINAL _ 0;
		lineWidth: INTEGER;
		insertFlag: CARDINAL;
		
		HashChainArray: TYPE = ARRAY [1..symTabSize/4] OF CARDINAL;
		hashChain: REF HashChainArray;
		
	-- local data base (supplied by parser)
	
		v: NPGS1.ValueStack;
		l: NPGS1.LinkStack;
		
		q: NPGS1.ActionStack;
		
		prodData: ProdDataRef;
		
	-- initialization/termination
	
		AssignDescriptors: PUBLIC PROC [
			qd: NPGS1.ActionStack, vd: NPGS1.ValueStack, ld: NPGS1.LinkStack, pp: ProdDataRef] = {
			q _ qd;
			v _ vd;
			l _ ld;
			prodData _ pp;
			};
			
		OutToken: PUBLIC PROC [symbol: CARDINAL] RETURNS [CARDINAL] = {
			r: ROPE = "* * *";
			IF symbol = 0 THEN {outstring[r]; RETURN[Rope.Length[r]]};
			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 _ 0; --indexes into prodInfo and rhsChar
		rhsFlag: BOOL; 
		lastSymbol, lhsDef: CARDINAL _ 0;
		
		ProcessQueue: PUBLIC PROC [qI, top: CARDINAL, cusp: BOOL] = {
			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 = {
					eofMark: CARDINAL _ NPGSConDefs.eofMark;
					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  => -- TYPE: NPGSParseTable  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
				{
				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[]];
				IF cusp THEN CuspPreSetPriorityTokenArray[hashChain]; -- new for CUSP
				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
						-- nonterminal used but not defined
						Error[check+3,-2,InputLoc[]];
					};
				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[];
				};
				
			 1  => -- head           ::= directives terminals nonterminals "||TABLE4"
				-- head           ::= directives terminals nonterminals aliases "||TABLE4"
				{
				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;
				};
				
			 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"
				{
					IF flags[echo] THEN {
						outeol[1];
						FOR opt: NPGSTypes.Options IN NPGSTypes.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];
					};
					
			11  => -- terminals      ::= terminals discard symbol
				-- nonterminals   ::= nonterminals discard symbol 
				{
					lastSymbol _ v[top+2].s;
					IF flags[echo] THEN {
						outnum[lastSymbol, 3]; outchar[' , 2];
						[] _ OutToken[lastSymbol];
						outeol[1]};
					};
					
			12  => -- nonterminals   ::= "||TABLE2"
				{
					PrintTableHead['2]; eofMark _ lastSymbol;
					nextAlias _ 0;  -- assert TABLE3 empty in case it is omitted
					aliases _ NIL;
					};
					
			13  => -- aliases        ::= "||TABLE3"
				{
					PrintTableHead['3];
					aliases _ MakeAliases[64];
					};
					
			14  => -- aliases        ::= aliases symbol symbol
				{temp: UNSPECIFIED _ NPGSConDefs.eofMark;
					IF v[top+1].s>temp THEN Error[check+7,v[top+1].s,InputLoc[]];
					IF v[top+2].s<=temp 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 _ CARDINAL[v[top+2].s]*tokenSize;
						FOR i IN [j..j+tokenSize) WHILE symTab[i]#0C DO outchar[symTab[i],1] ENDLOOP;
						outeol[1]};
					};
					
			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
				{temp: CARDINAL _ 0;
					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};
					temp _ prodInfo[prix-1].count;
					prodInfo[prix-1].count _ temp+1;
					};
					
			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 [NPGS1.Value] = {
			RETURN [NPGS1.nullValue];
			};    
		
-- Scanner: text input and error routines

	-- table installation
	
		hashTab: HashTableRef;
		scanTab: ScanTableRef;
		vocab: VocabularyRef;
		vocabIndex: IndexTableRef;
		
		InstallScanTable: PUBLIC PROC = {
			hashTab _ NPGSParseTable.InitHashTable[];
			scanTab _ NPGSParseTable.InitScanTable[];
			vocab _ NPGSParseTable.InitVocabulary[];
			vocabIndex _ NPGSParseTable.InitIndexTable[];
			};
			
-- scanner state

	stream: STREAM _ NIL;    -- the input stream (a dummy for now)
	Logger: PROC [PROC [log: STREAM]] _ NIL;
	
	NUL: CHAR = '\000;
	
	buffer: REF TEXT _ NIL;    -- token assembly area
	
	nTokens: CARDINAL _ 0;      -- token count
	nErrors: CARDINAL;      -- lexical errors
	
	char: CHAR;  -- current (most recently scanned) character
	tI: CARDINAL _ 0;  -- 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,t.index]}; --overlength
			IF sub = 1 THEN {
				t.class _ scanTab[buffer[0]];
				IF t.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;
							t.class _ j; RETURN};
						ENDLOOP;
				IF (h _ hashTab[h].link) = 0 THEN EXIT;
				ENDLOOP;
			buffer.length _ sub; t.class _ tokenID; t.value.s _ LocateToken[buffer];
			SELECT insertFlag FROM
				1 =>
				-- reading terminals and nonterminals
					IF t.value # NPGS1.nullValue
						 THEN Error[check+2,t.value.s,t.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];
						t.value.s _ token; --[scalar[token]];
						token _ token+1;
						};
				2 =>
				-- processing aliases
				IF t.value=NPGS1.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;
					t.value.s _ token; --[scalar[token]];
					token _ token+1;
					};
				3 =>
				-- processing productions
					IF t.value = NPGS1.nullValue THEN Error[check+3,-3,t.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;
			t.index _ tI;
			t.value.s _ NPGS1.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;
					t.class _ tokenNUM; t.value.s _ val; GO TO GotNext}; --[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 => {t.class _ endMarker; t.index _ tI; t.value.s _ NPGS1.nullValue};
			ENDLOOP;
		nTokens _ nTokens + 1;
		};
		
	-- initialization/finalization
	
		ScanInit: PUBLIC PROC [source: STREAM, logger: PROC [PROC [log: 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];
			};
			
		ErrorContext: PUBLIC PROC [to: STREAM, message: 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: 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[Rope.FromRefText[buffer]];
					2 => outstring["see previous message"];
					3 => {outstring[Rope.FromRefText[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;
			};
			
		}.