-- MDSupportImpl.mesa
-- last edit by Schmidt,  4-Mar-82 14:13:41
-- last edit by Satterthwaite, January 31, 1983 9:56 am
-- Pilot 6.0/ Mesa 7.0
-- mdsupportimpl for the system modeller
-- this module is also used in DesignModel.Config

DIRECTORY
  CompilerOps: TYPE USING [LetterSwitches],
  CWF: TYPE USING [SWF1, SWF2, WF0, WF1, WF2],
  Dir: TYPE USING [FileInfo, FileInfoRecord],
  Directory: TYPE USING [Error, Handle, ignore, Lookup],
  Environment: TYPE USING [wordsPerPage],
  File: TYPE USING [Capability, nullCapability],
  Inline: TYPE USING [LowHalf],
  LongString: TYPE USING [EqualString, EquivalentString],
  MDModel: TYPE USING [APPLSymbol, CkType, LETSymbol, LISTSymbol, ListType, LocForType, 
  	LOCSymbol, ModelSeqRecord, MODELSymbol, NarrowToLET, NarrowToLIST, 
	NarrowToLOC, NarrowToMODEL, NarrowToTYPE, OPENSymbol, PROCSymbol, 
	STRINGSymbol, SubType, Sym, Symbol, SymbolRecord, SymbolSeq, SymbolSeqRecord, TYPESymbol],
  PilotLoadStateOps: TYPE USING [NullConfig],
  Runtime: TYPE USING [CallDebugger],
  Space: TYPE USING [Create, CreateUniformSwapUnits, Delete, GetHandle, Handle, LongPointer, Map, 
  	nullHandle, PageFromLongPointer, virtualMemory],
  String: TYPE USING [LowerCase],
  Subr: TYPE USING [CopyString, debugflg, FindMappedSpace, FreeString, GetCreateDateWithSpace, 
  	LongZone, Prefix, SubStrCopy],
  TimeStamp: TYPE USING [Null, Stamp];

MDSupportImpl: PROGRAM  
IMPORTS CWF, Directory, Inline, LongString, MDModel, Runtime, Space, String, 
	Subr
