-- DesModSupImpl.mesa
-- last edit by Schmidt, April 27, 1982 2:24 pm
-- last edit by Satterthwaite, February 1, 1983 10:02 am

DIRECTORY
  CWF: TYPE USING [SWF1, SWF2, WF0, WF1],
  DesModSup: TYPE USING [],
  Dir: TYPE USING [FileInfo],
  LongString: TYPE USING [CompareStrings, EqualString, EquivalentString],
  MDModel: TYPE USING [AddToEndOfList, After, APPLSymbol, CkType, GetFileInfo, 
  	HasAStringName, IsOnList, LETSymbol, LISTSymbol, LOCSymbol, LookForInstSource,
  	LookForInstBcd, LookForTypeSource, LookForTypeBcd, MergeIntoList, 
	MODELSymbol, NarrowToAPPL, NarrowToLET, NarrowToLIST, NarrowToLOC,
	NarrowToPROC, NarrowToTYPE, NewSymAPPL, NewSymLIST,
	NewSymLOC, NewSymMODEL, NewSymOPEN, NewSymPROC, NewSymTYPE,
	OPENSymbol, PROCSymbol, RemoveFromList, SpliceBefore, Sym, 
	Symbol, SymbolSeq, TraverseAndRemove, TraverseList, TYPESymbol, ZeroOut],
  Process: TYPE USING [Yield],
  Runtime: TYPE USING [CallDebugger],
  Subr: TYPE USING [AbortMyself, CopyString, debugflg, EndsIn, strcpy],
  TimeStamp: TYPE USING [Null, Stamp],
  UserExec: TYPE USING[ExecHandle, UserAbort];
					
