
<<MBLoaderExtra.mesa  >>
<<Edited by Sandman on  5-Aug-81 11:56:04>>
<<Edited by Lewis on 25-Sep-81 15:03:08>>
<<Edited by Levin on April 5, 1983 3:04 pm>>

DIRECTORY
BcdDefs USING [
Base, EPIndex, EPLimit, EVIndex, EVNull, EXPIndex, EXPNull, FTIndex, FTSelf, IMPIndex, Link, MTIndex, MTNull, NameRecord, 
PackedString, TMIndex, TMNull, TMRecord, UnboundLink, VarLimit, VersionStamp],
BcdOps USING [
BcdBase, EXPHandle, FTHandle, IMPHandle, MTHandle, NameString, ProcessExports, ProcessImports, ProcessModules, TMHandle],
LongString USING [AppendString, AppendSubString, SubStringDescriptor],
MB USING [BHandle, Error, Handle, MT],
MBLoaderOps USING [
AcquireBcd, BcdExports, BcdExportsTypes, BcdUnresolved, Binding, BindLink, CloseLinkSpace, EnterModule, GetModule, GetVirtualLinks, 
InitBinding, OpenLinkSpace, ReadLink, ReleaseBcd, ReleaseBinding, UpdateLoadState, VirtualLinks, WriteLink],
PilotLoadStateFormat USING [ConfigIndex, ModuleInfo],
PrincOps USING [
ControlLink, GFTIndex, GFTNull, GlobalFrame, GlobalFrameHandle, NullGlobalFrame, NullLink, UnboundLink];

MBLoaderExtra: PROGRAM
IMPORTS BcdOps, MB, MBLoaderOps, String: LongString
EXPORTS MBLoaderOps =

BEGIN

OPEN BcdDefs, BcdOps;

data: MB.Handle _ NIL;

InitLoaderExtra: PUBLIC PROC [h: MB.Handle] = {data _ h};

FinishLoaderExtra: PUBLIC PROC = {data _ NIL};

Bind: PUBLIC PROC [loadee: MB.BHandle, config: PilotLoadStateFormat.ConfigIndex] = {
bcd: BcdOps.BcdBase = loadee.bcd;
system: MB.BHandle _ NIL;
<<bindings for loadee's imports>>
binding: MBLoaderOps.Binding _ DESCRIPTOR[NIL, 0];  
bindingsFound, resolved: BOOL;
CleanUp: PROC = {
IF BASE[binding] # NIL THEN  [] _ MBLoaderOps.ReleaseBinding[bcd, binding];
MBLoaderOps.ReleaseBcd[loadee];
};
BEGIN 
ENABLE UNWIND => CleanUp[];
resolved _ (bcd.nImports = 0);
<<bind (relocate) imports within loadee itself>>
binding _ MBLoaderOps.InitBinding[bcd];
[] _ BindImports[bcd: loadee.bcd, system: loadee.bcd, binding: binding];
resolved _ ProcessLinks[
loadee: loadee, system: loadee, binding: binding, config: config, initLinkSpace: TRUE];
binding _ MBLoaderOps.ReleaseBinding[loadee.bcd, binding];
<<bind into existing system>>
FOR i: CARDINAL DECREASING IN [0..config) DO
<<bind loadee's imports exported by existing Bcd i>>
IF ~resolved AND MBLoaderOps.BcdExports[i] THEN {
ENABLE UNWIND => MBLoaderOps.ReleaseBcd[system];
system _ MBLoaderOps.AcquireBcd[i];
binding _ MBLoaderOps.InitBinding[bcd];
bindingsFound _ BindImports[bcd: loadee.bcd, system: system.bcd, binding: binding];
IF bindingsFound THEN
resolved _ ProcessLinks[
loadee: loadee, system: system, binding: binding, config: i, initLinkSpace: FALSE]
ELSE resolved _ FALSE;
binding _ MBLoaderOps.ReleaseBinding[bcd, binding];
};
<<bind imports of existing Bcd i exported by loadee>>
IF MBLoaderOps.BcdUnresolved[i] AND (bcd.nExports # 0 OR bcd.nModules = 1) THEN {
ENABLE UNWIND => {
IF BASE[binding] # NIL THEN 
binding _ MBLoaderOps.ReleaseBinding[system.bcd, binding];
MBLoaderOps.ReleaseBcd[system];
};
IF system = NIL THEN system _ MBLoaderOps.AcquireBcd[i];
binding _ MBLoaderOps.InitBinding[system.bcd];
bindingsFound _ BindImports[bcd: system.bcd, system: loadee.bcd, binding: binding];
IF bindingsFound THEN 
[] _ ProcessLinks[
loadee: system, system: loadee, binding: binding, config: config, initLinkSpace: FALSE];
binding _ MBLoaderOps.ReleaseBinding[system.bcd, binding];
};
<<check exported types>>
IF bcd.typeExported AND MBLoaderOps.BcdExportsTypes[i] THEN {
ENABLE UNWIND => MBLoaderOps.ReleaseBcd[system];
IF system = NIL THEN system _ MBLoaderOps.AcquireBcd[i];
CheckTypes[bcd, system.bcd];
};
IF system # NIL THEN MBLoaderOps.ReleaseBcd[system];
system _ NIL;
ENDLOOP;
MBLoaderOps.UpdateLoadState[config: config, handle: loadee];
CleanUp[];
END;
};

