
<<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_BasicTime.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_BasicTime.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[];

}.