EXPORTS MDModel = {

NumberOfModels: CARDINAL = 10;
NumberOfFileInfoRecords: CARDINAL = 300;

-- declarations used throughout this module
TooManySymbols: ERROR = CODE;

FileInfoSeq: TYPE = LONG POINTER TO FileInfoSeqRecord;
FileInfoSeqRecord: TYPE = RECORD[
	size: CARDINAL ← 0,
	body: SEQUENCE maxsize: CARDINAL OF Dir.FileInfo
	];
	
-- MDS Usage!!
-- these are set by StartMDSupport and freed by StopMDSupport
traversetreecalled: PUBLIC CARDINAL ← 0;
numberofbcdsmapped: PUBLIC CARDINAL ← 0;
numberofsourcesparsed: PUBLIC CARDINAL ← 0;
globalLDSpace: Space.Handle ← Space.nullHandle;	-- should be monitored
fileInfoSeq: FileInfoSeq ← NIL;
-- end of MDS usage

-- for FileInfo
-- takes a LOC, returns its fi if already calculated
-- if not, will look on local disk for bcd and src files
-- does not compute bcdvers or depseq's or the moduleName, which would require it to analyze the 
-- contents of the source or bcd files
GetFileInfo: PUBLIC PROC[sploc: MDModel.LOCSymbol] RETURNS[fi: Dir.FileInfo] = {
MDModel.CkType[sploc, $typeLOC];
IF sploc.fi ~= NIL THEN RETURN[sploc.fi];
{
longzone: UNCOUNTED ZONE ← Subr.LongZone[];
srcsfn: STRING ← [100];
bcdsfn: STRING ← [100];
sploc.fi ← fi ← AllocateFileInfo[];
-- look for source
IF NOT LongString.EquivalentString[sploc.sext, "bcd"L] THEN {
	CWF.SWF2[srcsfn, "%s.%s"L, sploc.tail, sploc.sext];
	fi.srcFileName ← Subr.CopyString[srcsfn];
	fi.srcCap ← Directory.Lookup[fileName: srcsfn, permissions: Directory.ignore
		! Directory.Error => CONTINUE];
	IF fi.srcCap ~= File.nullCapability THEN 
		fi.srcPresent ← TRUE;
	-- does not set bcdCreate, depseq or modulename
	}
ELSE fi.isBcd ← TRUE;
CWF.SWF1[bcdsfn, "%s.Bcd"L, sploc.tail];
fi.bcdCap ← Directory.Lookup[fileName: bcdsfn, permissions: Directory.ignore
	! Directory.Error => CONTINUE];
IF fi.bcdCap = File.nullCapability AND Subr.Prefix[bcdsfn, "pilot"L] THEN {
	Subr.SubStrCopy[bcdsfn, bcdsfn, 5];
	fi.bcdCap ← Directory.Lookup[fileName: bcdsfn, permissions: Directory.ignore
		! Directory.Error => CONTINUE];
	};
IF fi.bcdCap = File.nullCapability AND Subr.Prefix[bcdsfn, "long"L] THEN {
	Subr.SubStrCopy[bcdsfn, bcdsfn, 4];
	fi.bcdCap ← Directory.Lookup[fileName: bcdsfn, permissions: Directory.ignore
		! Directory.Error => CONTINUE];
	};
fi.bcdFileName ← Subr.CopyString[bcdsfn];
IF fi.bcdCap ~= File.nullCapability THEN 
	fi.bcdPresent ← TRUE;
}};

AllocateFileInfo: PROC RETURNS[fi: Dir.FileInfo] = {
longzone: UNCOUNTED ZONE ← Subr.LongZone[];
IF fileInfoSeq.size >= fileInfoSeq.maxsize THEN ERROR
ELSE {
	fi ← fileInfoSeq[fileInfoSeq.size] ← longzone.NEW[Dir.FileInfoRecord ← []];
	fileInfoSeq.size ← fileInfoSeq.size + 1;
	};
};

-- frees the data structure and NIL's out LOC's fi
GetBcdCreate: PUBLIC PROC[fi: Dir.FileInfo] RETURNS[bcdCreate: LONG CARDINAL] = {
IF fi.bcdCreate ~= 0 OR NOT fi.bcdPresent THEN RETURN[fi.bcdCreate]
ELSE RETURN[fi.bcdCreate ← Subr.GetCreateDateWithSpace[fi.bcdCap, globalLDSpace]];
};

GetSrcCreate: PUBLIC PROC[fi: Dir.FileInfo] RETURNS[srcCreate: LONG CARDINAL] = {
IF fi.srcCreate ~= 0 OR NOT fi.srcPresent THEN RETURN[fi.srcCreate]
ELSE RETURN[fi.srcCreate ← Subr.GetCreateDateWithSpace[fi.srcCap, globalLDSpace]];
};

EraseCacheEntry: PUBLIC PROC[fi: Dir.FileInfo, src: BOOL] = {
IF src THEN {
	fi.srcCap ← File.nullCapability;
	fi.srcPresent ← FALSE;
	fi.srcDepSeq ← NIL;
	fi.srcCreate ← 0;
	}
ELSE {
	oldCap: File.Capability ← fi.bcdCap;
	fi.bcdCap ← File.nullCapability;
	fi.bcdPresent ← FALSE;
	fi.bcdDepSeq ← NIL;
	fi.bcdCreate ← 0;		
	fi.bcdVers ← TimeStamp.Null;
	IF oldCap ~= File.nullCapability THEN ResetFileEntries[oldCap, fi];
	};
};

-- will make sure that entries in the fileInfo data structure
-- that mention the same bcd file are reset to point to the version "fi" wants
-- oldCapability is the old capability for the file
ResetFileEntries: PUBLIC PROC[oldCapability: File.Capability, fi: Dir.FileInfo] = {
f: Dir.FileInfo;
IF oldCapability = File.nullCapability THEN RETURN;
FOR i: CARDINAL IN [0 .. fileInfoSeq.size) DO
	f ← fileInfoSeq[i];
	IF f.bcdCap = oldCapability THEN {
		f.bcdPresent ← fi.bcdPresent;
		f.bcdVers ← fi.bcdVers;
		f.bcdCreate ← fi.bcdCreate;
		f.bcdDepSeq ← fi.bcdDepSeq;
		f.bcdCap ← fi.bcdCap;
		};
	ENDLOOP;
};

LookupFileInfo: PUBLIC PROC[bcdFileName: LONG STRING, bcdVers: TimeStamp.Stamp] 
	RETURNS[fi: Dir.FileInfo] = {
FOR i: CARDINAL IN [0 .. fileInfoSeq.size) DO
	fi ← fileInfoSeq[i];
	IF fi.bcdVers = bcdVers
	AND LongString.EquivalentString[fi.bcdFileName, bcdFileName] THEN 
		RETURN[fi];
	ENDLOOP;
RETURN[NIL];
};
	
LocForType: PUBLIC PROC[sptype: MDModel.TYPESymbol] RETURNS[sploc: MDModel.LOCSymbol] = {
IF sptype.typeval = NIL AND sptype.letparent = NIL THEN RETURN[NIL];
sploc ← MDModel.NarrowToLOC[IF sptype.letparent ~= NIL
	THEN sptype.letparent.letval ELSE sptype.typeval];
};

LocForAppl: PUBLIC PROC[spappl: MDModel.APPLSymbol] RETURNS[sploc: MDModel.LOCSymbol] = {
IF spappl.applval = NIL AND spappl.letparent = NIL THEN RETURN[NIL];
sploc ← MDModel.NarrowToLOC[IF spappl.letparent ~= NIL
	THEN spappl.letparent.letval ELSE spappl.applval];
};


-- stick in a Defs file
-- formal is X and typeName is X1 in 
--	X: TYPE X1,	 in directory stmt of source file
-- we look for a statement X: TYPE X1 == @file already in the model
-- returns sptype = NIL if not found
LookForTypeSource: PUBLIC PROC[formal, typeName: LONG STRING, symbolseq: MDModel.SymbolSeq, 
	spmodel: MDModel.MODELSymbol] 
	RETURNS[sptype: MDModel.TYPESymbol, sptypeloc: MDModel.LOCSymbol, spproc: MDModel.PROCSymbol] = {

	ProcAnalyze: PROC[sp: MDModel.Symbol, innermodel: MDModel.MODELSymbol] 
		RETURNS[proceed: BOOL ← TRUE] = {
	fiInner: Dir.FileInfo;
	IF sptype ~= NIL THEN RETURN[FALSE];
	WITH sp SELECT FROM
	spt: MDModel.TYPESymbol => {
		sploc: MDModel.LOCSymbol = MDModel.LocForType[spt];
		-- in case this symbol has not been defined
		IF sploc = NIL THEN RETURN[TRUE];
		fiInner ← GetFileInfo[sploc];
		IF LongString.EqualString[spt.typesym, formal]
		AND LongString.EqualString[spt.typeName, typeName]
		THEN {
		    	sptypeloc ← sploc;
			sptype ← spt;
			RETURN[FALSE];
			};
		};
	spt: MDModel.PROCSymbol => spproc ← spt;
	ENDCASE => NULL;
	RETURN[TRUE];
	};

spproc ← NIL;
sptypeloc ← NIL;
sptype ← NIL;
-- postorder is important here
TraverseTree[spmodel, symbolseq, ProcAnalyze, FALSE, TRUE];
};

-- stick in a Defs file
-- we look for an entry with stamp bcdVers
-- or, if a file has not been analyzed, we accept a bcdFileName match (wrong!)
-- returns NIL if not found
LookForTypeBcd: PUBLIC PROC[bcdFileName: LONG STRING, bcdVers: TimeStamp.Stamp,
	symbolseq: MDModel.SymbolSeq, spmodel: MDModel.MODELSymbol] 
	RETURNS[sptype: MDModel.TYPESymbol, sptypeloc: MDModel.LOCSymbol, spproc: MDModel.PROCSymbol] = {
bcdfilename: STRING ← [200];

	ProcAnalyze: PROC[sp: MDModel.Symbol, innermodel: MDModel.MODELSymbol] 
		RETURNS[proceed: BOOL ← TRUE] = {
	fiInner: Dir.FileInfo;
	IF sptype ~= NIL THEN RETURN[FALSE];
	WITH sp SELECT FROM
	spt: MDModel.TYPESymbol => {
		sploc: MDModel.LOCSymbol = MDModel.LocForType[spt];
		-- in case this symbol has not been defined
		IF sploc = NIL THEN RETURN[TRUE];
		fiInner ← GetFileInfo[sploc];
		IF (fiInner.bcdVers.time = bcdVers.time
		     OR (fiInner.bcdVers = TimeStamp.Null 
			 -- handles case where fInner has not been anal
			 AND LongString.EquivalentString[fiInner.bcdFileName, bcdFileName])) 
		THEN {
		    	sptypeloc ← sploc;
			sptype ← spt;
			RETURN[FALSE];
			};
		};
	spt: MDModel.PROCSymbol => spproc ← spt;
	ENDCASE => NULL;
	RETURN[TRUE];
	};

spproc ← NIL;
sptypeloc ← NIL;
sptype ← NIL;
-- postorder is important here
TraverseTree[spmodel, symbolseq, ProcAnalyze, FALSE, TRUE];
};

-- spimpl is either APPL or LET
-- if sptype is not NIL, then use sptype as the type of the instance
-- formal and type are from IMPORTS formal: type
-- we look for formalImpl: type in the model
-- returns spappl = NIL if not found
LookForInstSource: PUBLIC PROC[formal, type: LONG STRING, 
	symbolseq: MDModel.SymbolSeq, spmodel: MDModel.MODELSymbol, sptype: MDModel.TYPESymbol] 
RETURNS[spappl: MDModel.APPLSymbol, spnewtype: MDModel.TYPESymbol, spproc: MDModel.PROCSymbol] ={
intname: STRING ← [100];

	ProcAnalyze: PROC[sp: MDModel.Symbol, innermodel: MDModel.MODELSymbol] 
		RETURNS[proceed: BOOL ← TRUE] = {
	IF spappl ~= NIL THEN RETURN[FALSE];
	WITH sp SELECT FROM
	spt: MDModel.LETSymbol => {
		FOR splist: MDModel.LISTSymbol ← spt.letgrp, splist.rest UNTIL splist = NIL DO
			WITH splist.first SELECT FROM
			spa1: MDModel.APPLSymbol => {
				-- the types must agree
				-- the interface record names must agree
				IF spa1.appltype = sptype 
				AND LongString.EqualString[intname, spa1.applsym] THEN {
					spappl ← spa1;
					RETURN[FALSE];
					};
				};
	 		ENDCASE;
	 		ENDLOOP;
		};
	spt: MDModel.APPLSymbol => {
		-- the types must agree
		-- the interface record names must agree
		IF spt.appltype = sptype 
		AND LongString.EqualString[intname, spt.applsym] THEN {
			spappl ← spt;
			RETURN[FALSE];
			};
		};
	spt: MDModel.PROCSymbol => spproc ← spt;
	ENDCASE => NULL;
	RETURN[TRUE];
	};

spappl ← NIL;
spproc ← NIL;
IF sptype = NIL THEN {
	-- this is buggy: we should call LookForType with
	-- the formal and typeNames for the corresponding Defs that is
	-- mentioned in IMPORTS Y: Defs = 
	-- instead we pass the string "defs" as both formal and typename
	[sptype] ← LookForTypeSource[type, type, symbolseq, spmodel];
	IF sptype = NIL THEN RETURN[NIL, NIL, NIL];	-- can't be found
	};
spnewtype ← sptype;
MDModel.CkType[sptype, $typeTYPE];
CWF.SWF1[intname, "%sImpl"L, formal];
-- postorder is important here
TraverseTree[spmodel, symbolseq, ProcAnalyze, FALSE, TRUE];
};

-- spimpl is either APPL or LET
-- if sptype is not NIL, then use sptype as the type of the instance
-- just looks for any instance with a bcdVers timestamp
-- (more precisely, any instance with type sptype)
LookForInstBcd: PUBLIC PROC[bcdFileName: LONG STRING, bcdVers: TimeStamp.Stamp, 
	symbolseq: MDModel.SymbolSeq, spmodel: MDModel.MODELSymbol, sptype: MDModel.TYPESymbol] 
RETURNS[spappl: MDModel.APPLSymbol, spnewtype: MDModel.TYPESymbol, spproc: MDModel.PROCSymbol] ={

	ProcAnalyze: PROC[sp: MDModel.Symbol, innermodel: MDModel.MODELSymbol] 
		RETURNS[proceed: BOOL ← TRUE] = {
	IF spappl ~= NIL THEN RETURN[FALSE];
	WITH sp SELECT FROM
	spt: MDModel.LETSymbol => {
		FOR splist: MDModel.LISTSymbol ← spt.letgrp, splist.rest UNTIL splist = NIL DO
			WITH splist.first SELECT FROM
			spa1: MDModel.APPLSymbol => {
				-- the types must agree
				-- the interface record names must agree
				IF spa1.appltype = sptype THEN {
					spappl ← spa1;
					RETURN[FALSE];
					};
				};
	 		ENDCASE;
			ENDLOOP;
		};
	spt: MDModel.APPLSymbol => {
		-- the types must agree
		IF spt.appltype = sptype THEN {
			spappl ← spt;
			RETURN[FALSE];
			};
		};
	spt: MDModel.PROCSymbol => spproc ← spt;
	ENDCASE => NULL;
	RETURN[TRUE];
	};

spappl ← NIL;
spproc ← NIL;
IF sptype = NIL THEN {
	[sptype] ← LookForTypeBcd[bcdFileName, bcdVers, symbolseq, spmodel];
	IF sptype = NIL THEN RETURN[NIL, NIL, NIL];	-- can't be found
	};
spnewtype ← sptype;
MDModel.CkType[sptype, $typeTYPE];
-- postorder is important here
TraverseTree[spmodel, symbolseq, ProcAnalyze, FALSE, TRUE];
};

ValidateModel: PUBLIC PROC[symbolseq: MDModel.SymbolSeq] = {

	AnalProc: PROC[sp1: MDModel.Symbol, spmodel: MDModel.MODELSymbol]
	RETURNS[proceed: BOOL ← TRUE] = {
	WITH sp~~sp1 SELECT FROM
	typeTYPE => {
		CkS[sp.typesym];
		CkS[sp.typeName];
		VerifyLoc[sp.typeval];
		VerifyLet[sp1, sp.letparent];
		IF sp.letparent = NIL AND sp.typeval = NIL 
		AND sp1 ~= symbolseq.controlv THEN 
			CWF.WF1["%s is undefined.\n"L, sp.typesym];
		};
	typeLOC => {
		CkT[sp.parmlist, $typeLIST];
		CkT[sp.nestedmodel, $typeMODEL];
		CkS[sp.tail];
		CkS[sp.sext];
		};
	typePROC => {
		CkS[sp.procsym];
		CkT[sp.procparm, $typeLIST];
		CkT[sp.procret, $typeLIST];
		CkT[sp.procval, $typeLIST];
		};
	typeSTRING => {
		CkS[sp.strval];
		};
	typeAPPL => {
		CkS[sp.applsym];
		CkT[sp.appltype, $typeTYPE];
		VerifyLoc[sp.applval];
		VerifyLet[sp1, sp.letparent];
		IF sp.letparent = NIL AND sp.applval = NIL AND Subr.debugflg THEN 
			CWF.WF1["Check: %s is a parameter.\n"L, sp.applsym];
		};
	typeLET => {
		splist: MDModel.LISTSymbol;
		splist ← sp.letgrp;
		WHILE splist ~= NIL DO
			WITH spi~~splist.first SELECT FROM
			typeTYPE => VerifyLet[splist.first, MDModel.NarrowToLET[sp1]];
			typeAPPL => VerifyLet[splist.first, MDModel.NarrowToLET[sp1]];
			ENDCASE => NULL;
			splist ← splist.rest;
			ENDLOOP;
		VerifyLoc[sp.letval];
		};
	typeLIST => {
		CkT[sp.rest, $typeLIST];
		};
	typeOPEN => NULL;
	typeMODEL => {
		CkS[sp.modelfilename];
		CkT[sp.model, $typeLIST];
		};
	ENDCASE => NULL;
	};
	
TraverseTree[symbolseq.toploc, symbolseq, AnalProc, FALSE, FALSE];
};

CkS: PROC[s: LONG STRING] = {
IF s = NIL THEN 
	IF Subr.debugflg THEN Runtime.CallDebugger["A String is NIL"L]
		ELSE CWF.WF0["A String is NIL\n"L];
};

CkT: PROC[sp: MDModel.Symbol, st: MDModel.SubType] = {
IF sp ~= NIL AND sp.stype ~= st THEN
	IF Subr.debugflg THEN Runtime.CallDebugger["Bad type"L]
		ELSE CWF.WF1["Bad type %s\n"L, MDModel.Sym[sp]];
};
-- verify spelem is on splet.letgrp
VerifyLet: PROC[spelem: MDModel.Symbol, splet: MDModel.LETSymbol] = {
splist: MDModel.LISTSymbol;
IF splet = NIL THEN RETURN;
splist ← splet.letgrp;
WHILE splist ~= NIL DO
	IF splist.first = spelem THEN EXIT;
	splist ← splist.rest;
	ENDLOOP;
IF splist = NIL THEN {
	CWF.WF1["%s is not on LET list.\n"L, MDModel.Sym[spelem]];
	RETURN;
	};
WITH spt~~spelem SELECT FROM
typeTYPE => IF spt.letparent ~= splet THEN
		-- type letparent is not filled in
		IF Subr.debugflg THEN Runtime.CallDebugger["Bad letparent"L] 
		ELSE CWF.WF1["Bad letparent for %s\n"L, spt.typesym]; 
typeAPPL => IF spt.letparent ~= splet THEN
		-- type letparent is not filled in
		IF Subr.debugflg THEN Runtime.CallDebugger["Bad letparent"L] 
		ELSE CWF.WF1["Bad letparent for %s\n"L, spt.applsym]; 
ENDCASE => ERROR;
};

-- calls itself recursively
VerifyLoc: PROC[sp: MDModel.Symbol] = {
IF sp = NIL THEN RETURN;
WITH sp SELECT FROM
spt: MDModel.LISTSymbol => TraverseList[spt, VerifyLoc];
ENDCASE => IF sp.stype # $typeLOC AND sp.stype # $typeAPPL THEN
	IF Subr.debugflg THEN Runtime.CallDebugger["Loc is neither a LOC nor an APPL\n"L] 
	ELSE CWF.WF0["Loc is neither a LOC nor an APPL\n"L];
}; 
	
GenerateUniqueName: PUBLIC PROC[spappl: MDModel.APPLSymbol] 
	RETURNS[sym: LONG STRING] = {
stemp: STRING ← [100];
u: CARDINAL;
sptype: MDModel.TYPESymbol = MDModel.NarrowToTYPE[spappl.appltype];
sptype.uniqueno ← sptype.uniqueno + 1;
u ← sptype.uniqueno;
CWF.SWF2[stemp, "%s%u"L, spappl.applsym, @u];
RETURN[Subr.CopyString[stemp]];
};


-- returns TRUE if first occurs after second in list sptoplist
After: PUBLIC PROC[first, second: MDModel.Symbol, sptoplist: MDModel.LISTSymbol] 
	RETURNS[BOOL] = {
splist: MDModel.LISTSymbol ← sptoplist;
IF first = NIL OR second = NIL THEN ERROR;
WHILE splist ~= NIL DO
	IF first = splist.first THEN {
		WHILE splist ~= NIL DO
			IF second = splist.first THEN RETURN[FALSE];
			splist ← splist.rest;
			ENDLOOP;
		RETURN[FALSE];	-- second not in list
		};
	IF second = splist.first THEN {
		-- second is in list, if first is after then TRUE
		-- if first is not on list at all, then FALSE
		WHILE splist ~= NIL DO
			IF first = splist.first THEN RETURN[TRUE];
			splist ← splist.rest;
			ENDLOOP;
		RETURN[FALSE];
		};
	splist ← splist.rest;
	ENDLOOP;
RETURN[FALSE];		-- neither is in list
};

-- return TRUE if spnode is on the list beginning at splist
IsOnList: PUBLIC PROC[spnode: MDModel.Symbol, splist: MDModel.LISTSymbol] 
	RETURNS[BOOL] = {
WHILE splist ~= NIL DO
	IF splist.first = spnode THEN RETURN[TRUE];
	splist ← splist.rest;
	ENDLOOP;
RETURN[FALSE];
};

-- remove spremove from the list descending from psptoplist↑
-- returns spparent, a list node, parent of spremove and no longer on the list 
-- as well as spremove; returns NIL if spremove is not on the root list
-- returns also a new list with the element removed
RemoveFromList: PUBLIC PROC[spremove: MDModel.Symbol, oldlist: MDModel.LISTSymbol] 
	RETURNS[spparent, newlist: MDModel.LISTSymbol] = {
splist, splast: MDModel.LISTSymbol;
splist ← newlist ← splast ← oldlist;
WHILE splist ~= NIL DO
	MDModel.CkType[splist, $typeLIST];
	IF splist.first = spremove THEN {
		-- delete it
		IF splist = oldlist THEN
			newlist ← splist.rest
		ELSE IF splast.stype = typeLIST THEN
			splast.rest ← splist.rest
		ELSE ERROR;
		spparent ← splist;
		RETURN[spparent, newlist];
		}
	ELSE splast ← splist;
	splist ← splist.rest;
	ENDLOOP;
RETURN[NIL, newlist];
};

SaveBitArray: TYPE = PACKED ARRAY[0..0) OF BOOL;

-- proceed here means don't anlayze any sons of this node
-- it doesn't mean abort the whole tree search

-- if followscopingrules then it will only follow LOC's for models
-- if they are preceded by an OPEN; this is a crock
TraverseTree: PUBLIC PROC[sproot: MDModel.Symbol, symbolseq: MDModel.SymbolSeq,
	proc: PROC[MDModel.Symbol, MDModel.MODELSymbol] RETURNS[BOOL],
	preorder, followscopingrules: BOOL] = {
oldsize: CARDINAL;
savebit: LONG POINTER TO SaveBitArray ← NIL;
longzone: UNCOUNTED ZONE;
nearopen: BOOL;
arrtype: TYPE = RECORD[
	SEQUENCE maxl: CARDINAL OF CARDINAL
	];

	RecurTraverseTree: PROC[sp: MDModel.Symbol, spmodel: MDModel.MODELSymbol,
		proc: PROC[MDModel.Symbol, MDModel.MODELSymbol] RETURNS[BOOL]] = {
	proceed: BOOL;
	IF sp = NIL OR sp.visited THEN RETURN;
	sp.visited ← TRUE;
	IF preorder THEN {
		proceed ← proc[sp, spmodel];
		IF NOT proceed THEN RETURN;
		};
	WITH spt~~sp SELECT FROM
	typeTYPE => {
		RecurTraverseTree[spt.typeval, spmodel, proc];
		};
	typePROC => {
		RecurTraverseTree[spt.procparm, spmodel, proc];
		RecurTraverseTree[spt.procret, spmodel, proc];
		RecurTraverseTree[spt.procval, spmodel, proc];
		};
	typeAPPL => {
		RecurTraverseTree[spt.appltype, spmodel, proc];
		RecurTraverseTree[spt.applval, spmodel, proc];
		};
	typeLIST => {
			RunThruList: PROC[spelem: MDModel.Symbol] = {
			RecurTraverseTree[spelem, spmodel, proc];
			};
		
		TraverseList[MDModel.NarrowToLIST[sp], RunThruList];
		};
	typeLET => {
		RecurTraverseTree[spt.letgrp, spmodel, proc];
		RecurTraverseTree[spt.letval, spmodel, proc];
		};
	typeLOC => {
		-- IF Subr.debugflg THEN
			-- CWF.WF2["%s is in %s.\n"L, spt.tail, 
				-- IF spmodel = NIL THEN "-NIL-"L 
					-- ELSE spmodel.modelfilename];
		RecurTraverseTree[spt.parmlist, spmodel, proc];
		IF NOT followscopingrules OR nearopen THEN
			RecurTraverseTree[spt.nestedmodel, spmodel, proc];
		nearopen ← FALSE;
		};
	typeOPEN => {
		nearopen ← TRUE;
		RecurTraverseTree[spt.open, spmodel, proc];
		nearopen ← FALSE;
		};
	typeMODEL => {
		RecurTraverseTree[spt.model, MDModel.NarrowToMODEL[sp], proc];
		};
	typeSTRING => NULL;
	ENDCASE => ERROR;	-- Unknown stype
	IF NOT preorder THEN {
		[] ← proc[sp, spmodel];
		sp.visited ← TRUE;
		};
	};

{
ENABLE UNWIND => IF savebit = NIL THEN symbolseq.traversalInProgress ← FALSE;
IF sproot = NIL THEN RETURN;
traversetreecalled ← traversetreecalled + 1;
-- IF Subr.debugflg THEN
	-- CWF.WF0["~~~Traverse Tree Begun.\n"L];
IF symbolseq.traversalInProgress THEN {
	longzone ← Subr.LongZone[];
	-- this is to be able to allocate PACKED SEQUENCES
	-- 16 bits ber cardinal
	oldsize ← symbolseq.size;
	IF NOT symbolseq.savedInUse THEN {
		symbolseq.savedInUse ← TRUE;
		savebit ← symbolseq.savedVisited;
		}
	ELSE {
		nwords: CARDINAL ← (oldsize / 16) + 1;
		savebit ← LOOPHOLE[longzone.NEW[arrtype[nwords]]];
		};
	FOR i: CARDINAL IN [0.. symbolseq.size) DO
		savebit[i] ← symbolseq[i].visited;
		ENDLOOP;
	};
symbolseq.traversalInProgress ← TRUE;
FOR i: CARDINAL IN [0.. symbolseq.size) DO
	symbolseq[i].visited ← FALSE;
	ENDLOOP;
nearopen ← TRUE;
RecurTraverseTree[sproot, 
	IF sproot.stype = $typeMODEL THEN MDModel.NarrowToMODEL[sproot] ELSE NIL, proc];
IF savebit ~= NIL THEN {
	FOR i: CARDINAL IN [0.. oldsize) DO
		symbolseq[i].visited ← savebit[i];
		ENDLOOP;
	-- is this necessary?
	FOR i: CARDINAL IN [oldsize .. symbolseq.size) DO
		symbolseq[i].visited ← FALSE;
		ENDLOOP;
	IF savebit ~= symbolseq.savedVisited THEN 
		longzone.FREE[@savebit];
	}
ELSE symbolseq.traversalInProgress ← FALSE;
-- IF Subr.debugflg THEN
	-- CWF.WF0["~~~Traverse Tree Finished.\n"L];
}};

-- the null list is simply sp = NIL
-- the unit list is one list node with a NIL sp.rest
-- lists are always terminated by sp.rest = NIL
-- sp.rest is always of type typeLIST
TraverseList: PUBLIC PROC[sp: MDModel.LISTSymbol, proc: PROC[MDModel.Symbol]] = {
nelem: CARDINAL ← 0;
spnext: MDModel.LISTSymbol;
WHILE sp ~= NIL DO
	MDModel.CkType[sp, $typeLIST];
	nelem ← nelem + 1;
	IF nelem > 1000 THEN ERROR;	-- cycling
	spnext ← sp.rest;	-- in case he deletes it
	proc[sp.first];
	sp ← spnext;
	ENDLOOP;
};

TraverseAndRemove: PUBLIC PROC[oldlist: MDModel.LISTSymbol,
	proc: PROC[sp: MDModel.Symbol] RETURNS[remove: BOOL]]
	RETURNS[newlist: MDModel.LISTSymbol]  = {
splist, splast: MDModel.LISTSymbol;
splast ← splist ← newlist ← oldlist;
WHILE splist ~= NIL DO
	MDModel.CkType[splist, $typeLIST];
	IF proc[splist.first] THEN {
		-- remove it from the list
		IF splist = newlist THEN 
			newlist ← splist.rest
		ELSE IF splast.stype = $typeLIST THEN
			splast.rest ← splist.rest
		ELSE ERROR;
		}
	ELSE splast ← splist;
	splist ← splist.rest;
	ENDLOOP;
RETURN[newlist];
};

-- add to the end of a list
-- psp is a pointer to a node that is the beginning of a list
-- if non-NIL then psp↑ must be of type typeLIST
AddToEndOfList: PUBLIC PROC[oldlist: MDModel.LISTSymbol, 
	spadd: MDModel.Symbol, listtype: MDModel.ListType, 
	symbolseq: MDModel.SymbolSeq] 
	RETURNS[newlist: MDModel.LISTSymbol]= {
sp, spbin: MDModel.LISTSymbol;
sp ← newlist ← oldlist;
IF spadd = NIL THEN ERROR;
spbin ← NewSymLIST[symbolseq];
spbin.first ← spadd;
spbin.rest ← NIL;
spbin.listtype ← listtype;
IF sp = NIL THEN newlist ← spbin
ELSE {
	WHILE sp.rest ~= NIL DO
		MDModel.CkType[sp.rest, $typeLIST];
		IF sp.listtype ~= listtype THEN ERROR;
		sp ← sp.rest;
		ENDLOOP;
	sp.rest ← spbin;
	};
RETURN[newlist];
};

-- behaves unusually depending on slist's form
-- if slist = NIL then returns sadd
-- if slist is not a list, the returns a list of slist and sadd
-- if slist is a list, appends sadd to slist and returns slist
-- if sadd is a list, the list is appended, 
-- if not, sadd is added to the list
MergeIntoList: PUBLIC PROC[slist, sadd: MDModel.Symbol, 
	symbolseq: MDModel.SymbolSeq, listtype: MDModel.ListType]
	RETURNS[MDModel.Symbol] = {
CheckNotNil[sadd];
IF slist = NIL THEN RETURN[sadd];
IF slist.stype ~= $typeLIST THEN {
	stop: MDModel.LISTSymbol;
	stop ← AddToEndOfList[NIL, slist, listtype, symbolseq];
	IF sadd.stype = $typeLIST THEN
		stop.rest ← MDModel.NarrowToLIST[sadd]
	ELSE
		stop ← AddToEndOfList[stop, sadd, listtype, symbolseq];
	RETURN[stop];
	}
ELSE {
	sl: MDModel.LISTSymbol ← MDModel.NarrowToLIST[slist];
	IF sadd.stype = $typeLIST THEN {
		sp: MDModel.LISTSymbol ← sl;
		WHILE sp.rest ~= NIL DO
			sp ← sp.rest;
			ENDLOOP;
		sp.rest ← MDModel.NarrowToLIST[sadd];
		}
	ELSE
		sl ← AddToEndOfList[sl, sadd, listtype, symbolseq];
	RETURN[sl];
	};
};

-- the beginning of the list is "sptoplist"
-- spmove is a MDModel.Symbol, spstay is a typeList MDModel.Symbol
-- move "spmove" before "spstay" in symbolseq
-- spmove does not have to be in the list already
SpliceBefore: PUBLIC PROC[symbolseq: MDModel.SymbolSeq, 
	spmove: MDModel.Symbol, spstay: MDModel.LISTSymbol,
	oldlist: MDModel.LISTSymbol] 
	RETURNS[newlist: MDModel.LISTSymbol] = {
spl, spparent, splast: MDModel.LISTSymbol;
[spparent, newlist] ← RemoveFromList[spmove, oldlist];
IF spparent = NIL THEN {
	-- not on list already, must make a new list node first
	spparent ← NewSymLIST[symbolseq];
	spparent.first ← spmove;
	};
splast ← spl ← newlist;
WHILE spl ~= NIL DO
	IF spl = spstay THEN {
		-- stick in front of spstay
		spparent.rest ← spstay;
		IF spl = newlist THEN
			newlist ← spparent
		ELSE IF splast.stype = $typeLIST THEN
			splast.rest ← spparent
		ELSE ERROR;
		EXIT;
		}
	ELSE splast ← spl;
	spl ← spl.rest;
	ENDLOOP;
RETURN[newlist];
};

ZeroOut: PUBLIC PROC[sp: MDModel.Symbol] = {
IF sp = NIL THEN ERROR;
LongZero[sp, MDModel.SymbolRecord.SIZE];
sp.vpart ← typeBAD[];
};

LongZero: PROC[lp: LONG POINTER, size: CARDINAL] = {
IF lp = NIL THEN ERROR;
FOR i: CARDINAL IN [0..size) DO
	(lp+i)↑ ← 0;
	ENDLOOP;
};

CheckNotNil: PUBLIC PROC[p: LONG POINTER] = {
IF p = NIL THEN ERROR;
};

-- returns the zone used by the symbolseq
AllocateSymbolSeq: PUBLIC PROC[nsym: CARDINAL] 
	RETURNS[symbolseq: MDModel.SymbolSeq] = {
arrtype: TYPE = RECORD[
	SEQUENCE maxl: CARDINAL OF CARDINAL
	];
space: Space.Handle;
longzone: UNCOUNTED ZONE ← Subr.LongZone[];
npages: LONG CARDINAL;
npages ← (MDModel.SymbolRecord.SIZE.LONG * nsym + MDModel.SymbolSeqRecord[0].SIZE)
	/Environment.wordsPerPage + 1;
space ← Space.Create[size: Inline.LowHalf[npages], parent: Space.virtualMemory];
Space.Map[space];
IF npages > 20 THEN Space.CreateUniformSwapUnits[10, space];
symbolseq ← Space.LongPointer[space];
-- assign to the MAX SIZE !!!!
(LOOPHOLE[symbolseq, LONG POINTER] + MDModel.SymbolSeqRecord[0].SIZE - 1)↑ ← nsym;
symbolseq.toploc ← NIL;
symbolseq.controlv ← NIL;
symbolseq.traversalInProgress ← FALSE;
symbolseq.modelSeq ← longzone.NEW[MDModel.ModelSeqRecord[NumberOfModels]];
symbolseq.savedInUse ← FALSE;
symbolseq.savedVisited ← longzone.NEW[arrtype[(symbolseq.maxsize / 16) + 1]];
symbolseq.size ← 0;
RETURN[symbolseq];
};

FreeSymbolSeq: PUBLIC PROC[psymbolseq: LONG POINTER TO MDModel.SymbolSeq] = {
longzone: UNCOUNTED ZONE ← Subr.LongZone[];
space: Space.Handle;
s: MDModel.Symbol;
IF psymbolseq↑ = NIL THEN RETURN;
FOR i: CARDINAL IN [0.. psymbolseq↑.size) DO
	s ← @(psymbolseq↑)[i];
	FreeStringsOf[s];
	ENDLOOP;
longzone.FREE[@psymbolseq.savedVisited];
longzone.FREE[@psymbolseq.modelSeq];
-- this frees symbolseq
space ← Subr.FindMappedSpace[Space.GetHandle[Space.PageFromLongPointer[psymbolseq↑]]];
Space.Delete[space: space];
psymbolseq↑ ← NIL;
};

FreeStringsOf: PUBLIC PROC[sp1: MDModel.Symbol] = {
WITH sp~~sp1 SELECT FROM
typeTYPE => {
	Subr.FreeString[sp.typesym];
	Subr.FreeString[sp.typeName];
	};
typeLOC => {
	Subr.FreeString[sp.host];
	Subr.FreeString[sp.path];
	Subr.FreeString[sp.tail];
	Subr.FreeString[sp.sext];
	};
typePROC => Subr.FreeString[sp.procsym];
typeSTRING => {
	Subr.FreeString[sp.strsym];
	Subr.FreeString[sp.strval];
	};
typeAPPL => {
	Subr.FreeString[sp.applsym];
	Subr.FreeString[sp.configname];
	};
typeMODEL => Subr.FreeString[sp.modelfilename];
typeLET, typeLIST, typeBAD, typeOPEN => NULL;
ENDCASE => ERROR;
};

-- create new Symbol's
NewSym: PROC[symbolseq: MDModel.SymbolSeq] 
	RETURNS[sym: MDModel.Symbol] = {
sym ← @symbolseq[symbolseq.size];
-- fill in with defaulted values
sym↑ ← [vpart: typeBAD[]];
symbolseq.size ← symbolseq.size + 1;
IF symbolseq.size >= symbolseq.maxsize THEN TooManySymbols;
RETURN[sym];
};

NewSymTYPE: PUBLIC PROC[symbolseq: MDModel.SymbolSeq] 
	RETURNS[sym: MDModel.TYPESymbol] = {
sym ← LOOPHOLE[NewSym[symbolseq]];
-- fill in with defaulted values
sym↑ ← [vpart: typeTYPE[NIL, NIL, NIL, FALSE, NIL, 0]];
};

NewSymLOC: PUBLIC PROC[symbolseq: MDModel.SymbolSeq] 
	RETURNS[sym: MDModel.LOCSymbol] = {
sym ← LOOPHOLE[NewSym[symbolseq]];
-- fill in with defaulted values
sym↑ ← [vpart: typeLOC[NIL, NIL, NIL, NIL, 0, NIL, NIL, NIL, FALSE, 0]];
};

NewSymPROC: PUBLIC PROC[symbolseq: MDModel.SymbolSeq] 
	RETURNS[sym: MDModel.PROCSymbol] = {
sym ← LOOPHOLE[NewSym[symbolseq]];
-- fill in with defaulted values
sym↑ ← [vpart: typePROC[NIL, NIL, NIL, NIL]];
};

NewSymSTRING: PUBLIC PROC[symbolseq: MDModel.SymbolSeq] 
	RETURNS[sym: MDModel.STRINGSymbol] = {
sym ← LOOPHOLE[NewSym[symbolseq]];
-- fill in with defaulted values
sym↑ ← [vpart: typeSTRING[NIL, NIL]];
};

NewSymAPPL: PUBLIC PROC[symbolseq: MDModel.SymbolSeq] 
	RETURNS[sym: MDModel.APPLSymbol] = {
sym ← LOOPHOLE[NewSym[symbolseq]];
-- fill in with defaulted values
sym↑ ← [vpart: typeAPPL[NIL, NIL, NIL, NIL, NIL, NIL]];
};

NewSymLET: PUBLIC PROC[symbolseq: MDModel.SymbolSeq] 
	RETURNS[sym: MDModel.LETSymbol] = {
sym ← LOOPHOLE[NewSym[symbolseq]];
-- fill in with defaulted values
sym↑ ← [vpart: typeLET[NIL, NIL]];
};

NewSymLIST: PUBLIC PROC[symbolseq: MDModel.SymbolSeq] 
	RETURNS[sym: MDModel.LISTSymbol] = {
sym ← LOOPHOLE[NewSym[symbolseq]];
-- fill in with defaulted values
sym↑ ← [vpart: typeLIST[normal, NIL, NIL]];
};

NewSymOPEN: PUBLIC PROC[symbolseq: MDModel.SymbolSeq] 
	RETURNS[sym: MDModel.OPENSymbol] = {
sym ← LOOPHOLE[NewSym[symbolseq]];
-- fill in with defaulted values
sym↑ ← [vpart: typeOPEN[NIL]];
};

NewSymMODEL: PUBLIC PROC[symbolseq: MDModel.SymbolSeq] 
	RETURNS[sym: MDModel.MODELSymbol] = {
sym ← LOOPHOLE[NewSym[symbolseq]];
-- fill in with defaulted values
sym↑ ← [vpart: typeMODEL[NIL, FALSE, File.nullCapability, 0, NIL, 
	Space.nullHandle, PilotLoadStateOps.NullConfig, FALSE]];
};

-- discover which nodes are recursive
-- callable from the Debugger
ValidateList: PROC[spl: MDModel.LISTSymbol, print: BOOL ← FALSE] = {
nelem: CARDINAL ← 0;
WHILE spl ~= NIL DO
	MDModel.CkType[spl, $typeLIST];
	nelem ← nelem + 1;
	IF nelem > 1000 THEN ERROR;	-- cycling
	IF print THEN {
		s: LONG STRING;
		spa: MDModel.Symbol ← spl.first;
		s ← MDModel.Sym[spa];
		CWF.WF2["Node %lb, str <%s>\n"L, @spa, s];
		};
	spl ← spl.rest;
	ENDLOOP;
CWF.WF1["%u links.\n"L, @nelem];
};

-- parse command line compiler switches
FoldInParms: PUBLIC PROC[parms: LONG STRING] 
	RETURNS[switches: CompilerOps.LetterSwitches, explicitSortSwitch: BOOL] = {
i: CARDINAL ← 0;
on: BOOL;
ch: CHAR;
  StandardDefaults: CompilerOps.LetterSwitches = [
    TRUE , -- A  Address faults for Nil checks
    TRUE , -- B  Bounds checking
    TRUE , -- C  Compile for Cedar (special FORK)
    FALSE, -- D  Call debugger on compiler error (FALSE => just log error)
    TRUE , -- E  Fixed (big eval stack)
    TRUE , -- F  Floating point microcode
    TRUE , -- G  TRUE => errlog goes to compiler.log, FALSE => use foo.errlog
    FALSE, -- H  Unused
    FALSE, -- I  Unused
    FALSE, -- J  cross-Jumping optimization
    FALSE, -- K  Unused
    TRUE , -- L  Fixed (handle Long pointers)
    TRUE , -- M  Reference counting microcode
    TRUE , -- N  Nil pointer checking
    FALSE, -- O  Unused
    FALSE, -- P  Pause after compilation with errors
    FALSE, -- Q  Unused
    FALSE, -- R  Unused
    TRUE , -- S  Sort (by static frequency) global vars & entry indexes
    FALSE, -- T  Unused
    FALSE, -- U  Uninitialized variable checking
    FALSE, -- V  Unused
    TRUE , -- W  log Warning messages
    FALSE, -- X  Unused
    FALSE, -- Y  complain about KFCB
    FALSE  -- Z  Unused
    ];
-- set defaults
switches ← -- CompilerOps.DefaultSwitches[]; -- StandardDefaults;
switches['s] ← FALSE;	-- the modeller defaults to /-s
explicitSortSwitch ← FALSE;
IF parms = NIL THEN RETURN;
WHILE i < parms.length DO
	on ← TRUE;
	IF parms[i] = '- THEN {
		i ← i + 1;
		on ← FALSE;
		};
	ch ← String.LowerCase[parms[i]];
	IF ch IN ['a .. 'z] THEN {
		switches[ch] ← on;
		IF ch = 's THEN explicitSortSwitch ← TRUE;
		};
	i ← i + 1;
	ENDLOOP;
};

StartMDSupport: PUBLIC PROC = {
longzone: UNCOUNTED ZONE ← Subr.LongZone[];
globalLDSpace ← Space.Create[1, Space.virtualMemory];
Space.Map[globalLDSpace];
fileInfoSeq ← longzone.NEW[FileInfoSeqRecord[NumberOfFileInfoRecords]];
};


StopMDSupport: PUBLIC PROC = {
f: Dir.FileInfo;
longzone: UNCOUNTED ZONE ← Subr.LongZone[];
IF globalLDSpace ~= Space.nullHandle THEN Space.Delete[globalLDSpace];
globalLDSpace ← Space.nullHandle;
FOR i: CARDINAL IN [0 .. fileInfoSeq.size) DO
	f ← fileInfoSeq[i];
	Subr.FreeString[f.bcdFileName];
	Subr.FreeString[f.srcFileName];
	Subr.FreeString[f.moduleName];
	longzone.FREE[@f];
	ENDLOOP;
longzone.FREE[@fileInfoSeq];
};


}.