BindImports: PROC [bcd, system: BcdOps.BcdBase, binding: MBLoaderOps.Binding] 
RETURNS [bindingsFound: BOOL] = {
bcdSsb: BcdOps.NameString = LOOPHOLE[bcd + bcd.ssOffset];
systemSsb: BcdOps.NameString = LOOPHOLE[system + system.ssOffset];
BindOneImport: PROC [ith: IMPHandle, iti: IMPIndex] RETURNS [BOOL] = {
ExpMatch: PROC [eth: EXPHandle, eti: EXPIndex] RETURNS [BOOL] = {
RETURN[
eth.port = ith.port AND 
EqualNames[bcdSsb, systemSsb, ith.name, eth.name] AND
EqualVersions[bcd, system, ith.file, eth.file]]
};
ModuleMatch: PROC [mth: MTHandle, mti: MTIndex] RETURNS [BOOL] = {
RETURN[
EqualNames[bcdSsb, systemSsb, ith.name, mth.name] AND 
EqualVersions[bcd, system, ith.file, mth.file]]
};
IF ith.port = interface THEN {
eti: BcdDefs.EXPIndex = BcdOps.ProcessExports[system, ExpMatch].eti;
FOR i: CARDINAL IN [0..ith.ngfi) DO
IF eti = EXPNull THEN binding[ith.gfi + i] _ [whichgfi: i, body: notbound[]]
ELSE {
bindingsFound _ TRUE; 
binding[ith.gfi + i] _ [whichgfi: i, body: interface[eti: eti]];
};
ENDLOOP;
}
ELSE {
mti: BcdDefs.MTIndex = BcdOps.ProcessModules[system, ModuleMatch].mti;
FOR i: CARDINAL IN [0..ith.ngfi) DO
IF mti = MTNull THEN binding[ith.gfi + i] _ [whichgfi: i, body: notbound[]]
ELSE {
bindingsFound _ TRUE; 
binding[ith.gfi + i] _ [whichgfi: i, body: module[mti: mti]];
};
ENDLOOP;
};
RETURN[FALSE]
};
bindingsFound _ FALSE;
[] _ BcdOps.ProcessImports[bcd, BindOneImport];
};

EqualNames: PROC [ss1, ss2: BcdOps.NameString, n1, n2: BcdDefs.NameRecord]
RETURNS [BOOL] = {
IF ss1.size[n1] # ss2.size[n2] THEN RETURN[FALSE];
FOR i: CARDINAL IN [0..ss1.size[n1]) DO
IF ss1.string.text[n1 + i] # ss2.string.text[n2 + i] THEN RETURN[FALSE];
ENDLOOP;
RETURN[TRUE]
};

EqualVersions: PROC [bcd1, bcd2: BcdOps.BcdBase, fti1, fti2: BcdDefs.FTIndex]
RETURNS [BOOL] = {
v1, v2: LONG POINTER TO BcdDefs.VersionStamp;
f1: FTHandle _ @LOOPHOLE[bcd1 + bcd1.ftOffset, BcdDefs.Base][fti1];
f2: FTHandle _ @LOOPHOLE[bcd2 + bcd2.ftOffset, BcdDefs.Base][fti2];
v1 _ (IF fti1 = BcdDefs.FTSelf THEN @bcd1.version ELSE @f1.version);
v2 _ (IF fti2 = BcdDefs.FTSelf THEN @bcd2.version ELSE @f2.version);
IF v1^ = v2^ THEN RETURN[TRUE];
BadVersion[
ssb: LOOPHOLE[bcd1 + bcd1.ssOffset],
name: (IF fti1 = BcdDefs.FTSelf THEN bcd1.source ELSE f1.name)
];
RETURN[FALSE]
};

BadVersion: PROC [ssb: BcdOps.NameString, name: BcdDefs.NameRecord] = {
msg: STRING _ [80];
filename: String.SubStringDescriptor _ [base: @ssb.string, offset: name, length: ssb.size[name]];
String.AppendSubString[msg, @filename];
String.AppendString[msg, " has incorrect version!"L];
MB.Error[msg];
};

