-- LoaderCore.mesa Edited by Sandman on October 3, 1980 10:24 AM
-- Copyright Xerox Corporation 1979, 1980
DIRECTORY
BcdDefs USING [
Base, CTIndex, CTNull, EPIndex, EPLimit, EVIndex, EVNull, EXPIndex, EXPNull,
FTIndex, FTSelf, IMPIndex, Link, MTIndex, MTNull, PackedString, TMIndex,
TMNull, TMRecord, UnboundLink, VarLimit, VersionStamp],
BcdOps USING [
BcdBase, CTHandle, EXPHandle, FTHandle, IMPHandle, MTHandle, ProcessConfigs,
ProcessExports, ProcessImports, ProcessModules, TMHandle],
ControlDefs USING [
ControlLink, ControlModule, GFT, GFTIndex, GFTNull, GlobalFrameHandle,
NullControl, NullGlobalFrame, NullLink, UnboundLink],
FrameOps USING [Alloc, MakeFsi],
InlineDefs USING [BITAND],
LoaderOps USING [
AllocateFrames, Binding, BindLink, CloseLinkSpace, DestroyMap, FindCode,
FindFiles, FindFrameIndex, GetGfi, InitBinding, FinalizeUtilities,
InitializeMap, InitializeUtilities, OpenLinkSpace, ReadLink, ReleaseBinding,
ReleaseFrames, WriteLink],
LoadStateFormat USING [ModuleInfo],
LoadStateOps USING [
AcquireBcd, BcdExports, BcdExportsTypes, BcdUnresolved, ConfigIndex,
EnterModule, GetMap, GetModule, InputLoadState, Map, MapConfigToReal,
ReleaseBcd, ReleaseLoadState, ReleaseMap, UpdateLoadState],
StringDefs USING [
AppendSubString, EqualSubStrings, SubStringDescriptor, SubString],
Storage USING [Words, FreeWords];
LoaderCore: PROGRAM
IMPORTS
BcdOps, FrameOps, InlineDefs, LoaderOps, LoadStateOps, StringDefs, Storage
EXPORTS LoaderOps =
BEGIN OPEN BcdDefs, BcdOps;
Binding: TYPE = LoaderOps.Binding;
ConfigIndex: TYPE = LoadStateOps.ConfigIndex;
Map: TYPE = LoadStateOps.Map;
GlobalFrameHandle: TYPE = ControlDefs.GlobalFrameHandle;
ControlModule: TYPE = ControlDefs.ControlModule;
SSD: TYPE = StringDefs.SubStringDescriptor;
VersionMismatch: PUBLIC SIGNAL [name: STRING] = CODE;
New: PUBLIC PROCEDURE [bcd: BcdBase, framelinks, alloc: BOOLEAN]
RETURNS [cm: ControlDefs.ControlModule] =
BEGIN OPEN LoadStateOps, LoaderOps;
system: BcdBase ← NIL;
map: Map ← DESCRIPTOR[NIL, 0];
sMap: Map ← DESCRIPTOR[NIL, 0];
binding: Binding ← DESCRIPTOR[NIL, 0];
frames: POINTER ← NIL;
nbcds, i: CARDINAL;
resolved: BOOLEAN;
CleanUpNew: PROCEDURE =
BEGIN
DestroyMap[map];
[] ← ReleaseBinding[bcd, binding];
LoaderOps.FinalizeUtilities[];
ReleaseBcd[bcd];
ReleaseLoadState[];
RETURN
END;
SetupLoad: PROCEDURE [bcd: BcdBase] RETURNS [map: Map, nbcds: CARDINAL] =
BEGIN OPEN LoaderOps;
InitializeUtilities[bcd];
FindFiles[bcd];
resolved ← bcd.nImports = 0;
map ← InitializeMap[bcd];
nbcds ← InputLoadState[];
RETURN
END;
BEGIN
ENABLE UNWIND => BEGIN ReleaseFrames[bcd, frames, map]; CleanUpNew[]; END;
[map: map, nbcds: nbcds] ← SetupLoad[bcd];
frames ← AllocateFrames[bcd, alloc, framelinks];
cm ← AssignFrameAddresses[frames, bcd, map, nbcds, alloc, framelinks];
binding ← InitBinding[bcd];
BindImports[bcd, bcd, binding];
resolved ← ProcessLinks[bcd, bcd, map, binding, nbcds, TRUE];
binding ← ReleaseBinding[bcd, binding];
FOR i DECREASING IN [0..nbcds) DO
IF ~resolved AND BcdExports[i] THEN
BEGIN
ENABLE UNWIND => ReleaseBcd[system];
system ← AcquireBcd[i];
binding ← InitBinding[bcd];
BindImports[bcd, system, binding];
resolved ← ProcessLinks[bcd, system, map, binding, i, FALSE];
binding ← ReleaseBinding[bcd, binding];
END;
IF BcdUnresolved[i] AND bcd.nExports # 0 THEN
BEGIN
ENABLE UNWIND => BEGIN ReleaseBcd[system]; ReleaseMap[sMap]; END;
IF system = NIL THEN system ← AcquireBcd[i];
sMap ← GetMap[i];
binding ← InitBinding[system];
BindImports[system, bcd, binding];
[] ← ProcessLinks[system, bcd, sMap, binding, nbcds, FALSE];
ReleaseMap[sMap];
sMap ← DESCRIPTOR[NIL, 0];
binding ← ReleaseBinding[system, binding];
END;
IF bcd.typeExported AND BcdExportsTypes[i] THEN
BEGIN
ENABLE UNWIND => ReleaseBcd[system];
IF system = NIL THEN system ← AcquireBcd[i];
CheckTypes[bcd, system];
END;
IF system # NIL THEN ReleaseBcd[system];
system ← NIL;
ENDLOOP;
UpdateLoadState[nbcds, bcd];
IF bcd.nModules = 1 THEN cm ← LOOPHOLE[frames];
CleanUpNew[];
END;
END;
AssignFrameAddresses: PROCEDURE [
p: POINTER, bcd: BcdBase, map: Map, config: ConfigIndex,
alloc, allframelinks: BOOLEAN] RETURNS [ControlDefs.ControlModule] =
BEGIN
frame: GlobalFrameHandle ← p;
single: BOOLEAN ← bcd.nModules = 1;
ModuleSearch: PROCEDURE [mth: MTHandle, mti: MTIndex] RETURNS [BOOLEAN] =
BEGIN
gfi: ControlDefs.GFTIndex;
i: CARDINAL;
framelinks: BOOLEAN;
framelinks ← allframelinks OR mth.links = frame OR ~mth.code.linkspace;
IF ~single AND alloc THEN
BEGIN
p ← NextMultipleOfFour[p + 1];
(p - 1)↑ ← LoaderOps.FindFrameIndex[mth, framelinks];
END;
IF ~single AND framelinks THEN p ← p + mth.frame.length;
frame ← NextMultipleOfFour[p];
p ← frame + mth.framesize;
gfi ← LoaderOps.GetGfi[frame, mth.ngfi];
FOR i IN [0..mth.ngfi) DO
map[mth.gfi + i] ← gfi + i;
LoadStateOps.EnterModule[
gfi + i,
[gfi: mth.gfi + i, config: config, resolved: mth.frame.length = 0]];
ENDLOOP;
frame↑ ←
[gfi: gfi, unused: 0, alloced: alloc OR single, shared: FALSE,
copied: FALSE, started: FALSE, trapxfers: FALSE, codelinks: ~framelinks,
code:, global:];
frame.global[0] ← ControlDefs.NullControl;
RETURN[FALSE];
END;
[] ← BcdOps.ProcessModules[bcd, ModuleSearch];
LoaderOps.FindCode[bcd, map];
RETURN[AssignControlModules[bcd, map]];
END;
NextMultipleOfFour: PROCEDURE [n: POINTER] RETURNS [POINTER] =
BEGIN RETURN[n + InlineDefs.BITAND[-LOOPHOLE[n, INTEGER], 3B]]; END;
BindImports: PROCEDURE [bcd, system: BcdBase, binding: Binding] =
BEGIN
ForEachImport: PROCEDURE [ith: IMPHandle, iti: IMPIndex] RETURNS [BOOLEAN] =
BEGIN
i: CARDINAL;
iname, sysname: SSD;
issb, sysssb: POINTER TO BcdDefs.PackedString;
module: MTIndex;
export: EXPIndex;
ExpMatch: PROCEDURE [eth: EXPHandle, eti: EXPIndex] RETURNS [BOOLEAN] =
BEGIN OPEN StringDefs;
sysname.offset ← eth.name;
sysname.length ← sysssb.size[eth.name];
RETURN[
eth.port = ith.port AND EqualSubStrings[@iname, @sysname] AND
EqualVersions[bcd, system, ith.file, eth.file, @iname]]
END;
ModuleMatch: PROCEDURE [mth: MTHandle, mti: MTIndex] RETURNS [BOOLEAN] =
BEGIN OPEN StringDefs;
sysname.offset ← mth.name;
sysname.length ← sysssb.size[mth.name];
RETURN[
EqualSubStrings[@iname, @sysname] AND EqualVersions[
bcd, system, ith.file, mth.file, @iname]]
END;
issb ← LOOPHOLE[bcd + bcd.ssOffset];
iname ← [base: @issb.string, offset: ith.name, length: issb.size[ith.name]];
sysssb ← LOOPHOLE[system + system.ssOffset];
sysname.base ← @sysssb.string;
IF ith.port = interface THEN
BEGIN
export ← BcdOps.ProcessExports[system, ExpMatch].eti;
FOR i IN [0..ith.ngfi) DO
IF export = EXPNull THEN
binding[ith.gfi + i] ← [whichgfi: i, body: notbound[]]
ELSE binding[ith.gfi + i] ← [whichgfi: i, body: interface[export]];
ENDLOOP
END
ELSE
BEGIN
module ← BcdOps.ProcessModules[system, ModuleMatch].mti;
FOR i IN [0..ith.ngfi) DO
IF module = MTNull THEN
binding[ith.gfi + i] ← [whichgfi: i, body: notbound[]]
ELSE binding[ith.gfi + i] ← [whichgfi: i, body: module[module]];
ENDLOOP;
END;
RETURN[FALSE];
END;
[] ← BcdOps.ProcessImports[bcd, ForEachImport];
END;
EqualVersions: PROCEDURE [
bcd1, bcd2: BcdBase, fti1, fti2: BcdDefs.FTIndex, name: StringDefs.SubString]
RETURNS [BOOLEAN] =
BEGIN
v1, v2: POINTER TO BcdDefs.VersionStamp;
f1: FTHandle ← @LOOPHOLE[bcd1 + bcd1.ftOffset, Base][fti1];
f2: FTHandle ← @LOOPHOLE[bcd2 + bcd2.ftOffset, Base][fti2];
v1 ← IF fti1 = FTSelf THEN @bcd1.version ELSE @f1.version;
v2 ← IF fti2 = FTSelf THEN @bcd2.version ELSE @f2.version;
IF v1↑ = v2↑ THEN RETURN[TRUE];
BadVersion[name];
RETURN[FALSE];
END;
BadVersion: PROCEDURE [name: StringDefs.SubString] =
BEGIN
filename: STRING ← [40];
StringDefs.AppendSubString[filename, name];
SIGNAL VersionMismatch[filename];
END;
ProcessLinks: PROCEDURE [
bcd, system: BcdBase, map: Map, binding: Binding, config: ConfigIndex,
initial: BOOLEAN] RETURNS [BOOLEAN] =
BEGIN OPEN ControlDefs;
smtb: Base = LOOPHOLE[system + system.mtOffset];
setb: Base = LOOPHOLE[system + system.expOffset];
unresolved: BOOLEAN ← FALSE;
NewLink: PROCEDURE [old: ControlLink, link: Link]
RETURNS [new: ControlLink, resolved: BOOLEAN] =
BEGIN
gfi: GFTIndex ← 0;
FindLink: PROCEDURE [link: Link]
RETURNS [new: ControlLink, resolved: BOOLEAN] =
BEGIN
ep: EPIndex;
inside: BOOLEAN;
rgfi: GFTIndex ← GFTNull;
bindLink: LoaderOps.BindLink = binding[link.gfi];
new ← ControlDefs.UnboundLink;
IF (inside ← link.gfi < bcd.firstdummy) THEN
BEGIN new ← ConvertLink[link]; rgfi ← map[link.gfi] END
ELSE
WITH b: bindLink SELECT FROM
interface =>
BEGIN
e: EXPHandle = @setb[b.eti];
SELECT e.port FROM
interface =>
BEGIN
ep ← link.ep + (b.whichgfi*EPLimit);
link ← e.links[ep];
rgfi ← LoadStateOps.MapConfigToReal[link.gfi, config];
END;
ENDCASE;
END;
module =>
BEGIN
m: MTHandle = @smtb[b.mti];
link ← [variable[vgfi: m.gfi, var: 0, vtag: var]];
rgfi ← LoadStateOps.MapConfigToReal[m.gfi, config];
END;
ENDCASE;
SELECT link.vtag FROM
var => new ← FindVariableLink[inside, link, rgfi];
proc0, proc1 => BEGIN new ← ConvertLink[link]; new.gfi ← rgfi END;
ENDCASE;
RETURN[new: new, resolved: rgfi # GFTNull]
END;
FindVariableLink: PROCEDURE [inside: BOOLEAN, el: Link, rgfi: GFTIndex]
RETURNS [link: ControlLink] =
BEGIN
ep: CARDINAL;
evi: EVIndex;
evb: Base;
gfi: GFTIndex ← el.vgfi;
mth: MTHandle;
frame: GlobalFrameHandle;
FindModule: PROCEDURE [mth: MTHandle, mti: MTIndex] RETURNS [BOOLEAN] =
BEGIN
mgfi: GFTIndex ← mth.gfi;
IF gfi IN [mth.gfi..mgfi + mth.ngfi) THEN
BEGIN ep ← VarLimit*(gfi - mgfi); RETURN[TRUE] END;
RETURN[FALSE]
END;
mth ← BcdOps.ProcessModules[
IF inside THEN bcd ELSE system, FindModule].mth;
IF mth = NIL THEN RETURN[ControlDefs.NullLink];
evb ←
IF ~inside THEN LOOPHOLE[system + system.evOffset, Base]
ELSE LOOPHOLE[bcd + bcd.evOffset, Base];
frame ← ControlDefs.GFT[rgfi].frame;
IF (ep ← ep + el.var) = 0 THEN RETURN[LOOPHOLE[frame]];
IF (evi ← mth.variables) = EVNull THEN RETURN[ControlDefs.NullLink];
RETURN[LOOPHOLE[frame + evb[evi].offsets[ep]]];
END;
new ← old;
resolved ← TRUE;
SELECT link.vtag FROM
proc0, proc1 =>
IF old = ControlDefs.UnboundLink THEN
[new: new, resolved: resolved] ← FindLink[link];
var =>
IF old = ControlDefs.NullLink THEN
[new: new, resolved: resolved] ← FindLink[link];
ENDCASE => new ← LOOPHOLE[link.typeID];
RETURN
END;
ModuleSearch: PROCEDURE [mth: MTHandle, mti: MTIndex] RETURNS [BOOLEAN] =
BEGIN OPEN ControlDefs;
i: CARDINAL;
gfi: GFTIndex = map[mth.gfi];
frame: GlobalFrameHandle ← GFT[gfi].frame;
resolved, bound: BOOLEAN;
old, new: ControlLink;
info: LoadStateFormat.ModuleInfo ← LoadStateOps.GetModule[gfi];
IF frame = ControlDefs.NullGlobalFrame OR info.resolved THEN RETURN[FALSE];
LoaderOps.OpenLinkSpace[frame, mth];
IF initial THEN
FOR i IN [0..mth.frame.length) DO
LoaderOps.WriteLink[
offset: i,
link:
SELECT mth.frame.frag[i].vtag FROM
var, type => NullLink,
ENDCASE => UnboundLink];
ENDLOOP;
resolved ← TRUE;
FOR i IN [0..mth.frame.length) DO
old ← LoaderOps.ReadLink[i];
[new: new, resolved: bound] ← NewLink[link: mth.frame.frag[i], old: old];
IF bound THEN LoaderOps.WriteLink[offset: i, link: new]
ELSE resolved ← FALSE;
ENDLOOP;
FOR i IN [gfi..gfi + mth.ngfi) DO
info ← LoadStateOps.GetModule[i];
info.resolved ← resolved;
LoadStateOps.EnterModule[i, info];
ENDLOOP;
LoaderOps.CloseLinkSpace[frame];
RETURN[FALSE];
END;
[] ← BcdOps.ProcessModules[bcd, ModuleSearch];
RETURN[unresolved];
END;
ConvertLink: PROCEDURE [bl: Link] RETURNS [cl: ControlDefs.ControlLink] =
BEGIN
IF bl = UnboundLink THEN RETURN[ControlDefs.UnboundLink];
SELECT bl.vtag FROM
var => cl ← [procedure[gfi: bl.vgfi, ep: bl.var, tag: frame]];
proc0, proc1 => cl ← [procedure[gfi: bl.gfi, ep: bl.ep, tag: procedure]];
type => cl ← LOOPHOLE[bl.typeID];
ENDCASE;
RETURN
END;
ProcessTypeMap: PROCEDURE [
bcd: BcdBase, proc: PROC [TMHandle, TMIndex] RETURNS [BOOLEAN]]
RETURNS [tmh: TMHandle, tmi: TMIndex] =
BEGIN
tmb: Base = LOOPHOLE[bcd + bcd.tmOffset];
FOR tmi ← FIRST[TMIndex], tmi + SIZE[TMRecord] UNTIL tmi = bcd.tmLimit DO
IF proc[tmh ← @tmb[tmi], tmi] THEN RETURN; ENDLOOP;
RETURN[NIL, TMNull];
END;
CheckTypes: PROCEDURE [bcd1, bcd2: BcdBase] =
BEGIN
typeError: STRING = "Exported Type Clash"L;
typb1: Base = LOOPHOLE[bcd1 + bcd1.typOffset];
typb2: Base = LOOPHOLE[bcd2 + bcd2.typOffset];
TypeMap1: PROCEDURE [tmh1: TMHandle, tmi1: TMIndex] RETURNS [BOOLEAN] =
BEGIN
TypeMap2: PROCEDURE [tmh2: TMHandle, tmi2: TMIndex] RETURNS [BOOLEAN] =
BEGIN
IF tmh2.offset = tmh1.offset AND tmh2.version = tmh1.version THEN
BEGIN
IF typb1[tmh1.map] # typb2[tmh2.map] THEN
ERROR VersionMismatch[typeError];
RETURN[TRUE];
END
ELSE RETURN[FALSE];
END;
[] ← ProcessTypeMap[bcd2, TypeMap2];
RETURN[FALSE];
END;
[] ← ProcessTypeMap[bcd1, TypeMap1];
RETURN
END;
CMMapItem: TYPE = RECORD [cti: CTIndex, level: CARDINAL, cm: ControlDefs.ControlModule];
AssignControlModules: PROCEDURE [bcd: BcdBase, map: Map]
RETURNS [cm: ControlDefs.ControlModule] =
BEGIN OPEN ControlDefs;
ctb: Base ← LOOPHOLE[bcd + bcd.ctOffset];
mtb: Base ← LOOPHOLE[bcd + bcd.mtOffset];
cti: CTIndex;
mapIndex, maxLevel: CARDINAL ← 0;
i: CARDINAL;
cmMap: POINTER TO ARRAY [0..0) OF CMMapItem;
MapControls: PROCEDURE [cth: CTHandle, cti: CTIndex] RETURNS [BOOLEAN] =
BEGIN OPEN ControlDefs;
cm: ControlModule;
level: CARDINAL ← 0;
c: CTIndex;
IF cth.nControls = 0 THEN cm ← NullControl
ELSE {
i: CARDINAL;
cm.list ← FrameOps.Alloc[
FrameOps.MakeFsi[cth.nControls + SIZE[CARDINAL] + SIZE[ControlModule]]];
cm.list.nModules ← cth.nControls + 1;
FOR i IN [0..cth.nControls) DO
cm.list.frames[i+1] ← GFT[map[mtb[cth.controls[i]].gfi]].frame; ENDLOOP;
cm.multiple ← TRUE};
FOR c ← ctb[cti].config, ctb[c].config UNTIL c = CTNull DO
level ← level + 1; ENDLOOP;
cmMap[mapIndex] ← [cti: cti, cm: cm, level: level];
mapIndex ← mapIndex + 1;
maxLevel ← MAX[maxLevel, level];
RETURN[FALSE];
END;
GetControl: PROCEDURE [mth: MTHandle, mti: MTIndex] RETURNS [BOOLEAN] =
BEGIN OPEN ControlDefs;
frame: GlobalFrameHandle ← GFT[map[mth.gfi]].frame;
IF mth.config # cti THEN RETURN[FALSE];
IF frame.global[0] = NullControl THEN frame.global[0] ← GetModule[cm];
RETURN[FALSE];
END;
IF bcd.nModules = 1 THEN
BEGIN
frame: GlobalFrameHandle ← GFT[map[1]].frame;
frame.global[0] ← NullControl;
RETURN[[frame[frame]]];
END;
cmMap ← Storage.Words[bcd.nConfigs*SIZE[CMMapItem]];
[] ← BcdOps.ProcessConfigs[bcd, MapControls];
FOR level: CARDINAL DECREASING IN [0..maxLevel] DO
FOR index: CARDINAL IN [0..mapIndex) DO
list: ControlModule;
IF cmMap[index].level # level OR (cm ← cmMap[index].cm) = NullControl THEN LOOP;
list ← cm;
list.multiple ← FALSE;
list.list.frames[1] ← SetLink[cm, list.list.frames[1]].frame;
FOR i: CARDINAL IN [2..list.list.nModules) DO
list.list.frames[i] ←
SetLink[GetModule[[frame[list.list.frames[1]]]], list.list.frames[i]].frame;
ENDLOOP;
cti ← cmMap[index].cti;
[] ← BcdOps.ProcessModules[bcd, GetControl];
ENDLOOP;
ENDLOOP;
FOR index: CARDINAL IN [0..mapIndex) DO
parent: CARDINAL;
list: ControlModule;
IF (list ← cmMap[index].cm) = NullControl THEN LOOP;
list.multiple ← FALSE;
IF (cti ← ctb[cmMap[index].cti].config) = CTNull THEN cm ← NullControl
ELSE {
FOR parent IN [0..mapIndex) DO IF cmMap[parent].cti = cti THEN EXIT; ENDLOOP;
cm ← GetModule[cmMap[parent].cm]};
list.list.frames[0] ← cm.frame;
ENDLOOP;
FOR i IN [0..mapIndex) DO
IF ctb[cmMap[i].cti].config = CTNull THEN {
cm ← GetModule[cmMap[i].cm]; EXIT};
ENDLOOP;
Storage.FreeWords[cmMap];
END;
SetLink: PROCEDURE [
cm: ControlModule, frame: GlobalFrameHandle] RETURNS [ControlModule] = {
t: ControlModule = frame.global[0];
frame.global[0] ← cm;
RETURN[IF t = ControlDefs.NullControl THEN [frame[frame]] ELSE t]};
GetModule: PROCEDURE [cm: ControlModule] RETURNS [ControlModule] = {
list: ControlModule;
DO
IF ~cm.multiple THEN RETURN[cm];
list ← cm;
list.multiple ← FALSE;
cm.frame ← list.list.frames[1];
ENDLOOP};
END...