-- UNUSED or OLD code
-ReplaceBy: PUBLIC PROC[spold, spnew: MDModel.Symbol, 
	symbolseq: MDModel.SymbolSeq] = {
IF spold = spnew THEN ERROR;
FOR i: CARDINAL IN [0.. symbolseq.size) DO
	WITH sp~~(@symbolseq[i]) SELECT FROM
	typeTYPE => {
		IF sp.typeval = spold THEN sp.typeval ← spnew;
		};
	typePROC => {
		IF sp.procparm = spold THEN 
			sp.procparm ← MDModel.NarrowToLIST[spnew];
		IF sp.procret = spold THEN 
			sp.procret ← MDModel.NarrowToLIST[spnew];
		IF sp.procval = spold THEN sp.procval ← spnew;
		};
	typeAPPL => {
		IF sp.appltype = spold THEN sp.appltype ← spnew;
		IF sp.applval = spold THEN sp.applval ← spnew;
		};
	typeLIST => {
		IF sp.first = spold THEN sp.first ← spnew;
		IF sp.rest = spold THEN 
			sp.rest ← MDModel.NarrowToLIST[spnew];
		};
	typeLET => {
		IF sp.letgrp = spold THEN 
			sp.letgrp ← MDModel.NarrowToLIST[spnew];
		IF sp.letval = spold THEN sp.letval ← spnew;
		};
	typeLOC => {
		IF sp.parmlist = spold THEN 
			sp.parmlist ← MDModel.NarrowToLIST[spnew];
		IF sp.nestedmodel = spold THEN 
			sp.nestedmodel ← MDModel.NarrowToMODEL[spnew];
		};
	typeOPEN => {
		IF sp.open = spold THEN sp.open ← spnew;
		};
	typeMODEL => {
		IF sp.model = spold THEN sp.model ← MDModel.NarrowToLIST[spnew];
		};
	typeSTRING => NULL;
	typeBAD => NULL;
	ENDCASE => ERROR;
	ENDLOOP;
};

