
<<PLImpl.mesa>>
<<Copyright (c) Xerox Corporation, 1981.  All rights reserved.>>
<<Last Modified by JHM On  6-Nov-81 13:47:56>>
<<last edited by Satterthwaite, April 18, 1986 5:03:01 pm PST>>

DIRECTORY
Disp: TYPE USING [ClearScreen, DispReset, DispSetup, Print, PrintString, ToggleMore],
IO: TYPE USING [STREAM, PutF, PutFR, 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 [GetSystemZone--NewZone--],
WindowProcInt: TYPE USING [StartWindowProc];

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

NodeType: TYPE = PL.NodeType;
Node: TYPE = PL.Node;
Symbol: TYPE = PL.Symbol;
<<>>
IMax: CARDINAL = 2;
IStack: ARRAY[1..IMax] OF Node _ ALL[NIL];
Abort: BOOL _ 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: INT = 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.ROPE;

PoplarProcess: PROC [in, out, error: IO.STREAM]= {
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", IO.rope[est]];
RETRY;
END;
P.RErr => BEGIN
OS.PutF["Runtime Error - %g\n", IO.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 prog.Length=0 THEN LOOP
ELSE IF prog.Equal["un", FALSE] THEN BEGIN
PopI[];
PrintTop;
END
ELSE IF prog.Equal["q",FALSE] OR prog.Equal["quit",FALSE] THEN EXIT
ELSE IF prog.Equal["more",FALSE] THEN BEGIN
[] _ D1.ToggleMore[];
PrintTop;
[] _ D1.ToggleMore[];
END
ELSE IF S.Sub[prog,0] = '$ THEN BEGIN
prog _ S.StringToFile[(S.SubString[prog, 1, prog.Length]).Concat[".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];>>
Z _ SafeStorage.GetSystemZone[];

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

END.

