-- file DIParser.Mesa
-- last modified by
--                  Sandman, January 16, 1979  3:58 PM
--                  Barbara, May 15, 1978  11:13 AM
--                  Bruce, July 23, 1980  5:50 PM

DIRECTORY
  CompilerUtil USING [parse, LockTableSegment, UnlockTableSegment],
  DebugOps USING [],
  Inline USING [COPY, LowHalf],
  P1 USING [AssignDescriptors, Atom, lastntstate, ProcessQueue, ScanInit, ScanReset, Token],
  ParseTable USING [ActionEntry, ActionTag, DefaultMarker, FinalState, Handle, InitialState, NTIndex, NTSymbol, ProductionInfo, State, TIndex, TSymbol],
  Storage USING [FreePages, Pages, PagesForWords];

Parser: PROGRAM
    IMPORTS CompilerUtil, P1, Inline, Storage 
    EXPORTS DebugOps, P1 =
  BEGIN  -- Debugger Interpreter parser with no error recovery
  OPEN P1, ParseTable;

  ParseError: PUBLIC SIGNAL [errorLoc: CARDINAL] = CODE;
  SyntaxError: PUBLIC SIGNAL [errorLoc: CARDINAL] = CODE;

  currentState: State;
  inputSymbol, lhs: TSymbol;

  input: PROCEDURE RETURNS [symbol: Token];
  inputLoc: CARDINAL;
  inputValue: UNSPECIFIED;
  qI, top: CARDINAL;
  stackSize: CARDINAL;
  queueSize: CARDINAL;

  q: DESCRIPTOR FOR ARRAY OF ActionEntry;  --reduction rules
  v: DESCRIPTOR FOR ARRAY OF UNSPECIFIED; --parse stack
  l: DESCRIPTOR FOR ARRAY OF CARDINAL; --sourceline index
  s: DESCRIPTOR FOR ARRAY OF State;

  -- transition tables for terminal input symbols

  tStart: DESCRIPTOR FOR ARRAY OF TIndex;
  tLength: DESCRIPTOR FOR ARRAY OF CARDINAL;
  tSymbol: DESCRIPTOR FOR ARRAY OF TSymbol;
  tAction: DESCRIPTOR FOR ARRAY OF ActionEntry;

  -- transition tables for nonterminal input symbols

  nStart: DESCRIPTOR FOR ARRAY OF NTIndex;
  nLength: DESCRIPTOR FOR ARRAY OF CARDINAL;
  nSymbol: DESCRIPTOR FOR ARRAY OF NTSymbol;
  nAction: DESCRIPTOR FOR ARRAY OF ActionEntry;
  ntDefaults: DESCRIPTOR FOR ARRAY OF ActionEntry;
  proddata: DESCRIPTOR FOR ARRAY OF ProductionInfo;

-- initialization/termination

  refCount: CARDINAL _ 0;
  table: ParseTable.Handle;

  Initialize: PROCEDURE [s: STRING] =
    BEGIN OPEN CompilerUtil;
    refCount _ refCount + 1;
    IF refCount > 1 THEN ParseInit[s, NIL]
    ELSE {table _ Inline.LowHalf[LockTableSegment[parse]]; ParseInit[s, table]};
    END;

  Finalize: PROCEDURE =
    BEGIN
    EraseQueue[];
    EraseStack[];
    refCount _ refCount - 1;
    IF refCount = 0 THEN CompilerUtil.UnlockTableSegment[CompilerUtil.parse];
    END;

  ParseInit: PROCEDURE [string: STRING, table: ParseTable.Handle] =
    BEGIN OPEN table;
    ScanInit[string, table];
    stackSize _ queueSize _ 0;  ExpandStack[64];  ExpandQueue[256];
    IF table # NIL THEN
      BEGIN
      tStart _ DESCRIPTOR[parseTable.tStart];
      tLength _ DESCRIPTOR[parseTable.tLength];
      tSymbol _ DESCRIPTOR[parseTable.tSymbol];
      tAction _ DESCRIPTOR[parseTable.tAction];
      nStart _ DESCRIPTOR[parseTable.nStart];
      nLength _ DESCRIPTOR[parseTable.nLength];
      nSymbol _ DESCRIPTOR[parseTable.nSymbol];
      nAction _ DESCRIPTOR[parseTable.nAction];
      ntDefaults _ DESCRIPTOR[parseTable.ntDefaults];
      proddata _ DESCRIPTOR[parseTable.prodData];
      END;
    RETURN
    END;

  InputLoc: PUBLIC PROCEDURE RETURNS [CARDINAL] =
    BEGIN
    RETURN [inputLoc]
    END;

