-- JaMControl.mesa
-- Written by John Warnock, Feb., 1979.
-- Last changed by Doug Wyatt, January 12, 1981 5:42 PM

DIRECTORY
JaMControlDefs,
JaMMasterDefs USING [
CommandArray, CommandIndex, Frame, MaxCommands, Object, StackLink],
JaMArrayDefs USING [JaMArray],
JaMAttributesDefs USING [JaMAttributes],
JaMDictionaryDefs USING [JaMDictionary,
DictBegin, DictDefine, DictDict, DictGet, DictWhere],
JaMExecDefs USING [JaMExec,
JaMError],
JaMFnsDefs USING [JaMFns,
PopBoolean, PopObject, PopString, PushObject],
JaMIODefs USING [JaMIO],
JaMLiteralDefs USING [JaMLiteral,
BooleanLit, IntegerLit, MakeStringObject, StringLit],
JaMMathDefs USING [JaMMath],
JaMScannerDefs USING [JaMScanner],
JaMStackDefs USING [JaMStack, Push, Top],
JaMStartDefs USING [JaMStart],
JaMStringDefs USING [JaMString],
JaMTypeChkDefs USING [JaMTypeChk],
JaMVMDefs USING [JaMVM,
AllocateWordsVM, FlushVM, GetWordsVM, GetWordVM,
PutWordsVM, PutWordVM, RestartVM],
FrameDefs USING [IsBound, LoadConfig],
ImageDefs USING [AddCleanupProcedure, AllReasons, BcdTime,
CleanupItem, CleanupProcedure, StopMesa],
IODefs USING [LineOverflow],
LoaderOps USING [InvalidFile, VersionMismatch],
MiscDefs USING [CallDebugger],
SegmentDefs USING [FileNameError],
StringDefs USING [AppendString, EqualString],
SystemDefs USING [AllocateHeapString, AllocateSegment],
TimeDefs USING [AppendDayTime, PackedTime, UnpackDT];

JaMControl: PROGRAM
IMPORTS JaMArrayDefs,JaMAttributesDefs,JaMDictionaryDefs,JaMExecDefs,
JaMFnsDefs,JaMIODefs,JaMLiteralDefs,JaMMathDefs,JaMScannerDefs,
JaMStackDefs,JaMStartDefs,JaMStringDefs,JaMTypeChkDefs,vm:JaMVMDefs,
FrameDefs,ImageDefs,IODefs,LoaderOps,MiscDefs,
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.

LongFileName: StringType Object; --must be initialized after starting VM
BadFileName: StringType Object;
BadFile: StringType Object;
BadCommand: StringType Object;
CommandOvrFlw: StringType Object;

OldVM: BOOLEAN;
SysDict: Object;

commandarray: PUBLIC POINTER TO CommandArray←NIL;

GetCommandArray: PUBLIC PROCEDURE RETURNS[POINTER TO CommandArray] =
BEGIN RETURN[commandarray] END;

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)

maxcommandpairs: CARDINAL = maxcommands;
CommandPair: TYPE = RECORD[string: STRING, proc: PROCEDURE];
CommandPairTable: TYPE = ARRAY[0..maxcommandpairs) OF CommandPair;
commandpaircount: CARDINAL←0;
commandpairs: POINTER TO CommandPairTable ← NIL;

maxstringobs: CARDINAL = 50;
StringObIndex: TYPE = [0..maxstringobs);
StringObArray: TYPE = ARRAY StringObIndex OF StringType Object;
StringArray: TYPE = ARRAY StringObIndex OF STRING;
stringobcount: CARDINAL←0;
stringobs: POINTER TO StringObArray ← NIL;
strings: POINTER TO StringArray ← NIL;

maxstringpairs: CARDINAL = 100;
StringPair: TYPE = RECORD[index: StringObIndex,
ob: POINTER TO StringType Object];
StringPairTable: TYPE = ARRAY[0..maxstringpairs) OF StringPair;
stringpaircount: CARDINAL←0;
stringpairs: POINTER TO StringPairTable ← NIL;

-- 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;

CopyString: PROCEDURE[string: STRING] RETURNS[STRING] =
BEGIN
s: STRING←SystemDefs.AllocateHeapString[string.length];
StringDefs.AppendString[s,string];
RETURN[s];
END;

