[Indigo]<JaM>Laurel>LJaMControl.mesa!1

-- JaMControl.mesa
-- Written by John Warnock, Feb., 1979.
-- Last changed by Doug Wyatt, February 10, 1981 7:26 PM
-- Last changed by Doug Brotz, June 8, 1981 10:47 PM

DIRECTORY
JaMControlDefs,
JaMMasterDefs USING [Frame, Object, StackLink],
JaMArrayDefs USING [JaMArray],
JaMAttributesDefs USING [JaMAttributes],
JaMDictionaryDefs USING [JaMDictionary, DictBegin, DictDefine,
DictDict, DictGet, DictWhere],
JaMExecDefs USING [JaMExec, JaMError,
badbcdfile, badname, commandovrflw, longname, unregistered],
JaMFnsDefs USING [JaMFns, PopBoolean, PopObject, PopString, PushObject],
JaMInterruptDefs USING [KillJaMBreak],
JaMIODefs USING [JaMIO],
JaMLiteralDefs USING [JaMLiteral, BooleanLit, IntegerLit,
MakeStringObject, StringLit],
JaMMathDefs USING [JaMMath],
JaMScannerDefs USING [JaMScanner],
JaMStackDefs USING [CleanupStack, JaMStack, Push, Top],
JaMStartDefs USING [JaMStart],
JaMStringDefs USING [JaMString],
JaMTypeChkDefs USING [JaMTypeChk],
JaMVMDefs USING [JaMVM, AllocateWordsVM, FlushVM, GetWordsVM,
GetWordVM, PutWordsVM, PutWordVM, RestartVM],
BcdDefs USING [VersionID],
BcdOps USING [BcdBase],
ControlDefs USING [ControlModule, NullControl],
FrameDefs USING [IsBound, UnlockCode, UnNewConfig],
FrameOps USING [Start],
ImageDefs USING [AddCleanupProcedure, AllReasons, BcdTime,
CleanupItem, CleanupProcedure, StopMesa],
IODefs USING [LineOverflow],
LaurelExecDefs USING [MakeMenuCommandCallable],
LoaderOps USING [BadCode, FileNotFound, InvalidFile, New,
VersionMismatch],
MiscDefs USING [CallDebugger],
Real USING [InitReals],
SegmentDefs USING [DefaultMDSBase, DeleteFileSegment, FileHandle,
FileNameError, FileSegmentAddress, FileSegmentHandle, HardUp,
InsufficientVM, LockFile, MakeSwappedIn, MoveFileSegment,
NewFile, NewFileSegment, OldFileOnly, Read, ReleaseFile,
SegmentFault, Unlock, UnlockFile],
StringDefs USING [AppendString, StringBoundsFault],
SystemDefs USING [AllocateHeapNode, AllocateSegment, FreeHeapNode,
FreeSegment, PruneHeap],
TimeDefs USING [AppendDayTime, PackedTime, UnpackDT];

JaMControl: PROGRAM
IMPORTS JaMArrayDefs, JaMAttributesDefs, JaMDictionaryDefs,
JaMExecDefs, JaMFnsDefs, JaMInterruptDefs, JaMIODefs, JaMLiteralDefs,
JaMMathDefs, JaMScannerDefs, JaMStackDefs, JaMStartDefs,
JaMStringDefs, JaMTypeChkDefs, vm:JaMVMDefs,
FrameDefs, FrameOps, ImageDefs, IODefs, LaurelExecDefs, LoaderOps, MiscDefs,
Real, SegmentDefs, StringDefs, SystemDefs, TimeDefs
EXPORTS JaMControlDefs =
BEGIN OPEN JaMLiteralDefs, JaMMasterDefs;

-- This is the main control program for JaM. This program STARTs JaM’s
-- modules, registers several critical commands, and then transfers
-- execution control to JaMStart.

OldVM: BOOLEAN;
SysDict: Object;

CommandArray: TYPE = JaMControlDefs.CommandArray;
commands: PUBLIC POINTER TO CommandArray←NIL;

MaxCommands: CARDINAL = 512;
internalmax: CARDINAL = 16;
maxcommands: CARDINAL = MaxCommands - internalmax;
commandindexcount: CARDINAL←0;
internalindex: CARDINAL←maxcommands;

-- Commands known to the current VM and image are
-- [0..commandindexcount)
-- internal Commands known to the current image are
-- [maxcommands..internalindex)

