-- JaMTypeScriptImpl.mesa
-- Last changed by Paxton, October 4, 1982 2:35 pm
-- Last Edited by: Stone, March 29, 1983 4:57 pm
-- Last Edited by: Pier, March 22, 1983 5:09 pm

DIRECTORY
JaMBasic,
JaMInternal,
JaMOps,
JaMTSFrame,
JaMTSInfo,
JaMTypeScript,
JaMVM,
StreamDefs,
Atom USING [GetPropFromList, PutPropOnList],
JaMStorage USING [Zone],
FS USING [OpenFile, Open, Error],
EditedStream USING [Rubout],
Basics USING [LowHalf],
Loader USING [Error, Instantiate, Start],
PrincOps USING [ControlModule],
Menus USING [Menu, CreateEntry, CreateMenu, InsertMenuEntry, MenuProc],
Process USING [Abort, Detach],
ProcessExtras USING [CheckForAborts],
Rope USING [Concat, ROPE, Fetch, Flatten, Size, FromRefText, ToRope],
Runtime USING [CallDebugger],
IO USING [PutChar, GetLineRope, PutRope, STREAM],
ViewerIO USING [CreateViewerStreams],
ViewerClasses USING [Viewer],
ViewerOps USING [DestroyViewer, OpenIcon, CreateViewer];

JaMTypeScriptImpl: PROGRAM
IMPORTS
JaMOps, JaMTSFrame, JaMTSInfo, Loader,
JaMStorage, Basics, Menus, Process, ProcessExtras, Rope, Runtime,
ViewerOps, IO, ViewerIO, Atom, FS, EditedStream
EXPORTS
JaMTypeScript, StreamDefs
= {
OPEN StreamDefs, JaMOps, JaMInternal, JaMBasic, JaMTypeScript;

z: UNCOUNTED ZONE = JaMStorage.Zone[];

version: STRING ← "JaM of 18-Jan-82";

prompt,start,badfile,badname,badversion: name Object;

dsObject: StreamObject ← [reset: DReset, get: DGet,
putback: DPutback, put: DPut, endof: DEndof, destroy: DDestroy, data: NIL];
ds: StreamHandle ← @dsObject;

GetDefaultDisplayStream: PUBLIC PROC RETURNS[StreamHandle] = { RETURN[ds] };

GetTypeScript: PUBLIC PROC [frame: Frame] RETURNS [ViewerClasses.Viewer] = {
RETURN [JaMTSFrame.GetTypeScript[frame]] };

DReset: PROC[StreamHandle] = { };
DGet: PROC[StreamHandle] RETURNS[CHARACTER] = { RETURN[0C] };
DPutback: PROC[StreamHandle,CHARACTER] = { };
DPut: PROC[s: StreamHandle, c: CHARACTER] = {
tool: ViewerClasses.Viewer ← JaMTSFrame.GetTypeScript[defaultFrame];
IF tool#NIL THEN {
 out: IO.STREAM ←NARROW [Atom.GetPropFromList[tool.props,$JaMTSOut]];
 IO.PutChar[out,c]};
};
DEndof: PROC[StreamHandle] RETURNS[BOOLEAN] = { RETURN[FALSE] };
DDestroy: PROC[StreamHandle] = { };

LReset: PROC[s: StreamHandle] = {
data: LineInfo ← LOOPHOLE[s.data];
data.index ← 0 };
LGet: PROC[s: StreamHandle] RETURNS[UNSPECIFIED] = {
data: LineInfo ← LOOPHOLE[s.data];
i: CARDINAL ← data.index;
IF i<data.string.length THEN { data.index ← i + 1; RETURN[data.string[i]] }
ELSE RETURN[0C] };
LPutback: PROC[s: StreamHandle, x: UNSPECIFIED] = {
data: LineInfo ← LOOPHOLE[s.data];
IF data.index>0 THEN data.index ← data.index - 1 };
LEndof: PROC[s: StreamHandle] RETURNS[BOOLEAN] = {
data: LineInfo ← LOOPHOLE[s.data];
RETURN[data.index>=data.string.length] };
LPut: PROC[s: StreamHandle, x: UNSPECIFIED] = { };
LDestroy: PROC[s: StreamHandle] = {
data: LineInfo ← LOOPHOLE[s.data];
IF ~data.destroy THEN RETURN;
z.FREE[@data.string];
z.FREE[@data];
z.FREE[@s] };
LineInfo: TYPE = LONG POINTER TO LineInfoRec;
LineInfoRec: TYPE = RECORD [ string: LONG STRING, index: CARDINAL ← 0, destroy: BOOLEAN ← FALSE ];