NotifyOverflow: SIGNAL=CODE;

NotifyCommand: PUBLIC PROCEDURE
[stringname: STRING, procedure: PROCEDURE] =
BEGIN
IF commandpaircount ~< maxcommandpairs THEN
BEGIN SIGNAL NotifyOverflow; RETURN END;
commandpairs[commandpaircount]←[CopyString[stringname],procedure];
commandpaircount←commandpaircount+1;
END;

AddStringOb: PROCEDURE[s: STRING] RETURNS[StringObIndex] =
BEGIN
i: CARDINAL;
FOR i IN[0..stringobcount)
DO IF StringDefs.EqualString[strings[i],s] THEN RETURN[i] ENDLOOP;
IF stringobcount ~< maxstringobs THEN
BEGIN SIGNAL NotifyOverflow; RETURN[0] END;
strings[i←stringobcount]←CopyString[s];
stringobcount←stringobcount+1;
RETURN[i];
END;

NotifyStringObject: PUBLIC PROCEDURE
[sob: POINTER TO StringType Object, stringvalue: STRING] =
BEGIN
IF stringpaircount ~< maxstringpairs THEN
BEGIN SIGNAL NotifyOverflow; RETURN END;
stringpairs[stringpaircount]←[AddStringOb[stringvalue],sob];
stringpaircount←stringpaircount+1;
END;

