
<<SMBindImpl.mesa>>
<<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
<<last edit by Satterthwaite, May 12, 1986 12:00:27 pm PDT>>

DIRECTORY
Atom: TYPE USING [MakeAtom],
BcdDefs: TYPE USING [
Base, BcdBase, EXPHandle, FTHandle, FTSelf, Link,
ModuleIndex, MTHandle, MTIndex, NullLink, ProcLimit],
SMBind: TYPE USING [InterfaceRecord, IR, IRIndex, BindInfo, RIR, VIR],
SMModelBcd: TYPE USING [RopeFromNS],
TimeStamp: TYPE USING [Stamp];

SMBindImpl: MONITOR
IMPORTS Atom, SMModelBcd
EXPORTS SMBind ~ {

<<no MDS usage>>

RelocateLink: PUBLIC SAFE PROC[bindInfo: SMBind.BindInfo, bcdLink: BcdDefs.Link]
RETURNS[link: BcdDefs.Link_BcdDefs.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 _
[variable[vtag~var, vgfi~bindInfo.moduleIndex+(bcdLink.vgfi-1), var~bcdLink.var]];
$proc0, $proc1 =>
link _
[procedure[tag~TRUE, gfi~bindInfo.moduleIndex+(bcdLink.gfi-1), ep~bcdLink.ep]];
$type => NULL;        -- *** no current checking for exported type clashes ***
ENDCASE => ERROR;
RETURN};

ImportLink: PUBLIC SAFE PROC[gfi: BcdDefs.ModuleIndex, ep: SMBind.IRIndex]
RETURNS[BcdDefs.Link] ~ TRUSTED {
RETURN[
[procedure[tag~TRUE, gfi~gfi+(ep/BcdDefs.ProcLimit), ep~(ep MOD BcdDefs.ProcLimit)]]]
};


BuildInterface: PUBLIC SAFE PROC[bindInfo: SMBind.BindInfo, eth: BcdDefs.EXPHandle]
RETURNS[ir: SMBind.RIR] ~ TRUSTED {
bcd: BcdDefs.BcdBase ~ bindInfo.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[bindInfo, eth.links[i]]];
ENDLOOP;
RETURN};


BuildFramePtrInterface: PUBLIC SAFE PROC[bindInfo: SMBind.BindInfo]
RETURNS[ir: SMBind.RIR] ~ TRUSTED {
bcd: BcdDefs.BcdBase ~ bindInfo.bcd;
mth: BcdDefs.MTHandle;
name: ATOM;
stamp: TimeStamp.Stamp;
IF bcd.nModules ~= 1 THEN ERROR;
mth _ @LOOPHOLE[bcd+bcd.mtOffset, BcdDefs.Base][BcdDefs.MTIndex.FIRST];
name _ Atom.MakeAtom[SMModelBcd.RopeFromNS[bcd, mth.name]];
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~[variable[vtag~var, vgfi~bindInfo.moduleIndex, var~0]]];
RETURN};


AllocateIR: PUBLIC SAFE PROC[stamp: TimeStamp.Stamp, name: ATOM, size: NAT]
RETURNS[ir: SMBind.RIR] ~ CHECKED {
ir _ NEW[SMBind.InterfaceRecord.real[size] _
[name~name, stamp~stamp, variants~real[TRASH]]];
FOR i: NAT IN [0 .. size) DO ir[i] _ [BcdDefs.NullLink] ENDLOOP};

AllocateVIR: PUBLIC SAFE PROC[stamp: TimeStamp.Stamp, name: ATOM]
RETURNS[SMBind.VIR] ~ CHECKED {
RETURN[
NEW[SMBind.InterfaceRecord.virtual _
[name~name, stamp~stamp, variants~virtual[index~TRASH]]]]
};

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

}.