FillStream: PROC [s: StreamHandle, rope: Rope.ROPE] = {
size: CARDINAL ← LOOPHOLE[Basics.LowHalf[Rope.Size[rope]]];
data: LineInfo ← LOOPHOLE[s.data];
IF data.string.length < size THEN {
 z.FREE[@data.string];
 data.string ← z.NEW[StringBody[size]] };
FOR i:CARDINAL IN [0..size) DO data.string[i] ← Rope.Fetch[rope,i]; ENDLOOP;
data.string.length ← size;
data.index ← 0 };

ReadLine: PROC[frame: Frame] = {
info: LineInfo ← NIL;
s: StreamHandle ← NIL;
tool: ViewerClasses.Viewer ← JaMTSFrame.GetTypeScript[frame];
rope: Rope.ROPE;
in: IO.STREAM ←NARROW [Atom.GetPropFromList[tool.props,$JaMTSIn]];
out: IO.STREAM ←NARROW [Atom.GetPropFromList[tool.props,$JaMTSOut]];
IF tool # NIL THEN rope ← GetCompleteLine[tool,in,out];
info ← z.NEW[LineInfoRec];
info.string ← z.NEW[StringBody[LOOPHOLE[Inline.LowHalf[Rope.Size[rope]]]]];
info.destroy ← TRUE; -- free the stream when done with it
s ← z.NEW[StreamObject];
s^ ← [reset: LReset, get: LGet, putback: LPutback,
endof: LEndof, put: LPut, destroy: LDestroy, data: info];
FillStream[s,rope];
JaMOps.Push[frame.opstk,MakeStream[s,X]];
};

QuitSignal: SIGNAL = CODE; -- for Quit to communicate with RunJaM
Quit: PROC[frame: Frame] = {
SIGNAL QuitSignal;
Stop[frame] };

JOpenTypescript: PROC[frame: Frame] = { -- expects name on stack
name: string JaMBasic.Object ← PopString[frame.opstk];
tool: ViewerClasses.Viewer ← JaMTSFrame.GetTypeScript[frame];
IF tool=NIL THEN {
text: STRING ← [64];
StringText[name,text];
tool ← InitTool[Rope.FromRefText[LOOPHOLE[LONG[text],REF READONLY TEXT]],frame].tool };
ViewerOps.OpenIcon[tool] };

CallDebugger: PROC[frame: Frame] = {
Runtime.CallDebugger["JaM executed .calldebugger"L];
};

LoadBCD: PROC[frame: Frame] = { BCDLoader[frame,FALSE] };
-- Expects opstk: (bcdFileName)
-- Loads and STARTS the configuration in bcdFileName

DebugBCD: PROC[frame: Frame] = { BCDLoader[frame,TRUE] };
-- Expects opstk: (bcdFileName)
-- Like LoadBCD, but invokes the debugger before STARTing

BCDLoader: PROC[frame: Frame, debug: BOOLEAN] = {
nameString: STRING ← [80];
name: Rope.ROPE;
ext: Rope.ROPE ← ".bcd";
extended: BOOLEAN ← FALSE;
file: FS.OpenFile;
prog: PrincOps.ControlModule ← NIL;
string: string Object ← PopString[frame.opstk];
IF string.length>nameString.maxlength THEN GOTO BadName
ELSE StringText[string,nameString];
name ← Rope.ToRope[nameString];
file ← FS.Open[name !
FS.Error => IF error.group=user THEN
 IF extended THEN GOTO BadName
ELSE { Rope.Concat[name,ext]; extended ← TRUE; RETRY }
ELSE GOTO BadName];
prog ← Loader.Instantiate[file: file !
Loader.Error => SELECT type FROM
versionMismatch => GOTO BadVersion;
ENDCASE => GOTO BadFile;
-- The following awful crock brought to you by the purveyors of CedarLoaderCore...
Loader.Error => GOTO BadVersion];
IF debug THEN {
message: STRING ← [100];
Append[message,"JaM: Just loaded "];
Append[message,name];
Runtime.CallDebugger[message];
};
Loader.Start[prog];
EXITS
BadFile => ERROR Error[badfile];
BadName => ERROR Error[badname];
BadVersion => ERROR Error[badversion];
};

