-- MDDBImpl.mesa
-- last edit by Schmidt, January 6, 1983 2:25 pm
-- last edit by Satterthwaite, January 31, 1983 9:24 am
-- Pilot 6.0/ Mesa 7.0
-- data base stuff for the system modeller
DIRECTORY
CWF: TYPE USING [FWF2, WF0, WF1, WF2, WF3, WF4, WFCR],
DBStash: TYPE USING [BcdVersLookup, GetTemporaryDepSeq, Insert, Lookup],
Dir: TYPE USING [AddToDep, ADepRecord, DepSeq, DepSeqRecord, FileInfo, MaximumDepSize,
ModType],
Directory: TYPE USING [UpdateDates],
File: TYPE USING [Capability, read],
FileStream: TYPE USING [Create],
LongString: TYPE USING [EqualString, EquivalentString],
MDComp: TYPE USING [SetVersAndModulename],
MDDB: TYPE USING [],
MDMain: TYPE USING [DebugWP],
MDModel: TYPE USING [AddToEndOfList, APPLSymbol,
FreeStringsOf, GetBcdCreate, GetFileInfo, GetSrcCreate,
LETSymbol, LISTSymbol, LOCSymbol, LocForAppl, LocForType,
LookForTypeBcd, LookForTypeSource, LookForInstBcd, LookForInstSource,
MergeIntoList, MODELSymbol, NarrowToAPPL, NarrowToLET,
NarrowToLIST, NarrowToLOC, NarrowToPROC,
NarrowToTYPE, NewSymLOC, numberofbcdsmapped,
numberofsourcesparsed, ParseUnit, PROCSymbol,
Sym, Symbol, SymbolSeq, TraverseAndRemove, TraverseList, TraverseTree, TYPESymbol],
MoveFiles: TYPE USING [BringOverRemoteFile],
ProcBcds: TYPE USING [InnardsObject, InstallAddressesBcd, InvalidBcd, PrintDepends,
ProcDep, ProcMod, ReadInSegmentsBcd, UnstallBcd],
Space: TYPE USING [Handle, nullHandle],
Stream: TYPE USING [Delete, Handle],
Subr: TYPE USING [AbortMyself, CopyString, debugflg, EndsIn, errorflg, FreeString,
LongZone, TTYProcs],
Time: TYPE USING [Current],
TimeStamp: TYPE USING [Null, Stamp],
TypeScript: TYPE USING[TS, UserAbort];
MDDBImpl: PROGRAM
IMPORTS CWF, DBStash, Dir, Directory, FileStream, LongString, MDComp, MDMain, MDModel,
MoveFiles, ProcBcds, Space, Stream, Subr, Time, TypeScript
EXPORTS MDDB = {
-- no MDS usage!!!
-- as a side effect sets sploc.moduleName if possible
BringOverFilesAndCheckAllParms: PUBLIC PROC[symbolseq: MDModel.SymbolSeq,
makethismodel: BOOL, typeScript: TypeScript.TS, ttywindow: Subr.TTYProcs] = {
parmsfilledin: BOOL;
time: LONG CARDINAL;
checkcalled: CARDINAL ← 0;
-- done preorder
ProcAnalyze: PROC[sptop: MDModel.Symbol, spmodel: MDModel.MODELSymbol]
RETURNS[proceed: BOOL ← TRUE] = {
-- calls itself recursively
-- 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 = MDModel.NarrowToLOC[spl];
IF CheckAndFillInParameters[sptop, sploc, symbolseq,
spmodel, makethismodel, typeScript, ttywindow] THEN
parmsfilledin ← TRUE;
checkcalled ← checkcalled + 1;
};
};
WITH spt~~sptop SELECT FROM
typeTYPE => ProcLoc[spt.typeval];
typeAPPL => ProcLoc[spt.applval];
typeLET => ProcLoc[spt.letval];
typeMODEL => CWF.WF1["Examining files in model %s:\n"L,
spt.modelfilename];
ENDCASE => NULL;
RETURN[TRUE];
};
IF TypeScript.UserAbort[typeScript] THEN SIGNAL Subr.AbortMyself;
-- Dir.ReadInUnsavedFiles[ttywindow];
parmsfilledin ← FALSE;
time ← Time.Current[];
-- preorder is important here
MDModel.TraverseTree[symbolseq.toploc, symbolseq, ProcAnalyze, TRUE];
time ← Time.Current[] - time;
CWF.WF0["\n"L];
MoveUndefinedsToParms[symbolseq];
IF parmsfilledin THEN CWF.WF0["Parms filled in during StartModel.\n"L];
IF TypeScript.UserAbort[typeScript] THEN Subr.AbortMyself[];
CWF.FWF2[MDMain.DebugWP, "CheckAndFillInParameters called %u times, totaltime %lu seconds.*N"L,
@checkcalled, @time];
};
-- this will cause the source file to be parsed
-- sp may be type TYPE, APPL, LET
CheckAndFillInParameters: PUBLIC PROC[sp: MDModel.Symbol,
sploc: MDModel.LOCSymbol, symbolseq: MDModel.SymbolSeq,
spmodel: MDModel.MODELSymbol, makethismodel: BOOL,
typeScript: TypeScript.TS, ttywindow: Subr.TTYProcs] RETURNS[modelchanged: BOOL]= {
fdepseq: Dir.DepSeq ← NIL;
isincache: BOOL ← TRUE;
fi: Dir.FileInfo;
IF spmodel = NIL THEN ERROR;
modelchanged ← FALSE;
IF sploc = NIL THEN RETURN;
IF TypeScript.UserAbort[typeScript] THEN SIGNAL Subr.AbortMyself;
fi ← MDModel.GetFileInfo[sploc];
[fdepseq, isincache] ← MakeDepSeqForFile[symbolseq, sploc, spmodel, makethismodel,
typeScript, ttywindow];
IF fdepseq = NIL THEN RETURN;
modelchanged ← MatchUpAndAddParameters[fdepseq, sp, sploc, symbolseq, spmodel];
SetModuleName[fi, fdepseq.moduleName];
IF fi.isBcd AND fi.bcdVers = TimeStamp.Null THEN
fi.bcdVers ← [net: 0, host: 0, time: sploc.createtime];
-- check correspondence between TYPE and modulename
IF sp.stype = typeTYPE THEN {
sptype: MDModel.TYPESymbol = MDModel.NarrowToTYPE[sp];
IF NOT LongString.EqualString[fi.moduleName, sptype.typeName] THEN
CWF.WF3["Warning - ModuleName for %s is %s, but model says it is %s.\n"L,
fi.bcdFileName, fi.moduleName, sptype.typeName];
};
-- never free an fdepseq if is in the cache
IF NOT isincache THEN FreeDepSeq[@fdepseq];
};
-- called by CheckAndFillInParameters, MakeADepRecord, and ReorganizeDefinitions
--
-- the depseq this returns is used to determine parameters to the model or element in model
-- if the bcd is listed in the model, we use the bcd
-- if the src is listed in the model, we use the src,
-- or if the source is not on the disk, we use the bcd
MakeDepSeqForFile: PROC[symbolseq: MDModel.SymbolSeq, sploc: MDModel.LOCSymbol,
spmodel: MDModel.MODELSymbol, makethismodel: BOOL,
typeScript: TypeScript.TS, ttywindow: Subr.TTYProcs]
RETURNS[fdepseq: Dir.DepSeq, isincache: BOOL] = {
fi: Dir.FileInfo = MDModel.GetFileInfo[sploc];
IF NOT fi.alreadyLookedFor THEN
MoveFiles.BringOverRemoteFile[sploc, makethismodel, typeScript, ttywindow];
IF sploc.nestedmodel ~= NIL
AND LongString.EquivalentString[sploc.sext, "model"L]
AND spmodel ~= NIL THEN {
fdepseq ← FillInFromModel[sploc, symbolseq, spmodel,
makethismodel, ttywindow];
isincache ← FALSE;
}
ELSE {
-- make an fdepseq; prefer the bcd
fdepseq ← NIL;
isincache ← TRUE;
IF NOT fi.bcdPresent AND NOT fi.srcPresent THEN GOTO out;
IF fi.isBcd THEN {
IF NOT fi.bcdPresent THEN GOTO out;
fdepseq ← GetBcdDepSeq[fi, sploc.createtime];
GOTO out;
};
IF fi.srcPresent THEN
fdepseq ← GetSrcDepSeq[fi, sploc.createtime]
ELSE fdepseq ← GetBcdDepSeq[fi, 0];
EXITS
out => NULL
};
IF fdepseq ~= NIL THEN
SetModuleName[fi, fdepseq.moduleName];
};
-- called by MakeDepSeqForFile
SetModuleName: PROC[fi: Dir.FileInfo, moduleName: LONG STRING] = {
IF fi.moduleName = NIL AND moduleName ~= NIL THEN
fi.moduleName ← Subr.CopyString[moduleName];
};
MatchUpAndAddParameters: PROC[fdepseq: Dir.DepSeq,
sptop: MDModel.Symbol, sploc: MDModel.LOCSymbol,
symbolseq: MDModel.SymbolSeq, spmodel: MDModel.MODELSymbol]
RETURNS[modelchanged: BOOL] = {
newlist: MDModel.LISTSymbol;
fakesploc: MDModel.LOCSymbol;
fentry: LONG POINTER TO Dir.ADepRecord;
found: BOOL ← TRUE;
processingExports: BOOL ← FALSE;
-- uses fentry and fakesploc
SetMod: PROC = {
dep: Dir.DepSeq;
IF fentry.bcdVers ~= TimeStamp.Null
AND (dep ← DBStash.BcdVersLookup[fentry.bcdVers]) ~= NIL THEN
fentry.moduleName ← fdepseq.CopyString[dep.moduleName]
ELSE IF Subr.EndsIn[fentry.bcdFileName, ".bcd"L] THEN {
-- this is a very slow way to figure out modulenames
fakesploc.tail ← Subr.CopyString[fentry.bcdFileName];
fakesploc.tail.length ← fakesploc.tail.length - 4;
fakesploc.sext ← Subr.CopyString["Bcd"L];
MDComp.SetVersAndModulename[fakesploc];
IF fakesploc.fi.moduleName ~= NIL THEN
fentry.moduleName ← fdepseq.CopyString[fakesploc.fi.moduleName];
MDModel.FreeStringsOf[fakesploc];
fakesploc.tail ← NIL;
fakesploc.sext ← NIL;
};
};
-- uses fentry
PrintRel: PROC = {
IF Subr.debugflg THEN
CWF.WF3["\n\tIn file, but not model: %s (%s), relation %s."L,
fentry.bcdFileName, fentry.moduleName,
SELECT fentry.relation FROM
imports => "Imports"L,
exports => "Exports"L,
directory => "Directory"L,
ENDCASE => ERROR];
};
MatchTYPE: PROC[sp: MDModel.Symbol] RETURNS[remove: BOOLEAN] = {
sptype: MDModel.TYPESymbol;
IF sp.stype ~= typeTYPE OR found THEN RETURN[FALSE];
sptype ← MDModel.NarrowToTYPE[sp];
IF fentry.moduleName = NIL THEN SetMod[];
IF LongString.EqualString[sptype.typeName, fentry.moduleName] THEN {
newlist ← MDModel.AddToEndOfList[newlist, sptype, normal, symbolseq];
found ← TRUE;
RETURN[TRUE];
};
RETURN[FALSE];
};
RemoveTYPE: PROC[sp: MDModel.Symbol] RETURNS[remove: BOOLEAN] = {
RETURN[sp.stype = typeTYPE];
};
MatchAPPL: PROC[sp: MDModel.Symbol] RETURNS[remove: BOOLEAN] = {
spappl: MDModel.APPLSymbol;
sptype: MDModel.TYPESymbol;
IF sp.stype ~= typeAPPL OR found THEN RETURN[FALSE];
spappl ← MDModel.NarrowToAPPL[sp];
sptype ← MDModel.NarrowToTYPE[spappl.appltype];
IF fentry.moduleName = NIL THEN SetMod[];
IF LongString.EqualString[sptype.typeName, fentry.moduleName] THEN {
newlist ← MDModel.AddToEndOfList[newlist, spappl, normal, symbolseq];
found ← TRUE;
RETURN[TRUE];
};
RETURN[FALSE];
};
RemoveAPPL: PROC[sp: MDModel.Symbol] RETURNS[remove: BOOLEAN] = {
spappl: MDModel.APPLSymbol;
IF sp.stype ~= typeAPPL THEN RETURN[FALSE];
spappl ← MDModel.NarrowToAPPL[sp];
IF spappl.appltype = symbolseq.controlv THEN RETURN[FALSE]; -- CONTROL parameter
IF processingExports
AND MDModel.LocForType[MDModel.NarrowToTYPE[spappl.appltype]]
= MDModel.LocForAppl[spappl] THEN RETURN[FALSE]; -- exported ptr to frame
RETURN[TRUE];
};
{
fi: Dir.FileInfo;
splet: MDModel.LETSymbol;
skipTypes: BOOLEAN ← FALSE;
IF sploc = NIL THEN ERROR;
modelchanged ← FALSE;
fi ← MDModel.GetFileInfo[sploc];
fakesploc ← MDModel.NewSymLOC[symbolseq];
IF Subr.debugflg THEN
CWF.WF2["ModuleName %s, File %s"L,fdepseq.moduleName, fdepseq.srcFileName];
-- directory
-- skipTypes: if the model refers to a source file, but the source
-- is not on the local disk and we have an fdepseq for the .Bcd, then don't muck with the
-- TYPES since we don't have enough information
skipTypes ← NOT fi.isBcd AND NOT fdepseq.fromsource;
newlist ← NIL;
IF NOT fi.isBcd AND NOT LongString.EquivalentString[sploc.sext, "config"L] AND NOT skipTypes THEN {
-- TYPEs are not valid parameters for .Bcd file or .Config files
-- they are removed
FOR i: CARDINAL IN [0 .. fdepseq.size) DO
fentry ← @fdepseq[i];
IF fentry.relation ~= directory THEN LOOP;
found ← FALSE;
sploc.parmlist ← MDModel.TraverseAndRemove[sploc.parmlist, MatchTYPE];
IF NOT found THEN {
sptype: MDModel.TYPESymbol;
PrintRel[];
IF fdepseq.fromsource THEN {
[sptype] ← MDModel.LookForTypeSource[fentry.bcdFileName, fentry.moduleName,
symbolseq, spmodel];
IF sptype = NIL THEN {
CWF.WF3["Error - %s requires a variable declared as '%s: TYPE %s', and there is no such declaration in the model.\n"L,
fi.srcFileName, fentry.bcdFileName, fentry.moduleName];
CWF.WF0["Edit the model and start over.\n"L];
};
}
ELSE {
-- this is screwy since we may have an entry with a bcdfilename and bcdvers,
-- and cannot search the model since all the bcdvers have not been
-- filled in
[sptype] ← MDModel.LookForTypeBcd[fentry.bcdFileName, fentry.bcdVers,
symbolseq, spmodel];
IF sptype = NIL THEN {
CWF.WF4["Error - %s requires %s of %v as a parameter, but no parameter to %s is of that type.\n"L,
fdepseq.bcdFileName, fentry.bcdFileName, @fentry.bcdVers,
IF fi.srcFileName = NIL THEN fi.bcdFileName ELSE fi.srcFileName];
CWF.WF0["Edit the model and start over.\n"L];
};
};
IF sptype ~= NIL THEN {
newlist ← MDModel.AddToEndOfList[newlist, sptype, normal, symbolseq];
modelchanged ← TRUE;
};
};
ENDLOOP;
};
IF NOT skipTypes THEN {
sploc.parmlist ← MDModel.TraverseAndRemove[sploc.parmlist, RemoveTYPE];
-- now add reorganized definitions
IF sploc.parmlist ~= NIL AND newlist ~= NIL THEN
sploc.parmlist ← MDModel.NarrowToLIST[MDModel.MergeIntoList[
newlist, sploc.parmlist, symbolseq, normal]]
ELSE IF newlist ~= NIL THEN sploc.parmlist ← newlist;
};
--
-- now do imports
newlist ← NIL;
-- skip imports to definitions files and imports to files only used as FRAMEPTRTYPEs
IF NOT fdepseq.isdefns AND sptop.stype ~= typeTYPE THEN {
FOR i: CARDINAL IN [0 .. fdepseq.size) DO
fentry ← @fdepseq[i];
IF fentry.relation ~= imports THEN LOOP;
found ← FALSE;
sploc.parmlist ← MDModel.TraverseAndRemove[sploc.parmlist, MatchAPPL];
IF NOT found THEN {
spappl: MDModel.APPLSymbol;
PrintRel[];
IF fdepseq.fromsource THEN {
[spappl] ← MDModel.LookForInstSource[fentry.bcdFileName, fentry.moduleName,
symbolseq, spmodel, NIL];
IF spappl = NIL THEN {
CWF.WF3["Error - %s imports a variable declared as '%sImpl: %s', and there is no such declaration in the model.\n"L,
fi.srcFileName, fentry.bcdFileName, fentry.moduleName];
CWF.WF0["Edit the model and start over.\n"L];
};
}
ELSE {
[spappl] ← MDModel.LookForInstBcd[fentry.bcdFileName, fentry.bcdVers,
symbolseq, spmodel, NIL];
IF spappl = NIL THEN {
CWF.WF4["Error - %s imports %s of %v as a parameter, but no parameter to %s is of that type.\n"L,
fdepseq.bcdFileName, fentry.bcdFileName,
@fentry.bcdVers,
IF fi.srcFileName = NIL THEN fi.bcdFileName ELSE fi.srcFileName];
CWF.WF0["Edit the model and start over.\n"L];
};
};
IF spappl ~= NIL THEN {
newlist ← MDModel.AddToEndOfList[newlist, spappl, normal, symbolseq];
modelchanged ← TRUE;
};
};
ENDLOOP;
};
sploc.parmlist ← MDModel.TraverseAndRemove[sploc.parmlist, RemoveAPPL];
-- now add reorganized definitions
IF sploc.parmlist ~= NIL AND newlist ~= NIL THEN
sploc.parmlist ← MDModel.NarrowToLIST[MDModel.MergeIntoList[
sploc.parmlist, newlist, symbolseq, normal]]
ELSE IF newlist ~= NIL THEN sploc.parmlist ← newlist;
--
-- now do exports
IF sptop.stype ~= typeLET THEN GOTO leave; -- won't massage into LET stmt
processingExports ← TRUE;
splet ← MDModel.NarrowToLET[sptop];
newlist ← NIL;
FOR i: CARDINAL IN [0 .. fdepseq.size) DO
fentry ← @fdepseq[i];
IF fentry.relation ~= exports THEN LOOP;
found ← FALSE;
splet.letgrp ← MDModel.TraverseAndRemove[splet.letgrp, MatchAPPL];
IF NOT found THEN {
PrintRel[];
IF fdepseq.fromsource THEN {
CWF.WF3["Warning - %s exports a variable with type '%s', and there is no variable of that type in the LET stmt for %s.\n"L,
fi.srcFileName, fentry.moduleName,
IF fi.srcFileName = NIL THEN fi.bcdFileName ELSE fi.srcFileName];
}
ELSE {
CWF.WF4["Warning - %s exports %s of %v, but no variable in the LET statement for %s is of that type.\n"L,
fdepseq.bcdFileName, fentry.bcdFileName, @fentry.bcdVers,
IF fi.srcFileName = NIL THEN fi.bcdFileName ELSE fi.srcFileName];
}
};
ENDLOOP;
splet.letgrp ← MDModel.TraverseAndRemove[splet.letgrp, RemoveAPPL];
-- now add reorganized definitions
IF splet.letgrp ~= NIL AND newlist ~= NIL THEN
splet.letgrp ← MDModel.NarrowToLIST[MDModel.MergeIntoList[
splet.letgrp, newlist, symbolseq, normal]]
ELSE IF newlist ~= NIL THEN splet.letgrp ← newlist;
--
GOTO leave;
EXITS
leave => IF Subr.debugflg THEN {
IF NOT modelchanged THEN CWF.WF0[": Agree."L];
CWF.WFCR[];
};
}};
MakeADepRecord: PROC[sptype: MDModel.TYPESymbol, depseq: Dir.DepSeq,
spmodel: MDModel.MODELSymbol, makethismodel: BOOL,
ttywindow: Subr.TTYProcs, symbolseq: MDModel.SymbolSeq]
RETURNS[adeprecord: Dir.ADepRecord] = {
-- fi: Dir.FileInfo;
-- fdepseq: Dir.DepSeq;
-- sploc: MDModel.LOCSymbol;
-- isincache: BOOL;
adeprecord ← [moduleName: depseq.CopyString[sptype.typeName],
bcdFileName: NIL, bcdVers: TimeStamp.Null];
-- adeprecord ← [];
-- sploc ← MDModel.LocForType[sptype];
-- IF sploc = NIL THEN RETURN;
-- fi ← MDModel.GetFileInfo[sploc];
-- [fdepseq, isincache] ← MakeDepSeqForFile[symbolseq, sploc, NIL, makethismodel, ttywindow];
-- MDComp.SetVersAndModulename[sploc];
-- IF fdepseq = NIL AND fi.moduleName = NIL THEN
-- fi.moduleName ← Subr.CopyString[sptype.typesym]; make up name
-- adeprecord ← [moduleName: depseq.CopyString[fi.moduleName],
-- bcdFileName: depseq.CopyString[fi.bcdFileName],
-- bcdVers: fi.bcdVers];
};
-- only needed in MDDBImpl
FreeDepSeq: PROC[pdepseq: LONG POINTER TO Dir.DepSeq] = {
longzone: UNCOUNTED ZONE = Subr.LongZone[];
IF pdepseq↑ = NIL THEN RETURN;
Subr.FreeString[pdepseq↑.bcdFileName];
Subr.FreeString[pdepseq↑.srcFileName];
Subr.FreeString[pdepseq↑.moduleName];
FOR i: CARDINAL IN [0.. pdepseq↑.size) DO
Subr.FreeString[pdepseq↑[i].moduleName];
Subr.FreeString[pdepseq↑[i].bcdFileName];
ENDLOOP;
longzone.FREE[pdepseq];
};
-- this returns a DepSeq that is not in the cache
FillInFromModel: PROC[sploc: MDModel.LOCSymbol, symbolseq: MDModel.SymbolSeq,
spmodel: MDModel.MODELSymbol, makethismodel: BOOL,
ttywindow: Subr.TTYProcs]
RETURNS[depseq: Dir.DepSeq] = {
stemp: STRING ← [100];
adeprecord: Dir.ADepRecord;
spproc: MDModel.PROCSymbol ← NIL;
splist: MDModel.LISTSymbol;
relation: Dir.ModType;
longzone: UNCOUNTED ZONE = Subr.LongZone[];
ProcAddName: PROC[sp: MDModel.Symbol] = {
WITH spt~~sp SELECT FROM
typeAPPL => {
sptype: MDModel.TYPESymbol;
IF spt.applsym = NIL THEN RETURN;
sptype ← MDModel.NarrowToTYPE[spt.appltype];
adeprecord ← MakeADepRecord[sptype, depseq, spmodel,
makethismodel, ttywindow, symbolseq];
adeprecord.relation ← relation;
Dir.AddToDep[depseq, @adeprecord];
};
typeLET, typeTYPE, typeSTRING => NULL; -- this is an error, but ...
ENDCASE => ERROR;
};
depseq ← NIL;
splist ← sploc.nestedmodel.model;
WHILE splist ~= NIL DO
IF splist.first.stype = typePROC THEN {
spproc ← MDModel.NarrowToPROC[splist.first];
EXIT;
};
splist ← splist.rest;
ENDLOOP;
IF spproc = NIL THEN RETURN;
depseq ← longzone.NEW[Dir.DepSeqRecord[Dir.MaximumDepSize]];
depseq.CopyString ← Subr.CopyString;
relation ← imports;
MDModel.TraverseList[spproc.procparm, ProcAddName];
relation ← exports;
MDModel.TraverseList[spproc.procret, ProcAddName];
-- CWF.WF1["Nested model, imports and exports %u.\n"L, @depseq.size];
};
MoveUndefinedsToParms: PROC[symbolseq: MDModel.SymbolSeq] = {
ProcAnal: PROC[sptop: MDModel.Symbol, spmodel: MDModel.MODELSymbol]
RETURNS[proceed: BOOL ← TRUE] = {
spm: MDModel.PROCSymbol;
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];
CWF.WF2["%s has been added as a parameter to the model %s.\n"L,
MDModel.Sym[spa1], spmodel.modelfilename];
RETURN[TRUE];
};
IF spa1.stype = typeLET THEN {
spadd: MDModel.APPLSymbol;
splet: MDModel.LETSymbol = MDModel.NarrowToLET[spa1];
IF splet.letval = NIL AND splet.letgrp.rest = NIL THEN {
IF splet.letgrp.first.stype = typeLET THEN
spadd ← MDModel.NarrowToAPPL[splet.letgrp.first]
ELSE spadd ← MDModel.NarrowToAPPL[splet.letgrp.first];
spm.procparm ← MDModel.AddToEndOfList[spm.procparm,
spadd, normal, symbolseq];
CWF.WF2["%s has been added as a parameter to the model %s.\n"L,
spadd.applsym, spmodel.modelfilename];
RETURN[TRUE];
};
};
RETURN[FALSE];
};
IF sptop.stype ~= typePROC THEN RETURN;
spm ← MDModel.NarrowToPROC[sptop];
spm.procval ← MDModel.TraverseAndRemove[MDModel.NarrowToLIST[spm.procval],
AddIt];
};
MDModel.TraverseTree[symbolseq.toploc, symbolseq, ProcAnal];
};
-- srcCreate is treated as a hint
-- this parses source files
-- returns NIL if can't parse source
GetSrcDepSeq: PUBLIC PROC[fi: Dir.FileInfo, srcCreate: LONG CARDINAL] RETURNS[srcDepSeq: Dir.DepSeq] = {
IF fi.srcDepSeq ~= NIL THEN {
-- not a hit DBStash.BumpNHits[];
RETURN[fi.srcDepSeq];
};
{
cap: File.Capability;
stin: Stream.Handle;
IF NOT Subr.EndsIn[fi.srcFileName, ".mesa"L]
AND NOT Subr.EndsIn[fi.srcFileName, ".config"L] THEN RETURN[NIL];
IF NOT fi.srcPresent THEN GOTO err;
IF srcCreate ~= 0 AND (fi.srcDepSeq ← DBStash.Lookup[srcCreate, fi.srcFileName]) ~= NIL THEN
RETURN[fi.srcDepSeq];
IF (fi.srcDepSeq ← DBStash.Lookup[MDModel.GetSrcCreate[fi], fi.srcFileName]) ~= NIL THEN
RETURN[fi.srcDepSeq];
IF Subr.debugflg THEN CWF.WF1["AnalSource: %s\n"L, fi.srcFileName];
srcDepSeq ← DBStash.GetTemporaryDepSeq[];
srcDepSeq.srcCreate ← fi.srcCreate;
srcDepSeq.fromsource ← TRUE;
cap ← Directory.UpdateDates[fi.srcCap, File.read];
stin ← FileStream.Create[cap];
srcDepSeq.srcFileName ← srcDepSeq.CopyString[fi.srcFileName];
MDModel.ParseUnit[stin, srcDepSeq, fi.srcFileName];
Stream.Delete[stin];
srcDepSeq ← DBStash.Insert[srcDepSeq.srcCreate, fi.srcFileName, srcDepSeq];
fi.srcDepSeq ← srcDepSeq;
MDModel.numberofsourcesparsed ← MDModel.numberofsourcesparsed + 1;
RETURN[srcDepSeq];
EXITS
err => RETURN[NIL];
-- CWF.WF1["SourceParser: Can't open file %s\n"L, srcsfn];
}};
-- this reads in bcd files
-- bcdDepSeq is returned, never free it
-- bcdCreate is treated as a hint
GetBcdDepSeq: PUBLIC PROC[fi: Dir.FileInfo, bcdCreate: LONG CARDINAL] RETURNS[bcdDepSeq: Dir.DepSeq] = {
adeprecord: Dir.ADepRecord ← [];
procMod: ProcBcds.ProcMod = {
uns ← NIL;
IF smodulename ~= NIL AND smodulename.length = 0 THEN RETURN; -- garbage
bcdDepSeq.bcdFileName ← bcdDepSeq.CopyString[fi.bcdFileName];
bcdDepSeq.bcdVers ← bcdvers;
bcdDepSeq.srcFileName ← bcdDepSeq.CopyString[sourcefile];
bcdDepSeq.srcCreate ← sourcevers.time;
bcdDepSeq.moduleName ← IF smodulename = NIL THEN NIL ELSE bcdDepSeq.CopyString[smodulename];
bcdDepSeq.switches['a] ← FALSE; -- always
bcdDepSeq.switches['b] ← boundsChecks;
bcdDepSeq.switches['c] ← cedarSwitch;
bcdDepSeq.switches['j] ← crossJump;
bcdDepSeq.switches['l] ← linksInCode;
bcdDepSeq.switches['n] ← nilChecks;
bcdDepSeq.switches['s] ← sortByUsage;
bcdDepSeq.isdefns ← isdefns;
bcdDepSeq.isconfig ← isconfig;
bcdDepSeq.istablecompiled ← istablecompiled;
bcdDepSeq.symbolSpace ← symbolSpace;
-- since the symbolSpace may not have the cap filled in
bcdDepSeq.symbolSpace.file ← fi.bcdCap;
};
-- filename will probably have ".bcd" at the end
procDep: ProcBcds.ProcDep = {
IF smodulename ~= NIL AND smodulename.length = 0 THEN RETURN; -- garbage
adeprecord ← [];
adeprecord.moduleName ← IF smodulename = NIL THEN NIL ELSE bcdDepSeq.CopyString[smodulename];
adeprecord.bcdFileName ← bcdDepSeq.CopyString[filename];
adeprecord.bcdVers ← bcdvers;
SELECT relcode FROM
defstype => {
adeprecord.relation ← directory;
Dir.AddToDep[bcdDepSeq, @adeprecord];
};
imports => {
adeprecord.relation ← imports;
Dir.AddToDep[bcdDepSeq, @adeprecord];
};
exports => {
adeprecord.relation ← exports;
Dir.AddToDep[bcdDepSeq, @adeprecord];
};
ENDCASE => NULL; -- ignore other stuff
};
IF fi.bcdDepSeq ~= NIL THEN {
-- not a hit DBStash.BumpNHits[];
RETURN[fi.bcdDepSeq];
};
{
-- others are defaulted
innardsobject: ProcBcds.InnardsObject ← [bcdheaderspace: Space.nullHandle];
success: BOOL;
bcdDepSeq ← NIL;
IF bcdCreate ~= 0 AND (fi.bcdDepSeq ← DBStash.Lookup[bcdCreate, fi.bcdFileName]) ~= NIL THEN
RETURN[fi.bcdDepSeq];
IF NOT fi.bcdPresent THEN GOTO err;
IF (fi.bcdDepSeq ← DBStash.Lookup[MDModel.GetBcdCreate[fi], fi.bcdFileName]) ~= NIL THEN
RETURN[fi.bcdDepSeq];
bcdDepSeq ← DBStash.GetTemporaryDepSeq[];
bcdDepSeq.fromsource ← FALSE;
-- cannot use loaded bcd since it may not be the same as the one on the disk
-- under the name fi.bcdFileName
-- IF fi.loadInfoSeq ~= NIL AND fi.loadInfoSeq.bcdbase ~= NIL THEN
-- innardsobject.bcd ← fi.loadInfoSeq.bcdbase
-- ELSE {
MDModel.numberofbcdsmapped ← MDModel.numberofbcdsmapped + 1;
innardsobject.cap ← fi.bcdCap;
ProcBcds.ReadInSegmentsBcd[@innardsobject
! ProcBcds.InvalidBcd => {
CWF.WF1["Error - %s is not a valid bcd file.\n"L, fi.bcdFileName];
GOTO out;
}
];
-- };
ProcBcds.InstallAddressesBcd[@innardsobject];
[success] ← ProcBcds.PrintDepends[@innardsobject, procMod, procDep,
FALSE, FALSE, TRUE, fi.bcdFileName]; -- less is TRUE
IF NOT success THEN {
CWF.WF1["Error - couldn't analyze %s correctly.\n"L, fi.bcdFileName];
Subr.errorflg ← TRUE;
};
IF innardsobject.bcdheaderspace ~= Space.nullHandle THEN
ProcBcds.UnstallBcd[@innardsobject];
bcdDepSeq ← DBStash.Insert[MDModel.GetBcdCreate[fi], fi.bcdFileName, bcdDepSeq];
fi.bcdDepSeq ← bcdDepSeq;
EXITS
err => CWF.WF1["Couldn't find %s.\n"L, fi.bcdFileName];
out => bcdDepSeq ← NIL;
}};
ValList: PROC[splist: MDModel.LISTSymbol] = {
nelem: CARDINAL ← 0;
WHILE splist ~= NIL DO
nelem ← nelem + 1;
IF nelem > 1000 THEN ERROR; -- cycling
splist ← splist.rest;
ENDLOOP;
};
}.
[identical, modelchanged] ← CompareModelAndFile[mdepseq, fdepseq,
sptop, sploc, symbolseq, spmodel];
-- reorganize the Directory stmt into order for the quick check
-- not necessary if we've already analyzed the bcd unless there are
-- extra, uneccesary parameters we want to remove
IF LongString.EquivalentString[sploc.sext, "mesa"L]
AND (fdepseq.fromsource OR mdirs ~= fdirs) THEN
ReorganizeDefinitions[symbolseq, sploc, fdepseq];
-- reorganize the imports and exports
-- claim: this is no longer necessary
-- but users like the xtra stuff deleted
ReorganizeImportsAndExports[symbolseq, sptop, fdepseq];
mdepseq ← longzone.NEW[Dir.DepSeqRecord[Dir.MaximumDepSize]];
mdepseq.CopyString ← Subr.CopyString;
MakeSymDesc[sp, mdepseq, symbolseq, spmodel, makethismodel, ttywindow];
IF mdepseq.bcdFileName = NIL THEN GOTO leave;
MakeSymDesc: PROC[sp: MDModel.Symbol, depseq: Dir.DepSeq,
symbolseq: MDModel.SymbolSeq,
spmodel: MDModel.MODELSymbol, makethismodel: BOOL,
ttywindow: Subr.TTYProcs] ={
stemp: STRING ← [100];
adeprecord: Dir.ADepRecord;
ProcAddName: PROC[sp: MDModel.Symbol] = {
WITH spt~~sp SELECT FROM
typeTYPE => {
IF spt.typesym = NIL THEN RETURN;
adeprecord ← MakeADepRecord[MDModel.NarrowToTYPE[sp], depseq,
spmodel, makethismodel, ttywindow, symbolseq];
adeprecord.relation ← directory;
Dir.AddToDep[depseq, @adeprecord];
};
typeAPPL => {
IF spt.applsym = NIL THEN RETURN;
adeprecord ← MakeADepRecord[
MDModel.NarrowToTYPE[spt.appltype], depseq,
spmodel, makethismodel, ttywindow, symbolseq];
adeprecord.relation ← imports;
Dir.AddToDep[depseq, @adeprecord];
};
typeSTRING => {
depseq.switches ← MDModel.FoldInParms[spt.strval];
};
typeLET => NULL; -- this is an error, but ...
ENDCASE => ERROR;
};
IF sp = NIL THEN CWF.WF0["Error - sp is nil.\n"L];
-- set default compiler switches
depseq.switches ← MDModel.FoldInParms[NIL];
WITH spt~~sp SELECT FROM
typeTYPE => {
spval: MDModel.LOCSymbol;
CWF.SWF1[stemp, "%s.bcd"L, spt.typesym];
depseq.bcdFileName ← depseq.CopyString[stemp];
spval ← MDModel.LocForType[MDModel.NarrowToTYPE[sp]];
IF spval ~= NIL THEN MDModel.TraverseList[spval.parmlist,ProcAddName];
};
typeAPPL => {
spval: MDModel.LOCSymbol;
-- first, enter its export(s)
-- don't bother if sp is of type LIST, etc.
IF sp.stype NOT IN MDModel.HasAStringName THEN RETURN;
IF MDModel.Sym[spt.appltype] ~= NIL AND
NOT LongString.EquivalentString[MDModel.Sym[spt.appltype], "CONTROL"L]
THEN {
adeprecord ← MakeADepRecord[MDModel.NarrowToTYPE[spt.appltype], depseq,
spmodel, makethismodel, ttywindow, symbolseq];
adeprecord.relation ← exports;
Dir.AddToDep[depseq, @adeprecord];
};
-- has no value?
IF spt.applval = NIL THEN RETURN;
-- now run down its parm list
-- if its a LIST (actually a plus LIST)then its already
-- been looked at
IF spt.applval.stype = typeLIST THEN RETURN;
spval ← MDModel.NarrowToLOC[spt.applval];
CWF.SWF1[stemp, "%s.bcd"L, spval.tail];
depseq.bcdFileName ← depseq.CopyString[stemp];
MDModel.TraverseList[spval.parmlist,ProcAddName];
};
typeLET => {
spval: MDModel.LOCSymbol;
splist: MDModel.LISTSymbol;
spappl: MDModel.APPLSymbol;
sptype: MDModel.TYPESymbol;
-- first add exports
splist ← spt.letgrp;
WHILE splist ~= NIL DO
IF splist.first.stype ~= typeAPPL THEN {
splist ← splist.rest;
LOOP;
};
spappl ← MDModel.NarrowToAPPL[splist.first];
sptype ← MDModel.NarrowToTYPE[spappl.appltype];
IF sptype.typesym ~= NIL AND
NOT LongString.EquivalentString[sptype.typesym, "CONTROL"L]
THEN {
adeprecord ← MakeADepRecord[sptype, depseq,
spmodel, makethismodel, ttywindow, symbolseq];
adeprecord.relation ← exports;
Dir.AddToDep[depseq, @adeprecord];
};
splist ← splist.rest;
ENDLOOP;
-- has no value?
IF spt.letval = NIL THEN RETURN;
-- now run down its parm list
-- if its a LIST (actually a plus LIST)then its already
-- been looked at
IF spt.letval.stype = typeLIST THEN RETURN;
spval ← MDModel.NarrowToLOC[spt.letval];
CWF.SWF1[stemp, "%s.bcd"L, spval.tail];
depseq.bcdFileName ← depseq.CopyString[stemp];
MDModel.TraverseList[spval.parmlist,ProcAddName];
};
ENDCASE => ERROR;
};
-- return the string name of the module you import
-- sp is of type TYPE, APPL, or LET
NumOfDirs: PROC[pd: Dir.DepSeq] RETURNS[numdirs: CARDINAL] = {
numdirs ← 0;
FOR i: CARDINAL IN [0 .. pd.size) DO
IF pd[i].relation = directory THEN
numdirs ← numdirs + 1;
ENDLOOP;
};
-- this procedure may change the model by adding parameters
CompareModelAndFile: PROC[mdepseq, fdepseq: Dir.DepSeq,
sptop: MDModel.Symbol, sploc: MDModel.LOCSymbol,
symbolseq: MDModel.SymbolSeq, spmodel: MDModel.MODELSymbol, typeScript: TypeScript.TS]
RETURNS[identical, modelchanged: BOOL] = {
defshints: ARRAY[0 .. Dir.MaximumDepSize) OF MDModel.TYPESymbol ← ALL[NIL];
modelnoparms, found: BOOL;
skipimports, skiptypes: BOOL;
fi: Dir.FileInfo;
fakesploc: MDModel.LOCSymbol;
dep: Dir.DepSeq;
LookFor: PROC[mod: LONG STRING, bcdVers: TimeStamp.Stamp]
RETURNS[sptype: MDModel.TYPESymbol] = {
FOR i: CARDINAL IN [0 .. fdepseq.size) DO
IF fdepseq[i].relation ~= directory THEN LOOP;
IF (bcdVers ~= TimeStamp.Null AND fdepseq[i].bcdVers = bcdVers)
OR LongString.EqualString[mod, fdepseq[i].moduleName] THEN
RETURN[defshints[i]];
ENDLOOP;
RETURN[NIL];
};
MDModel.CkType[sploc, typeLOC];
-- this handles the case of a module with string parameters
modelnoparms ← (mdepseq.size = 0) AND (sploc.parmlist = NIL);
identical ← TRUE;
modelchanged ← FALSE;
fi ← MDModel.GetFileInfo[sploc];
skiptypes ← fi.isBcd;
-- first we do a little magic to make sure that the fdepseq is filled
-- with modulenames
fakesploc ← MDModel.NewSymLOC[symbolseq];
FOR j: CARDINAL IN [0..fdepseq.size) DO
IF fdepseq[j].moduleName ~= NIL OR fdepseq[j].relation ~= directory THEN LOOP;
IF fdepseq[j].bcdVers ~= TimeStamp.Null
AND (dep ← DBStash.BcdVersLookup[fdepseq[j].bcdVers]) ~= NIL THEN
fdepseq[j].moduleName ← fdepseq.CopyString[dep.moduleName]
ELSE {
-- this is a very slow way to figure out modulenames
fakesploc.tail ← Subr.CopyString[fdepseq[j].bcdFileName];
fakesploc.tail.length ← fakesploc.tail.length - 4;
fakesploc.sext ← Subr.CopyString["Bcd"L];
MDComp.SetVersAndModulename[fakesploc];
IF fakesploc.fi.moduleName ~= NIL THEN
fdepseq[j].moduleName ← fdepseq.CopyString[fakesploc.fi.moduleName];
MDModel.FreeStringsOf[fakesploc];
};
ENDLOOP;
fakesploc.tail ← NIL;
fakesploc.sext ← NIL;
FOR reltype: Dir.ModType DECREASING IN [imports .. directory] DO
-- check the file against the model
-- add parameters as necessary to the model
IF skiptypes AND reltype = directory THEN LOOP;
FOR j: CARDINAL IN [0..fdepseq.size) DO
IF fdepseq[j].relation ~= reltype THEN LOOP;
IF TypeScript.UserAbort[typeScript] THEN SIGNAL Subr.AbortMyself;
found ← FALSE;
FOR i: CARDINAL IN [0.. mdepseq.size) DO
IF mdepseq[i].relation ~= reltype THEN LOOP;
IF mdepseq[i].moduleName = NIL THEN LOOP;
IF LongString.EqualString[mdepseq[i].moduleName,
fdepseq[j].moduleName] THEN {
found ← TRUE;
EXIT;
};
ENDLOOP;
IF NOT found THEN {
sptype: MDModel.TYPESymbol ← NIL;
IF Subr.debugflg THEN
CWF.WF2["\n\tIn file, but not model: %s, relation %s."L,
fdepseq[j].bcdFileName,
SELECT reltype FROM
imports => "Imports"L,
exports => "Exports"L,
directory => "Directory"L,
ENDCASE => ERROR];
identical ← FALSE;
modelchanged ← TRUE;
IF reltype ~= directory THEN
sptype ← LookFor[fdepseq[j].moduleName, fdepseq[j].bcdVers];
-- now add it to the model
-- this IF test is temporary
-- all it does is avoid problems
-- with Defs files with IMPORTS
skipimports ← fdepseq.isdefns;
-- this skips imports for FRAMEPTRTYPES
IF sptop.stype = typeTYPE
AND MDModel.NarrowToTYPE[sptop].frameptr THEN
skipimports ← TRUE;
IF NOT (reltype=imports AND skipimports) THEN
defshints[j] ← AddToModel[symbolseq, sptop, sploc,
fdepseq[j].moduleName, fdepseq[j].bcdFileName,
fdepseq[j].bcdVers, reltype, spmodel, sptype];
};
ENDLOOP;
ENDLOOP;
IF modelnoparms AND modelchanged THEN -- must be defaultable
sploc.parmsdefaultable ← TRUE;
-- questionable
IF identical THEN
sploc.parmsdefaultable ← TRUE;
};
ReorganizeDefinitions: PROC[symbolseq: MDModel.SymbolSeq,
sploc: MDModel.LOCSymbol, fdepseq: Dir.DepSeq] = {
splist: MDModel.LISTSymbol;
sptype: MDModel.TYPESymbol;
sptypeloc: MDModel.LOCSymbol;
spp: MDModel.Symbol;
newlist: MDModel.LISTSymbol ← NIL;
IsBad: PROC[sp: MDModel.Symbol] RETURNS[remove: BOOL] = {
IF sp.stype = typeTYPE THEN RETURN[TRUE];
IF sp.stype = typeAPPL THEN {
sptype: MDModel.TYPESymbol = MDModel.NarrowToTYPE[
MDModel.NarrowToAPPL[sp].appltype];
-- remove if type of appl is not on newlist
RETURN[NOT MDModel.IsOnList[sptype, newlist]];
};
RETURN[FALSE];
};
-- for each defs file, delete it and append to end this puts it into
-- order for the binder
FOR i: CARDINAL IN [0 .. fdepseq.size) DO
IF fdepseq[i].relation ~= directory THEN LOOP;
splist ← sploc.parmlist;
WHILE splist ~= NIL DO
IF splist.first.stype ~= typeTYPE THEN {
splist ← splist.rest;
LOOP;
};
sptype ← MDModel.NarrowToTYPE[splist.first];
sptypeloc ← MDModel.LocForType[sptype];
IF sptypeloc = NIL THEN {
splist ← splist.rest;
LOOP;
};
-- fi ← MDModel.GetFileInfo[sptypeloc];
-- IF fi.moduleName = NIL THEN {
-- fdepseq: Dir.DepSeq;
-- may be nil if this parameter was added by AddToModel
-- [fdepseq, ] ← MakeDepSeqForFile[symbolseq, sptypeloc, NIL,
-- FALSE, NIL];
-- IF fdepseq = NIL THEN
-- SetModuleName[fi, sptype.typesym]; make up name;
-- };
IF LongString.EquivalentString[sptype.typeName,
fdepseq[i].moduleName] THEN{
[spp, sploc.parmlist] ← MDModel.RemoveFromList[sptype,
sploc.parmlist];
newlist ← MDModel.AddToEndOfList[newlist, sptype,
normal, symbolseq];
-- should free spp
EXIT; -- the inner loop
};
splist ← splist.rest;
ENDLOOP;
ENDLOOP;
-- now remove any definitions that aren't actually in the file
-- and any APPL's that depend on this
sploc.parmlist ← MDModel.TraverseAndRemove[sploc.parmlist, IsBad];
-- now add reorganized definitions
IF sploc.parmlist ~= NIL THEN
sploc.parmlist ← MDModel.NarrowToLIST[MDModel.MergeIntoList[
newlist, sploc.parmlist, symbolseq, normal]]
ELSE sploc.parmlist ← newlist;
};
ReorganizeImportsAndExports: PROC[symbolseq: MDModel.SymbolSeq,
sptop1: MDModel.Symbol, fdepseq: Dir.DepSeq] = {
sploc: MDModel.LOCSymbol;
splist: MDModel.LISTSymbol;
spappl: MDModel.APPLSymbol;
sptop: MDModel.LETSymbol;
spp: MDModel.Symbol;
sptype: MDModel.TYPESymbol;
newlist: MDModel.LISTSymbol ← NIL;
IsAppl: PROC[sp: MDModel.Symbol] RETURNS[remove: BOOL] = {
spappl: MDModel.APPLSymbol;
IF sp.stype ~= typeAPPL THEN RETURN[FALSE];
spappl ← MDModel.NarrowToAPPL[sp];
-- remove it if it is NOT a frame pointer variable
-- and if it is not a CONTROL module entry
RETURN[spappl.appltype ~= symbolseq.controlv
AND NOT MDModel.NarrowToTYPE[spappl.appltype].frameptr];
};
-- IMPORTS
-- for each imports, delete it and append to end this puts it into
-- order for the binder
spp ← MDModel.LocForSp[sptop1];
IF spp = NIL THEN ERROR;
sploc ← MDModel.NarrowToLOC[spp];
FOR i: CARDINAL IN [0 .. fdepseq.size) DO
IF fdepseq[i].relation ~= imports THEN LOOP;
splist ← sploc.parmlist;
WHILE splist ~= NIL DO
IF splist.first.stype ~= typeAPPL THEN {
splist ← splist.rest;
LOOP;
};
spappl ← MDModel.NarrowToAPPL[splist.first];
sptype ← MDModel.NarrowToTYPE[spappl.appltype];
-- need to look at the typename since the moduleName
-- in the fdepseq is an interface name you import or export
IF LongString.EquivalentString[sptype.typeName, fdepseq[i].moduleName] THEN{
[spp, sploc.parmlist] ← MDModel.RemoveFromList[spappl,
sploc.parmlist];
newlist ← MDModel.AddToEndOfList[newlist, spappl,
normal, symbolseq];
-- should free spp
EXIT; -- the inner loop
};
splist ← splist.rest;
ENDLOOP;
ENDLOOP;
-- now remove any imports that aren't actually in the file
sploc.parmlist ← MDModel.TraverseAndRemove[sploc.parmlist, IsAppl];
-- now add reorganized imports
IF newlist ~= NIL THEN
sploc.parmlist ← MDModel.NarrowToLIST[MDModel.MergeIntoList[
sploc.parmlist, newlist, symbolseq, normal]];
-- now for multiple exports
IF sptop1.stype ~= typeLET THEN RETURN;
sptop ← MDModel.NarrowToLET[sptop1];
newlist ← NIL;
-- for each exports, delete it and append to end this puts it into
-- order for the binder
FOR i: CARDINAL IN [0 .. fdepseq.size) DO
IF fdepseq[i].relation ~= exports THEN LOOP;
splist ← sptop.letgrp;
WHILE splist ~= NIL DO
IF splist.first.stype ~= typeAPPL THEN {
splist ← splist.rest;
LOOP;
};
spappl ← MDModel.NarrowToAPPL[splist.first];
sptype ← MDModel.NarrowToTYPE[spappl.appltype];
-- need to look at the typename since the moduleName
-- in the fdepseq is an interface name you import
-- or export
IF LongString.EquivalentString[sptype.typeName,fdepseq[i].moduleName] THEN {
[spp, sptop.letgrp] ←
MDModel.RemoveFromList[splist.first,
sptop.letgrp];
newlist ← MDModel.AddToEndOfList[newlist, splist.first,
normal, symbolseq];
-- should free spp
EXIT; -- the inner loop
};
splist ← splist.rest;
ENDLOOP;
ENDLOOP;
-- now remove any exports that aren't actually in the file
sptop.letgrp ← MDModel.TraverseAndRemove[sptop.letgrp, IsAppl];
IF newlist ~= NIL THEN
sptop.letgrp ← MDModel.NarrowToLIST[MDModel.MergeIntoList[
sptop.letgrp, newlist, symbolseq, normal]];
};
-- looks for sname explicitely on the parm list
-- sname is the moduleName, w/o .bcd or .mesa
LookSym: PROC[sname: LONG STRING, sp: MDModel.Symbol] RETURNS[MDModel.Symbol] = {
son: MDModel.Symbol ← NIL;
ProcAnal: PROC[sp: MDModel.Symbol] = {
son ← IF son ~= NIL THEN son ELSE LookSym[sname, sp];
};
IF sp = NIL THEN RETURN[NIL];
WITH spt~~sp SELECT FROM
typeLOC => {
IF LongString.EquivalentString[spt.tail,sname] THEN RETURN[sp];
-- CWF.WF1["looksym %s\n", sp.tail];
};
typeLIST => NULL;
ENDCASE => RETURN[NIL];
MDModel.TraverseList[MDModel.NarrowToLIST[sp], ProcAnal];
RETURN[son];
};
-- this fills in parameter defaults if necessary
CompareDesc: PROC[fdepseq: Dir.DepSeq,
sptop: MDModel.Symbol, sploc: MDModel.LOCSymbol,
symbolseq: MDModel.SymbolSeq, spmodel: MDModel.MODELSymbol]
RETURNS[modelchanged: BOOL] = {
identical: BOOL;
modelchanged ← FALSE;
IF Subr.debugflg THEN
CWF.WF2["ModuleName %s, File %s"L,fdepseq.moduleName,
fdepseq.srcFileName];
[identical, modelchanged] ← MatchUpAndAddParameters[fdepseq,
sptop, sploc, symbolseq, spmodel];
};
-- sptype may be NIL
-- spaddtype may be NIL
-- sptop is either an APPL, TYPE, or LET
AddToModel: PUBLIC PROC[symbolseq: MDModel.SymbolSeq, sptop: MDModel.Symbol,
sploc: MDModel.LOCSymbol, moduleName, bcdFileName: LONG STRING,
bcdVers: TimeStamp.Stamp, reltype: Dir.ModType, spmodel: MDModel.MODELSymbol,
sptype: MDModel.TYPESymbol] RETURNS[spaddtype: MDModel.TYPESymbol] = {
modName: STRING ← [100];
spaddtype ← NIL;
IF bcdFileName = NIL THEN RETURN;
IF moduleName ~= NIL THEN Subr.strcpy[modName, moduleName];
IF reltype = directory THEN {
-- yes, add this to end of proc's procval list
[spaddtype,] ← MDModel.EnterType[bcdFileName, modName, bcdVers,
symbolseq, spmodel, TRUE
! MDModel.NeedModuleName => {
CWF.FWF1[MDMain.DebugWP, "Making up modulename for %s.\n"L, bcdFileName];
Subr.strcpy[modName, bcdFileName];
IF Subr.EndsIn[modName, ".bcd"L] THEN
modName.length ← modName.length - 4;
RETRY;
}];
sploc.parmlist ← MDModel.AddToEndOfList[sploc.parmlist,
spaddtype, normal,symbolseq]
}
ELSE {
-- yes, add this to end of proc's procval list
spi: MDModel.APPLSymbol = MDModel.EnterInstAndLoc[
bcdFileName, modName, bcdVers, symbolseq, spmodel, sptype, TRUE
! MDModel.NeedModuleName => {
CWF.FWF1[MDMain.DebugWP, "Making up modulename for %s.\n"L, bcdFileName];
Subr.strcpy[modName, bcdFileName];
IF Subr.EndsIn[modName, ".bcd"L] THEN
modName.length ← modName.length - 4;
RETRY;
}];
IF reltype = imports THEN {
sploc.parmlist ← MDModel.AddToEndOfList[sploc.parmlist,
spi, normal, symbolseq]
}
ELSE IF reltype = exports THEN {
-- must massage into a LET if not already in it
WITH spt~~sptop SELECT FROM
typeLET => {
spt.letgrp ← MDModel.AddToEndOfList[spt.letgrp,
spi, normal, symbolseq];
};
typeAPPL => {
spnew: MDModel.LETSymbol = MDModel.NewSymLET[symbolseq];
spnew.letval ← spt.applval;
spt.applval ← NIL;
MDModel.ReplaceBy[sptop, spnew, symbolseq];
spnew.letgrp ← MDModel.AddToEndOfList[NIL, sptop, normal,
symbolseq];
spnew.letgrp ← MDModel.AddToEndOfList[spnew.letgrp,
spi, normal, symbolseq];
spt.letparent ← spnew;
spi.letparent ← spnew;
};
-- exports are ok if the TYPE is a frame ptr type
typeTYPE => IF NOT spt.frameptr THEN
CWF.WF3["Error - %s.%s is a TYPE (not a FRAMEPTRTYPE) but it exports %s!\n"L,
sploc.tail, sploc.sext, bcdFileName];
ENDCASE => ERROR;
}
ELSE ERROR;
};
};