ProcessLinks: PROC [
loadee, system: MB.BHandle, binding: MBLoaderOps.Binding,
config: PilotLoadStateFormat.ConfigIndex, initLinkSpace: BOOL] 
RETURNS [completelyBound: BOOL] = {
bcd: BcdOps.BcdBase = loadee.bcd;
mt: MB.MT = loadee.mt;
smtb: BcdDefs.Base = LOOPHOLE[system.bcd + system.bcd.mtOffset];
setb: BcdDefs.Base = LOOPHOLE[system.bcd + system.bcd.expOffset];
ProcessModulesLinks: PROC [mth: MTHandle, mti: MTIndex] RETURNS [BOOL] = {
gfi: PrincOps.GFTIndex = (mth.gfi + loadee.gfiOffset);  -- biased
frame: PrincOps.GlobalFrameHandle = mt[mth.gfi].frame;
info: PilotLoadStateFormat.ModuleInfo _ MBLoaderOps.GetModule[gfi];
linkBound, linkJustBound, modulesLinksAllBound: BOOL;
old, new: PrincOps.ControlLink;
i: CARDINAL;
virtualLinks: MBLoaderOps.VirtualLinks;
IF frame = PrincOps.NullGlobalFrame OR info.resolved THEN RETURN[FALSE];
MBLoaderOps.OpenLinkSpace[loadee, mth];
virtualLinks _ MBLoaderOps.GetVirtualLinks[loadee, mth];
IF initLinkSpace THEN
FOR i IN [0..LENGTH[virtualLinks]) DO
MBLoaderOps.WriteLink[
offset: i,
link: SELECT virtualLinks[i].vtag FROM
var, type => PrincOps.NullLink, 
ENDCASE => PrincOps.UnboundLink];
ENDLOOP;
modulesLinksAllBound _ TRUE;
FOR i IN [0..LENGTH[virtualLinks]) DO  -- bind each external link
old _ MBLoaderOps.ReadLink[i];
[new: new, linkBound: linkBound, linkJustBound: linkJustBound] _ NewLink[
link: virtualLinks[i], old: old];
IF linkJustBound THEN MBLoaderOps.WriteLink[offset: i, link: new];
modulesLinksAllBound _ (modulesLinksAllBound AND linkBound); 
ENDLOOP;
FOR i IN [gfi..gfi + mth.ngfi) DO
info _ MBLoaderOps.GetModule[i];
info.resolved _ modulesLinksAllBound;
MBLoaderOps.EnterModule[i, info];
ENDLOOP;
completelyBound _ (completelyBound AND modulesLinksAllBound);
MBLoaderOps.CloseLinkSpace[];
RETURN[FALSE]
};
NewLink: PROC [link: BcdDefs.Link, old: PrincOps.ControlLink] 
RETURNS [new: PrincOps.ControlLink, linkBound, linkJustBound: BOOL] = {
ConvertProcOrVarLink: PROC [link: BcdDefs.Link]
RETURNS [new: PrincOps.ControlLink, resolved: BOOL] = {
ep: EPIndex;
insideLoadee: BOOL = (link.gfi < loadee.bcd.firstdummy);
rgfi: PrincOps.GFTIndex _ PrincOps.GFTNull;
new _ PrincOps.UnboundLink;
IF insideLoadee THEN {
new _ ConvertLink[link];
IF link.gfi # PrincOps.GFTNull THEN rgfi _ link.gfi + loadee.gfiOffset;
}
ELSE {
bindLink: MBLoaderOps.BindLink = binding[link.gfi];
WITH b: bindLink SELECT FROM
interface => {
e: EXPHandle = @setb[b.eti];
SELECT e.port FROM
interface => {
ep _ link.ep + (b.whichgfi * BcdDefs.EPLimit);
link _ e.links[ep];  -- matching exported link
IF link.gfi # PrincOps.GFTNull THEN
rgfi _ link.gfi + system.gfiOffset};
ENDCASE;
};
module => {
m: MTHandle = @smtb[b.mti];
link _ [variable[vgfi: m.gfi, var: 0, vtag: var]];
IF link.gfi # PrincOps.GFTNull THEN rgfi _ m.gfi + system.gfiOffset;
};
ENDCASE;
};
SELECT link.vtag FROM
proc0, proc1 => {
new _ ConvertLink[link];  
new.gfi _ rgfi;  -- relocate link's gfi
};
var => new _ FindVariableLink[insideLoadee, link, rgfi];
ENDCASE;
RETURN[new: new, resolved: (rgfi # PrincOps.GFTNull)]
};
FindVariableLink: PROC [
insideLoadee: BOOL, varLink: BcdDefs.Link, rgfi: PrincOps.GFTIndex] 
RETURNS [link: PrincOps.ControlLink] = INLINE {
mth: MTHandle;
frame: PrincOps.GlobalFrameHandle;
gfi: PrincOps.GFTIndex = varLink.vgfi;
evb: BcdDefs.Base;
vp: CARDINAL;
FindModule: PROC [mth: MTHandle, mti: MTIndex] RETURNS [BOOL] = {
mgfi: PrincOps.GFTIndex = mth.gfi;
IF gfi IN [mth.gfi..mgfi + mth.ngfi) THEN
{vp _ BcdDefs.VarLimit*(gfi - mgfi);  RETURN[TRUE]};
RETURN[FALSE]
};
IF rgfi = PrincOps.GFTNull THEN RETURN[PrincOps.NullLink];
mth _ BcdOps.ProcessModules[
(IF insideLoadee THEN loadee.bcd ELSE system.bcd), FindModule].mth;
IF mth = NIL THEN RETURN[PrincOps.NullLink];
IF insideLoadee THEN {
evb _ LOOPHOLE[(loadee.bcd + loadee.bcd.evOffset), BcdDefs.Base];
frame _ loadee.mt[rgfi - loadee.gfiOffset].frame;
}
ELSE {
evb _ LOOPHOLE[(system.bcd + system.bcd.evOffset), BcdDefs.Base];
frame _ system.mt[rgfi - system.gfiOffset].frame;
};
vp _ vp + varLink.var;
IF vp = 0 THEN RETURN[LOOPHOLE[frame]];
IF mth.variables = BcdDefs.EVNull THEN RETURN[PrincOps.NullLink];
RETURN[LOOPHOLE[frame + evb[mth.variables].offsets[vp]]]
};
new _ old;  
linkBound _ linkJustBound _ FALSE;
SELECT link.vtag FROM
proc0, proc1 =>
IF old = PrincOps.UnboundLink THEN { 
[new: new, resolved: linkJustBound] _ ConvertProcOrVarLink[link];
linkBound _ linkJustBound;
}
ELSE linkBound _ TRUE;
var =>
IF old = PrincOps.NullLink THEN {
[new: new, resolved: linkJustBound] _ ConvertProcOrVarLink[link];
linkBound _ linkJustBound;
}
ELSE linkBound _ TRUE;
ENDCASE => --type-- new _ LOOPHOLE[link.typeID];
IF ~linkJustBound THEN new _ old;  -- end of NewLink
};
completelyBound _ TRUE;
[] _ BcdOps.ProcessModules[loadee.bcd, ProcessModulesLinks];
RETURN[completelyBound];  -- all modules completely resolved
};

ConvertLink: PROC [bl: BcdDefs.Link] RETURNS [cl: PrincOps.ControlLink] = {
IF bl = BcdDefs.UnboundLink THEN RETURN[PrincOps.UnboundLink];
SELECT bl.vtag FROM
proc0, proc1 => cl _ [procedure[gfi: bl.gfi, ep: bl.ep, tag: TRUE]];
var => cl _ [procedure[gfi: bl.vgfi, ep: bl.var, tag: FALSE]];
type => cl _ LOOPHOLE[bl.typeID];
ENDCASE;
};

CheckTypes: PROC [bcd1, bcd2: BcdOps.BcdBase] = {
typb1: BcdDefs.Base = LOOPHOLE[bcd1 + bcd1.typOffset];
typb2: BcdDefs.Base = LOOPHOLE[bcd2 + bcd2.typOffset];
TypeMap1: PROC [tmh1: BcdOps.TMHandle, tmi1: BcdDefs.TMIndex] RETURNS [BOOL] = {
TypeMap2: PROC [tmh2: BcdOps.TMHandle, tmi2: BcdDefs.TMIndex] RETURNS [BOOL] = {
IF tmh2.offset = tmh1.offset AND tmh2.version = tmh1.version THEN {
IF typb1[tmh1.map] # typb2[tmh2.map] THEN MB.Error["Exported Type Clash"L];
RETURN[TRUE]
}
ELSE RETURN[FALSE]
};
[] _ EnumerateTypeMap[bcd2, TypeMap2];
RETURN[FALSE]
};
[] _ EnumerateTypeMap[bcd1, TypeMap1];
};

EnumerateTypeMap: PROC [
bcd: BcdOps.BcdBase, proc: PROC [BcdOps.TMHandle, BcdDefs.TMIndex] RETURNS [BOOL]]
RETURNS [tmh: BcdOps.TMHandle, tmi: BcdDefs.TMIndex] = {
tmb: BcdDefs.Base = LOOPHOLE[bcd + bcd.tmOffset];
FOR tmi _ FIRST[BcdDefs.TMIndex], tmi + SIZE[BcdDefs.TMRecord] 
UNTIL tmi = bcd.tmLimit DO
IF proc[(tmh _ @tmb[tmi]), tmi] THEN RETURN; 
ENDLOOP;
RETURN[NIL, BcdDefs.TMNull]
};

END.