-- MDMainImpl.mesa
-- last edit by Schmidt, January 14, 1983 10:27 am
-- last edit by Satterthwaite, February 9, 1983 12:50 pm
-- procedures for the system modeller
DIRECTORY
ConvertUnsafe: TYPE USING [ToRope],
CWF: TYPE USING [FWF0, FWF1, FWF2, FWF3, SetCode, SWF1, WF0, WF1, WF2, WF4],
DBStash: TYPE USING [ForceOut, GetNHits, GetNLeaders, SetNHits, SetNLeaders],
Dir: TYPE USING [FileInfo, NewVersion],
Directory: TYPE USING [Error, Handle, ignore, Lookup],
File: TYPE USING [Capability],
IO: TYPE USING [Handle, Flush, Put, PutChar, PutF, rope, string],
LongString: TYPE USING [EquivalentString],
MDComp: TYPE USING [DetermineRecomp, NewBind],
MDDB: TYPE USING [BringOverFilesAndCheckAllParms, CheckAndFillInParameters],
MDLoad: TYPE USING [LoadBcdsAndResolveImports, StartAllControlBcds, UnLoad],
MDMain: TYPE USING [Transaction],
MDModel: TYPE USING [
AllocateSymbolSeq, FreeSymbolSeq, GetFileInfo, GetSrcCreate, LOCSymbol, ModelParse,
MODELSymbol, NarrowToLIST, NarrowToLOC, numberofbcdsmapped, numberofsourcesparsed,
ParseInit, ProcessFilename, StartMDSupport, StopMDSupport, StopScanner, Symbol, SymbolSeq,
TraverseList, TraverseTree, traversetreecalled, ValidateModel],
MDUtil: TYPE USING [AcquireMsgLock, PrintNewModelStream, ReleaseMsgLock, SupportInit],
MoveFiles: TYPE USING [InternalPermanentOrTemporary],
Process: TYPE USING [Detach, Yield],
Rope: TYPE USING [ROPE, Text],
RopeInline: TYPE USING [InlineFlatten],
STPSubr: TYPE USING [StopSTP],
Subr: TYPE USING [
AbortMyself, debugflg, errorflg, GetCreateDate, LongZone,
numberofleaders, strcpy, SubrStop, SubStrCopy, TTYProcs],
Time: TYPE USING [Current],
TypeScript: TYPE USING [TS, UserAbort],
UserExec: TYPE USING [CommandProc, RegisterCommand, UserAbort],
ViewerClasses: TYPE USING [Viewer],
ViewerEvents: TYPE USING [
EventProc, EventRegistration, RegisterEventProc, UnRegisterEventProc];
MDMainImpl: MONITOR
IMPORTS ConvertUnsafe, CWF, DBStash, Dir, Directory, IO, LongString, MDComp, MDDB,
MDLoad, MDModel, MDUtil, MoveFiles, Process, RopeInline,
STPSubr, Subr, Time, TypeScript, UserExec, ViewerEvents
EXPORTS MDMain = {
maxsym: NAT = 7000; -- the number of symbols
-- MDS Usage!!!
-- this is freed only by shutdown forever
g: REF GlobalData ← NIL;
modellerIsIdle: PUBLIC BOOL ← FALSE; -- not TRUE until ModelImpl.Init finishes
ttywindow: Subr.TTYProcs ← NIL; -- print on this window please
attachEditorRef: ViewerEvents.EventRegistration ← NIL; -- valid if Tioga and modeller are connected
-- endof MDS Usage!!!
NPREV: NAT = 30;
GlobalData: TYPE = RECORD[
-- viewers stuff
ttyTypeScript: TypeScript.TS ← NIL, -- typescript to print on
ttyin: IO.Handle ← NIL, -- IOStream for above
ttyout: IO.Handle ← NIL, -- IOStream for above
msgout: IO.Handle ← NIL, -- for compiler progress messages
debugout: IO.Handle ← NIL, -- for printing debugging messages
--
startmodelling: BOOL ← FALSE,
stopmodelling: BOOL ← TRUE,
longzone: UNCOUNTED ZONE ← NIL,
symbolseq: MDModel.SymbolSeq ← NIL,
working: MDModel.LOCSymbol ← NIL,
prevstring: ARRAY[0 .. NPREV) OF Rope.Text ← ALL[NIL],
nprevstring: CARDINAL ← 0
];
-- local variables
maxdirsize: CARDINAL = 700; -- the max number of files on the disk
-- modeller algorithm:
-- (MakeModel non-interactive)
-- 1) - 4) StartModelling (see below)
-- 5) determine what needs to be compiled
-- if source ~= bcd, the recompile
-- if bcd is ok, but a parameter has changed, then recompile
-- record name of bcd produced
-- (add internal modulename from bcd files)
-- 6) if notify and there were new sources, generate new model
-- thus non-interactive modelling looks like
-- StartModelling X
-- run recompilation analysis algorithm
-- MakeModel
-- StopModelling
-- StartModelling
-- 1) parse model (try to handle *: id, id:*,
-- don't handle omitted parameters and :@loc)
-- 2) determine we have correct versions
-- retrieve them from remote servers
-- (now sources are correct)
-- 3) fill in defaults for initial model
-- (now model is fully qualified)
-- 4) check parameters to source files for accuracy
-- (at this point the model is complete and correct)
-- (add internal modulename from source files)
--
-- action.filename is the name of a model file
InternalStartModelling: INTERNAL PROC[action: REF MDMain.Transaction] = {
fn: STRING ← [100];
time: LONG CARDINAL;
-- p: PROCESS;
nhits, nmisses: LONG CARDINAL;
{
ttywindow ← action.ttyprintwindow;
time ← Time.Current[];
Subr.errorflg ← FALSE;
(action.ttyout).PutF["StartModelling %s\n", IO.rope[action.filename]];
IF g.startmodelling OR NOT g.stopmodelling THEN {
CWF.WF0["Error - you have not StoppedModelling.\n"L];
CWF.WF0["Type y to proceed and I will do a StopModelling for you,\n"L];
IF ttywindow.Confirm[
ttywindow.in, ttywindow.out, ttywindow.data,
"type n or CR and I will quit: ", 'n] = 'n
THEN RETURN;
InternalStopModelling[];
IF g = NIL THEN InitializeData[];
(action.ttyout).PutF["StartModelling %s\n", IO.rope[action.filename]];
};
-- initialize
g.ttyTypeScript ← action.ttyTypeScript;
g.ttyin ← action.ttyin;
g.ttyout ← action.ttyout;
g.msgout ← action.msgout;
g.debugout ← action.debugout;
g.startmodelling ← TRUE;
g.stopmodelling ← FALSE;
MDModel.numberofbcdsmapped ← MDModel.numberofsourcesparsed ← 0;
Subr.numberofleaders ← 0;
DBStash.SetNLeaders[];
DBStash.SetNHits[];
MDModel.traversetreecalled ← 0;
g.symbolseq ← MDModel.AllocateSymbolSeq[maxsym];
MDUtil.SupportInit[g.symbolseq, g.ttyTypeScript, g.ttyout];
MDModel.StartMDSupport[];
Chk[];
MDModel.ParseInit[g.symbolseq, action.noninteractive, g.ttyTypeScript, ttywindow];
CWF.SWF1[fn, "@%s"L, LOOPHOLE[action.filename]]; -- ProcessFilename likes an @
g.symbolseq.toploc ← MDModel.ProcessFilename[fn];
Chk[];
-- now parse the model
MDModel.ModelParse[g.symbolseq, g.ttyTypeScript, ttywindow];
IF g.symbolseq.toploc.nestedmodel = NIL THEN GOTO PErr;
g.working ← g.symbolseq.toploc;
Chk[];
-- fill up the disk cache
-- this procedure will parse the source files
-- and will move undefineds to be parameters, recursively postorder
-- can't fork here since we're in the monitor
MDDB.BringOverFilesAndCheckAllParms[g.symbolseq, action.noninteractive,
g.ttyTypeScript, action.ttyprintwindow];
IF Subr.debugflg THEN
MDModel.ValidateModel[g.symbolseq];
STPSubr.StopSTP[];
CWF.FWF1[DebugWP, "Symbolseq.size %u, "L, @g.symbolseq.size];
PrintElapsedTime[time];
[nhits, nmisses] ← DBStash.GetNHits[];
CWF.FWF2[DebugWP, "DB %lu hits, %lu misses.\n"L, @nhits, @nmisses];
CWF.FWF2[DebugWP, "# bcds mapped in %u, # sources parsed %u.\n"L,
@MDModel.numberofbcdsmapped, @MDModel.numberofsourcesparsed];
TemporaryStop[];
EXITS
PErr => {
CWF.WF0["Parsing error - can't continue.\n"L];
InternalStopModelling[];
};
};
};
InternalCompile: INTERNAL PROC[uniquename, tryreplacement: BOOL,
confirm: REF BOOL] RETURNS[compProblems: BOOL] = {
time: LONG CARDINAL ← Time.Current[];
DBStash.SetNLeaders[];
Subr.numberofleaders ← 0;
MDModel.traversetreecalled ← 0;
CWF.WF0["Compile\n"L];
Chk[];
-- this generates a new model(s)
MoveFiles.InternalPermanentOrTemporary[symbolseq: g.symbolseq,
working: g.working, temporary: TRUE, force: FALSE, window: ttywindow,
typeScript: g.ttyTypeScript, ttyout: g.ttyout];
Chk[];
MDModel.numberofbcdsmapped ← MDModel.numberofsourcesparsed ← 0;
-- this procedure may look at bcd's
-- now determine what needs to be compiled and emit comp stmts
-- and bind stmts
[, compProblems] ← MDComp.DetermineRecomp[g.working, g.symbolseq,
ttywindow, uniquename, tryreplacement, confirm, g.ttyTypeScript, g.ttyin,
g.ttyout, g.msgout];
g.msgout.Flush[];
CWF.FWF2[DebugWP, "# bcds mapped in %u, # sources parsed %u.\n"L,
@MDModel.numberofbcdsmapped, @MDModel.numberofsourcesparsed];
PrintElapsedTime[time];
Chk[];
TemporaryStop[];
};
InternalStopModelling: INTERNAL PROC = {
CWF.WF0["StopModelling\n"L];
IF g = NIL OR NOT g.startmodelling OR g.stopmodelling THEN {
CWF.WF0["Error - You must give a StartModelling command first.\n"L];
RETURN;
};
IF g.symbolseq.toploc.nestedmodel ~= NIL
AND g.symbolseq.toploc.nestedmodel.modelchanged THEN {
IF ttywindow.Confirm[
ttywindow.in, ttywindow.out, ttywindow.data,
"You did not save the new model(s).\nAre you sure you want to StopModelling ",
'n] = 'n
THEN {
CWF.WF0["No.\n"L];
RETURN;
}
ELSE CWF.WF0["Yes.\n"L];
};
CleanupData[];
};
-- for NoticeAll
-- look at all files on local disk, if there are any
-- newer versions, do a Notice on them
NoticeAll: PUBLIC ENTRY PROC = {
nnotice: CARDINAL;
time: LONG CARDINAL;
{
ENABLE {
ABORTED, Subr.AbortMyself => {
CWF.WF0["NoticeAll aborted."L];
GOTO out;
};
};
CheckSource: INTERNAL PROC[spl: MDModel.Symbol,
spmodel: MDModel.MODELSymbol]
RETURNS[proceed: BOOL←TRUE] = {
fi: Dir.FileInfo;
sploc: MDModel.LOCSymbol;
IF spl.stype ~= typeLOC THEN RETURN;
Chk[];
sploc ← MDModel.NarrowToLOC[spl];
fi ← MDModel.GetFileInfo[sploc];
-- this is to allow two bcds with different dates to
-- be expressed in the model (e.g. Mopcodes)
IF fi.isBcd THEN RETURN;
[] ← Dir.NewVersion[fi: fi, src: TRUE ! Directory.Error => GOTO out];
IF sploc.createtime ~= MDModel.GetSrcCreate[fi] THEN {
IF InternalNotice[ConvertUnsafe.ToRope[fi.srcFileName]] THEN nnotice ← nnotice+1;
};
RETURN;
EXITS
out => RETURN;
};
PrintSeparatorLine[];
time ← Time.Current[];
modellerIsIdle ← FALSE;
CheckStarted[];
Chk[];
Subr.numberofleaders ← 0;
DBStash.SetNLeaders[];
CWF.WF0["NoticeAll begun ....\n"L];
nnotice ← 0;
(g.symbolseq.toploc).TraverseTree[g.symbolseq, CheckSource];
CWF.WF1["%u files noticed.\n"L, @nnotice];
TemporaryStop[];
GOTO out;
EXITS
out => {
modellerIsIdle ← TRUE;
PrintElapsedTime[time];
PrintSeparatorLine[];
};
};
};
-- for each Notice:
-- 3) fill in defaults for module being notified
-- (this involves looking at the sourcefile)
-- 4) check parameters to notified source file for accuracy
-- (this involves looking at the bcd)
InternalNotice: INTERNAL PROC[filename: Rope.Text]
RETURNS[noticed: BOOL] = {
main: STRING ← [100];
ext: STRING ← [100];
noticetime: LONG CARDINAL;
fi: Dir.FileInfo;
cap: File.Capability;
-- done postorder
CheckSource: PROC[sptop: MDModel.Symbol, spmodel: MDModel.MODELSymbol]
RETURNS[proceed: BOOL ← TRUE] = {
-- calls itself recursively
-- spmodel, noticed, sptop is passed in
ProcLoc: PROC[spl: MDModel.Symbol] = {
IF spl = NIL THEN RETURN;
IF spl.stype = typeLIST THEN
MDModel.TraverseList[MDModel.NarrowToLIST[spl], ProcLoc]
ELSE IF spl.stype = typeLOC THEN {
sploc: MDModel.LOCSymbol;
sploc ← MDModel.NarrowToLOC[spl];
IF LongString.EquivalentString[main, sploc.tail]
AND LongString.EquivalentString[ext, sploc.sext]
AND noticetime ~= sploc.createtime THEN {
spmodel.modelchanged ← TRUE;
sploc.createtime ← noticetime;
fi ← MDModel.GetFileInfo[sploc];
IF NOT fi.isBcd THEN {
fi.srcCap ← cap;
fi.srcCreate ← noticetime;
fi.srcPresent ← TRUE;
fi.srcDepSeq ← NIL;
noticed ← TRUE;
[] ← MDDB.CheckAndFillInParameters[sptop, sploc,
g.symbolseq, spmodel, FALSE, g.ttyTypeScript, NIL];
-- last parameter shouldn't be NIL ↑
IF Subr.debugflg THEN
g.ttyout.PutF["Notice %s in %s.\n", IO.rope[filename],
IO.string[spmodel.modelfilename]];
-- this adds a new bcd if there happens
-- to be one lying around
[] ← Dir.NewVersion[fi: fi, src: FALSE
! Directory.Error => CONTINUE];
}
ELSE { -- .Bcd in model
[] ← Dir.NewVersion[fi: fi, src: FALSE
! Directory.Error => CONTINUE];
};
};
};
};
WITH spt: sptop SELECT FROM
typeTYPE => ProcLoc[spt.typeval];
typeAPPL => ProcLoc[spt.applval];
typeLET => ProcLoc[spt.letval];
typeMODEL => IF spt.modelchanged THEN {
spmodel.modelchanged ← TRUE;
IF Subr.debugflg THEN
CWF.WF2["%s forces %s model changed.\n"L,
spt.modelfilename, spmodel.modelfilename];
};
ENDCASE => NULL;
RETURN[TRUE];
};
noticed ← FALSE;
g.ttyout.PutF["Notice %s ... ", IO.rope[filename]];
Subr.strcpy[main, LOOPHOLE[filename]];
Process.Yield[];
-- now we can't rely on the disk cache; since the new version
-- will not be reflected in the cache
cap ← Directory.Lookup[fileName: main, permissions: Directory.ignore
! Directory.Error => {
g.ttyout.PutF["Notice Error - %s not on local disk.\n", IO.rope[filename]];
GOTO out;
};
];
noticetime ← Subr.GetCreateDate[cap];
Subr.strcpy[ext, "Mesa"L];
FOR i: CARDINAL DECREASING IN [0 .. main.length) DO
IF main[i] = '. THEN {
Subr.SubStrCopy[ext, LOOPHOLE[filename], i + 1];
main.length ← i;
EXIT;
};
ENDLOOP;
Chk[];
-- postorder is important here
MDModel.TraverseTree[g.symbolseq.toploc.nestedmodel, g.symbolseq,
CheckSource, FALSE];
CWF.WF0[IF noticed THEN "noticed.\n"L ELSE "not noticed.\n"L];
TemporaryStop[];
EXITS
out => NULL;
};
SetWorkingModel: PUBLIC ENTRY PROC[modelname: Rope.Text] = {
clean: BOOL ← FALSE;
{
ENABLE {
ABORTED => {
CWF.WF0["SetWorkingModel Aborted.\n"L];
clean ← TRUE;
GOTO out;
};
Subr.AbortMyself => {
CWF.WF0["SetWorkingModel Aborted.\n"L];
GOTO out;
};
};
CheckStarted[];
modellerIsIdle ← FALSE;
IF modelname = NIL THEN
g.working ← g.symbolseq.toploc
ELSE
g.working ← LocForModelName[g.symbolseq, LOOPHOLE[modelname]];
IF g.working = NIL THEN
CWF.WF1["Error - Could not set working model to %s.\n"L, LOOPHOLE[modelname]]
ELSE IF modelname ~= NIL THEN
CWF.WF1["Working Model set to %s.\n"L, LOOPHOLE[modelname]]
ELSE
CWF.WF0["Working model reset to outermost model.\n"L];
TemporaryStop[];
GOTO out;
EXITS
out => {
IF clean THEN CleanupData[];
PrintSeparatorLine[];
modellerIsIdle ← TRUE;
};
}};
LocForModelName: PROC[symbolseq: MDModel.SymbolSeq, modelname: LONG STRING]
RETURNS[sploc: MDModel.LOCSymbol] = {
LookFor: PROC[sp: MDModel.Symbol, sp3: MDModel.MODELSymbol]
RETURNS[proceed: BOOL ← TRUE] = {
spl: MDModel.LOCSymbol;
IF sploc ~= NIL OR sp.stype ~= typeLOC THEN RETURN;
spl ← MDModel.NarrowToLOC[sp];
IF spl.nestedmodel ~= NIL AND
LongString.EquivalentString[spl.nestedmodel.modelfilename, modelname] THEN {
sploc ← spl;
RETURN[FALSE];
};
};
sploc ← NIL;
MDModel.TraverseTree[symbolseq.toploc, symbolseq, LookFor];
};
PrintElapsedTime: PROC[oldtime: LONG CARDINAL] = {
elapt: LONG CARDINAL ← Time.Current[];
nleaders: CARDINAL;
nleaders ← Subr.numberofleaders + DBStash.GetNLeaders[];
elapt ← elapt - oldtime;
IF elapt = 0 THEN elapt ← 1;
CWF.FWF3[DebugWP, "Elapsed seconds: %lu, leaders: %u, traversetrees: %u\n"L,
@elapt, @nleaders, @MDModel.traversetreecalled];
Subr.numberofleaders ← 0;
MDModel.traversetreecalled ← 0;
DBStash.SetNLeaders[];
};
-- these are the procedures that are exported but in fact
-- just call INTERNAL procedures
StartModelling: PUBLIC ENTRY PROC[action: REF MDMain.Transaction] = {
clean: BOOL ← FALSE;
{
ENABLE {
ABORTED, Subr.AbortMyself => {
CWF.WF0["StartModelling Aborted.\n"L];
clean ← TRUE;
GOTO out;
};
};
PrintSeparatorLine[];
modellerIsIdle ← FALSE;
IF g = NIL THEN InitializeData[]; -- will not delete any string heaps
InternalStartModelling[action];
GOTO out;
EXITS
out => {
IF clean THEN CleanupData[];
PrintSeparatorLine[];
modellerIsIdle ← TRUE;
};
}};
ReStartModelling: PUBLIC ENTRY PROC[action: REF MDMain.Transaction] = {
clean: BOOL ← FALSE;
{
ENABLE {
ABORTED, Subr.AbortMyself => {
CWF.WF0["ReStartModelling Aborted.\n"L];
clean ← TRUE;
GOTO out;
};
};
PrintSeparatorLine[];
modellerIsIdle ← FALSE;
IF g ~= NIL AND g.startmodelling THEN
InternalStopModelling[];
IF g = NIL THEN InitializeData[];
InternalStartModelling[action];
GOTO out;
EXITS
out => {
IF clean THEN CleanupData[];
PrintSeparatorLine[];
modellerIsIdle ← TRUE;
};
}};
-- for MakeModel:
-- 6) if necessary, generate config and bind stmt
-- 7) if were new sources, generate new model
MakeModel: PUBLIC ENTRY PROC[action: REF MDMain.Transaction] = {
clean: BOOL ← FALSE;
{
ENABLE {
ABORTED, Subr.AbortMyself => {
CWF.WF0["MakeModel Aborted.\n"L];
clean ← TRUE;
GOTO out;
};
};
PrintSeparatorLine[];
g.ttyout.PutF["MakeModel %s\n", IO.rope[action.filename]];
modellerIsIdle ← FALSE;
IF g = NIL THEN InitializeData[];
Chk[];
InternalStartModelling[action];
Chk[];
[] ← InternalCompile[FALSE, FALSE, NIL];
Chk[];
InternalStopModelling[];
GOTO out;
EXITS
out => {
IF clean THEN CleanupData[];
modellerIsIdle ← TRUE;
PrintSeparatorLine[];
};
}};
Compile: PUBLIC ENTRY PROC[
action: REF MDMain.Transaction,
uniquename, tryreplacement: BOOL, confirm: REF BOOL] = {
clean: BOOL ← FALSE;
{
ENABLE {
ABORTED => {
CWF.WF0["Compile Aborted.\n"L];
clean ← TRUE;
GOTO out;
};
Subr.AbortMyself => {
CWF.WF0["Compile Aborted.\n"L];
GOTO out;
};
};
PrintSeparatorLine[];
modellerIsIdle ← FALSE;
IF g = NIL THEN { -- StartModelling not given, do it for him
IF g = NIL THEN InitializeData[];
InternalStartModelling[action];
};
CheckStarted[];
[] ← InternalCompile[uniquename, tryreplacement, confirm];
GOTO out;
EXITS
out => {
IF clean THEN CleanupData[];
modellerIsIdle ← TRUE;
PrintSeparatorLine[];
};
}};
-- for Temporary:
-- just write out the model from memory
Temporary: PUBLIC ENTRY PROC = {
clean: BOOL ← FALSE;
{
ENABLE {
ABORTED => {
CWF.WF0["Temporary Aborted.\n"L];
clean ← TRUE;
GOTO out;
};
Subr.AbortMyself => {
CWF.WF0["Temporary Aborted.\n"L];
GOTO out;
};
};
PrintSeparatorLine[];
CheckStarted[];
modellerIsIdle ← FALSE;
MoveFiles.InternalPermanentOrTemporary[symbolseq: g.symbolseq,
working: g.working, temporary: TRUE, force: TRUE, window: ttywindow,
typeScript: g.ttyTypeScript, ttyout: g.ttyout];
TemporaryStop[];
GOTO out;
EXITS
out => {
modellerIsIdle ← TRUE;
IF clean THEN CleanupData[];
PrintSeparatorLine[];
};
}};
-- for Permanent:
-- store back any files on which a Notify has been done
Permanent: PUBLIC ENTRY PROC = {
clean: BOOL ← FALSE;
{
ENABLE {
ABORTED => {
CWF.WF0["Permanent Aborted.\n"L];
clean ← TRUE;
GOTO out;
};
Subr.AbortMyself => {
CWF.WF0["Permanent Aborted.\n"L];
GOTO out;
};
};
PrintSeparatorLine[];
CheckStarted[];
modellerIsIdle ← FALSE;
MoveFiles.InternalPermanentOrTemporary[symbolseq: g.symbolseq,
working: g.working, temporary: FALSE, force: FALSE, window: ttywindow,
typeScript: g.ttyTypeScript, ttyout: g.ttyout];
TemporaryStop[];
GOTO out;
EXITS
out => {
IF clean THEN CleanupData[];
modellerIsIdle ← TRUE;
PrintSeparatorLine[];
};
}};
-- for StopModelling
-- query if Permanent or Temporary hasn't been done
-- shut down stuff, free memory
StopModelling: PUBLIC ENTRY PROC = {
clean: BOOL ← FALSE;
{
ENABLE {
ABORTED, Subr.AbortMyself => {
CWF.WF0["StopModelling Aborted.\n"L];
clean ← TRUE;
GOTO out;
};
};
PrintSeparatorLine[];
CheckStarted[];
modellerIsIdle ← FALSE;
InternalStopModelling[];
GOTO out;
EXITS
out => {
modellerIsIdle ← TRUE;
IF clean THEN CleanupData[];
PrintSeparatorLine[];
};
}};
-- utility to print out model
-- uses the working model
-- will FreeString[modelname];
Type: PUBLIC ENTRY PROC[modelname: Rope.Text, default: BOOL] = {
clean: BOOL ← FALSE;
{
ENABLE {
ABORTED => {
CWF.WF0["Type Aborted.\n"L];
clean ← TRUE;
GOTO out;
};
Subr.AbortMyself => {
CWF.WF0["Type Aborted.\n"L];
GOTO out;
};
};
root: MDModel.LOCSymbol;
PrintSeparatorLine[];
CheckStarted[];
modellerIsIdle ← FALSE;
root ← g.working;
IF modelname ~= NIL THEN {
root ← LocForModelName[g.symbolseq, LOOPHOLE[modelname]];
CWF.WF1["Type %s\n"L, LOOPHOLE[modelname]];
IF root = NIL THEN {
CWF.WF1["Error - can't find %s.\n"L, LOOPHOLE[modelname]];
GOTO out;
};
}
ELSE CWF.WF0["Type.\n"L];
MDUtil.PrintNewModelStream[g.symbolseq, root.nestedmodel, NIL,
NIL, NOT default, g.ttyTypeScript, g.ttyout];
TemporaryStop[];
GOTO out;
EXITS
out => {
IF clean THEN CleanupData[];
modellerIsIdle ← TRUE;
PrintSeparatorLine[];
};
}};
-- this is running in the background when called so
-- it catches an unusual number of signals
Notice: PUBLIC ENTRY PROC[filename: Rope.Text] = {
{
ENABLE {
ABORTED, Subr.AbortMyself => {
CWF.WF0["Notice aborted."L];
GOTO out;
};
};
PrintSeparatorLine[];
CheckStarted[];
modellerIsIdle ← FALSE;
[] ← InternalNotice[filename];
TemporaryStop[];
GOTO out;
EXITS
out => {
modellerIsIdle ← TRUE;
PrintSeparatorLine[];
};
};
};
Bind: PUBLIC ENTRY PROC = {
clean: BOOL ← FALSE;
{
ENABLE {
ABORTED => {
CWF.WF0["Bind Aborted.\n"L];
clean ← TRUE;
GOTO out;
};
Subr.AbortMyself => {
CWF.WF0["Bind Aborted.\n"L];
GOTO out;
};
};
spmodel: MDModel.MODELSymbol;
PrintSeparatorLine[];
CheckStarted[];
modellerIsIdle ← FALSE;
spmodel ← g.working.nestedmodel;
[] ← MDComp.NewBind[spmodel, g.symbolseq, TRUE, TRUE, NIL,
spmodel.modelfilename, spmodel.modelcreate,
ttywindow, g.ttyTypeScript, g.ttyin, g.ttyout, g.msgout];
TemporaryStop[];
GOTO out;
EXITS
out => {
modellerIsIdle ← TRUE;
IF clean THEN CleanupData[];
PrintSeparatorLine[];
};
}};
Loader: PUBLIC ENTRY PROC[tryreplacement: BOOL] = {
clean: BOOL ← FALSE;
{
ENABLE {
ABORTED => {
CWF.WF0["Modeller Loader Aborted.\n"L];
clean ← TRUE;
GOTO out;
};
Subr.AbortMyself => {
CWF.WF0["Modeller Loader Aborted.\n"L];
GOTO out;
};
};
spmodel: MDModel.MODELSymbol;
PrintSeparatorLine[];
CheckStarted[];
modellerIsIdle ← FALSE;
spmodel ← g.working.nestedmodel;
MDLoad.LoadBcdsAndResolveImports[spmodel, g.symbolseq, tryreplacement, ttywindow, g.ttyout];
TemporaryStop[];
GOTO out;
EXITS
out => {
modellerIsIdle ← TRUE;
IF clean THEN CleanupData[];
PrintSeparatorLine[];
};
}};
UnLoader: PUBLIC ENTRY PROC = {
clean: BOOL ← FALSE;
{
ENABLE {
ABORTED => {
CWF.WF0["Modeller UnLoader Aborted.\n"L];
clean ← TRUE;
GOTO out;
};
Subr.AbortMyself => {
CWF.WF0["Modeller UnLoader Aborted.\n"L];
GOTO out;
};
};
spmodel: MDModel.MODELSymbol;
PrintSeparatorLine[];
CheckStarted[];
modellerIsIdle ← FALSE;
spmodel ← g.working.nestedmodel;
CWF.WF0["Unloading modules.\n"L];
-- this will actually delete all the modules code segments, etc
MDLoad.UnLoad[spmodel, g.symbolseq, TRUE];
TemporaryStop[];
GOTO out;
EXITS
out => {
IF clean THEN CleanupData[];
modellerIsIdle ← TRUE;
PrintSeparatorLine[];
};
}};
Begin: PUBLIC ENTRY PROC[action: REF MDMain.Transaction, confirm: REF BOOL] = {
clean: BOOL ← FALSE;
{
ENABLE {
ABORTED => {
CWF.WF0["Begin Aborted.\n"L];
clean ← TRUE;
GOTO out;
};
Subr.AbortMyself => {
CWF.WF0["Begin Aborted.\n"L];
GOTO out;
};
};
spmodel: MDModel.MODELSymbol;
compProblems: BOOL;
modellerIsIdle ← FALSE;
PrintSeparatorLine[];
IF g = NIL THEN { -- StartModelling not given, do it for him
IF g = NIL THEN InitializeData[];
InternalStartModelling[action];
};
CheckStarted[];
spmodel ← g.working.nestedmodel;
-- this will actually delete all the modules code segments, etc
MDLoad.UnLoad[spmodel, g.symbolseq, TRUE];
compProblems ← InternalCompile[FALSE, FALSE, confirm];
IF compProblems THEN
CWF.WF0["Loading and starting aborted.\n"L]
ELSE {
MDLoad.LoadBcdsAndResolveImports[spmodel, g.symbolseq, FALSE, ttywindow, g.ttyout];
MDLoad.StartAllControlBcds[spmodel, g.symbolseq];
spmodel.started ← TRUE;
};
-- modellerIsIdle will be reset in MDLoadImpl
TemporaryStop[];
GOTO out;
EXITS
out => {
IF clean THEN CleanupData[];
modellerIsIdle ← TRUE;
PrintSeparatorLine[];
};
}};
Continue: PUBLIC ENTRY PROC[confirm: REF BOOL] = {
clean: BOOL ← FALSE;
{
ENABLE {
ABORTED => {
CWF.WF0["Continue Aborted.\n"L];
clean ← TRUE;
GOTO out;
};
Subr.AbortMyself => {
CWF.WF0["Continue Aborted.\n"L];
GOTO out;
};
};
compProblems: BOOL;
spmodel: MDModel.MODELSymbol;
modellerIsIdle ← FALSE;
PrintSeparatorLine[];
CheckStarted[];
spmodel ← g.working.nestedmodel;
compProblems ← InternalCompile[FALSE, FALSE, confirm];
IF compProblems THEN
CWF.WF0["Loading with replacement aborted.\n"L]
ELSE {
MDLoad.LoadBcdsAndResolveImports[spmodel, g.symbolseq, FALSE, ttywindow, g.ttyout];
IF NOT spmodel.started THEN
MDLoad.StartAllControlBcds[spmodel, g.symbolseq];
spmodel.started ← TRUE;
};
-- modellerIsIdle will be reset in MDLoadImpl
TemporaryStop[];
GOTO out;
EXITS
out => {
IF clean THEN CleanupData[];
modellerIsIdle ← TRUE;
PrintSeparatorLine[];
};
}};
Start: PUBLIC ENTRY PROC = {
clean: BOOL ← FALSE;
{
ENABLE {
ABORTED => {
CWF.WF0["Start Aborted.\n"L];
clean ← TRUE;
GOTO out;
};
Subr.AbortMyself => {
CWF.WF0["Start Aborted.\n"L];
GOTO out;
};
};
spmodel: MDModel.MODELSymbol;
modellerIsIdle ← FALSE;
PrintSeparatorLine[];
CheckStarted[];
spmodel ← g.working.nestedmodel;
MDLoad.StartAllControlBcds[spmodel, g.symbolseq];
-- modellerIsIdle will be reset in MDLoadImpl
TemporaryStop[];
GOTO out;
EXITS
out => {
IF clean THEN CleanupData[];
modellerIsIdle ← TRUE;
PrintSeparatorLine[];
};
}};
-- this is called to initialize the world
InitializeData: PROC = {
-- this storage is freed by CleanupData[];
longzone: UNCOUNTED ZONE;
IF g ~= NIL THEN ERROR;
-- Subr.LongZone will call SubrInit with 256 pages if needed
longzone ← Subr.LongZone[];
g ← NEW[GlobalData ← []];
g.longzone ← longzone;
};
-- this frees all of the data structures, until InitializeData is called again
CleanupData: INTERNAL PROC = {
npages: CARDINAL;
IF g = NIL THEN RETURN;
IF g.working ~= NIL THEN
-- doesn't delete the code segments
MDLoad.UnLoad[g.working.nestedmodel, g.symbolseq, FALSE];
MDModel.StopMDSupport[];
STPSubr.StopSTP[];
MDModel.FreeSymbolSeq[@g.symbolseq];
MDModel.StopScanner[];
npages ← DBStash.ForceOut[];
CWF.FWF1[DebugWP, "%u pages used in DB huge space.\n"L, @npages];
TemporaryStop[];
FREE[@g];
Subr.SubrStop[]; -- frees the long zone
modellerIsIdle ← TRUE;
};
TemporaryStop: PROC =
{
g.ttyout.Flush[];
IF g.debugout ~= NIL THEN g.debugout.Flush[];
};
-- only prints if the debugging window is available
DebugWP: PUBLIC PROC[ch: CHAR] = {
IF g ~= NIL AND g.debugout ~= NIL THEN
g.debugout.PutChar[ch];
};
Chk: PROC = {
IF TypeScript.UserAbort[g.ttyTypeScript] THEN SIGNAL Subr.AbortMyself;
};
-- this will do any delayed notices
CheckStarted: INTERNAL PROC = {
IF g = NIL THEN {
CWF.WF0["Error - StartModelling has not been given.\n"L];
SIGNAL Subr.AbortMyself;
};
IF g.startmodelling AND g.nprevstring > 0 THEN {
FOR i: CARDINAL IN [0 .. g.nprevstring) DO
[] ← InternalNotice[g.prevstring[i]];
g.prevstring[i] ← NIL;
ENDLOOP;
g.nprevstring ← 0;
};
};
PrintSeparatorLine: PUBLIC PROC = {
CWF.FWF0[DebugWP, "-----------------\n"L];
CWF.WF0["-----------------\n"L];
};
-- code from Tioga
AttachSymbiote: PUBLIC PROC[msgout: IO.Handle] =
{
IF attachEditorRef = NIL THEN
attachEditorRef ← ViewerEvents.RegisterEventProc[
proc: CallProcedureForNotice, event: $save, before: FALSE];
MDUtil.AcquireMsgLock[];
msgout.Put[IO.string["Editor set to call modeller.\n"L]
! UNWIND => MDUtil.ReleaseMsgLock[]];
MDUtil.ReleaseMsgLock[];
};
DetachSymbiote: PUBLIC PROC[msgout: IO.Handle] = {
IF attachEditorRef ~= NIL THEN
ViewerEvents.UnRegisterEventProc[attachEditorRef, save];
attachEditorRef ← NIL;
MDUtil.AcquireMsgLock[];
msgout.Put[IO.string["Editor detached from modeller.\n"L]
! UNWIND => MDUtil.ReleaseMsgLock[]];
MDUtil.ReleaseMsgLock[];
};
-- this is the procedure called by the editor
-- can't print anything in this procedure
CallProcedureForNotice: ViewerEvents.EventProc = TRUSTED {
ENABLE ANY => GOTO out;
flat: Rope.Text;
IF g = NIL OR NOT g.startmodelling THEN RETURN;
IF viewer.file = NIL THEN RETURN;
flat ← RopeInline.InlineFlatten[viewer.file];
IF NOT modellerIsIdle THEN {
IF g.nprevstring >= g.prevstring.LENGTH THEN RETURN;
g.prevstring[g.nprevstring] ← flat;
g.nprevstring ← g.nprevstring + 1;
RETURN;
};
-- this will acquire the monitor lock
Process.Detach[FORK Notice[flat]];
EXITS
out => NULL;
};
PrintFileInfo: UserExec.CommandProc = TRUSTED {
ENABLE Subr.AbortMyself => {
CWF.WF0["XFIPrint aborted.\n"L];
GOTO out;
};
PrintLoc: PROC[sp: MDModel.Symbol, spmodel: MDModel.MODELSymbol]
RETURNS[proceed: BOOL ← TRUE] = {
sploc: MDModel.LOCSymbol;
fi: Dir.FileInfo;
IF sp.stype ~= typeLOC THEN RETURN;
sploc ← MDModel.NarrowToLOC[sp];
fi ← sploc.fi;
CWF.WF4["%s: (create %w, vers %v%s) "L,
fi.bcdFileName, @fi.bcdCreate, @fi.bcdVers,
IF fi.bcdPresent THEN ", bcdPresent"L ELSE ""L];
CWF.WF4["mod %s\n\t%s: (create %w%s)\n"L,
fi.moduleName, fi.srcFileName, @fi.srcCreate,
IF fi.srcPresent THEN ", srcPresent"L ELSE ""L];
IF UserExec.UserAbort[exec] THEN SIGNAL Subr.AbortMyself;
};
MDModel.TraverseTree[g.symbolseq.toploc, g.symbolseq, PrintLoc];
EXITS
out => NULL;
};
CWFWRoutine: PROC[uns: LONG POINTER, form: LONG STRING, wp: PROC[CHAR]] = {
time: LONG CARDINAL ← LOOPHOLE[uns, LONG POINTER TO LONG CARDINAL]↑;
IF time = 0 THEN CWF.FWF0[wp, "(Null)"L] ELSE CWF.FWF1[wp, "%lt"L, uns];
};
Init: PROC = {
UserExec.RegisterCommand["XFIPrint.~", PrintFileInfo];
CWF.SetCode['w, CWFWRoutine];
};
Init[];
}.