SMFIImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
last edit by Satterthwaite, May 30, 1986 11:02:07 am PDT
DIRECTORY
Ascii: TYPE USING [Lower],
Atom: TYPE USING [MakeAtom],
Basics: TYPE USING [BITXOR],
BasicTime: TYPE USING [GMT, nullGMT],
BcdDefs: TYPE USING [
Base, BcdBase, EXPHandle, EXPIndex, IMPHandle, IMPIndex, MTHandle, MTIndex,
Namee, NameRecord, NameString, NullName],
BcdHashTable: TYPE HashTable USING [Table, Create, Erase, ForEach, Fetch, Store],
BcdOps: TYPE USING [
FindName, ProcessExports, ProcessImports, ProcessModules],
Commander: TYPE USING [CommandProc, Register],
CS: TYPE USING [GMTFromRope, EndsIn, RopeFromGMT, RopeFromStamp, ShortName, z],
CtoSP1: TYPE P1 USING [InstallParseTable, Parse],
CtoSParseData: TYPE USING [],
FS: TYPE USING [
Close, Error, GetInfo, Open, OpenFile, Read, StreamFromOpenFile, nullOpenFile],
IO: TYPE USING [Close, Put, PutF, rope, STREAM],
PrincOpsUtils: TYPE USING [Codebase],
Rope: TYPE USING [Concat, Equal, Fetch, Flatten, FromProc, Length, ROPE, Text],
SMEval: TYPE USING [Eval],
SMFI: TYPE USING [BcdFileInfo, BcdFileInfoRecord, SrcFileInfo, SrcFileInfoRecord],
SMFIOps: TYPE USING[],
SMOps: TYPE USING [MS],
SMTree: TYPE Tree USING [Link, Text, null],
SMTreeOps: TYPE TreeOps USING [GetExt, NthSon, PopTree, PutExt],
SMTypeCons: TYPE USING [
TM, MkArrow, MkControlType, MkCross2, MkDeclElem, MkDeclReverse, MkInterfaceType,
MkPair, MkStampType, MkUnitDecl],
SMUtil: TYPE USING [PrintSubTree],
SrcHashTable: TYPE HashTable USING [Table, Create, Erase, ForEach, Fetch, Store],
TimeStamp: TYPE USING [Null, Stamp],
VM: TYPE USING [AddressForPageNumber, Allocate, Free, Interval, nullInterval];
SMFIImpl: CEDAR MONITOR
IMPORTS
Ascii, Atom, Basics, BcdHashTable, BcdOps, Commander, CS, CtoSP1, CtoSParseData, FS, IO,
PrincOpsUtils, Rope, SMEval, SMTreeOps, SMTypeCons, SMUtil, SrcHashTable, VM
EXPORTS SMFIOps ~ {
OPEN Tree~~SMTree, TreeOps~~SMTreeOps;
code in this module updates the FI tables
therefore most PUBLIC procedures acquire the lock
MDS usage
these data structures are protected by the monitor lock
srcFiTable: SrcHashTable.Table ← NIL;
bcdFiTable: BcdHashTable.Table ← NIL;
end of MDS
file name utilities
Ambiguous: PUBLIC PROC[version: Rope.ROPE] RETURNS[BOOL] ~ {
RETURN[version = NIL OR (version.Length = 1 AND Ascii.Lower[version.Fetch[0]] = 'h)]};
UnitToRope: PUBLIC PROC[unitId: Tree.Link] RETURNS[r: Rope.ROPE] ~ {
son1: Tree.Link ~ TreeOps.NthSon[unitId, 1]; -- host
son2: Tree.Link ~ TreeOps.NthSon[unitId, 2]; -- directory
r ← NARROW[TreeOps.NthSon[unitId, 3], Tree.Text];
IF son1 # Tree.null OR son2 # Tree.null THEN {
r ← NARROW["/", Rope.ROPE].Concat[r];
IF son2 # Tree.null THEN r ← NARROW[son2, Tree.Text].Concat[r];
IF son1 # Tree.null THEN r ← NARROW[son1, Tree.Text].Concat[r]};
RETURN};
operations for cache management
Key: TYPE~BasicTime.GMT;
SrcGetKey: PROC[n: SMFI.SrcFileInfo] RETURNS[Key] ~ {RETURN[n.create]};
BcdGetKey: PROC[n: SMFI.BcdFileInfo] RETURNS[Key] ~ {RETURN[n.create]};
CompareKeys: PROC[k1, k2: Key] RETURNS[BOOL] ~ {RETURN[k1 = k2]};
HashFromKey: PROC[k: Key] RETURNS[CARDINAL] ~ {
words: ARRAY [0..2) OF WORD ~ LOOPHOLE[k];
RETURN[Basics.BITXOR[words[0], words[1]]]};
code to manipulate the FI's
Flush: PUBLIC ENTRY PROC ~ {
ENABLE UNWIND => {NULL};
srcFiTable.Erase[]; srcFiTable ← NIL;
bcdFiTable.Erase[]; bcdFiTable ← NIL};
Reset: PUBLIC ENTRY PROC ~ {
ENABLE UNWIND => {NULL};
ResetSrc: PROC[srcFi: SMFI.SrcFileInfo] RETURNS[stop: BOOL←FALSE] ~ {
IF srcFi.state > $analyzed THEN {
srcFi.file.Close; srcFi.file ← FS.nullOpenFile;
srcFi.state ← MAX[srcFi.state, $analyzed]};
};
ResetBcd: PROC[bcdFi: SMFI.BcdFileInfo] RETURNS[stop: BOOL←FALSE] ~ {
IF bcdFi.state > $analyzed THEN {
bcdFi.file.Close; bcdFi.file ← FS.nullOpenFile;
bcdFi.state ← MAX[bcdFi.state, $analyzed]};
};
[] ← srcFiTable.ForEach[ResetSrc]; [] ← bcdFiTable.ForEach[ResetBcd]};
FindSource: PUBLIC ENTRY PROC[create: BasicTime.GMT�sicTime.nullGMT]
RETURNS[fi: SMFI.SrcFileInfo] ~ {
ENABLE UNWIND => {NULL};
IF create # BasicTime.nullGMT THEN {
fi ← srcFiTable.Fetch[create].value;
IF fi # NIL THEN RETURN};
fi ← (CS.z).NEW[SMFI.SrcFileInfoRecord ← [create~create, state~$empty]];
[] ← srcFiTable.Store[create, fi]};
NewestSource: PUBLIC PROC[name, wDir: Rope.ROPE] RETURNS[SMFI.SrcFileInfo] ~ {
file: FS.OpenFile;
none: BOOL ← FALSE;
file ← FS.Open[name~name, wDir~wDir ! FS.Error => {none ← TRUE; CONTINUE}];
RETURN[FindSource[IF none THEN BasicTime.nullGMT ELSE CreateFromFile[file]]]};
FindBcd: PUBLIC ENTRY PROC[create: BasicTime.GMT�sicTime.nullGMT]
RETURNS[fi: SMFI.BcdFileInfo] ~ {
ENABLE UNWIND => {NULL};
IF create # BasicTime.nullGMT THEN {
fi ← bcdFiTable.Fetch[create].value;
IF fi # NIL THEN RETURN};
fi ← (CS.z).NEW[SMFI.BcdFileInfoRecord ← [create~create, state~$empty]];
[] ← bcdFiTable.Store[create, fi]};
NewestBcd: PUBLIC PROC[name, wDir: Rope.ROPE] RETURNS[SMFI.BcdFileInfo] ~ {
file: FS.OpenFile;
none: BOOL ← FALSE;
file ← FS.Open[name~name, wDir~wDir ! FS.Error => {none ← TRUE; CONTINUE}];
RETURN[FindBcd[IF none THEN BasicTime.nullGMT ELSE CreateFromFile[file]]]};
PrintFileInfo: ENTRY Commander.CommandProc ~ TRUSTED {
ENABLE UNWIND => {NULL};
argv: UECP.Argv ~ UECP.Parse[event.commandLine];
FOR i: CARDINAL IN [1..argv.argc) DO
PrintEntries[argv[i], cmd.in, cmd.out];
ENDLOOP;
-- IF argv.argc = 1 THEN -- PrintEntries[NIL, cmd.in, cmd.out]}; -- no args
PrintEntries: PROC[rope: Rope.ROPE, in, out: IO.STREAM] ~ {
PrintSrc: PROC[srcFi: SMFI.SrcFileInfo] RETURNS[stop: BOOL←FALSE] ~ {
IF rope = NIL OR rope.Equal[srcFi.simpleName, FALSE] THEN {
out.PutF[
"Entry: %g!%g", IO.rope[srcFi.localName], IO.rope[CS.RopeFromGMT[srcFi.create]]];
IF srcFi.state = $opened THEN out.Put[IO.rope[", present"]];
out.Put[IO.rope["\n type:"]];
SMUtil.PrintSubTree[out, srcFi.type, 4];
out.Put[IO.rope["\n\n"]];
--IF in.UserAbort THEN ERROR IO.UserAborted[NIL, NIL]--};
};
PrintBcd: PROC[bcdFi: SMFI.BcdFileInfo] RETURNS[stop: BOOL←FALSE] ~ {
IF rope = NIL OR rope.Equal[bcdFi.simpleName, FALSE] THEN {
out.PutF[
"Entry: %g!%g", IO.rope[bcdFi.localName], IO.rope[CS.RopeFromGMT[bcdFi.create]]];
IF bcdFi.state = $opened THEN out.Put[IO.rope[", present"]];
IF bcdFi.stamp # TimeStamp.Null THEN {
out.PutF["\n version: %g", IO.rope[CS.RopeFromStamp[bcdFi.stamp]]]};
out.Put[IO.rope["\n type:"]];
SMUtil.PrintSubTree[out, bcdFi.type, 4];
out.Put[IO.rope["\n\n"]];
--IF in.UserAbort THEN ERROR IO.UserAborted[NIL, NIL]--};
};
[] ← srcFiTable.ForEach[PrintSrc]; [] ← bcdFiTable.ForEach[PrintBcd]};
Available: PUBLIC ENTRY PROC[fi: SMFI.SrcFileInfo] RETURNS[BOOL] ~ {
ENABLE UNWIND => {NULL};
RETURN[fi.state = $opened]};
Fill: PUBLIC PROC[ms: SMOps.MS, fi: SMFI.SrcFileInfo, localName, wDir: Rope.ROPE] ~ {
ENABLE UNWIND => {NULL};
IF fi.state < $opened THEN {
fi.localName ← localName; fi.wDir ← wDir;
fi.simpleName ← CS.ShortName[localName];
FillSource[ms, fi]};
};
code to read in and analyze files
each inner procedure acquires ML
EvaluateUnitId: PUBLIC PROC[ms: SMOps.MS, unitId: Tree.Link]
RETURNS[value: Tree.Link] ~ {
unitName: Rope.ROPE ~ UnitToRope[unitId];
version: Tree.Text ~ NARROW[TreeOps.NthSon[unitId, 4]];
simpleName: Rope.ROPE ~ CS.ShortName[unitName];
IF CS.EndsIn[unitName, ".mesa"] THEN {
fi: SMFI.SrcFileInfo;
IF Ambiguous[version] THEN fi ← NewestSource[unitName, ms.wDir]
ELSE {
oldFi: SMFI.SrcFileInfo ~ NARROW[TreeOps.GetExt[unitId]];
create: BasicTime.GMT ~ CS.GMTFromRope[version];
fi ← (IF oldFi # NIL AND oldFi.create = create
THEN oldFi ELSE FindSource[CS.GMTFromRope[version]])
};
TreeOps.PutExt[unitId, fi];
IF fi.state < $analyzed THEN {
fi.localName ← unitName; fi.wDir ← ms.wDir;
fi.simpleName ← simpleName;
FillSource[ms, fi]};
value ← fi}
ELSE IF CS.EndsIn[simpleName, ".bcd"] THEN {
fi: SMFI.BcdFileInfo ~ (IF Ambiguous[version]
THEN NewestBcd[unitName, ms.wDir] ELSE FindBcd[CS.GMTFromRope[version]]);
IF fi.state < $analyzed THEN {
fi.localName ← unitName; fi.wDir ← ms.wDir;
fi.simpleName ← simpleName;
FillBcd[ms, fi]};
value ← fi}
ELSE IF CS.EndsIn[simpleName, ".model"] THEN {
ERROR}  -- do nothing for now
ELSE ERROR;
RETURN};
fills in src for .mesa
FillSource: ENTRY PROC[ms: SMOps.MS, fi: SMFI.SrcFileInfo] ~ {
file: FS.OpenFile ← FS.nullOpenFile;
failed: BOOL ← FALSE;
fi.fName ← fi.localName; -- assume default file naming context
file ← FS.Open[name~fi.localName, wantedCreatedTime~fi.create, wDir~fi.wDir
! FS.Error => {failed ← TRUE; CONTINUE}];
fi.file ← file;
IF ~failed AND fi.create = BasicTime.nullGMT THEN fi.create ← CreateFromFile[file];
IF failed THEN fi.state ← MIN[fi.state, $analyzed]
ELSE IF fi.state = $analyzed OR AddCedarInfo[ms, fi] THEN fi.state ← $opened};
fills in bcd for .bcd in model
FillBcd: ENTRY PROC[ms: SMOps.MS, fi: SMFI.BcdFileInfo] ~ {
file: FS.OpenFile ← FS.nullOpenFile;
failed: BOOL ← FALSE;
fi.fName ← fi.localName; -- assume default file naming context
file ← FS.Open[name~fi.localName, wantedCreatedTime~fi.create, wDir~fi.wDir
! FS.Error => {failed ← TRUE; CONTINUE}];
IF ~failed AND fi.create = BasicTime.nullGMT THEN fi.create ← CreateFromFile[file];
note that the version stamp is not validated here
fi.file ← file;
IF failed THEN fi.state ← MIN[fi.state, $analyzed]
ELSE IF fi.state = $analyzed          -- stamp not verified
OR AddBcdInfo[ms, fi].success THEN fi.state ← $opened; -- stamp verified
};
CreateFromFile: PROC[file: FS.OpenFile] RETURNS[BasicTime.GMT] ~ INLINE {
RETURN[file.GetInfo[].created]};
code to analyze srcs and bcds
for .mesa
AddCedarInfo: PROC[ms: SMOps.MS, fi: SMFI.SrcFileInfo] RETURNS[success: BOOL] ~ {
in: IO.STREAM ← NIL;
in ← fi.file.StreamFromOpenFile[streamOptions~[closeFSOpenFileOnClose~FALSE]
! FS.Error => {CONTINUE}];
IF in = NIL THEN {fi.type ← Tree.null; success ← FALSE}
ELSE {
complete: BOOL;
nTokens, nErrors: CARDINAL;
TRUSTED {[complete, nTokens, nErrors] ← CtoSP1.Parse[ms, in, TRUE]};
fi.type ← (IF complete -- AND nErrors = 0 --
THEN SMEval.Eval[ms, (ms.tm).PopTree, NIL]
ELSE Tree.null);
success ← (nErrors = 0);
IF ~success THEN {
(ms.out).PutF["%g was not parsed successfully\n", IO.rope[fi.simpleName]];
fi.type ← Tree.null};
in.Close[]};
RETURN};
for .bcd
imports and exports are partially uncheckable (not enough info in Bcd)
AddBcdInfo: PROC[ms: SMOps.MS, fi: SMFI.BcdFileInfo] RETURNS[success: BOOL] ~ TRUSTED {
tm: SMTypeCons.TM ~ [ms.tm];
LinkList: TYPE ~ LIST OF Tree.Link;
d, m: LinkList ← NIL;
r: Tree.Link ← Tree.null;
range: Tree.Link;
bcdBase: BcdDefs.BcdBase ← NIL;
nameString: BcdDefs.NameString;
ftb: BcdDefs.Base;
sgb: BcdDefs.Base;
UnitList: PROC[l: LIST OF Tree.Link] RETURNS[BOOL] ~ CHECKED INLINE {
RETURN[l # NIL AND l.rest = 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]]};
ForEachModule: PROC[mth: BcdDefs.MTHandle, mti: BcdDefs.MTIndex]
RETURNS[stop: BOOL←FALSE] ~ TRUSTED {
name: ATOM ~ Atom.MakeAtom[NameToRope[mth.name]];
type: Tree.Link ~ tm.MkInterfaceType[name];
IF bcdBase.definitions THEN
r ← (IF r = Tree.null THEN type ELSE tm.MkPair[r, type])
ELSE {
t: Tree.Link ~ tm.MkCross2[tm.MkUnitDecl[tm.MkDeclElem[name, type]], name];
r ← (IF r = Tree.null THEN t ELSE tm.MkPair[r, t])}
};
ForEachImport: PROC[ith: BcdDefs.IMPHandle, iti: BcdDefs.IMPIndex]
RETURNS[stop: BOOL←FALSE] ~ TRUSTED {
name: ATOM ~ Atom.MakeAtom[
IF ith.namedInstance THEN NameeToRope[[import[iti]]]
ELSE NameToRope[ith.name].Concat["Impl"]];
type: Tree.Link ~ tm.MkStampType[ftb[ith.file].version];
d ← (ms.z).CONS[tm.MkDeclElem[name, type], d]};
ForEachExport: PROC[eth: BcdDefs.EXPHandle, iti: BcdDefs.EXPIndex]
RETURNS[stop: BOOL←FALSE] ~ TRUSTED {
t: Tree.Link ~ tm.MkStampType[ftb[eth.file].version];
r ← (IF r = NIL THEN t ELSE tm.MkPair[r, t])};
{
interval: VM.Interval;
[interval, bcdBase] ← LoadUpBcd[fi.file];
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;
IF bcdBase.definitions THEN {
[] ← BcdOps.ProcessModules[bcdBase, ForEachModule];
fi.type ← SMEval.Eval[ms, r, NIL]}
ELSE {
[] ← BcdOps.ProcessImports[bcdBase, ForEachImport];
[] ← BcdOps.ProcessExports[bcdBase, ForEachExport];
implementors export a variable of type CONTROL as well
r ← (IF r = Tree.null THEN tm.MkControlType ELSE tm.MkPair[r, tm.MkControlType]);
[] ← BcdOps.ProcessModules[bcdBase, ForEachModule];
fi.type ← SMEval.Eval[ms, tm.MkArrow[domain~tm.MkDeclReverse[d], range~r], NIL]};
};
VM.Free[interval];
};
RETURN};
LoadUpBcd: PROC[file: FS.OpenFile]
RETURNS[interval: VM.Interval, bcdBase: BcdDefs.BcdBase] ~ TRUSTED {
nPages: INT ← MIN[10, file.GetInfo[].pages];
interval ← VM.nullInterval;
IF file = FS.nullOpenFile THEN ERROR;
DO
interval ← VM.Allocate[count~nPages];
bcdBase ← VM.AddressForPageNumber[interval.page];
FS.Read[file~file, from~0, nPages~nPages, to~bcdBase];
IF bcdBase.nPages <= nPages THEN EXIT;
nPages ← bcdBase.nPages;
VM.Free[interval]; interval ← VM.nullInterval
ENDLOOP;
RETURN};
initialization
InitModule: PROC ~ {
srcFiTable ← SrcHashTable.Create[ops~[SrcGetKey, HashFromKey, CompareKeys]];
bcdFiTable ← BcdHashTable.Create[ops~[BcdGetKey, HashFromKey, CompareKeys]];
TRUSTED {
CtoSP1.InstallParseTable[LOOPHOLE[PrincOpsUtils.Codebase[LOOPHOLE[CtoSParseData]]]]};
Commander.Register["SMFilePrint", PrintFileInfo]};
InitModule[];
}.