-- Modified version of the Tool Driver's TDParser

DIRECTORY
  Format USING [Decimal],
  MStream USING [Handle],
  ParseInterface USING [
    ActionEntry, ActionTag, DefaultMarker, FinalState, InitialState, 
    NTIndex, NTState, NTSymbol, ProductionInfo, State,
    TableRef, TIndex, TSymbol, EndMarker, tSEMICOLON],
  Runtime USING [GetTableBase, GlobalFrame],
  Storage USING [FreePages, Pages, PagesForWords],
  ParseTables USING [],
  ParseDefs USING [AssignDescriptors, Atom, ProcessQueue, ScanInit,
  	ScanFinal, Value, Value2, ErrorContext], 
  PrintingDefs USING [outProc, OutCode]; 
    
Parser: PROGRAM
    IMPORTS Format, Runtime, Storage, ParseTables, ParseDefs, PrintingDefs EXPORTS ParseDefs = {
  OPEN ParseInterface;

  errorLimit: CARDINAL = 10;  
  currentState: State;
  inputSymbol, lhs: TSymbol;
  lastntstate: ParseInterface.State = LAST[ParseInterface.NTState];
  
  inputValue: ParseDefs.Value;
  inputLoc: CARDINAL;
  stackSize: CARDINAL;
  queueSize: CARDINAL;
  
  q: LONG DESCRIPTOR FOR ARRAY OF ActionEntry;  --reduction rules
  qI: CARDINAL;
  
  v: LONG DESCRIPTOR FOR ARRAY OF ParseDefs.Value; --parse stack
  v2: LONG DESCRIPTOR FOR ARRAY OF ParseDefs.Value2; --parse stack
  l: LONG DESCRIPTOR FOR ARRAY OF CARDINAL; -- source position
  s: LONG DESCRIPTOR FOR ARRAY OF State;
  top: CARDINAL;
  
  -- transition tables for terminal input symbols
  
  tStart: LONG DESCRIPTOR FOR ARRAY OF TIndex;
  tLength: LONG DESCRIPTOR FOR ARRAY OF CARDINAL;
  tSymbol: LONG DESCRIPTOR FOR ARRAY OF TSymbol;
  tAction: LONG DESCRIPTOR FOR ARRAY OF ActionEntry;
  
  -- transition tables for nonterminal input symbols
  
  nStart: LONG DESCRIPTOR FOR ARRAY OF NTIndex;
  nLength: LONG DESCRIPTOR FOR ARRAY OF CARDINAL;
  nSymbol: LONG DESCRIPTOR FOR ARRAY OF NTSymbol;
  nAction: LONG DESCRIPTOR FOR ARRAY OF ActionEntry;
  ntDefaults: LONG DESCRIPTOR FOR ARRAY OF ActionEntry;
  
  -- production information
  
  proddata: LONG DESCRIPTOR FOR ARRAY OF ParseInterface.ProductionInfo;
  
-- initialization/termination

  table: ParseInterface.TableRef;
  
  ParseInit: PROCEDURE [stream: MStream.Handle] =
    BEGIN
    table _ Runtime.GetTableBase[Runtime.GlobalFrame[ParseTables]];
    ParseDefs.ScanInit[stream, table];
    stackSize _ queueSize _ 0;
    s _ NIL;  q _ NIL;
    tStart _ DESCRIPTOR[table.parseTable.tStart];
    tLength _ DESCRIPTOR[table.parseTable.tLength];
    tSymbol _ DESCRIPTOR[table.parseTable.tSymbol];
    tAction _ DESCRIPTOR[table.parseTable.tAction];
    nStart _ DESCRIPTOR[table.parseTable.nStart];
    nLength _ DESCRIPTOR[table.parseTable.nLength];
    nSymbol _ DESCRIPTOR[table.parseTable.nSymbol];
    nAction _ DESCRIPTOR[table.parseTable.nAction];
    ntDefaults _ DESCRIPTOR[table.parseTable.ntDefaults];
    proddata _ DESCRIPTOR[table.parseTable.prodData];
    ExpandQueue[256];
    ExpandStack[128];  
    END;
    
--  the main parsing procedures

  Parse: PUBLIC PROCEDURE [stream: MStream.Handle] =
    BEGIN
    i, valid, k, m: CARDINAL;		-- stack pointers
    j, j0: CARDINAL;
    nErrors: CARDINAL;
    tj: ActionEntry;
    
    ParseInit[stream];
    i _ top _ valid _ 0;  qI _ 0;  nErrors _ 0;
    s[0] _ currentState _ InitialState;
    [inputSymbol, inputValue, inputLoc] _ ParseDefs.Atom[].symbol;
    
    WHILE currentState # FinalState DO
      BEGIN
      j0 _ tStart[currentState];
      FOR j IN [j0 .. j0 + tLength[currentState]) 
	DO
	SELECT tSymbol[j] FROM
	  inputSymbol, DefaultMarker => EXIT;
	  ENDCASE;
	REPEAT
	  FINISHED => GOTO SyntaxError;
	ENDLOOP;
	
      tj _ tAction[j]; 
      IF ~tj.tag.reduce	-- scan or scan reduce entry
	THEN
	  BEGIN
	  IF qI > 0 
	    THEN
	      BEGIN
	      FOR k IN (valid..i] DO s[k] _ s[top+(k-valid)] ENDLOOP;
	      ParseDefs.ProcessQueue[qI, top];
	      qI _ 0;
	      END;
	  top _ valid _ i _ i+1;
	  v[i] _ inputValue;
	  [inputSymbol, inputValue, inputLoc]  _ ParseDefs.Atom[].symbol;
	  END;
	  
      WHILE tj.tag # ActionTag[FALSE, 0] DO
	IF qI >= queueSize THEN ExpandQueue[256];
	q[qI] _ tj;  qI _ qI + 1;
	i _ i-tj.tag.pLength;	-- pop 1 state per rhs symbol
	currentState _ s[IF i > valid THEN top+(i-valid) ELSE (valid _ i)];
	lhs _ proddata[tj.transition].lhs;
	  BEGIN
	  IF currentState <= lastntstate 
	    THEN
	      BEGIN  j _ nStart[currentState];
	      FOR j IN [j..j+nLength[currentState])
		DO
		IF lhs = nSymbol[j] THEN
		  BEGIN  tj _ nAction[j]; GO TO nfound  END;
		ENDLOOP;
	      END;
	  tj _ ntDefaults[lhs];
	  EXITS
	    nfound => NULL;
	  END;
	i _ i+1;
	ENDLOOP;
      IF (m _ top+(i-valid)) >= stackSize THEN ExpandStack[64];
      s[m] _ currentState _ tj.transition;
      EXITS
      	SyntaxError =>
	{
		PrintingDefs.OutCode["Syntax Error at "L, 0];
		Format.Decimal[PrintingDefs.outProc^, inputLoc];
		PrintingDefs.OutCode[", error context '"L, 0];
		ParseDefs.ErrorContext[];
		PrintingDefs.OutCode["'\n"L, 0];
		IF top > 0 THEN
			i _ valid _ top _ top-1;
		qI _ 0;
		currentState _ s[i];
		nErrors _ nErrors + 1;
		IF nErrors > errorLimit THEN {
		    PrintingDefs.OutCode["Abandoning parse.\n"L, 0];
		    EXIT; };
		-- on error scan to next '; or
		-- to the end of file
		DO
			IF inputSymbol = tSEMICOLON OR
			   inputSymbol = ParseInterface.EndMarker
		        THEN EXIT;
			[inputSymbol, inputValue, inputLoc]
					_ ParseDefs.Atom[].symbol;
		ENDLOOP;
	};
      END;
      ENDLOOP;
      
    ParseDefs.ProcessQueue[qI, top];

    EraseQueue[];
    EraseStack[];
    ParseDefs.ScanFinal[];
    END;
    
  ExpandStack: PROCEDURE [delta: CARDINAL] =
    BEGIN
    sS, sL, sV, sV2: CARDINAL;
    p: LONG POINTER;
    newS: LONG DESCRIPTOR FOR ARRAY OF State;
    newL: LONG DESCRIPTOR FOR ARRAY OF CARDINAL;
    newV: LONG DESCRIPTOR FOR ARRAY OF ParseDefs.Value;
    newV2: LONG DESCRIPTOR FOR ARRAY OF ParseDefs.Value2;
    newSize: CARDINAL = stackSize + delta;
    sS _ newSize*SIZE[State];
    sL _ newSize*SIZE[CARDINAL];
    sV _ newSize*SIZE[ParseDefs.Value];
    sV2 _ newSize*SIZE[ParseDefs.Value2];
    p _ Storage.Pages[Storage.PagesForWords[sS+sL+sV+sV2]];
    newS _ DESCRIPTOR[p, newSize];
    newL _ DESCRIPTOR[p+sS, newSize];
    newV _ DESCRIPTOR[p+sS+sL, newSize];
    newV2 _ DESCRIPTOR[p+sS+sL+sV, newSize];
    FOR i: CARDINAL IN [0..stackSize) DO
    	newS[i] _ s[i];
	newL[i] _ l[i];
	newV[i] _ v[i];
	newV2[i] _ v2[i];
    ENDLOOP;
    EraseStack[];
    s _ newS;
    l _ newL;
    v _ newV;
    v2 _ newV2;
    stackSize _ newSize;
    ParseDefs.AssignDescriptors[q,v,v2,l,proddata];
    END;
    
  EraseStack: PROCEDURE =
    {IF stackSize # 0 THEN {stackSize _ 0; Storage.FreePages[BASE[s]]}};
    
  ExpandQueue: PROCEDURE [delta: CARDINAL] =
    BEGIN
    newQ: LONG DESCRIPTOR FOR ARRAY OF ActionEntry;
    newSize: CARDINAL = queueSize + delta;
    newQ _ DESCRIPTOR[Storage.Pages[Storage.PagesForWords[
      newSize*SIZE[ActionEntry]]], newSize];
    IF queueSize # 0 THEN
      BEGIN
      FOR i: CARDINAL IN [0..queueSize) DO
	    newQ[i] _ q[i];
      ENDLOOP;
      EraseQueue[];
      END;
    q _ newQ;
    queueSize _ newSize;
    END;
    
  EraseQueue: PROCEDURE =
    {IF queueSize # 0 THEN {queueSize _ 0; Storage.FreePages[BASE[q]]}};
    
}.