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