-- SMFIImpl.mesa, June 17, 1983 9:50 am
-- last edit by Schmidt May 24, 1983 11:11 am
-- last edit by Satterthwaite, August 11, 1983 2:36 pm
DIRECTORY
Atom: TYPE USING [MakeAtom],
BcdDefs: TYPE USING [
Base, EXPIndex, FTIndex, IMPIndex, MTIndex, Namee, NameRecord, NullName],
BcdOps: TYPE USING [
BcdBase, EXPHandle, IMPHandle, MTHandle, NameString,
FindName, ProcessExports, ProcessImports, ProcessModules],
CS: TYPE USING [CardFromRope, EndsIn, RopeFromStamp, StampFromRope, z],
CtoSP1: TYPE --P1-- USING [InstallParseTable, Parse],
CtoSParseData: TYPE,
Directory: TYPE USING [Error, ignore, Lookup],
File: TYPE USING [Capability, nullCapability],
FileIO: TYPE USING [Open, OpenFailed],
FileSegment: TYPE USING [],
FileStream: TYPE USING [GetLeaderPropertiesForCapability],
IO: TYPE USING [
card, Close, Put, PutF, rope, string, STREAM, UserAbort, UserAborted],
Rope: TYPE USING [Cat, Equal, Fetch, Flatten, FromProc, Length, Lower, ROPE, Text],
Runtime: TYPE USING [GetTableBase],
SMEval: TYPE USING [Eval],
SMFI: TYPE USING [BcdFileInfo, BcdFileInfoRecord, SrcFileInfo, SrcFileInfoRecord],
SMFIOps: TYPE USING [],
SMOps: TYPE USING [MS],
SMTree: TYPE Tree USING [Link, null],
SMTreeOps: TYPE USING [PopTree],
SMTypeCons: TYPE USING [
MkArrow, MkControlType, MkCrossReverse, MkCross2, MkDeclElem, MkDeclReverse,
MkInterfaceType, MkStampType],
SMUtil: TYPE USING [PrintSubTree],
Space: TYPE USING [
Create, CreateUniformSwapUnits, Delete, Handle, LongPointer, MakeReadOnly,
Map, virtualMemory],
TimeStamp: TYPE USING [Null, Stamp],
UECP: TYPE USING [Argv, Parse],
UserExec: TYPE USING [CommandProc, GetStreams, RegisterCommand];
SMFIImpl: CEDAR MONITOR
IMPORTS
Atom, BcdOps, CS, CtoSP1, CtoSParseData, Directory, FileIO, FileStream, IO,
Rope, Runtime, SMEval, SMTreeOps, SMTypeCons, SMUtil,
Space, UECP, UserExec
EXPORTS SMFIOps ~ {
OPEN Tree~~SMTree;
-- code in this module updates the FI tables
-- therefore most PUBLIC procedures acquire the monitor lock
-- MDS usage
-- these data structures are protected by the monitor lock
srcFiList: SMFI.SrcFileInfo ← NIL;
bcdFiList: SMFI.BcdFileInfo ← NIL;
-- endof MDS
-- code to manipulate the FI's
Flush: PUBLIC ENTRY PROC ~ {
ENABLE UNWIND => {NULL};
srcFiList ← NIL;
bcdFiList ← NIL};
Reset: PUBLIC ENTRY PROC ~ {
ENABLE UNWIND => {NULL};
FOR srcFi: SMFI.SrcFileInfo ← srcFiList, srcFi.link UNTIL srcFi = NIL DO
srcFi.capability ← File.nullCapability;
srcFi.state ← MAX[srcFi.state, $analyzed];
ENDLOOP;
FOR bcdFi: SMFI.BcdFileInfo ← bcdFiList, bcdFi.link UNTIL bcdFi = NIL DO
bcdFi.capability ← File.nullCapability;
bcdFi.state ← MAX[bcdFi.state, $analyzed];
ENDLOOP;
};
FindSource: PUBLIC ENTRY PROC[create: LONG CARDINAL←0]
RETURNS[fi: SMFI.SrcFileInfo] ~ {
ENABLE UNWIND => {NULL};
IF create # 0 THEN
FOR srcFi: SMFI.SrcFileInfo ← srcFiList, srcFi.link UNTIL srcFi = NIL DO
IF srcFi.create = create THEN RETURN[srcFi]
ENDLOOP;
fi ← (CS.z).NEW[SMFI.SrcFileInfoRecord ← [create~create, state~$empty, link~srcFiList]];
srcFiList ← fi};
NewestSource: PUBLIC PROC[srcFileName: Rope.Text]
RETURNS[fi: SMFI.SrcFileInfo] ~ TRUSTED {
cap: File.Capability;
none: BOOL ← FALSE;
cap ← Directory.Lookup[fileName~LOOPHOLE[srcFileName], permissions~Directory.ignore
! Directory.Error => {none ← TRUE; CONTINUE}];
RETURN[FindSource[IF none THEN 0 ELSE CreateFromCap[cap]]]};
FindBcd: PUBLIC ENTRY PROC[stamp: TimeStamp.Stamp←TimeStamp.Null]
RETURNS[fi: SMFI.BcdFileInfo] ~ {
ENABLE UNWIND => {NULL};
IF stamp # TimeStamp.Null THEN
FOR bcdFi: SMFI.BcdFileInfo ← bcdFiList, bcdFi.link UNTIL bcdFi = NIL DO
IF bcdFi.stamp = stamp THEN RETURN[bcdFi]
ENDLOOP;
fi ← (CS.z).NEW[SMFI.BcdFileInfoRecord ← [stamp~stamp, state~$empty, link~bcdFiList]];
bcdFiList ← fi};
FindBcdByName: PUBLIC PROC[bcdFileName: Rope.Text] RETURNS[fi: SMFI.BcdFileInfo] ~ {
FOR bcdFi: SMFI.BcdFileInfo ← bcdFiList, bcdFi.link UNTIL bcdFi = NIL DO
IF bcdFileName.Equal[bcdFi.localName, FALSE] THEN RETURN[bcdFi]
ENDLOOP;
RETURN[NIL]};
PrintFileInfo: ENTRY UserExec.CommandProc ~ TRUSTED {
ENABLE UNWIND => {NULL};
argv: UECP.Argv ~ UECP.Parse[event.commandLine];
in, out: IO.STREAM;
[in, out] ← UserExec.GetStreams[exec];
FOR i: CARDINAL IN [1 .. argv.argc) DO
PrintEntries[argv[i].Flatten[], in, out];
ENDLOOP;
IF argv.argc = 1 THEN PrintEntries[NIL, in, out]}; -- no args
-- prints all if rope = NIL
PrintEntries: PROC[rope: Rope.Text, in, out: IO.STREAM] ~ {
FOR srcFi: SMFI.SrcFileInfo ← srcFiList, srcFi.link UNTIL srcFi = NIL DO
IF rope = NIL OR rope.Equal[srcFi.shortName, FALSE] THEN {
out.PutF["Entry: %s!(%t)", IO.rope[srcFi.localName], IO.card[srcFi.create]];
IF srcFi.state = $opened THEN out.Put[IO.string[", present"L]];
out.Put[IO.string["\n type:"L]];
SMUtil.PrintSubTree[out, srcFi.type, 4];
out.Put[IO.string["\n\n"L]];
IF in.UserAbort THEN ERROR IO.UserAborted[NIL, NIL]};
ENDLOOP;
FOR bcdFi: SMFI.BcdFileInfo ← bcdFiList, bcdFi.link UNTIL bcdFi = NIL DO
IF rope = NIL OR rope.Equal[bcdFi.shortName, FALSE] THEN {
out.PutF[
"Entry: %s!%s", IO.rope[bcdFi.localName], IO.rope[CS.RopeFromStamp[bcdFi.stamp]]];
IF bcdFi.state = $opened THEN out.Put[IO.string[", present"L]];
out.Put[IO.string["\n type:"L]];
SMUtil.PrintSubTree[out, bcdFi.type, 4];
out.Put[IO.string["\n\n"L]];
IF in.UserAbort[] THEN ERROR IO.UserAborted[NIL, NIL]};
ENDLOOP;
};
-- code to read in and analyze files
-- each inner procedure acquires ML
EvaluateUnitId: PUBLIC PROC[ms: SMOps.MS, unitId, version: Rope.ROPE]
RETURNS[value: SMTree.Link] ~ {
ENABLE UNWIND => {NULL};
shortName: Rope.Text ~ unitId.Flatten[]; -- for now
IF CS.EndsIn[shortName, ".mesa"] THEN {
fi: SMFI.SrcFileInfo ~ IF Ambiguous[version]
THEN NewestSource[shortName] ELSE FindSource[CS.CardFromRope[version]];
IF fi.state >= $analyzed THEN RETURN[fi];
fi.host ← fi.directory ← NIL; fi.shortName ← shortName; fi.version ← 0;
FillSource[fi];
IF fi.state = $opened THEN AddCedarInfo[ms, fi];
RETURN[fi]}
ELSE IF CS.EndsIn[shortName, ".bcd"] THEN {
fi: SMFI.BcdFileInfo;
IF Ambiguous[version] THEN {
fi ← FindBcdByName[shortName];
IF fi = NIL THEN fi ← FindBcd[TimeStamp.Null]}
ELSE fi ← FindBcd[CS.StampFromRope[version]];
IF fi.state >= $analyzed THEN RETURN[fi];
fi.host ← fi.directory ← NIL; fi.shortName ← shortName; fi.version ← 0;
FillBcd[ms, fi];
RETURN[fi]}
ELSE IF CS.EndsIn[shortName, ".model"] THEN {
ERROR} -- do nothing for now
ELSE ERROR};
Ambiguous: PUBLIC PROC[version: Rope.ROPE] RETURNS[BOOL] ~ {
RETURN[version = NIL OR (version.Length = 1 AND Rope.Lower[version.Fetch[0]] = 'h)]};
-- fills in src for .mesa
FillSource: PUBLIC ENTRY PROC[fi: SMFI.SrcFileInfo] ~ TRUSTED {
cap: File.Capability;
failed: BOOL ← FALSE;
fi.localName ← fi.shortName;
RetrieveRemoteSrcFile[fi]; -- place holder
cap ← Directory.Lookup[
fileName~LOOPHOLE[fi.localName], permissions~Directory.ignore
! Directory.Error => {failed ← TRUE; CONTINUE}];
IF ~failed THEN {
create: LONG CARDINAL ~ CreateFromCap[cap];
IF fi.create = 0 THEN fi.create ← create
ELSE IF fi.create # create THEN failed ← TRUE};
IF failed THEN {fi.capability ← File.nullCapability; fi.state ← MAX[fi.state, $analyzed]}
ELSE {fi.capability ← cap; fi.state ← $opened}};
-- fills in bcd for .bcd in model
FillBcd: ENTRY PROC[ms: SMOps.MS, fi: SMFI.BcdFileInfo] ~ TRUSTED {
rn: Rope.Text ~ GetRootName[fi.shortName];
failed: BOOL ← FALSE;
fi.localName ← rn.Cat[".bcd"].Flatten[];
RetrieveRemoteBcdFile[fi]; -- place holder
fi.capability ← Directory.Lookup[
fileName~LOOPHOLE[fi.localName], permissions~Directory.ignore
! Directory.Error => {failed ← TRUE; CONTINUE}];
-- note that version stamp is not validated here
IF failed THEN fi.state ← MAX[fi.state, $analyzed]
ELSE IF fi.state = $analyzed THEN fi.state ← $opened -- stamp not verified
ELSE IF AddBcdInfo[ms, fi].success THEN fi.state ← $opened}; -- stamp verified
GetRootName: PROC[name: Rope.Text] RETURNS[root: Rope.Text] ~ {
i: CARDINAL ← name.Length - 1;
WHILE i > 0 AND name.Fetch[i] ~= '. DO i ← i-1 ENDLOOP;
root ← IF i > 0 THEN name.Flatten[0, i] ELSE name;
RETURN};
CreateFromCap: PROC[cap: File.Capability] RETURNS[LONG CARDINAL] ~ TRUSTED {
RETURN[FileStream.GetLeaderPropertiesForCapability[cap].create]};
RetrieveRemoteSrcFile: PROC[fi: SMFI.SrcFileInfo] ~ {};
RetrieveRemoteBcdFile: PROC[fi: SMFI.BcdFileInfo] ~ {};
-- code to analyze bcds and srcs
-- for Mesas
AddCedarInfo: ENTRY PROC[ms: SMOps.MS, fi: SMFI.SrcFileInfo] ~ {
in: IO.STREAM ← NIL;
in ← FileIO.Open[fi.shortName ! FileIO.OpenFailed => {CONTINUE}];
IF in = NIL THEN fi.type ← Tree.null
ELSE {
complete: BOOL;
nTokens, nErrors: NAT;
TRUSTED {[complete, nTokens, nErrors] ← CtoSP1.Parse[ms, in]};
fi.type ← IF complete --AND nErrors = 0--
THEN SMEval.Eval[ms, (ms.tm).PopTree, NIL]
ELSE Tree.null;
IF nErrors # 0 THEN {
(ms.out).PutF["%s was not parsed successfully\n", IO.rope[fi.shortName]];
fi.type ← Tree.null};
in.Close[]}
};
-- for Bcds
-- imports and exports are partially uncheckable (not enough info in Bcd)
AddBcdInfo: PROC[ms: SMOps.MS, fi: SMFI.BcdFileInfo] RETURNS[success: BOOL]~ TRUSTED {
LinkList: TYPE ~ LIST OF Tree.Link;
d, m, r: LinkList ← NIL;
range: Tree.Link;
bcdBase: BcdOps.BcdBase ← NIL;
nameString: BcdOps.NameString;
ftb: BcdDefs.Base;
sgb: BcdDefs.Base;
UnitList: PROC[l: LIST OF Tree.Link] RETURNS[BOOL] ~ CHECKED INLINE {
RETURN[l # NIL AND l.first = NIL]};
NameToRope: PROC[name: BcdDefs.NameRecord] RETURNS[Rope.Text] ~ TRUSTED {
i: CARDINAL ← 0;
EachChar: PROC RETURNS[c: CHAR] ~ TRUSTED {
c ← nameString.string.text[name+i]; i ← i+1; RETURN};
RETURN[Rope.FromProc[nameString.size[name], EachChar].Flatten]};
NameeToRope: PROC[namee: BcdDefs.Namee] RETURNS[Rope.Text] ~ TRUSTED {
name: BcdDefs.NameRecord ~ BcdOps.FindName[bcdBase, namee];
RETURN[IF name = BcdDefs.NullName THEN NIL ELSE NameToRope[name]]};
{
space: Space.Handle;
ForEachModule: PROC[mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
RETURNS[stop: BOOL←FALSE] ~ TRUSTED {
name: ATOM ~ Atom.MakeAtom[NameToRope[mth.name]];
type: Tree.Link ~ SMTypeCons.MkInterfaceType[ms.tm, name];
IF bcdBase.definitions THEN r ← (ms.z).CONS[type, r]
ELSE {
m ← (ms.z).CONS[SMTypeCons.MkDeclElem[ms.tm, name, type], m]; -- for cross2
r ← (ms.z).CONS[name, r]}; -- programs export instances
};
ForEachImport: PROC[ith: BcdOps.IMPHandle, iti: BcdDefs.IMPIndex]
RETURNS[stop: BOOL←FALSE] ~ TRUSTED {
name: ATOM ~ Atom.MakeAtom[
IF ith.namedInstance THEN NameeToRope[[import[iti]]]
ELSE NameToRope[ith.name].Cat["Impl"]];
type: Tree.Link ~ SMTypeCons.MkStampType[ms.tm, ftb[ith.file].version];
d ← (ms.z).CONS[SMTypeCons.MkDeclElem[ms.tm, name, type], d]};
ForEachExport: PROC[eth: BcdOps.EXPHandle, eti: BcdDefs.EXPIndex]
RETURNS[stop: BOOL←FALSE] ~ TRUSTED {
r ← (ms.z).CONS[SMTypeCons.MkStampType[ms.tm, ftb[eth.file].version], r]};
[space, bcdBase] ← LoadUpBcd[fi.capability];
success ← (fi.stamp = bcdBase.version OR fi.stamp = TimeStamp.Null);
IF success THEN {
nameString ← LOOPHOLE[bcdBase + bcdBase.ssOffset];
ftb ← LOOPHOLE[bcdBase, BcdDefs.Base] + bcdBase.ftOffset;
sgb ← LOOPHOLE[bcdBase, BcdDefs.Base] + bcdBase.sgOffset;
fi.stamp ← bcdBase.version;
[] ← BcdOps.ProcessModules[bcdBase, ForEachModule];
[] ← BcdOps.ProcessImports[bcdBase, ForEachImport];
[] ← BcdOps.ProcessExports[bcdBase, ForEachExport];
IF ~bcdBase.definitions THEN {
-- implementors export a variable of type CONTROL as well
r ← (ms.z).CONS[SMTypeCons.MkControlType[ms.tm], r]};
range ← IF UnitList[r] THEN r.first ELSE SMTypeCons.MkCrossReverse[ms.tm, r];
IF ~bcdBase.definitions THEN {
range ← SMTypeCons.MkCross2[
tm~ms.tm,
decl~SMTypeCons.MkDeclReverse[ms.tm, m],
type~range];
};
fi.type ← SMEval.Eval[
ms,
SMTypeCons.MkArrow[
tm~ms.tm,
domain~SMTypeCons.MkDeclReverse[ms.tm, d],
range~range],
NIL];
};
Space.Delete[space]}};
LoadUpBcd: PROC[cap: File.Capability]
RETURNS[space: Space.Handle, bcdBase: BcdOps.BcdBase] ~ TRUSTED {
nPages: CARDINAL ← 10;
IF cap = File.nullCapability THEN ERROR;
DO
space ← Space.Create[size~nPages, parent~Space.virtualMemory];
space.Map[window~[file~cap, base~1]];
bcdBase ← space.LongPointer;
IF bcdBase.nPages <= nPages THEN EXIT;
nPages ← bcdBase.nPages;
Space.Delete[space];
ENDLOOP;
Space.CreateUniformSwapUnits[parent~space, size~8]; -- good idea?
space.MakeReadOnly};
InitModule: PROC ~ {
TRUSTED {CtoSP1.InstallParseTable[Runtime.GetTableBase[LOOPHOLE[CtoSParseData]]]};
UserExec.RegisterCommand["YFIPrint", PrintFileInfo]};
InitModule[];
}.