-- PLImpl.mesa,  Last Modified On  6-Nov-81 13:47:56, JHM

DIRECTORY
  Disp: TYPE USING [ClearScreen, DispReset, DispSetup, Print, PrintString, ToggleMore],
  IO: TYPE USING [Handle, PutF, PutFR, rope, ROPE, time],
  PL: TYPE USING [BlessString, Dist, EndDisplay, Eval, GetSpecialNodes, Insert,
  	Interrupt, Node, NodeType, ParseSetup, PBug, RErr, rSTR, SErr, SetCurrentNode,
  	SN, StoreSetup, SupSetup, Symbol],
  PString: TYPE USING [StringToFile, Sub, SubString],
  Rope: TYPE USING [Concat, Equal, Length, ROPE],
  Route: TYPE USING [KeyRoutine, Route1Setup, Route2Setup],
  SafeStorage: TYPE USING [NewZone],
  WindowProcInt: TYPE USING [StartWindowProc];

PLImpl: CEDAR PROGRAM IMPORTS D1:Disp, S: PString, P:PL, Route, SafeStorage, IO, Rope, WindowProcInt EXPORTS PL = BEGIN
OPEN Rope, IO, P;
--
IS, OS, ES: PUBLIC Handle;

NodeType: TYPE = PL.NodeType;
Node: TYPE = PL.Node;
Symbol: TYPE = PL.Symbol;
--
edfile: STRING _ [30];
IMax: CARDINAL = 2;
IStack: ARRAY[1..IMax] OF Node _ ALL[NIL];
Abort: BOOLEAN _ FALSE;
MTSt,Fail,Nail: Node;
Z: PUBLIC ZONE;
     
DayTimeRoutine: PROC[Node] RETURNS[Node] = {
	RETURN[P.SN[IO.PutFR["%t", IO.time[]]]];
	};

--SetMaxDataQuantaRoutine: PROC[n1: Node] RETURNS[Node] =
--BEGIN
--n: CARDINAL = VM.Cardinal[S.MakeInteger[P.BlessString[n1]]];
--nn: LONG INTEGER = RTStorageOps.SetMaxDataQuanta[n];
--RETURN[P.SN[S.MakeNUM[nn]]];
--END;


PrintTop: PROC = 
      BEGIN
      D1.ClearScreen[];
      [] _ D1.ToggleMore[];
      WITH IStack[1] SELECT FROM
	x: rSTR =>
	   BEGIN
	   D1.PrintString[x.str];
	   OS.PutF["\n"];
	   END
        ENDCASE => D1.Print[IStack[1]];
      [] _ D1.ToggleMore[];
      END;
      

PushI: PROC[n: Node] = BEGIN
i: CARDINAL;
FOR i DECREASING IN [1..IMax) DO
      IStack[i+1] _ IStack[i];
      ENDLOOP;
IStack[1] _ n;		-- this is the top of stack
END;

PopI: PROC = BEGIN
i: CARDINAL;
FOR i IN [2..IMax] DO
      IStack[i-1] _ IStack[i];
      ENDLOOP;
IStack[IMax] _ Nail;
END;

Setup: PROC = BEGIN
-- []_RTStorageOps.SetMaxDataQuanta[200];
P.StoreSetup[];			-- inserts don't work till this is done
P.ParseSetup[];
P.SupSetup[];
Route.Route1Setup[];
Route.Route2Setup[];
D1.DispSetup[];
[] _ P.Insert["daytime",[,,ZARY[DayTimeRoutine]]];
END;



n: Node;
prog: ROPE;
	
PoplarProcess: PROC [in, out, error: IO.Handle]= {
IS _ in; OS _ out; ES _ error;
[Fail,MTSt, Nail] _ P.GetSpecialNodes[];
Setup[];
FOR i: CARDINAL IN [1.. IMax] DO
      IStack[i] _ Nail;
      ENDLOOP;
DO
      ENABLE BEGIN
	   UNWIND, ABORTED => BEGIN OS.PutF["XXX\n"]; RETRY END;
	   P.EndDisplay => RETRY;
	   P.Interrupt => BEGIN
		 OS.PutF["**** Interrupt ****\n"];
		 RETRY;
		 END;
	   P.PBug => BEGIN
		 OS.PutF["Poplar Bug!! - %g\n", rope[est]];
		 RETRY;
		 END;
	   P.RErr => BEGIN
		 OS.PutF["Runtime Error - %g\n", rope[est]];
		 RETRY;
		 END;
	   P.SErr => RETRY;
	--ANY => BEGIN
	--	 OS.PutF["Mysterious Poplar Bug!!!\n"];
	--	 RETRY;
	--	 END
	   END;
      D1.DispReset[];
      n _  Route.KeyRoutine[MTSt];
      IF n.Type = FAIL THEN LOOP;
      prog  _ P.BlessString[n];
      IF Rope.Length[prog]=0 THEN LOOP
      ELSE IF Rope.Equal[prog,"un", FALSE] THEN BEGIN
	   PopI[];
	   PrintTop;
	   END
      ELSE IF Rope.Equal[prog,"q",FALSE] OR Rope.Equal[prog,"quit",FALSE] THEN EXIT
      ELSE IF Rope.Equal[prog,"more",FALSE] THEN BEGIN
	   [] _ D1.ToggleMore[];
	   PrintTop;
	   [] _ D1.ToggleMore[];
	   END
      ELSE IF S.Sub[prog,0] = '$ THEN BEGIN
	   prog _ S.StringToFile[Rope.Concat[S.SubString[prog, 1, Rope.Length[prog]],
					".pl"]];
	   IF prog = NIL THEN { OS.PutF["Not found!\n"]}
	   ELSE    [] _ P.Eval[P.Dist[prog], NIL]
	   END
      ELSE {P.SetCurrentNode[IStack[1]];
            {tt:Node = P.Dist[prog];
             IF tt.Type=ASS THEN []_P.Eval[tt,NIL]
             ELSE {PushI[P.Eval[tt,NIL]];PrintTop}}}
      
      ENDLOOP;
};


Z _ SafeStorage.NewZone[quantized];

WindowProcInt.StartWindowProc["Poplar0.9", PoplarProcess];

END.