-- the initial frame stack. (note: 1 entry).
FrameStack: TYPE = ARRAY FrameStkPtr OF Frame;
nframes: CARDINAL=1;
FrameStkPtr: TYPE = [0..nframes);
nlinks: CARDINAL=SIZE[Frame]*nframes;
StackLinkArray: TYPE = ARRAY[0..nlinks) OF StackLink;
framestack: POINTER TO FrameStack←NIL;
stacklinks: POINTER TO StackLinkArray←NIL;
frameplace: FrameStkPtr←0;
frame: Frame;

GetCurrentFrame: PUBLIC PROCEDURE RETURNS[frm:Frame] =
BEGIN RETURN[frame] END;

RegisterCommand: PUBLIC PROCEDURE[stringname: STRING, procedure: PROCEDURE] =
BEGIN
JaMLiteralDefs.StringLit[stringname,frame.opstk];
IF OldVM AND RegisterOldCommand[procedure] THEN RETURN;
RegisterNewCommand[procedure];
END;

LookupObject: PROCEDURE[key,ob: POINTER TO Object] RETURNS[BOOLEAN] =
BEGIN
JaMFnsDefs.PushObject[key↑];
JaMDictionaryDefs.DictWhere[];
IF NOT JaMFnsDefs.PopBoolean[] THEN RETURN[FALSE];
JaMFnsDefs.PushObject[key↑];
JaMDictionaryDefs.DictGet[];
ob↑←JaMFnsDefs.PopObject[];
RETURN[TRUE];
END;

RegisterOldCommand: PROCEDURE[procedure: PROCEDURE]
RETURNS[BOOLEAN] =
BEGIN
nameob,ob: Object;
nameob←JaMFnsDefs.PopObject[];
IF LookupObject[@nameob,@ob] THEN WITH dob:ob SELECT FROM
CommandType => { commands[dob.Command]←procedure; RETURN[TRUE] };
ENDCASE;
JaMFnsDefs.PushObject[nameob];
RETURN[FALSE];
END;

RegisterNewCommand: PROCEDURE[procedure: PROCEDURE] =
BEGIN
command: Object;
IF NOT commandindexcount<maxcommands THEN
{ OPEN JaMExecDefs; ERROR JaMError[commandovrflw,FALSE] };
command←[nolit,CommandType[Command:commandindexcount]];
commands[commandindexcount]←procedure;
commandindexcount ← commandindexcount+1;
UpdateCICount[]; -- update VM’s version of commandindexcount
JaMFnsDefs.PushObject[command];
JaMDictionaryDefs.DictDefine[];
END;

RegisterIntCommand: PUBLIC PROCEDURE[procedure: PROCEDURE]
RETURNS[c: CommandType Object] =
BEGIN
IF NOT internalindex < MaxCommands THEN
{ OPEN JaMExecDefs; ERROR JaMError[commandovrflw,FALSE] };
internalindex ← internalindex+1;
commands[internalindex]←procedure;
RETURN[[nolit,CommandType[Command:internalindex]]];
END;

RegisterString: PROCEDURE[stringname: STRING, stringval: STRING] =
BEGIN
frame: Frame←GetCurrentFrame[];
JaMLiteralDefs.StringLit[stringname,frame.opstk];
JaMStackDefs.Push[JaMLiteralDefs.MakeStringObject[stringval],frame.opstk];
JaMDictionaryDefs.DictDefine[];
END;

RegisterBoolean: PROCEDURE[obname: STRING, b: BOOLEAN] =
BEGIN
frame: Frame←GetCurrentFrame[];
JaMLiteralDefs.StringLit[obname,frame.opstk];
JaMLiteralDefs.BooleanLit[b,frame.opstk];
JaMDictionaryDefs.DictDefine[];
END;

RegisterObject: PROCEDURE[obname: STRING, ob: Object] =
BEGIN
frame: Frame←GetCurrentFrame[];
JaMLiteralDefs.StringLit[obname,frame.opstk];
JaMStackDefs.Push[ob,frame.opstk];
JaMDictionaryDefs.DictDefine[];
END;

UnregisteredCommand: PROCEDURE =
{ OPEN JaMExecDefs; ERROR JaMError[unregistered,TRUE] };

Quit: PROCEDURE =
BEGIN
IF FrameDefs.IsBound[LaurelExecDefs.MakeMenuCommandCallable] THEN
BEGIN
THROUGH [1..2] DO FrameDefs.UnlockCode[Real.InitReals]; ENDLOOP;
JaMInterruptDefs.KillJaMBreak[];
vm.FlushVM[];
UNTIL loadedConfigs = NIL DO UnNewLastConfig[]; ENDLOOP;
IF commands # NIL THEN SystemDefs.FreeSegment[commands];
JaMStackDefs.CleanupStack[];
[] ← SystemDefs.PruneHeap[];
ERROR QuitError;
END
ELSE ImageDefs.StopMesa[];
END;

