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.