--  the main parsing procedures

  DParse: PUBLIC PROCEDURE [string: STRING] RETURNS [complete: BOOLEAN] =
    BEGIN
    i, valid, k, m: CARDINAL;		-- stack pointers
    j, j0: CARDINAL;
    tj: ActionEntry;

    input _ Atom;
    Initialize[string];
    i _ top _ valid _ 0;  qI _ 0;
    s[0] _ currentState _ InitialState;
    [inputSymbol, inputValue, inputLoc] _ input[].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 => GO TO 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;
	      AssignDescriptors[q,v,l,proddata];
	      ProcessQueue[qI, top !
		ParseError => GO TO SyntaxError;
		UNWIND => Finalize[]];
	      qI _ 0;
	      EXITS
		SyntaxError =>
		  BEGIN
		  Finalize[];
		  SIGNAL SyntaxError[inputLoc];
		  END;
	      END;
	  top _ valid _ i _ i+1;
	  v[i] _ inputValue;  l[i] _ inputLoc;
	  [inputSymbol,inputValue,inputLoc]  _ input[].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 =>
	  BEGIN 
	  Finalize[];
	  SIGNAL SyntaxError[inputLoc];
	  END;
      END;
    ENDLOOP;

    BEGIN
    AssignDescriptors[q,v,l,proddata];
    ProcessQueue[qI, top !
      ParseError => GOTO SyntaxError;
      UNWIND => Finalize[]];
    EXITS
      SyntaxError =>
	BEGIN
	Finalize[];
	SIGNAL SyntaxError[inputLoc];
	END;
    END;

    Finalize[];
    RETURN [ScanReset[]]
    END;

  ExpandStack: PROCEDURE [delta: CARDINAL] =
    BEGIN
    sS, sL, sV: CARDINAL;
    p: POINTER;
    newS: DESCRIPTOR FOR ARRAY OF State;
    newL: DESCRIPTOR FOR ARRAY OF CARDINAL;
    newV: DESCRIPTOR FOR ARRAY OF UNSPECIFIED;
    newSize: CARDINAL = stackSize + delta;
    sS _ newSize*SIZE[State];
    sL _ newSize*SIZE[CARDINAL];
    sV _ newSize*SIZE[UNSPECIFIED];
    p _ Storage.Pages[Storage.PagesForWords[sS+sL+sV]];
    newS _ DESCRIPTOR[p, newSize];
    newL _ DESCRIPTOR[p+sS, newSize];
    newV _ DESCRIPTOR[p+sS+sL, newSize];
    IF stackSize # 0 THEN
      BEGIN
      Inline.COPY[from: BASE[s], nwords: stackSize, to: BASE[newS]];
      Inline.COPY[from: BASE[l], nwords: stackSize, to: BASE[newL]];
      Inline.COPY[from: BASE[v], nwords: stackSize, to: BASE[newV]];
      EraseStack[];
      END;
    s _ newS;  l _ newL;  v _ newV;  stackSize _ newSize;
    RETURN
    END;

  EraseStack: PROCEDURE =
    BEGIN
    IF stackSize = 0 THEN RETURN;
    stackSize _ 0;
    Storage.FreePages[BASE[s]];
    RETURN
    END;

  ExpandQueue: PROCEDURE [delta: CARDINAL] =
    BEGIN
    newQ: DESCRIPTOR FOR ARRAY OF ActionEntry;
    newSize: CARDINAL = queueSize + delta;
    newQ _ DESCRIPTOR[Storage.Pages[Storage.PagesForWords[
      newSize*SIZE[ActionEntry]]], newSize];
    IF queueSize # 0 THEN
      BEGIN
      Inline.COPY[from: BASE[q], nwords: newSize, to: BASE[newQ]];
      EraseQueue[];
      END;
    q _ newQ;  queueSize _ newSize;
    RETURN
    END;

  EraseQueue: PROCEDURE =
    BEGIN
    IF queueSize = 0 THEN RETURN;
    queueSize _ 0;
    Storage.FreePages[BASE[q]];
    RETURN
    END;

END.