QuitError: PUBLIC ERROR = CODE;

LoadBCD: PROCEDURE = { BCDLoader[debug: FALSE] };
-- Expects opstk: (bcdFileName)
-- Loads and STARTS the configuration in bcdFileName

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

LoadedConfigRec: TYPE = RECORD
[next: LoadedConfigRecPtr,
cm: ControlDefs.ControlModule,
bcdFile: SegmentDefs.FileHandle];
LoadedConfigRecPtr: TYPE = POINTER TO LoadedConfigRec;

loadedConfigs: LoadedConfigRecPtr ← NIL;

BCDLoader: PROCEDURE [debug: BOOLEAN] =
BEGIN
OPEN SegmentDefs;
s: STRING ← [40];
extended: BOOLEAN ← FALSE;
bcdFile: FileHandle ← NIL;
cm: ControlDefs.ControlModule ← ControlDefs.NullControl;
bcd: BcdOps.BcdBase;
bcdseg: FileSegmentHandle;
oldLoadedConfigs: LoadedConfigRecPtr;

OurLoad: PROCEDURE RETURNS [worked: BOOLEAN] =
-- This is derived from AltoLoader.Load and incorporates some bug
-- fixes and some optimizations.
BEGIN
pages: CARDINAL;
worked ← FALSE;
bcdseg ← NewFileSegment[bcdFile, 1, 1, Read];
MakeSwappedIn[bcdseg, DefaultMDSBase, HardUp
! SegmentFault => GO TO bogus];
bcd ← FileSegmentAddress[bcdseg];
IF bcd.versionIdent # BcdDefs.VersionID OR bcd.definitions THEN
{Unlock[bcdseg]; GO TO bogus}
ELSE IF (pages ← bcd.nPages) > 1 THEN
BEGIN
Unlock[bcdseg];
MoveFileSegment[bcdseg, 1, pages];
MakeSwappedIn[bcdseg, DefaultMDSBase, HardUp];
bcd ← FileSegmentAddress[bcdseg];
END;
worked ← TRUE;
EXITS
bogus => DeleteFileSegment[bcdseg];
END; -- of OurLoad --

OurUnload: PROCEDURE =
BEGIN
Unlock[bcdseg];
DeleteFileSegment[bcdseg];
END; -- of OurUnload --

BEGIN
JaMFnsDefs.PopString[s ! IODefs.LineOverflow =>
{ OPEN JaMExecDefs; ERROR JaMError[longname,TRUE] }];
bcdFile ← NewFile[s, Read, OldFileOnly
! FileNameError =>
BEGIN
--maybe extension omitted
IF extended THEN GOTO BadName;
StringDefs.AppendString[s,".bcd"L];
extended←TRUE;
RETRY;
END];
LockFile[bcdFile];
IF ~OurLoad[ ! InsufficientVM => GO TO out] THEN GO TO cantExecute;
cm ← LoaderOps.New[bcd, TRUE, FALSE
! LoaderOps.BadCode => GO TO cantExecute;
LoaderOps.InvalidFile,
LoaderOps.VersionMismatch => GO TO BadVersion;
StringDefs.StringBoundsFault,
LoaderOps.FileNotFound => GO TO out;
InsufficientVM => {OurUnload[]; GO TO out} ];
IF cm = ControlDefs.NullControl THEN GO TO cantExecute;
IF debug THEN
BEGIN
message: STRING ← [60];
StringDefs.AppendString[message,"About to START "];
StringDefs.AppendString[message,s];
MiscDefs.CallDebugger[message];
END;
FrameOps.Start[cm ! UNWIND => FrameDefs.UnNewConfig[cm.frame]];
oldLoadedConfigs ← loadedConfigs;
loadedConfigs ← SystemDefs.AllocateHeapNode[SIZE[LoadedConfigRec]];
loadedConfigs↑ ← LoadedConfigRec[oldLoadedConfigs, cm, bcdFile];
EXITS
BadName => {OPEN JaMExecDefs; ERROR JaMError[badname,TRUE]};
BadVersion => {OPEN JaMExecDefs; ERROR JaMError[badbcdfile, TRUE]};
cantExecute,
out => IF bcdFile ~= NIL THEN
{SegmentDefs.UnlockFile[bcdFile]; SegmentDefs.ReleaseFile[bcdFile]};
END;
END;

