<> <> <> 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; <> <> <> <> srcFiTable: SrcHashTable.Table _ NIL; bcdFiTable: BcdHashTable.Table _ NIL; <> <> 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}; <> 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]]]}; <> 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}; <> <> <> <> -- 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]}; }; <> <> 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}; <> 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}; <> 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]; <> 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]}; <> <> 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}; <> <> 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]; <> 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}; <> 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[]; }.