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