UnNewLastConfig: PROCEDURE =
BEGIN
newLoadedConfigs: LoadedConfigRecPtr;
IF loadedConfigs = NIL THEN RETURN;
newLoadedConfigs ← loadedConfigs.next;
FrameDefs.UnNewConfig[loadedConfigs.cm.frame];
IF loadedConfigs.bcdFile ~= NIL THEN
{SegmentDefs.UnlockFile[loadedConfigs.bcdFile];
SegmentDefs.ReleaseFile[loadedConfigs.bcdFile]};
SystemDefs.FreeHeapNode[loadedConfigs];
loadedConfigs ← newLoadedConfigs;
END; -- of UnNewLastConfig --

-- hard-wired VM addresses of commandindexcount and SysDict
vmaCICount: LONG POINTER = LOOPHOLE[LONG[0]];
vmaSysDict: LONG POINTER = LOOPHOLE[LONG[1]];

StartVM: PROCEDURE =
BEGIN OPEN vm;
-- fire up the VM
OldVM ← RestartVM["JaM.VM",1000,20];
IF OldVM THEN
BEGIN
commandindexcount←GetWordVM[vmaCICount,0];
GetWordsVM[vmaSysDict,@SysDict,SIZE[Object]];
JaMStackDefs.Push[SysDict,frame.dictstk];
END
ELSE
BEGIN
-- Build the System Dictionary (note: only 256 entries).
vma: LONG POINTER;
IF (vma ← AllocateWordsVM[1])#vmaCICount THEN ERROR;
IF (vma ← AllocateWordsVM[SIZE[Object]])#vmaSysDict THEN ERROR;
JaMLiteralDefs.IntegerLit[256,frame.opstk];
JaMDictionaryDefs.DictDict[];
JaMDictionaryDefs.DictBegin[];
SysDict←JaMStackDefs.Top[frame.dictstk];
PutWordsVM[vmaSysDict,@SysDict,SIZE[Object]];
commandindexcount←0; UpdateCICount[];
END;
END;

UpdateCICount: PROCEDURE =
INLINE { vm.PutWordVM[commandindexcount,vmaCICount,0] };

imagekey: Object;
version: STRING ← [40];

AllocArrays: PROCEDURE[Alloc: PROCEDURE[CARDINAL] RETURNS[POINTER]] =
BEGIN
commands ← Alloc[SIZE[CommandArray[MaxCommands]]];
framestack ← Alloc[SIZE[FrameStack]];
stacklinks ← Alloc[SIZE[StackLinkArray]];
END;

InitControl: PROCEDURE = {
i: CARDINAL;
versiontime: TimeDefs.PackedTime;

-- Allocate arrays
BEGIN
words: CARDINAL←0;
p: POINTER←NIL;
Count: PROCEDURE[size: CARDINAL] RETURNS[POINTER] =
BEGIN words←words+size; RETURN[NIL] END;
Alloc: PROCEDURE[size: CARDINAL] RETURNS[POINTER] =
BEGIN q: POINTER←p; p←p+size; RETURN[q] END;
AllocArrays[Count]; -- count words required
p←SystemDefs.AllocateSegment[words]; -- get a large enough block
AllocArrays[Alloc]; -- now allocate out of the block
END;

-- Initialize command table
FOR i: CARDINAL IN [0..MaxCommands)
DO commands[i]←UnregisteredCommand ENDLOOP;

-- Initialize frame stack
FOR i IN [0..nlinks) DO stacklinks[i] ← NIL ENDLOOP;
FOR i IN FrameStkPtr DO
framestack[i] ←
[@stacklinks[SIZE[Frame]*i],
@stacklinks[SIZE[Frame]*i+1],
@stacklinks[SIZE[Frame]*i+2]]
ENDLOOP;
frameplace←0;
frame ← framestack[frameplace];

-- Start everybody else
-- Each JaM module should contain a STOP in its initialization code.
-- It should not attempt to use the VM before that point.
-- After being RESTARTed, it should use RegisterCommand to register
-- its own intrinsics.

START JaMLiteralDefs.JaMLiteral;
START JaMStackDefs.JaMStack;
START JaMDictionaryDefs.JaMDictionary;
START JaMIODefs.JaMIO;
START JaMAttributesDefs.JaMAttributes;
START JaMMathDefs.JaMMath;
START JaMArrayDefs.JaMArray;
START JaMStringDefs.JaMString;
START JaMFnsDefs.JaMFns;
START JaMTypeChkDefs.JaMTypeChk;
START JaMScannerDefs.JaMScanner;
START JaMExecDefs.JaMExec;
START JaMStartDefs.JaMStart;

-- JaMVM should not have been invoked up to now.
START vm.JaMVM;

-- Initialize timestamp and version
versiontime←ImageDefs.BcdTime[];
imagekey←[nolit,LongIntegerType[LOOPHOLE[versiontime]]];
StringDefs.AppendString[version, "(JaM of "L];
TimeDefs.AppendDayTime[version,TimeDefs.UnpackDT[versiontime]];
StringDefs.AppendString[version, "
) .print"L];
};