- uses a POSTORDER tree walk
OldReplaceBy: PROC[spold, spnew: MDModel.Symbol, symbolseq: MDModel.SymbolSeq] = {

	ProcAnalyze: PROC[sp: MDModel.Symbol] RETURNS[proceed: BOOL ← TRUE] = {
	SELECT sp.stype FROM
	$typeTYPE => {
		IF sp.subid = spold THEN sp.subid ← spnew;
		IF sp.typeval = spold THEN sp.typeval ← spnew;
		};
	$typePROC => {
		IF sp.procparm = spold THEN sp.procparm ← spnew;
		IF sp.procret = spold THEN sp.procret ← spnew;
		IF sp.procval = spold THEN sp.procval ← spnew;
		};
	$typeAPPL => {
		IF sp.appltype = spold THEN sp.appltype ← spnew;
		IF sp.applval = spold THEN sp.applval ← spnew;
		};
	$typeLIST => {
		IF sp.first = spold THEN sp.first ← spnew;
		IF sp.rest = spold THEN sp.rest ← spnew;
		};
	$typeLET => {
		IF sp.letgrp = spold THEN sp.letgrp ← spnew;
		IF sp.letval = spold THEN sp.letval ← spnew;
		};
	$typeLOC => {
		IF sp.parmlist = spold THEN sp.parmlist ← spnew;
		};
	$typeSTRING => NULL;
	ENDCASE => ERROR;
	RETURN[TRUE];
	};

IF spold = spnew THEN ERROR;
TraverseTree[symbolseq.toploc, symbolseq, ProcAnalyze, FALSE];
};