-- JaMTajoImpl.mesa
-- Last changed by Doug Wyatt, 24-Feb-82 18:13:55
DIRECTORY
JaMBasic,
JaMInternal,
JaMOps,
JaMTajo,
JaMVM,
JaMFnsDefs USING [PushInteger],
StreamDefs,
Ascii USING [CR],
Directory USING [Error, Lookup],
File USING [Capability],
Heap USING [systemZone],
Process USING [Abort, Detach, EnableAborts],
Runtime USING [CallDebugger, ConfigError, GetBcdTime, IsBound, LoadConfig],
Storage USING [String, FreeString],
Time USING [Append, Unpack],
TTY USING [PutString],
PilotLoaderOps USING [VersionMismatch],
Exec USING [AddCommand, commandLine, w],
Tool,
ToolWindow,
FormSW,
TTYSW,
Put,
UserInput,
Window;
JaMTajoImpl: MONITOR
IMPORTS
JaMOps, JaMVM, JaMFnsDefs,
Directory, Heap, Process, Runtime, Storage, Time, TTY,
PilotLoaderOps, Exec,
Tool, ToolWindow, FormSW, TTYSW, Put, UserInput
EXPORTS
JaMTajo, StreamDefs
= {
OPEN TajoPut:Put, StreamDefs, JaMOps, JaMInternal, JaMBasic;
Button: TYPE = JaMTajo.Button;
zone: UNCOUNTED ZONE = Heap.systemZone;
version: STRING ← "JaM of dd-mmm-yy hh:mm ";
prompt,start,badfile,badname,badversion: name Object;
buttonName: ARRAY Button OF name Object;
myframe: Frame ← NIL;
State: TYPE = {idle, busy};
state: State ← idle;
readyForInput: CONDITION;
somethingToDo: CONDITION;
objectToDo: Object; -- the object to be executed
tool: Window.Handle ← NIL;
formSW,ttySW: Window.Handle ← NIL;
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] };
DReset: PROC[StreamHandle] = { };
DGet: PROC[StreamHandle] RETURNS[CHARACTER] = { RETURN[0C] };
DPutback: PROC[StreamHandle,CHARACTER] = { };
DPut: PROC[s: StreamHandle, c: CHARACTER] = {
IF ttySW#NIL THEN TajoPut.Char[ttySW,c] };
DEndof: PROC[StreamHandle] RETURNS[BOOLEAN] = { RETURN[FALSE] };
DDestroy: PROC[StreamHandle] = { };
line: STRING ← NIL;
lineIndex: CARDINAL ← 0;
LReset: PROC[s: StreamHandle] = { lineIndex ← 0 };
LGet: PROC[s: StreamHandle] RETURNS[UNSPECIFIED] = {
i: CARDINAL ← lineIndex;
IF i<line.length THEN { lineIndex ← i + 1; RETURN[line[i]] }
ELSE RETURN[0C] };
LPutback: PROC[s: StreamHandle, x: UNSPECIFIED] = {
IF lineIndex>0 THEN lineIndex ← lineIndex - 1 };
LEndof: PROC[s: StreamHandle] RETURNS[BOOLEAN] = {
RETURN[lineIndex>=line.length] };
LPut: PROC[s: StreamHandle, x: UNSPECIFIED] = { };
LDestroy: PROC[s: StreamHandle] = { };
lineObject: StreamObject ← [reset: LReset, get: LGet, putback: LPutback,
endof: LEndof, put: LPut, destroy: LDestroy, data: NIL];
lineStream: StreamHandle ← @lineObject;
jamStarted: BOOLEAN ← FALSE;
JaMExecCommand: PROC = { OPEN Exec;
IF jamStarted THEN {
TTY.PutString[w,"JaM has already been started."L];
RETURN;
};
jamStarted ← TRUE;
-- Allocate line, and grab the rest of the command line now, before it goes away
line ← Storage.String[MAX[200,commandLine.s.length-commandLine.i]];
WHILE commandLine.i<commandLine.s.length DO
line[line.length] ← commandLine.s[commandLine.i];
line.length ← line.length + 1; commandLine.i ← commandLine.i + 1;
ENDLOOP;
Process.Detach[FORK RunJaM[]];
};
quit: BOOLEAN ← FALSE;
Quit: PROC[frame: Frame] = {
quit ← TRUE; Stop[frame];
};
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 };
fname: 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)>fname.maxlength THEN GOTO BadName
ELSE StringText[string,fname];
file ← Directory.Lookup[fname !
Directory.Error => SELECT type FROM
fileNotFound => IF extended THEN GOTO BadName
ELSE { Append[fname,ext]; extended ← TRUE; RETRY };
ENDCASE => GOTO BadName];
prog ← Runtime.LoadConfig[file: file, offset: 1 !
Runtime.ConfigError => GOTO BadFile;
PilotLoaderOps.VersionMismatch => {
Push[frame.opstk,MakeString[name]]; -- push name of offending interface
Push[frame.opstk,MakeString[fname]]; -- push name of file being loaded
GOTO BadVersion}];
IF debug THEN {
message: STRING ← [100];
Append[message,"JaM: Just loaded "];
Append[message,fname];
Runtime.CallDebugger[message];
};
IF Runtime.IsBound[prog] THEN START prog;
EXITS
BadFile => ERROR Error[badfile];
BadName => ERROR Error[badname];
BadVersion => ERROR Error[badversion,FALSE];
};
JPrint: PROC[frame: Frame] = {
string: string Object ← PopString[frame.opstk];
Proc: PROC[c: CHARACTER] RETURNS[BOOLEAN] = {
abort: BOOLEAN ← GetAbort[frame];
IF NOT abort THEN ds.put[ds,c]; RETURN[abort] };
IF tool=NIL THEN RETURN; -- running on cedar side
StringForAll[string,Proc];
};
InstallJaMPilot: PROC[why: InstallReason, frame: Frame] = { SELECT why FROM
register => {
found: BOOLEAN;
badfile ← MakeName[".badfile"L];
badname ← MakeName[".badname"L];
badversion ← MakeName[".badversion"L];
prompt ← MakeName[".prompt"L];
start ← MakeName[".start"L];
buttonName[rd] ← MakeName[".reddown"L];
buttonName[ru] ← MakeName[".redup"L];
buttonName[yd] ← MakeName[".yellowdown"L];
buttonName[yu] ← MakeName[".yellowup"L];
buttonName[bd] ← MakeName[".bluedown"L];
buttonName[bu] ← MakeName[".blueup"L];
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];
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]];
[found,] ← TryToLoad[frame,start];
IF NOT found THEN Def[frame,start,MakeString[".version .print (
).print"L,X]];
};
ENDCASE;
};
RunJaM: PROC = {
WaitForSomethingToDo: ENTRY PROC = {
WHILE state=idle DO WAIT somethingToDo ENDLOOP;
};
NotifyReadyForMore: ENTRY PROC = {
state ← idle; BROADCAST readyForInput;
};
lineLoop: PROCESS ← NIL;
StartJaM[vmname: "JaM.VM"L, maxPages: 2000];
myframe ← defaultFrame;
quit ← FALSE;
-- do start macro
Execute[myframe,start !ABORTED => CONTINUE];
-- do command line
IF line.length>0 THEN {
objectToDo ← MakeStream[lineStream,X];
Execute[myframe,objectToDo !ABORTED => CONTINUE];
line.length ← 0;
};
Process.Detach[lineLoop ← FORK LineLoop[]];
state ← idle;
UNTIL quit DO
WaitForSomethingToDo[];
Execute[myframe,objectToDo !ABORTED => CONTINUE];
NotifyReadyForMore[];
ENDLOOP;
Process.Abort[lineLoop];
myframe ← NIL;
StopJaM[];
Storage.FreeString[line];
IF tool# NIL THEN ToolWindow.Destroy[tool];
};
Do: ENTRY PROC[ob: Object] = {
UNTIL state=idle DO WAIT readyForInput ENDLOOP;
objectToDo ← ob; state ← busy; BROADCAST somethingToDo;
UNTIL state=idle DO WAIT readyForInput ENDLOOP;
};
LineLoop: PROC = {
EndLine: PROC[c: CHARACTER] RETURNS[BOOLEAN] = {
IF c=Ascii.CR THEN RETURN[LineComplete[line]] ELSE RETURN[FALSE] };
UNTIL quit OR ttySW=NIL DO
Do[prompt];
[] ← TTYSW.GetEditedString[ttySW,line,EndLine,TRUE !
TTYSW.LineOverflow => IF s=line THEN {
new: STRING ← Storage.String[s.maxlength+s.maxlength/2];
FOR i: CARDINAL IN[0..s.length) DO new[i] ← s[i] ENDLOOP;
new.length ← s.length; line ← new; Storage.FreeString[s];
RESUME[new] };
TTYSW.Rubout => { TajoPut.Line[ttySW," XXX"L]; line.length ← 0; CONTINUE };
ANY => EXIT];
IF quit THEN EXIT;
TajoPut.CR[ttySW];
lineIndex ← 0;
Do[MakeStream[lineStream,X]];
ENDLOOP;
};
MouseProc: TYPE = JaMTajo.MouseProc;
mouseProc: MouseProc ← DefaultMouseProc;
DefaultMouseProc: PROC[x,y: INTEGER] = {
JaMFnsDefs.PushInteger[x];
JaMFnsDefs.PushInteger[y];
};
SetMouseProc: PUBLIC PROC[new: MouseProc] RETURNS[MouseProc] = {
old: MouseProc ← mouseProc;
mouseProc ← new; RETURN[old];
};
DoButton: PUBLIC ENTRY PROC[button: Button, x,y: INTEGER] = {
IF state#idle THEN RETURN; -- ignore buttons if not idle
mouseProc[x,y]; -- push transformed coordinates
objectToDo ← buttonName[button];
state ← busy; BROADCAST somethingToDo;
};
-- Tajo stuff
InitTool: PROC = {
-- IF TajoCedarSwap.WhereAmI[] = cedar THEN RETURN;
tool ← Tool.Create[
makeSWsProc: MakeSWs, initialState: active,
clientTransition: ClientTransition, name: version,
initialBox: [[500, 40], [464, 380]]];
ToolWindow.SetTinyName[tool,"JaM"L];
};
AcceptTypeInFrom: PUBLIC PROC[w: Window.Handle] = {
IF ttySW=NIL THEN RETURN;
UserInput.CreateIndirectStringInOut[from: w, to: ttySW];
UserInput.SetKeyPNR[w, keyboard, UserInput.TypeInPNR];
UserInput.SetCursorPNR[w, UserInput.TypeInCursorPNR];
};
ClientTransition: ToolWindow.TransitionProcType = {
IF old=active AND new#active THEN JaMVM.Check[];
};
logName: STRING ← [20];
MakeSWs: Tool.MakeSWsProc = {
Tool.UnusedLogName[unused: logName, root: "JaM.log"L];
formSW ← Tool.MakeFormSW[window: window, formProc: MakeForm];
ttySW ← Tool.MakeTTYSW[window: window, name: logName];
};
MakeForm: FormSW.ClientItemsProcType = { OPEN FormSW;
nItems: CARDINAL = 3;
items ← AllocateItemDescriptor[nItems];
items[0] ← CommandItem[tag: "Interrupt"L,
place: newLine, proc: InterruptButton];
items[1] ← CommandItem[tag: "CheckVM"L,
place: nextPlace, proc: CheckVMButton];
items[2] ← StringItem[tag: "Logged on"L,
place: nextPlace, string: @logName, readOnly: TRUE];
RETURN[items: items, freeDesc: TRUE];
};
InterruptButton: FormSW.ProcType = {
IF myframe#NIL THEN SetAbort[myframe,TRUE];
};
CheckVMButton: FormSW.ProcType = {
JaMVM.Check[];
};
-- Initialization
version.length ← 7;
Time.Append[version, Time.Unpack[Runtime.GetBcdTime[]]];
Install[InstallJaMPilot];
Process.EnableAborts[@somethingToDo];
InitTool[];
Exec.AddCommand["JaM"L,JaMExecCommand];
}.
Wyatt 7-Nov-81 14:20:34 add CheckVM button
ENABLE ABORTED for all of main loop in RunJaM
Wyatt 19-Feb-82 10:57:40 better handling of VersionMismatch
specify initialBox for Tool.Create
Wyatt 24-Feb-82 18:13:12 no longer refers to TajoCedarSwap