RunControl: PROC = {
-- start up the VM
StartVM[];
IF FrameDefs.IsBound[LaurelExecDefs.MakeMenuCommandCallable] THEN
BEGIN
LaurelExecDefs.MakeMenuCommandCallable[newMail];
LaurelExecDefs.MakeMenuCommandCallable[user];
LaurelExecDefs.MakeMenuCommandCallable[mailFile];
LaurelExecDefs.MakeMenuCommandCallable[display];
LaurelExecDefs.MakeMenuCommandCallable[delete];
LaurelExecDefs.MakeMenuCommandCallable[undelete];
LaurelExecDefs.MakeMenuCommandCallable[moveTo];
LaurelExecDefs.MakeMenuCommandCallable[copy];
END
ELSE ImageDefs.AddCleanupProcedure[@cleanup];

-- Record commands and strings in the VM
RESTART JaMLiteralDefs.JaMLiteral;
RESTART JaMStackDefs.JaMStack;
RESTART JaMDictionaryDefs.JaMDictionary;
RESTART JaMIODefs.JaMIO;
RESTART JaMAttributesDefs.JaMAttributes;
RESTART JaMMathDefs.JaMMath;
RESTART JaMArrayDefs.JaMArray;
RESTART JaMStringDefs.JaMString;
RESTART JaMFnsDefs.JaMFns;
RESTART JaMTypeChkDefs.JaMTypeChk;
RESTART JaMScannerDefs.JaMScanner;
RESTART JaMExecDefs.JaMExec;
RESTART JaMStartDefs.JaMStart;

-- Commands implemented by JaMControl
RegisterCommand[".quit"L,Quit];
RegisterCommand[".loadbcd"L,LoadBCD];
RegisterCommand[".debugbcd"L,DebugBCD];
RegisterCommand[".unnew"L,UnNewLastConfig];

-- A name for the system dictionary
RegisterObject[".sysdict"L,SysDict];
-- An error handler for undefined keys
RegisterString[".undefkey"L," (Undefined key - .undefkey: ).print
( ) .cvis .print"L];
--Booleans
RegisterBoolean[".true"L,TRUE];
RegisterBoolean[".false"L,FALSE];

RegisterString[".prompt"L,"(*) .print"L];
RegisterString[".version"L,version];
IF ~OldVM THEN RegisterString[".start"L,".version"L];
};

-- Initialization
cleanup: ImageDefs.CleanupItem ← [link: NIL,
mask: ImageDefs.AllReasons, proc: CleanupJaMControl];

CleanupJaMControl: ImageDefs.CleanupProcedure =
BEGIN
SELECT why FROM
Finish,Abort => vm.FlushVM[];
ENDCASE;
END;

InitControl[];
STOP;
RunControl[];

END.

DKW January 17, 1980 4:02 AM
added .herald

DKW March 25, 1980 1:01 PM
changed .herald to .version
added .start initialization

DKW March 26, 1980 11:10 PM
changed LoadBCD: defaulting omitted ".bcd" now works

DKW March 28, 1980 4:34 PM
Added the .makeimage command. Substantially changed initialization code
to make this possible: added AddStartProc, and a CleanupProcedure to redo
necessary initialization when an image is restarted. JaMControl is now the
control module for JaM; it takes care of STARTing all other JaM modules,
then invokes JaMStart.

DKW March 29, 1980 1:16 AM
removed GetCommandArray; see JaMControlDefs.CallCommand

DKW May 9, 1980 4:18 PM
changed MakeImage to MakeUnMergedImage

DKW May 31, 1980 1:03 AM
updated for Mesa 6

DKW July 14, 1980 11:08 PM
changed RunConfig to LoadConfig;START

DKW July 25, 1980 1:52 PM
no longer makes JaM.image

DKW December 15, 1980 11:45 AM
disabled InstallCommandsAndStrings stuff

DKW January 9, 1981 3:51 PM
introduced STOP between InitControl and RunControl
JaMRun now takes care of starting Reals and calling JaMStartDefs.RunJaM

DKW January 12, 1981 5:41 PM
BCDLoader doesn’t try to START a config with no control module

DKW February 10, 1981 2:51 PM
new form of CommandArray
ripped out all the fancy installation code
now RESTARTs all JaM modules after starting VM