DesModSupImpl: PROGRAM
IMPORTS CWF, LongString, MDModel, Runtime, Process, Subr, UserExec
EXPORTS DesModSup = {
					

-- raised by EnterType and EnterInstAndLoc
-- when moduleName = NIL and can't find a type that it can use
-- so it must have a moduleName
NeedModuleName: PUBLIC SIGNAL = CODE;

-- take a list of Appls and Lets and TYPEs, and put a Model: PROC
-- header in front of them
-- also moves all undefined Appls to the Model parameter list
-- then puts a single list node in front of the PROC node
FixupExterior: PUBLIC PROC[symbolseq: MDModel.SymbolSeq, modelname: STRING] = {
spm: MDModel.PROCSymbol;
spa: MDModel.APPLSymbol;
spl: MDModel.LISTSymbol;

	
spm _ MDModel.NewSymPROC[symbolseq];
spm.procsym _ Subr.CopyString[modelname];
spm.procval _ symbolseq.toploc.nestedmodel.model;
spm.procparm _ NIL;
spm.procret _ NIL;
symbolseq.toploc.nestedmodel.model _ MDModel.NewSymLIST[symbolseq];
symbolseq.toploc.nestedmodel.model.first _ spm;
symbolseq.toploc.nestedmodel.model.rest _ NIL;
-- MDModel.TraverseTree[spm.procval, symbolseq, SeeIfUndefined];
spl _ MDModel.NarrowToLIST[spm.procval];
-- move type information to the parameter field
WHILE spl ~= NIL DO
	MDModel.CkType[spl, typeLIST];
	IF spl.first.stype = typeAPPL THEN {
		spa _ MDModel.NarrowToAPPL[spl.first];
		IF spa.applval = NIL THEN { 
			sptype: MDModel.TYPESymbol;
			sploc: MDModel.LOCSymbol;
			sptemp: MDModel.LISTSymbol;
			stemp: STRING _ [100];
			-- SpliceType[symbolseq, spa.appltype];
			spm.procparm _ MDModel.AddToEndOfList[spm.procparm, 
				spa.appltype, normal, symbolseq];
			sptemp _ MDModel.NarrowToLIST[spm.procval];
			[newlist: spm.procval] _ 
				MDModel.RemoveFromList[spa.appltype, sptemp];
			sptype _ MDModel.NarrowToTYPE[spa.appltype];
			sploc _ MDModel.NarrowToLOC[sptype.typeval];
			CWF.SWF2[stemp, "%s.%s"L, sploc.tail, sploc.sext];
			};
		};
	spl _ spl.rest;
	ENDLOOP;
-- now move instance information to the parameter field
{
	AddIt: PROC[spa1: MDModel.Symbol] RETURNS[remove: BOOL] = {
	IF spa1.stype = typeAPPL 
	AND MDModel.NarrowToAPPL[spa1].applval = NIL THEN {
		spm.procparm _ MDModel.AddToEndOfList[spm.procparm, 
			spa1, normal, symbolseq];
		RETURN[TRUE];
		};
	IF spa1.stype = typeLET THEN {
		splet: MDModel.LETSymbol;
		splet _ MDModel.NarrowToLET[spa1];
		IF splet.letval = NIL AND splet.letgrp.rest = NIL THEN {
			spappl: MDModel.APPLSymbol;
			spappl _ MDModel.NarrowToAPPL[splet.letgrp.first];
			spappl.letparent _ NIL;
			spm.procparm _ MDModel.AddToEndOfList[spm.procparm, 
				spappl, normal, symbolseq];
			RETURN[TRUE];
			};
		};
	RETURN[FALSE];
	};
	
spm.procval _ MDModel.TraverseAndRemove[MDModel.NarrowToLIST[spm.procval],
	 AddIt];
}};

EnterType: PUBLIC PROC[bcdFileName, moduleName: LONG STRING, bcdVers: TimeStamp.Stamp,
	symbolseq: MDModel.SymbolSeq, spmodel: MDModel.MODELSymbol] 
	RETURNS[sptype: MDModel.TYPESymbol] ={
bcdfilename: STRING _ [200];
sptypeloc: MDModel.LOCSymbol;
spproc: MDModel.PROCSymbol _ NIL;
plist: LONG POINTER TO MDModel.LISTSymbol _ NIL;

IF bcdVers = TimeStamp.Null THEN
	[sptype, sptypeloc, spproc] _ MDModel.LookForTypeSource[bcdFileName, moduleName, symbolseq, spmodel]
ELSE [sptype, sptypeloc, spproc] _ MDModel.LookForTypeBcd[bcdFileName, bcdVers, symbolseq, spmodel];
Subr.strcpy[bcdfilename, bcdFileName];
IF Subr.EndsIn[bcdfilename, ".bcd"L] THEN 
	bcdfilename.length _ bcdfilename.length - 4;
IF sptype = NIL OR sptypeloc = NIL THEN {
	IF sptypeloc = NIL THEN {
		fi: Dir.FileInfo;
		sptypeloc _ MDModel.NewSymLOC[symbolseq];
		sptypeloc.tail _ Subr.CopyString[bcdfilename];
		sptypeloc.sext _ Subr.CopyString["bcd"L];
		sptypeloc.createtime _ 0;
		fi _ MDModel.GetFileInfo[sptypeloc];
		fi.bcdVers _ bcdVers;
		};
	IF sptype = NIL THEN {
		sptype _ MDModel.NewSymTYPE[symbolseq];
		IF moduleName = NIL OR moduleName.length = 0 THEN ERROR NeedModuleName;
		sptype.typesym _ Subr.CopyString[
			IF LongString.EquivalentString[bcdFileName, moduleName] 
				OR bcdVers ~= TimeStamp.Null THEN moduleName 
			ELSE bcdFileName];
		sptype.typeName _ Subr.CopyString[moduleName];
		sptype.typeval _ sptypeloc;
		plist _ IF spproc = NIL THEN @spmodel.model 
			ELSE LOOPHOLE[@spproc.procval];
		plist^ _ MDModel.AddToEndOfList[plist^, sptype, 
			normal, symbolseq];
		}
	ELSE {
		MDModel.CkType[sptype, typeTYPE];
		sptype.typeval _ sptypeloc;
		};
	};
RETURN[sptype];
};

-- spimpl is either APPL or LET
-- if sptype is not NIL, then use sptype as the type of the instance
-- bcdVers should not be 0 when moduleName = NIL
EnterInstAndLoc: PUBLIC PROC[bcdFileName, moduleName: LONG STRING, 
	bcdVers: TimeStamp.Stamp, symbolseq: MDModel.SymbolSeq,
	spmodel: MDModel.MODELSymbol, sptype: MDModel.TYPESymbol] 
	RETURNS[spappl: MDModel.APPLSymbol] ={
spproc: MDModel.PROCSymbol _ NIL;

IF sptype = NIL THEN
	[sptype] _ EnterType[bcdFileName, moduleName, bcdVers, 
		symbolseq, spmodel];
MDModel.CkType[sptype, typeTYPE];
IF bcdVers = TimeStamp.Null THEN 
	[spappl, sptype, spproc] _ MDModel.LookForInstSource[bcdFileName, moduleName, 
		symbolseq, spmodel, sptype]
ELSE [spappl, sptype, spproc] _ MDModel.LookForInstBcd[bcdFileName, bcdVers, 
	symbolseq, spmodel, sptype];
IF spappl = NIL THEN {
	plist: LONG POINTER TO MDModel.LISTSymbol;
	splist: MDModel.LISTSymbol;
	intname: STRING _ [100];
	CWF.SWF1[intname, "%sImpl"L, IF moduleName = NIL THEN bcdFileName ELSE moduleName];
	spappl _ MDModel.NewSymAPPL[symbolseq];
	spappl.applsym _ Subr.CopyString[intname];
	spappl.appltype _ sptype;
	spappl.applval _ NIL;
	spappl.letparent _ NIL;
	IF spproc = NIL THEN {
		splist _ spmodel.model;
		WHILE splist ~= NIL DO
			IF splist.first.stype = typePROC THEN {
				spproc _ MDModel.NarrowToPROC[splist.first];
				EXIT;
				};
			splist _ splist.rest;
			ENDLOOP;
		};
	plist _ IF spproc = NIL THEN @spmodel.model 
		ELSE LOOPHOLE[@spproc.procval];
	plist^ _ MDModel.AddToEndOfList[plist^, spappl, normal, symbolseq];
	RETURN[spappl];
	}
ELSE {
	spappl.appltype _ sptype;
	};
RETURN[spappl];
};

-- makes the root be a list with constant
-- defs files and then the Model
-- assumes symbolseq.toploc.nestedmodel.model is a LIST of one element, 
-- which is a PROC
MoveTypesToFront: PUBLIC PROC[symbolseq: MDModel.SymbolSeq] = {
spmain: MDModel.PROCSymbol;
changes: BOOL _ TRUE;

	-- move elements to outermost list
	-- sp comes from spmain.procparm
	ListProcMove: PROC[sp: MDModel.Symbol] = {
	IF sp.stype ~= typeTYPE THEN RETURN;
	IF NOT MDModel.IsOnList[sp, symbolseq.toploc.nestedmodel.model] THEN { 
		symbolseq.toploc.nestedmodel.model _ 
			MDModel.AddToEndOfList[symbolseq.toploc.nestedmodel.model,
				sp, normal, symbolseq];
		changes _ TRUE;
		};
	};

	-- move elements it depends on to outermost list
	-- sp comes from symbolseq.toploc.nestedmodel.model
	ListProcMoveAgain: PROC[sp: MDModel.Symbol] = {
	spl: MDModel.LOCSymbol;
	sptype: MDModel.TYPESymbol;
	IF sp.stype = typeAPPL THEN RETURN;
	sptype _ MDModel.NarrowToTYPE[sp];
	IF sptype.typeval ~= NIL THEN {
		spl _ MDModel.NarrowToLOC[sptype.typeval];
		MDModel.TraverseList[spl.parmlist, ListProcMove];
		};
	};

	-- delete elements on either list if we've moved it
	-- sp comes from symbolseq.toploc.nestedmodel.model
	ListProcDelete: PROC[sp: MDModel.Symbol] = {
	spl: MDModel.LISTSymbol;
	IF MDModel.IsOnList[sp, spmain.procparm] THEN
		[newlist: spmain.procparm] _ 
			MDModel.RemoveFromList[sp, spmain.procparm];
	IF spmain.procval = NIL THEN RETURN;
	spl _ MDModel.NarrowToLIST[spmain.procval];
	IF MDModel.IsOnList[sp, spl] THEN {
		[newlist: spmain.procval] _ MDModel.RemoveFromList[sp, spl];
		};
	};

-- symbolseq.toploc.nestedmodel.model starts off as a list of one element
spmain _ MDModel.NarrowToPROC[symbolseq.toploc.nestedmodel.model.first];
symbolseq.toploc.nestedmodel.model _ NIL;
-- copy the parms to the outer list
-- this will make symbolseq.toploc.nestedmodel.model be a list of many elements
MDModel.TraverseList[spmain.procparm, ListProcMove];
-- now move any they depend on
WHILE changes DO
	changes _ FALSE;
	MDModel.TraverseList[symbolseq.toploc.nestedmodel.model, ListProcMoveAgain];
	ENDLOOP;
-- now delete them from the rest
MDModel.TraverseList[symbolseq.toploc.nestedmodel.model, ListProcDelete];
-- this will append the PROC body; or what's left of it
symbolseq.toploc.nestedmodel.model _ MDModel.AddToEndOfList[
	symbolseq.toploc.nestedmodel.model, spmain, 
		normal, symbolseq];
};


-- reorder the list in a logical order
-- topologically so those that depend on things come afterwards 
-- alternatively use a procedure to look down the list for before-ness
-- returns a new list
ReorganizeInOrder: PUBLIC PROC[symbolseq: MDModel.SymbolSeq, 
	oldlist: MDModel.LISTSymbol, exec: UserExec.ExecHandle]
	RETURNS[newlist: MDModel.LISTSymbol] = {
splist: MDModel.LISTSymbol;
spa: MDModel.Symbol;
changes: BOOL _ TRUE;
nloops: CARDINAL;

	-- spa is passed in
	AnalProc: PROC[sploc1: MDModel.Symbol] = {
	nelem: CARDINAL _ 0;
	spparm: MDModel.LISTSymbol;
	sploc: MDModel.LOCSymbol;
	IF sploc1.stype ~= typeLOC THEN RETURN;
	sploc _ MDModel.NarrowToLOC[sploc1];
	spparm _ sploc.parmlist;
	WHILE spparm ~= NIL DO
		MDModel.CkType[spparm, typeLIST];
		nelem _ nelem + 1;
		IF nelem > 100 THEN ERROR;	-- cycling
		MoveOneElement[spparm.first];
		spparm _ spparm.rest;
		ENDLOOP;
	RETURN;
	};
	
	-- spa is passed in
	MoveOneElement: PROC[element: MDModel.Symbol] = {
	IF MDModel.IsOnList[element, newlist] THEN {
		IF NOT element.recursive 
		AND MDModel.After[element, spa, newlist] THEN { 
			newlist _ MDModel.SpliceBefore[symbolseq,
				element, splist, newlist];
			changes _ TRUE;
			};
		}	
	ELSE {	-- not on list may be a LET node
		splet: MDModel.LETSymbol;
		splet _ (IF element.stype = typeTYPE THEN
				MDModel.NarrowToTYPE[element].letparent
			ELSE IF element.stype = typeAPPL THEN
				MDModel.NarrowToAPPL[element].letparent
			ELSE NIL);
		IF splet ~= NIL 
		AND NOT spa.recursive
		AND NOT splet.recursive
		AND MDModel.After[splet, spa, newlist] THEN {
			newlist _ MDModel.SpliceBefore[symbolseq,
				splet, splist, newlist];
			changes _ TRUE;
			};
		};
	};
			
	-- this moves the type of each APPL in a LET list
	ForEachType: PROC[sp: MDModel.Symbol] = {
	spappl: MDModel.APPLSymbol;
	IF sp.stype ~= typeAPPL THEN RETURN;
	spappl _ MDModel.NarrowToAPPL[sp];
	MoveOneElement[spappl.appltype];
	};
	
newlist _ oldlist;
FOR nloops IN [1..30] DO
	changes _ FALSE;
	splist _ newlist;
	WHILE splist ~= NIL DO
		Process.Yield[];	-- let others run
		IF UserExec.UserAbort[exec] THEN SIGNAL Subr.AbortMyself[];
		MDModel.CkType[splist, typeLIST];
		spa _ splist.first;
		WITH spa1: spa SELECT FROM
		typeAPPL => {
			SetRecursiveBitsAppl[symbolseq, 
				MDModel.NarrowToAPPL[spa]];
			IF spa1.applval ~= NIL THEN {
				IF spa1.applval.stype = typeLIST THEN
					MDModel.TraverseList[
					MDModel.NarrowToLIST[spa1.applval], AnalProc]
				ELSE AnalProc[spa1.applval];
				};
			};
		typeLET =>  {
			SetRecursiveBitsLet[symbolseq, MDModel.NarrowToLET[spa]];
			IF spa1.letval.stype = typeLIST THEN
				MDModel.TraverseList[
					MDModel.NarrowToLIST[spa1.letval], AnalProc]
			ELSE AnalProc[spa1.letval];
			MDModel.TraverseList[spa1.letgrp, ForEachType];
			};
		typeTYPE => {
			IF spa1.typeval.stype = typeLIST THEN
				MDModel.TraverseList[
					MDModel.NarrowToLIST[spa1.typeval], AnalProc]
			ELSE AnalProc[spa1.typeval];
			};
		ENDCASE => NULL;
		splist _ splist.rest;
		ENDLOOP;
	IF NOT changes THEN {
		CWF.WF1["(%u loops.)\n"L, @nloops];
		EXIT;
		};
	IF nloops = 26 AND Subr.debugflg THEN 
		Runtime.CallDebugger["Looks like looping (Hit p CR to proceed.)"L];
	REPEAT
	FINISHED => CWF.WF0["Note- loop exhausted.\n"L];
	ENDLOOP;
RETURN[newlist];
};

MAXLIST: CARDINAL = 100;

SortListOfSymbols: PUBLIC PROC[symbolseq: MDModel.SymbolSeq, oldlist: MDModel.LISTSymbol] 
	RETURNS[newlist: MDModel.LISTSymbol, nsyms: CARDINAL] = {
syms: ARRAY[0 .. MAXLIST) OF MDModel.Symbol;
spi, spj: MDModel.Symbol;

	RemoveIt: PROC[sp: MDModel.Symbol] RETURNS[remove: BOOL] = {
	IF sp.stype IN MDModel.HasAStringName 
	AND MDModel.Sym[sp] ~= NIL
	AND nsyms < LENGTH[syms] 
	THEN {
		syms[nsyms] _ sp;
		nsyms _ nsyms + 1;
		RETURN[TRUE];
		};
	RETURN[FALSE];
	};
	
nsyms _ 0;
newlist _ MDModel.TraverseAndRemove[oldlist, RemoveIt];
IF nsyms = 0 THEN RETURN;
-- now sort it
FOR i: CARDINAL IN [0 .. nsyms - 1) DO
	spi _ syms[i];
	FOR j: CARDINAL IN [i + 1 .. nsyms) DO
		spj _ syms[j];
		-- this puts TYPES before APPLs
		IF (spj.stype = typeTYPE AND spi.stype = typeAPPL)
		OR LongString.CompareStrings[MDModel.Sym[spj], 
		    MDModel.Sym[spi]] < 0 THEN {
			syms[i] _ spj;
			syms[j] _ spi;
			spi _ spj;
			};
		ENDLOOP;
	ENDLOOP;
-- now add them
FOR i: CARDINAL IN [0 .. nsyms) DO
	newlist _ MDModel.AddToEndOfList[newlist, syms[i], normal, symbolseq];
	ENDLOOP;
};
	
	

-- removes standard Mesa TYPEs, replacing them with an open
ProcessForStandardOpen: PUBLIC PROC[symbolseq: MDModel.SymbolSeq] = {
newlist: MDModel.LISTSymbol;
somestd: BOOL _ FALSE;
thrownaway: MDModel.LISTSymbol;
[newlist, somestd, thrownaway] _ ListStandardOpen[
	symbolseq.toploc.nestedmodel.model, symbolseq];
symbolseq.toploc.nestedmodel.model _ NIL;
IF somestd THEN {
	sploc: MDModel.LOCSymbol;
	spopen: MDModel.OPENSymbol;
	sploc _ MDModel.NewSymLOC[symbolseq];
	sploc.host _ Subr.CopyString["Ivy"L];
	sploc.path _ Subr.CopyString["Schmidt>Pilot"L];
	sploc.tail _ Subr.CopyString["StandardPilot"L];
	sploc.sext _ Subr.CopyString["Model"L];
	sploc.nestedmodel _ MDModel.NewSymMODEL[symbolseq];
	sploc.nestedmodel.model _ thrownaway;
	spopen _ MDModel.NewSymOPEN[symbolseq];
	spopen.open _ sploc;
	symbolseq.toploc.nestedmodel.model _ 
		MDModel.AddToEndOfList[NIL, spopen, normal, symbolseq];
	};
symbolseq.toploc.nestedmodel.model _ MDModel.NarrowToLIST[
	MDModel.MergeIntoList[symbolseq.toploc.nestedmodel.model, newlist, 
		symbolseq, normal]];
};

ListStandardOpen: PROC[oldlist: MDModel.LISTSymbol, symbolseq: MDModel.SymbolSeq] 
	RETURNS[newlist: MDModel.LISTSymbol, somestd: BOOL,
		thrownaway: MDModel.LISTSymbol] = {
original: MDModel.LISTSymbol;
original _ oldlist;
somestd _ FALSE;
thrownaway _ newlist _ NIL;
WHILE oldlist ~= NIL DO
	{
	IF oldlist.first.stype = typePROC THEN {
		spp: MDModel.PROCSymbol _ MDModel.NarrowToPROC[oldlist.first];
		IF spp.procval ~= NIL AND spp.procval.stype = typeLIST THEN {
			newstd: BOOL;
			throw: MDModel.LISTSymbol;
			[spp.procval, newstd, throw] _ ListStandardOpen[
				MDModel.NarrowToLIST[spp.procval], symbolseq];
			IF throw ~= NIL THEN
				thrownaway _ MDModel.NarrowToLIST[
					MDModel.MergeIntoList[thrownaway, throw,
			 			symbolseq, normal]];
			somestd _ somestd OR newstd;
			};
		}
	ELSE IF oldlist.first.stype = typeTYPE 
	AND AlreadyInStandard[MDModel.NarrowToTYPE[oldlist.first]] THEN {
		IF Subr.debugflg THEN 
			CWF.WF1["Removing %s since it is in standard.\n"L, 
				MDModel.NarrowToTYPE[oldlist.first].typesym];
		somestd _ TRUE;
		thrownaway _ MDModel.AddToEndOfList[thrownaway, oldlist.first,
			 normal, symbolseq];
		GOTO next;
		};
	-- add to new list
	newlist _ MDModel.AddToEndOfList[newlist, oldlist.first, normal, symbolseq];
	GOTO next;
	EXITS
	next => oldlist _ oldlist.rest;
	};
	ENDLOOP;
FreeListHeaders[original];
};

AlreadyInStandard: PROC[sptype: MDModel.TYPESymbol] RETURNS[standard: BOOL] = {
std: ARRAY [0 .. 65) OF RECORD[
	modulename: STRING,
	createtime: LONG CARDINAL
	-- createtime is either the create time of the file listed in the model
	--	or is the time part of the functional time stamp
	] _ [
	["Ascii"L, 		2513637266],
	["BitBlt"L, 		2527465195],
	["CmFile"L, 		2514424598],
	["Compatibility"L, 	2527806666],
	["Cursor"L, 		2509385386],
	["Date"L, 		2513895850],
	["DCSFileTypes"L, 	2475178361],
	["Directory"L, 		2517693769],
	["Environment"L, 	2527465960],
	["Event"L, 		2508881119],
	["Exec"L, 		2527816258],
	["ExecOps"L, 		2522691244],
	["File"L, 		2508166537],
	["FileStream"L, 	2511989735],
	["FileSW"L, 		2509387464],
	["FileTypes"L, 		2527608841],
	["Format"L, 		2526835204],
	["FormSW"L, 		2508885370],
	["Heap"L, 		2512678088],
	["HeapString"L, 	2527806717],
	["Inline"L, 		2527466277],
	["Keys"L, 		2527463501],
	["KeyStations"L, 	2527695385],
	["LongString"L, 	2522357869],
	["Menu"L, 		2527806675],
	["MiscAlpha"L, 		2527466367],
	["Mopcodes"L, 		2527463862],
	["MsgSW"L, 		0],
	["PieceSource"L, 	0],
	["PrincOps"L, 		2527524542],
	["Process"L, 		2527016599],
	["Profile"L, 		2504449015],
	["Put"L, 		2513029493],
	["Runtime"L, 		2514412201],
	["RuntimeInternal"L, 	2529858042],
	["SDDefs"L, 		2527463578],
	["Segments"L, 		2527547640],
	["Space"L, 		2511801733],
	["SpecialSystem"L, 	2514239895],
	["Storage"L, 		2510096576],
	["STP"L, 		2516889925],
	["STPOps"L, 		2530729409],
	["Stream"L, 		2512514215],
	["Streams"L, 		2516815806],
	["String"L, 		2505079728],
	["Strings"L, 		2525300545],
	["StringSW"L, 		2527806730],
	["System"L, 		2527032238],
	["SystemInternal"L, 	2508165980],
	["TajoMisc"L, 		2527806732],
	["TextDisplay"L, 	2527806677],
	["TextSource"L, 	2527806670],
	["TextSW"L, 		2508891169],
	["Time"L, 		2511811906],
	["TimeStamp"L, 		2527463438],
	["Tool"L, 		2508882495],
	["ToolWindow"L, 	2505782260],
	["Transaction"L, 	2508440429],
	["TTY"L, 		2527614966],
	["TTYSW"L, 		2508885779],
	["UserInput"L, 		2508878121],
	["UserTerminal"L, 	2514232875],
	["Volume"L, 		2512677128],
	["Window"L, 		2512633822],
	["WindowFont"L, 	2527806664]
	];

sploc: MDModel.LOCSymbol;
fi: Dir.FileInfo;
standard _ FALSE;
IF sptype.typeval = NIL OR sptype.typeval.stype ~= typeLOC THEN RETURN[FALSE];
sploc _ MDModel.NarrowToLOC[sptype.typeval];
fi _ MDModel.GetFileInfo[sploc];
IF sploc.createtime = 0 AND fi.bcdVers = TimeStamp.Null THEN RETURN[FALSE];
FOR i: CARDINAL IN [0 .. LENGTH[std]) DO
	IF (sploc.createtime = std[i].createtime 
	   OR fi.bcdVers.time = std[i].createtime)
	AND LongString.EqualString[sptype.typesym, std[i].modulename] THEN
		RETURN[TRUE];
	ENDLOOP;
RETURN[FALSE];
};

-- free the nodes of type LIST, but not the things
-- they point to as they may be used elsewhere
FreeListHeaders: PROC[splist: MDModel.LISTSymbol] = {
spnext: MDModel.LISTSymbol;
WHILE splist ~= NIL DO
	MDModel.CkType[splist, typeLIST];
	spnext _ splist.rest;
	MDModel.ZeroOut[splist];
	splist _ spnext;
	ENDLOOP;
};



-- the recursive bits stuff
SetRecursiveBitsAppl: PROC[symbolseq: MDModel.SymbolSeq, 
	spappl: MDModel.APPLSymbol] = {
rec: BOOL;
sploc: MDModel.LOCSymbol;
splist: MDModel.LISTSymbol;
spa: MDModel.APPLSymbol;
IF spappl.recursive 
OR spappl.applval = NIL 
OR spappl.applval.stype ~= typeLOC 
	THEN RETURN;
sploc _ MDModel.NarrowToLOC[spappl.applval];
splist _ sploc.parmlist;
WHILE splist ~= NIL DO
	IF splist.first.stype ~= typeAPPL THEN {
		splist _ splist.rest;
		LOOP;
		};
	spa _ MDModel.NarrowToAPPL[splist.first];
	IF spa.applval ~= NIL AND spa.applval.stype = typeLOC THEN {
		rec _ LookFor[MDModel.NarrowToLOC[spa.applval], spappl];
		IF rec THEN spappl.recursive _ spa.recursive _ TRUE;
		}
	ELSE IF spa.letparent ~= NIL THEN 
		CheckForRecursiveImportsAndExports[spa.letparent, spappl, symbolseq];
	splist _ splist.rest;
	ENDLOOP;
};
 
-- discover which nodes are recursive
SetRecursiveBitsLet: PROC[symbolseq: MDModel.SymbolSeq, 
	splet: MDModel.LETSymbol] = {
splist: MDModel.LISTSymbol;
nlist: CARDINAL _ 0;
splist _ splet.letgrp;
WHILE splist ~= NIL DO
	nlist _ nlist + 1;
	IF nlist > 100 THEN ERROR;		-- cycling
	IF splist.first.stype = typeAPPL THEN
		CheckForRecursiveImportsAndExports[splet, 
			MDModel.NarrowToAPPL[splist.first], symbolseq];
	splist _ splist.rest
	ENDLOOP;
};

-- look for recursion in LET[] stmts
-- look and see if spappl is referenced in splet.letval
CheckForRecursiveImportsAndExports: PROC[splet: MDModel.LETSymbol, 
	spappl: MDModel.APPLSymbol, symbolseq: MDModel.SymbolSeq] = {
rec: BOOL;
IF splet.letval = NIL THEN RETURN;
IF splet.letval.stype = typeLOC THEN {
	rec _ LookFor[MDModel.NarrowToLOC[splet.letval], spappl];
	IF rec THEN splet.recursive _ rec;
	}
ELSE {
	spl: MDModel.LISTSymbol;
	spa1: MDModel.APPLSymbol;
	spl _ MDModel.NarrowToLIST[splet.letval];
	WHILE spl ~= NIL DO
		IF spl.first.stype ~= typeAPPL THEN {
			spl _ spl.rest;
			LOOP;	-- this is an error, but better to ignore for now
			};
		spa1 _ MDModel.NarrowToAPPL[spl.first];
		rec _ LookFor[MDModel.NarrowToLOC[spa1.applval], spappl];
		IF rec THEN splet.recursive _ rec;
		spl _ spl.rest;
		ENDLOOP;
	};
};

LookFor: PROC[sp: MDModel.LOCSymbol, spappl: MDModel.Symbol] RETURNS[rec: BOOL] = {
splist: MDModel.LISTSymbol;
rec _ FALSE;
splist _ sp.parmlist;
WHILE splist ~= NIL DO
	IF splist.first = spappl THEN {
		spappl.recursive _ TRUE;
		rec _ TRUE;
		};
	splist _ splist.rest;
	ENDLOOP;
};

}.