
<<SMLoadImpl.mesa>>
<<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
<<last edit by Satterthwaite, May 12, 1986 11:59:30 am PDT>>

DIRECTORY
Atom: TYPE USING [MakeAtom],
BcdDefs: TYPE USING [
Base, BcdBase, EVIndex, EXPHandle, FTHandle, FTSelf, Link,
MTHandle, MTIndex, NullLink, VarLimit],
BcdOps: TYPE USING [ProcessModules],
LoadState: TYPE USING [
BuildProcDescUsingModule, ConfigID, local, ModuleIndex, ModuleToGlobalFrame],
PrincOps: TYPE USING [ControlLink, NullLink],
SMModelBcd: TYPE USING [RopeFromNS],
SMLoad: TYPE USING [InterfaceRecord, IR, LoadInfo],
TimeStamp: TYPE USING [Stamp];

SMLoadImpl: MONITOR
IMPORTS Atom, BcdOps, LoadState, SMModelBcd
EXPORTS SMLoad ~ {

<<no MDS usage>>

RelocateLink: PUBLIC SAFE PROC[loadInfo: SMLoad.LoadInfo, bcdLink: BcdDefs.Link]
RETURNS[link: PrincOps.ControlLink_PrincOps.NullLink] ~ TRUSTED {
<<valid only for a bound link, ie, bcdLink.gfi < bcd.firstdummy>>
IF bcdLink # BcdDefs.NullLink THEN    -- N.B. bcdLink.gfi is 1-origin
SELECT bcdLink.vtag FROM
$var =>
link _ FindVariableLink[loadInfo, bcdLink];
$proc0, $proc1 =>
link _ LoadState.local.BuildProcDescUsingModule[
loadInfo.config, loadInfo.moduleIndex+(bcdLink.gfi-1), bcdLink.ep];
$type => NULL;        -- *** no current checking for exported type clashes ***
ENDCASE => ERROR;
RETURN};


BuildInterface: PUBLIC SAFE PROC[loadInfo: SMLoad.LoadInfo, eth: BcdDefs.EXPHandle]
RETURNS[ir: SMLoad.IR] ~ TRUSTED {
bcd: BcdDefs.BcdBase ~ loadInfo.bcd;
name: ATOM ~ Atom.MakeAtom[SMModelBcd.RopeFromNS[bcd, eth.name]];
fth: BcdDefs.FTHandle ~ @LOOPHOLE[bcd + bcd.ftOffset, BcdDefs.Base][eth.file];
IF eth.size = 0 THEN RETURN[NIL];
ir _ AllocateIR[fth.version, name, eth.size];
FOR i: CARDINAL IN [0 .. eth.size) DO
ir[i] _ [link~RelocateLink[loadInfo, eth.links[i]]];
ENDLOOP;
RETURN};

FindVariableLink: PROC[loadInfo: SMLoad.LoadInfo, bcdLink: BcdDefs.Link--.variable--] 
RETURNS[link: PrincOps.ControlLink] ~ {
bcd: BcdDefs.BcdBase ~ loadInfo.bcd;
evb: BcdDefs.Base ~ LOOPHOLE[bcd + bcd.evOffset, BcdDefs.Base];
module: LoadState.ModuleIndex;
evi: BcdDefs.EVIndex;
ep: CARDINAL;
offset: CARDINAL;

ForEachModule: PROC[mth: BcdDefs.MTHandle, mti: BcdDefs.MTIndex]
RETURNS[BOOL] ~ {
IF bcdLink.vgfi IN [mth.gfi .. mth.gfi+mth.ngfi) THEN {
module _ loadInfo.moduleIndex + (mth.gfi-1);
evi _ mth.variables;
ep _ (bcdLink.vgfi-mth.gfi)*BcdDefs.VarLimit + bcdLink.var;
RETURN[TRUE]};
RETURN[FALSE]};

[] _ BcdOps.ProcessModules[bcd, ForEachModule];
offset _ (IF ep = 0 THEN 0 ELSE evb[evi].offsets[ep]);
RETURN[LOOPHOLE[
LoadState.local.ModuleToGlobalFrame[loadInfo.config, module] + offset]]
};


BuildFramePtrInterface: PUBLIC SAFE PROC[loadInfo: SMLoad.LoadInfo]
RETURNS[ir: SMLoad.IR] ~ TRUSTED {
bcd: BcdDefs.BcdBase ~ loadInfo.bcd;
mtb: BcdDefs.Base ~ LOOPHOLE[bcd+bcd.mtOffset];
mth: BcdDefs.MTHandle ~ @mtb[BcdDefs.MTIndex.FIRST];
name: ATOM ~ Atom.MakeAtom[SMModelBcd.RopeFromNS[bcd, mth.name]];
stamp: TimeStamp.Stamp;
IF bcd.nModules ~= 1 THEN ERROR;
IF mth.file = BcdDefs.FTSelf THEN
stamp _ bcd.version
ELSE {
fth: BcdDefs.FTHandle ~ @LOOPHOLE[bcd+bcd.ftOffset, BcdDefs.Base][mth.file];
stamp _ fth.version};
ir _ AllocateIR[stamp, name, 1];
ir[0] _ [link~LOOPHOLE[
LoadState.local.ModuleToGlobalFrame[loadInfo.config, loadInfo.moduleIndex]]];
RETURN};


AllocateIR: PUBLIC SAFE PROC[stamp: TimeStamp.Stamp, name: ATOM, size: NAT]
RETURNS[ir: SMLoad.IR] ~ CHECKED {
ir _ NEW[SMLoad.InterfaceRecord[size] _ [name~name, stamp~stamp, body~]];
FOR i: NAT IN [0 .. size) DO ir[i] _ [PrincOps.NullLink] ENDLOOP};

FreeIR: PUBLIC SAFE PROC[ir: SMLoad.IR] RETURNS[SMLoad.IR_NIL] ~ CHECKED {
IF ir # NIL THEN {ir.name _ NIL;  FREE[@ir]}};

}.