RegisterCommand: PROCEDURE[name: STRING, procedure: PROCEDURE] =
BEGIN
JaMLiteralDefs.StringLit[name,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 =>
BEGIN commandarray[dob.Command]←procedure; RETURN[TRUE] END;
ENDCASE;
JaMFnsDefs.PushObject[nameob];
RETURN[FALSE];
END;

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

RegisterExtCommand: PUBLIC PROCEDURE
[stringname: STRING, procedure: PROCEDURE] =
BEGIN
RegisterCommand[stringname,procedure];
NotifyCommand[stringname,procedure];
END;

RegisterIntCommand: PUBLIC PROCEDURE[procedure: PROCEDURE]
RETURNS[c: CommandType Object] =
BEGIN
IF NOT internalindex < MaxCommands THEN
ERROR JaMExecDefs.JaMError[CommandOvrFlw,FALSE];
internalindex ← internalindex+1;
commandarray[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 =
BEGIN
ERROR JaMExecDefs.JaMError[BadCommand,TRUE];
END;

Quit: PROCEDURE = BEGIN ImageDefs.StopMesa[] END;

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

BCDLoader: PROCEDURE[debug: BOOLEAN] =
BEGIN
s: STRING ← [40];
extended: BOOLEAN ← FALSE;
prog: PROGRAM;
JaMFnsDefs.PopString[s ! IODefs.LineOverflow =>
ERROR JaMExecDefs.JaMError[LongFileName,TRUE]];
prog←FrameDefs.LoadConfig[s !
SegmentDefs.FileNameError =>
BEGIN
--maybe extension omitted
IF extended THEN GOTO BadName;
StringDefs.AppendString[s,".bcd"]; extended←TRUE;
RETRY;
END;
LoaderOps.InvalidFile,
LoaderOps.VersionMismatch => GO TO BadVersion];
IF debug THEN
BEGIN
message: STRING ← [60];
StringDefs.AppendString[message,"About to START "];
StringDefs.AppendString[message,s];
MiscDefs.CallDebugger[message];
END;
IF FrameDefs.IsBound[prog] THEN START prog;
EXITS
BadName => ERROR JaMExecDefs.JaMError[BadFileName,TRUE];
BadVersion => ERROR JaMExecDefs.JaMError[BadFile,TRUE];
END;

-- 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 =
BEGIN
vm.PutWordVM[commandindexcount,vmaCICount,0];
END;

--installType: CARDINAL=4476; // some "random" number
--
--InstallCommandsAndStrings: PROCEDURE =
--BEGIN
--ob: Object;
--vma,vmaddress: LONG POINTER;
--clength,slength: CARDINAL;
--clength←commandindexcount*SIZE[PROCEDURE];
--slength←stringobcount*SIZE[StringType Object];
--vmaddress←vm.AllocateWordsVM[1+clength+slength];
--vm.PutWordVM[commandindexcount,vmaddress,0];
--vma←vmaddress+1;
--vm.PutWordsVM[vma,commandarray,clength];
--vma←vma+clength;
--vm.PutWordsVM[vma,stringobs,slength];
--ob←[lit,UserType[Type: installType, Address: vmaddress]];
--JaMFnsDefs.PushObject[imagekey];
--JaMFnsDefs.PushObject[ob];
--JaMDictionaryDefs.DictDefine[];
--END;

--RestoreCommandsAndStrings: PROCEDURE RETURNS[restored: BOOLEAN] =
--BEGIN
--RETURN[FALSE];
--ob: Object;
--vma,vmaddress: LONG POINTER;
--ccount,clength,slength: CARDINAL;
--IF NOT LookupObject[@imagekey,@ob] THEN RETURN[FALSE];
--WITH dob:ob SELECT FROM
--UserType =>
--BEGIN
--IF dob.Type#installType THEN RETURN[FALSE];
--vmaddress←dob.Address;
--END;
--ENDCASE => RETURN[FALSE];
--ccount←vm.GetWordVM[vmaddress,0];
--clength←ccount*SIZE[PROCEDURE];
--slength←stringobcount*SIZE[StringType Object];
--vma←vmaddress+1;
--vm.GetWordsVM[vma,commandarray,clength];
--vma←vma+clength;
--vm.GetWordsVM[vma,stringobs,slength];
--RETURN[TRUE];
--END;

ReRegister: PROCEDURE =
BEGIN
i: CARDINAL;
-- Initialize commandarray
FOR i IN [0..maxcommands)
DO commandarray[i]←UnregisteredCommand ENDLOOP;

-- Register commands and strings if necessary
--IF NOT RestoreCommandsAndStrings[] THEN
BEGIN
-- Register commands
FOR i IN[0..commandpaircount)
DO OPEN cp:commandpairs[i];
RegisterCommand[cp.string,cp.proc];
ENDLOOP;
-- Register string objects
FOR i IN[0..stringobcount)
DO
stringobs[i]←JaMLiteralDefs.MakeStringObject[strings[i]];
ENDLOOP;
--InstallCommandsAndStrings;
END;

-- copy string objects
FOR i IN[0..stringpaircount)
DO OPEN sp:stringpairs[i];
sp.ob↑←stringobs[sp.index];
ENDLOOP;
END;

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

AllocArrays: PROCEDURE[Alloc: PROCEDURE[CARDINAL] RETURNS[POINTER]] =
BEGIN
commandarray ← Alloc[SIZE[CommandArray]];
commandpairs ← Alloc[SIZE[CommandPairTable]];
stringobs ← Alloc[SIZE[StringObArray]];
strings ← Alloc[SIZE[StringArray]];
stringpairs ← Alloc[SIZE[StringPairTable]];
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;

FOR i IN [0..maxcommandpairs)
DO commandpairs[i]←[NIL,UnregisteredCommand] ENDLOOP;
commandpaircount←0;
FOR i IN [0..maxstringobs)
DO stringobs[i]←[nolit,StringType[0,0,NIL]]; strings[i]←NIL ENDLOOP;
stringobcount←0;
FOR i IN [0..maxstringpairs)
DO stringpairs[i]←[0,NIL] ENDLOOP;
stringpaircount←0;

-- 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
-- The START code for a JaM module should not attempt to use the VM.
-- Each module should use NotifyCommand and NotifyStringObject
-- to notify JaMControl of commands and strings to be installed
-- when the VM is ready.
-- Each module is expected 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;
StartControl; -- me too

-- 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[];
ImageDefs.AddCleanupProcedure[@cleanup];

-- Record commands and strings in the VM
ReRegister;

-- 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];
};

StartControl: PROCEDURE =
BEGIN
NotifyStringObject[@LongFileName, ".longname"L];
NotifyStringObject[@BadFileName, ".badname"L];
NotifyStringObject[@BadFile, ".badbcdfile"L];
NotifyStringObject[@BadCommand, ".unregistered"L];
NotifyStringObject[@CommandOvrFlw, ".commandovrflw"L];

-- Commands implemented by JaMControl
NotifyCommand[".quit"L,Quit];
NotifyCommand[".loadbcd"L,LoadBCD];
NotifyCommand[".debugbcd"L,DebugBCD];
END;

-- 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