-- SMSrcBcdImpl.mesa,
-- last edit by Schmidt, May 5, 1983 3:45 pm
-- last edited by Satterthwaite, May 26, 1983 12:53 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],
CtoSP1: TYPE --P1-- USING [InstallParseTable, Parse],
CtoSParseData: TYPE,
File: TYPE USING [Capability, nullCapability],
FileIO: TYPE USING [Open, OpenFailed],
FileParms: TYPE USING [SymbolSpace],
FileSegment: TYPE USING [],
IO: TYPE USING [Close, Handle, PutF, rope],
Rope: TYPE USING [Cat, Flatten, FromChar, ROPE, Text],
Runtime: TYPE USING [GetTableBase],
SMEval: TYPE USING [Eval],
SMFI: TYPE USING [
BcdFileInfo, BcdInfo, BcdInfoRecord, BcdModuleRecord, SrcFileInfo],
SMOps: TYPE USING [MS],
SMSrcBcd: TYPE USING [],
SMTree: TYPE Tree USING [Link, null],
SMTreeOps: TYPE USING [PopTree],
SMTypeCons: TYPE USING [
MkArrow, MkControlType, MkDeclElem, MkDeclReverse, MkInterfaceType],
Space: TYPE USING [
Create, CreateUniformSwapUnits, Delete, Handle, LongPointer,
MakeReadOnly, Map, virtualMemory],
TimeStamp: TYPE USING [Stamp];
-- consider this a part of the SMFIImpl monitor
SMSrcBcdImpl: CEDAR PROGRAM
IMPORTS
Atom, BcdOps, CtoSP1, CtoSParseData, FileIO, IO, Rope, Runtime,
SMEval, SMTreeOps, SMTypeCons, Space
EXPORTS SMSrcBcd ~ {
OPEN Tree~~SMTree;
-- no mds
-- for Mesas
AddCedarInfo: PUBLIC PROC[ms: SMOps.MS, fi: SMFI.SrcFileInfo] ~ {
in: IO.Handle ← 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: PUBLIC PROC[ms: SMOps.MS, fi: SMFI.BcdFileInfo] ~ TRUSTED {
bcdInfo: SMFI.BcdInfo;
LinkList: TYPE ~ LIST OF Tree.Link;
d, r: LinkList ← NIL;
bcdBase: BcdOps.BcdBase ← NIL;
nameString: BcdOps.NameString;
ftb: BcdDefs.Base;
sgb: BcdDefs.Base;
NameToRope: PROC[name: BcdDefs.NameRecord] RETURNS[Rope.Text] ~ TRUSTED {
r: Rope.ROPE ← NIL;
FOR i: CARDINAL IN [0 .. nameString.size[name]) DO
r ← r.Cat[Rope.FromChar[nameString.string.text[name+i]]];
ENDLOOP;
RETURN [r.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]]};
PrefixElem: PROC[id, typeId: Rope.Text, typeStamp: TimeStamp.Stamp, rest: LinkList]
RETURNS[LinkList] ~ CHECKED {
type: ATOM ~ Atom.MakeAtom[typeId];
RETURN [(ms.z).CONS[
SMTypeCons.MkDeclElem[ms.tm, IF id=NIL THEN type ELSE Atom.MakeAtom[id], type],
rest]]};
{
firstMth: BcdOps.MTHandle;
space: Space.Handle;
ForEachModule: PROC[mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
RETURNS[stop: BOOL←FALSE] ~ TRUSTED {
bcdInfo.modules ← CONS[
[moduleName~NameToRope[mth.name],
symbolSpace~[
file~fi.bcdCap,
span~[base~sgb[mth.sseg].base, pages~sgb[mth.sseg].pages]]],
bcdInfo.modules]};
ForEachImport: PROC[ith: BcdOps.IMPHandle, iti: BcdDefs.IMPIndex]
RETURNS[stop: BOOL←FALSE] ~ TRUSTED {
d ← PrefixElem[
id~(IF ith.namedInstance THEN NameeToRope[[import[iti]]] ELSE NIL),
typeId~NameToRope[ith.name], typeStamp~ftb[ith.file].version,
rest~d]};
ForEachExport: PROC[eth: BcdOps.EXPHandle, eti: BcdDefs.EXPIndex]
RETURNS[stop: BOOL←FALSE] ~ TRUSTED {
r ← PrefixElem[
id~(IF eth.namedInstance THEN NameeToRope[[export[eti]]] ELSE NIL),
typeId~NameToRope[ftb[eth.file].name], typeStamp~ftb[eth.file].version,
rest~r]};
IF ~fi.bcdPresent THEN RETURN;
[space, bcdBase] ← LoadUpBcd[fi.bcdCap];
nameString ← LOOPHOLE[bcdBase + bcdBase.ssOffset];
ftb ← LOOPHOLE[bcdBase, BcdDefs.Base] + bcdBase.ftOffset;
firstMth ←
@(LOOPHOLE[bcdBase, BcdDefs.Base] + bcdBase.mtOffset)[BcdDefs.MTIndex.FIRST];
sgb ← LOOPHOLE[bcdBase, BcdDefs.Base] + bcdBase.sgOffset;
bcdInfo ← (ms.z).NEW[SMFI.BcdInfoRecord ← []];
bcdInfo.srcFileName ← NameToRope[bcdBase.source];
bcdInfo.srcCreate ← bcdBase.sourceVersion.time;
[] ← BcdOps.ProcessModules[bcdBase, ForEachModule];
bcdInfo.isDefs ← bcdBase.definitions;
bcdInfo.isConfig ← (bcdBase.nConfigs # 0);
[] ← BcdOps.ProcessImports[bcdBase, ForEachImport];
FOR mod: LIST OF SMFI.BcdModuleRecord ← bcdInfo.modules, mod.rest UNTIL mod = NIL DO
id: ATOM ~ Atom.MakeAtom[mod.first.moduleName];
type: Tree.Link ~ SMTypeCons.MkInterfaceType[ms.tm, id];
r ← CONS[SMTypeCons.MkDeclElem[ms.tm, id, type], r];
IF ~bcdInfo.isDefs THEN {
-- if impl, then exports instances too
idImpl: ATOM ~ Atom.MakeAtom[(mod.first.moduleName).Cat["Impl"]];
r ← CONS[SMTypeCons.MkDeclElem[ms.tm, idImpl, id], r]};
ENDLOOP;
[] ← BcdOps.ProcessExports[bcdBase, ForEachExport];
IF ~bcdInfo.isDefs THEN {
-- implementors export a variable of type CONTROL as well
idType: Tree.Link ~ SMTypeCons.MkControlType[ms.tm];
idImpl: ATOM ~ Atom.MakeAtom[(bcdInfo.modules.first.moduleName).Cat["ImplC"]];
r ← CONS[SMTypeCons.MkDeclElem[ms.tm, idImpl, idType], r]};
fi.bcdInfo ← bcdInfo;
fi.type ← SMEval.Eval[
ms,
SMTypeCons.MkArrow[
tm~ms.tm,
domain~SMTypeCons.MkDeclReverse[ms.tm, d],
range~SMTypeCons.MkDeclReverse[ms.tm, r]],
NIL];
Space.Delete[space]}};
LoadUpBcd: PROC[cap: File.Capability]
RETURNS[space: Space.Handle, bcdBase: BcdOps.BcdBase] ~ TRUSTED {
nPages: CARDINAL;
IF cap = File.nullCapability THEN ERROR;
space ← Space.Create[size~10, parent~Space.virtualMemory];
space.Map[window~[file~cap, base~1]];
bcdBase ← space.LongPointer;
nPages ← bcdBase.nPages;
IF nPages > 10 THEN {
Space.Delete[space];
-- now map in the right number of pages
space ← Space.Create[size~nPages, parent~Space.virtualMemory];
space.Map[window~[file~cap, base~1]];
bcdBase ← space.LongPointer};
Space.CreateUniformSwapUnits[parent~space, size~8];
space.MakeReadOnly};
TRUSTED {CtoSP1.InstallParseTable[Runtime.GetTableBase[LOOPHOLE[CtoSParseData]]]};
}.