JPrint: PROC[frame: Frame] = {
string: string Object ← PopString[frame.opstk];
Proc: PROC[c: CHARACTER] RETURNS[BOOLEAN] = {
abort: BOOLEAN ← GetAbort[frame];
IF NOT abort THEN IO.PutChar[out,c];
RETURN[abort] };
tool: ViewerClasses.Viewer ← JaMTSFrame.GetTypeScript[frame];
out,in: IO.STREAM;
IF tool=NIL THEN RETURN;
out ← NARROW [Atom.GetPropFromList[tool.props,$JaMTSOut]];
in ← NARROW [Atom.GetPropFromList[tool.props,$JaMTSIn]];
IF ProcessExtras.UserAbort[in] THEN SetAbort[frame,TRUE]
ELSE StringForAll[string,Proc];
};

NullName: PROC[frame: Frame] = {
Push[frame.opstk,[L,name[id:[local:FALSE,index:0]]]]
};

InstallJaMViewer: PROC[frame: Frame] = {
-- found: BOOLEAN;
badfile ← MakeName[".badfile"L];
badname ← MakeName[".badname"L];
badversion ← MakeName[".badversion"L];
prompt ← MakeName[".prompt"L];

RegisterExplicit[frame,".userline"L,ReadLine];
RegisterExplicit[frame,".print"L,JPrint];
RegisterExplicit[frame,".loadbcd"L,LoadBCD];
RegisterExplicit[frame,".debugbcd"L,DebugBCD];
RegisterExplicit[frame,".calldebugger"L,CallDebugger];
RegisterExplicit[frame,".quit"L,Quit];
RegisterExplicit[frame,".nullname"L,NullName];
RegisterExplicit[frame,".opentypescript"L,JOpenTypescript];

Def[frame,prompt,MakeString["(*).print"L,X]];
Def[frame,MakeName[".version"L],MakeString[version]];
-- Def[frame, undefname, MakeString["(Undefined name - .undefname: ).print
--( ).cvis .print"L,X]];
--Assert: .start is already defined by the time we get here
-- [found,] ← TryToLoad[frame,start];
-- IF NOT found THEN Def[frame,start,MakeString[".version .print (
--).print"L,X]];
};

RunJaM: PROC [tool: ViewerClasses.Viewer, frame: Frame, tsi: JaMTSInfo.TSInfo] = {
lineLoop: PROCESS ← NIL;
quit: BOOLEAN ← FALSE;

Process.Detach[lineLoop ← FORK LineLoop[tool,tsi]];
tsi.state ← idle;
UNTIL quit DO
JaMTSInfo.WaitForSomethingToDo[tsi];
Execute[frame, tsi.objectToDo !
QuitSignal => { quit ← TRUE; RESUME }; -- signal raised by Quit
ABORTED => CONTINUE];
JaMTSInfo.NotifyReadyForMore[tsi];
ENDLOOP;

Process.Abort[lineLoop];
DestroyTS[tool];
};

DestroyTS: PROC [tool: ViewerClasses.Viewer] = {
info: JaMTSInfo.TSInfo ← JaMTSFrame.GetTSInfo[tool];
frame: Frame ← JaMTSFrame.GetFrame[tool];
info.proc[frame];
JaMTSFrame.Forget[tool];
ViewerOps.DestroyViewer[tool];
};

GetCompleteLine: PROC [tool: ViewerClasses.Viewer, in, out: IO.STREAM] RETURNS [line: Rope.ROPE ← NIL] = TRUSTED {
 DO -- continue until have a complete line
  IF tool.destroyed OR Process.CheckForAborts[in] THEN RETURN [NIL];
  line ← Rope.Concat[line,IO.GetLineRope[in !
   EditedStream.Rubout => {
   IO.PutRope[out, " XXX\n"];
   CONTINUE};
   ]];
  IF line=NIL THEN RETURN;
  IF JaMOps.LineComplete[LOOPHOLE[Rope.Flatten[line], LONG STRING]] THEN RETURN;
  line ← Rope.Concat[line,"\n"];
  ENDLOOP;
 };

LineLoop: PROC [tool: ViewerClasses.Viewer, tsi: JaMTSInfo.TSInfo] = {
in: IO.STREAM ←NARROW [Atom.GetPropFromList[tool.props,$JaMTSIn]];
out: IO.STREAM ←NARROW [Atom.GetPropFromList[tool.props,$JaMTSOut]];
UNTIL tool.destroyed DO
JaMTSInfo.Do[prompt,tsi];
FillStream[tsi.lineStream,GetCompleteLine[tool, in, out]];
IF tool.destroyed THEN EXIT;
JaMTSInfo.Do[MakeStream[tsi.lineStream,X],tsi];
ENDLOOP;
};

mouseProc: MouseProc ← DefaultMouseProc;

DefaultMouseProc: PROC[frame: Frame, x,y: REAL] = {
PushReal[frame.opstk, x];
PushReal[frame.opstk, y];
};

SetMouseProc: PUBLIC PROC[new: MouseProc] RETURNS[MouseProc] = {
old: MouseProc ← mouseProc;
mouseProc ← new; RETURN[old];
};

DoAtom: PUBLIC PROC[tool: ViewerClasses.Viewer, atom: ATOM] = {
frame: Frame ← JaMTSFrame.GetFrame[tool];
tsi: JaMTSInfo.TSInfo ← JaMTSFrame.GetTSInfo[tool];
JaMTSInfo.DoAtom[tsi,frame,atom] };

DoButton: PUBLIC PROC[tool: ViewerClasses.Viewer, atom: ATOM, x,y: REAL] = {
frame: Frame ← JaMTSFrame.GetFrame[tool];
tsi: JaMTSInfo.TSInfo ← JaMTSFrame.GetTSInfo[tool];
JaMTSInfo.DoButton[tsi,frame,atom,x,y,mouseProc] };

-- Viewers stuff

InitTool: PUBLIC PROC [viewerName: Rope.ROPE, frame: Frame ← NIL, param: Rope.ROPE ← NIL, initFrame: BOOLEAN ← FALSE]
RETURNS [tool: ViewerClasses.Viewer, already: BOOLEAN] = { OPEN Menus;
toolMenu: Menus.Menu;
in, out: IO.STREAM;
tsi: JaMTSInfo.TSInfo;
IF frame=NIL THEN frame ← defaultFrame;
IF (tool ← JaMTSFrame.GetTypeScript[frame]) # NIL THEN { already ← TRUE; RETURN };
already ← FALSE;
toolMenu ← CreateMenu[];
Menus.InsertMenuEntry[toolMenu, CreateEntry[name: "Interrupt", proc: InterruptButton]];
Menus.InsertMenuEntry[toolMenu, CreateEntry[name: "Destroy", proc: DestroyButton]];
tool ← ViewerOps.CreateViewer[flavor: $Typescript, info: [name: viewerName, iconic: FALSE, column: right]];
tool.menu ← toolMenu;
[in,out] ← ViewerIO.CreateViewerStreams[name: viewerName, viewer: tool];
tsi ← JaMTSInfo.Create[];
tool.props ← Atom.PutPropOnList[propList: tool.props, prop: $JaMTSIn, val: in];
tool.props ← Atom.PutPropOnList[propList: tool.props, prop: $JaMTSOut, val: out];
tsi.lineStream ← z.NEW[StreamObject ← [reset: LReset, get: LGet, putback: LPutback,
endof: LEndof, put: LPut, destroy: LDestroy, data: NIL]];
tsi.lineStream.data ← z.NEW[LineInfoRec ← [string: z.NEW[StringBody[200]], index: 0, destroy: FALSE]];
tsi.proc ← NullProc;
JaMTSFrame.Remember[tool,frame,tsi];
IF initFrame THEN {
 Begin[frame, root.sysDict]; -- push the system dictionary
 Execute[frame, start !
  QuitSignal => RESUME;
  ABORTED => CONTINUE] };
IF Rope.Size[param] > 0 THEN { -- do command line
 FillStream[tsi.lineStream,param];
 Execute[frame,MakeStream[tsi.lineStream,X] !ABORTED => CONTINUE] };
Process.Detach[FORK RunJaM[tool,frame,tsi]] };

NullProc: PROC [Frame] = { };

NotifyBeforeDestroy: PUBLIC PROC [ts: ViewerClasses.Viewer, proc: PROC [JaMInternal.Frame]] = {
-- before destroy ts, call proc with frame for ts as arg
info: JaMTSInfo.TSInfo ← JaMTSFrame.GetTSInfo[ts];
info.proc ← proc };

DestroyButton: Menus.MenuProc = TRUSTED {
DestroyTS[NARROW[parent]] };

InterruptButton: Menus.MenuProc = TRUSTED {
frame: Frame ← JaMTSFrame.GetFrame[NARROW[parent]];
IF frame#NIL THEN SetAbort[frame,TRUE];
};

-- Initialization

Start: PROC = {
start ← MakeName[".start"L];
Execute[defaultFrame,start !
QuitSignal => RESUME;
ABORTED => CONTINUE];
InstallJaMViewer[defaultFrame];
};

Start; -- this starts the whole thing

}.