-- 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],
Directory USING [Error, Lookup],
File USING [Capability],
Inline USING [LowHalf],
Loader USING [Error],
Menus USING [Menu, CreateEntry, CreateMenu, InsertMenuEntry, MenuProc],
Process USING [Abort, Detach],
Rope USING [Concat, ROPE, Fetch, Flatten, Size, FromRefText],
Runtime USING [CallDebugger, IsBound, LoadConfig],
IO USING [PutChar, GetSequence, Signal, GetChar, PutRope, Reset, SetEcho, STREAM, UserAbort, Error],
ViewerIO USING [CreateViewerStreams],
ViewerClasses USING [Viewer],
ViewerOps USING [DestroyViewer, OpenIcon, CreateViewer];
JaMTypeScriptImpl: PROGRAM
IMPORTS
JaMOps, JaMTSFrame, JaMTSInfo, Loader,
Directory, JaMStorage, Inline, Menus, Process, Rope, Runtime,
ViewerOps, IO, ViewerIO, Atom
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[Inline.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] = {
Append: PROC[s,t: STRING] = {
FOR i: CARDINAL IN[0..t.length) WHILE s.length<s.maxlength DO
s[s.length] ← t[i]; s.length ← s.length + 1 ENDLOOP };
name: STRING ← [80];
ext: STRING ← ".bcd"L;
extended: BOOLEAN ← FALSE;
file: File.Capability;
prog: PROGRAM ← NIL;
string: string Object ← PopString[frame.opstk];
IF (string.length+ext.length)>name.maxlength THEN GOTO BadName
ELSE StringText[string,name];
file ← Directory.Lookup[name !
Directory.Error => SELECT type FROM
fileNotFound => IF extended THEN GOTO BadName
ELSE { Append[name,ext]; extended ← TRUE; RETRY };
ENDCASE => GOTO BadName];
prog ← Runtime.LoadConfig[file: file, offset: 1 !
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];
};
IF Runtime.IsBound[prog] THEN 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 IO.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 IO.UserAbort[in] THEN RETURN [NIL];
line ← Rope.Concat[line,GetLine[in !
IO.Signal => IF ec=Rubout THEN {
IO.PutRope[out, " XXX\n"];
in.Reset[];
[] ← in.SetEcho[out];
CONTINUE};
IO.Error => IF ec=StreamClosed THEN CONTINUE
]];
IF line=NIL THEN RETURN;
IF JaMOps.LineComplete[LOOPHOLE[Rope.Flatten[line], LONG STRING]] THEN RETURN;
line ← Rope.Concat[line,"\n"];
ENDLOOP;
};
GetLine: PROC [in: IO.STREAM] RETURNS [Rope.ROPE] = CHECKED {
rope: Rope.ROPE ← IO.GetSequence[in];
[] ← IO.GetChar[in];
RETURN[rope];
};
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: NIL, 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
}.