-- BcdBind.mesa
-- Last edited by Satterthwaite on September 15, 1982 3:38 pm
-- Last edited by Lewis on 16-Dec-80 10:12:01
DIRECTORY
Alloc: TYPE USING [AddNotify, Bounds, DropNotify, Handle, Notifier, Top],
BcdBindDefs: TYPE USING [RelocHandle],
BcdComData: TYPE USING [currentName, table, textIndex, zone],
BcdControlDefs: TYPE USING [],
BcdDefs: TYPE USING [
CTIndex, cttype, cxtype, EPLimit, EXPIndex, EXPNull, exptype,
FTIndex, FTNull, fttype, GFTIndex, IMPIndex, IMPNull, IMPRecord, imptype,
LFIndex, LFNull, lftype, Link, MTIndex, MTRecord, mttype,
NameRecord, NullLink, NullName, sstype, sttype, treetype, UnboundLink],
BcdErrorDefs: TYPE USING [
ErrorHti, ErrorInterface, ErrorSti, Error2Files, GetModule, GetSti],
BcdOps: TYPE USING [NameString],
BcdUtilDefs: TYPE USING [
EqVersions, GetDummyGfi, GetGfi, InstanceName, NameForSti],
Strings: TYPE USING [SubStringDescriptor],
Symbols: TYPE USING [CXIndex, CXNull, HTIndex, STIndex, STNull, STRecord],
SymbolOps: TYPE USING [FindString],
Table: TYPE USING [Base],
Tree: TYPE USING [Scan, Null],
TreeOps: TYPE USING [ScanList];
BcdBind: PROGRAM
IMPORTS
Alloc, BcdErrorDefs, BcdUtilDefs, SymbolOps, TreeOps,
data: BcdComData
EXPORTS BcdControlDefs = {
OPEN BcdDefs, Symbols;
BindError: PUBLIC ERROR = CODE;
table: Alloc.Handle;
tb, stb, ctb, cxb, mtb, lfb, etb, itb, ftb: Table.Base;
ssb: BcdOps.NameString;
Notifier: Alloc.Notifier = {
tb ← base[treetype]; stb ← base[sttype]; cxb ← base[cxtype];
ctb ← base[cttype]; mtb ← base[mttype]; lfb ← base[lftype];
etb ← base[exptype]; itb ← base[imptype];
ftb ← base[fttype];
ssb ← base[sstype]};
Error: PROC = {ERROR BindError};
ItiToIndex: PROC [impi: IMPIndex] RETURNS [CARDINAL] = INLINE {
RETURN [LOOPHOLE[impi, CARDINAL]/IMPRecord.SIZE]};
relocationHead: BcdBindDefs.RelocHandle;
rel: BcdBindDefs.RelocHandle;
BindRoot: PUBLIC PROC [relocationRoot: BcdBindDefs.RelocHandle] = {
table ← data.table; table.AddNotify[Notifier];
relocationHead ← relocationRoot;
SetupGFMap[];
AssignImports[
! BcdErrorDefs.GetSti => {
IF rel # NIL THEN
RESUME [StiForContext[
IF rel.type = $inner THEN rel.parentcx ELSE rel.context]]}];
BindModules[];
ReleaseGFMap[];
table.DropNotify[Notifier]; table ← NIL};
LinkType: TYPE = RECORD [
SELECT tag:* FROM
gfi => [gfi: GFTIndex],
import => [impi: IMPIndex],
ENDCASE];
GFMapItem: TYPE = RECORD [
linkItem: LinkType,
expi: EXPIndex,
offset: [0..4)];
GFMap: TYPE = RECORD [SEQUENCE length: CARDINAL OF GFMapItem];
RelMap: TYPE = RECORD [SEQUENCE length: CARDINAL OF CARDINAL];
finalFirstDummy: GFTIndex;
gfMap: LONG POINTER TO GFMap ← NIL;
relMap: LONG POINTER TO RelMap ← NIL;
SetupGFMap: PROC = {
nDummies: CARDINAL ← BcdUtilDefs.GetDummyGfi[0]-1;
nImports: CARDINAL = table.Bounds[imptype].size/IMPRecord.SIZE;
finalFirstDummy ← BcdUtilDefs.GetGfi[0];
IF nDummies # 0 THEN nDummies ← nDummies + 1;
gfMap ← (data.zone).NEW[GFMap[nDummies]];
FOR i: CARDINAL IN [0..nDummies) DO gfMap[i] ← [[gfi[0]], EXPNull, 0] ENDLOOP;
relMap ← (data.zone).NEW[RelMap[nImports]];
FOR rel: BcdBindDefs.RelocHandle ← relocationHead, rel.link UNTIL rel = NIL DO
FOR iti: IMPIndex ← IMPIndex.FIRST+rel.import, iti+IMPRecord.SIZE
UNTIL iti = rel.importLimit DO
relMap[ItiToIndex[iti]] ← itb[iti].gfi + rel.dummygfi-rel.originalfirstdummy;
ENDLOOP;
ENDLOOP};
RelocatedGfi: PROC [iti: IMPIndex] RETURNS [CARDINAL] = {
RETURN [IF iti = IMPNull THEN 0 ELSE relMap[ItiToIndex[iti]]]};
ReleaseGFMap: PROC = {
IF gfMap # NIL THEN (data.zone).FREE[@gfMap];
IF relMap # NIL THEN (data.zone).FREE[@relMap]};
NameToHti: PROC [name: NameRecord] RETURNS [hti: HTIndex] = {
found: BOOL;
ss: Strings.SubStringDescriptor ← [base: @ssb.string, offset: name, length: ssb.size[name]];
[found, hti] ← SymbolOps.FindString[@ss];
IF ~found THEN Error[]};
ExpiForSti: PROC [sti: STIndex] RETURNS [EXPIndex] = {
RETURN [IF sti = STNull
THEN EXPNull
ELSE
WITH s:stb[sti] SELECT FROM
external => WITH m:s.map SELECT FROM interface => m.expi, ENDCASE => EXPNull,
ENDCASE => EXPNull]};
AssignImports: PROC = {
saveIndex: CARDINAL = data.textIndex;
saveName: NameRecord = data.currentName;
FOR rel ← relocationHead, rel.link UNTIL rel = NIL DO
data.textIndex ← rel.textIndex;
data.currentName ← BcdUtilDefs.NameForSti[StiForContext[rel.context]];
SELECT TRUE FROM
(rel.type = $outer) => AssignOuter[rel];
(rel.parameters # Tree.Null) => AssignByPosition[rel];
ENDCASE => AssignByName[rel];
ENDLOOP;
data.textIndex ← saveIndex; data.currentName ← saveName};
AssignOuter: PROC [rel: BcdBindDefs.RelocHandle] = {
FOR iti: IMPIndex ← IMPIndex.FIRST+rel.import, iti+IMPRecord.SIZE
UNTIL iti = rel.importLimit DO
sti: STIndex = LookupInstance[iti, rel.context];
IF sti = STNull THEN LOOP;
IF stb[sti].impi # IMPNull
THEN {
OPEN imp: itb[stb[sti].impi];
stb[sti].impgfi ← imp.gfi ← BcdUtilDefs.GetGfi[imp.ngfi]}
ELSE BcdErrorDefs.ErrorSti[error, "is not imported by any module"L, sti];
ENDLOOP};
AssignByName: PROC [rel: BcdBindDefs.RelocHandle] = {
iti, import: IMPIndex;
export: EXPIndex;
defgfi: CARDINAL;
sti, parentSti: STIndex;
FOR iti ← IMPIndex.FIRST+rel.import, iti+IMPRecord.SIZE UNTIL iti = rel.importLimit DO
sti ← IF rel.type = $inner
THEN LookupInstance[iti, rel.context]
ELSE LookupInterface[iti, rel.context];
IF sti = STNull THEN LOOP;
defgfi ← stb[sti].impgfi;
IF stb[sti].impi # IMPNull
THEN
SELECT rel.type FROM
$inner => {
IF (parentSti ← LookupInterface[iti, rel.parentcx]) = STNull
THEN LOOP;
import ← stb[parentSti].impi; export ← ExpiForSti[parentSti];
defgfi ← stb[parentSti].impgfi;
sti ← parentSti};
ENDCASE => {import ← stb[sti].impi; export ← ExpiForSti[sti]}
ELSE {import ← IMPNull; export ← ExpiForSti[sti]};
WITH s: stb[sti] SELECT FROM
external =>
WITH m:s.map SELECT FROM
module => AssignModule[defgfi, m.mti, iti];
interface => AssignInterface[defgfi, import, export, iti];
unknown => AssignImport[defgfi, import, iti];
ENDCASE => Error[];
unknown => AssignImport[defgfi, import, iti];
ENDCASE => Error[];
ENDLOOP};
LookupInstance: PROC [iti: IMPIndex, cxi: CXIndex] RETURNS [STIndex] = {
RETURN [IF cxi = CXNull
THEN STNull
ELSE Lookup[
hti: NameToHti[IF itb[iti].namedInstance
THEN BcdUtilDefs.InstanceName[[import[iti]]]
ELSE itb[iti].name],
cxi: rel.context]]};
LookupInterface: PROC [iti: IMPIndex, cxi: CXIndex] RETURNS [STIndex] = {
RETURN [IF cxi = CXNull THEN STNull ELSE Lookup[NameToHti[itb[iti].name], cxi]]};
AssignByPosition: PROC [rel: BcdBindDefs.RelocHandle] = {
iti: IMPIndex;
TooManyParameters: ERROR = CODE;
AssignPosition: Tree.Scan = {
sti: STIndex = WITH t SELECT FROM symbol => index, ENDCASE => ERROR;
import: IMPIndex = stb[sti].impi;
export: EXPIndex = ExpiForSti[sti];
defgfi: CARDINAL = stb[sti].impgfi;
IF iti = rel.importLimit THEN ERROR TooManyParameters;
WITH s: stb[sti] SELECT FROM
external =>
WITH m:s.map SELECT FROM
module => AssignModule[defgfi, m.mti, iti];
interface => AssignInterface[defgfi, import, export, iti];
unknown => AssignImport[defgfi, import, iti];
ENDCASE => Error[];
ENDCASE => BcdErrorDefs.ErrorSti[error, "is undeclared"L, sti];
iti ← iti + BcdDefs.IMPRecord.SIZE};
iti ← IMPIndex.FIRST + rel.import;
TreeOps.ScanList[rel.parameters, AssignPosition
! TooManyParameters => {GOTO tooMany}];
IF iti # rel.importLimit THEN GOTO tooFew;
EXITS
tooMany => BcdErrorDefs.ErrorHti[error,
"has too many parameters"L, HtiForRelocation[rel]];
tooFew => BcdErrorDefs.ErrorHti[error,
"has too few parameters"L, HtiForRelocation[rel]]};
MakeLink: PROC [defgfi: CARDINAL, import: IMPIndex, offset: CARDINAL]
RETURNS [LinkType] = {
RETURN [SELECT TRUE FROM
(defgfi # 0) => [gfi[defgfi+offset]],
(import = IMPNull) => [gfi[0]],
ENDCASE => [import[import]]]};
AssignModule: PROC [defgfi: GFTIndex, mti: MTIndex, iti: IMPIndex] = {
OPEN imp: itb[iti];
gfi: CARDINAL = RelocatedGfi[iti];
IF imp.port # $module OR ~BcdUtilDefs.EqVersions[imp.file, mtb[mti].file]
THEN
BcdErrorDefs.Error2Files[
class: error,
s: "is required for import, but available version is"L,
ft1: imp.file, ft2: mtb[mti].file];
gfMap[gfi] ← [
linkItem: [gfi[IF defgfi # 0 THEN defgfi ELSE mtb[mti].gfi]],
expi: EXPNull, offset: 0]};
AssignInterface: PROC [defgfi: GFTIndex, import: IMPIndex, expi: EXPIndex, iti: IMPIndex] = {
OPEN exp: etb[expi], imp: itb[iti];
gfi: CARDINAL = RelocatedGfi[iti];
IF expi # EXPNull AND
(imp.port # exp.port OR ~BcdUtilDefs.EqVersions[imp.file, exp.file]) THEN
BcdErrorDefs.Error2Files[
class: error,
s: "is required for import, but available version is"L,
ft1: imp.file, ft2: exp.file];
IF imp.port = $module THEN
gfMap[gfi] ← [
linkItem: [gfi[etb[expi].links[0].gfi]],
expi: EXPNull, offset: 0]
ELSE FOR i: [0..4) IN [0..imp.ngfi) DO
gfMap[gfi+i] ← [
linkItem: MakeLink[defgfi, import, i],
expi: expi, offset: i];
ENDLOOP};
AssignImport: PROC [defgfi: GFTIndex, import: IMPIndex, iti: IMPIndex] = {
OPEN imp: itb[iti];
gfi: CARDINAL = RelocatedGfi[iti];
IF import # IMPNull AND
(imp.port # itb[import].port OR
~BcdUtilDefs.EqVersions[imp.file, itb[import].file]) THEN
BcdErrorDefs.Error2Files[
class: error,
s: "is required for import, but available version is"L,
ft1: imp.file, ft2: itb[import].file];
FOR i: [0..4) IN [0..imp.ngfi) DO
gfMap[gfi+i] ← [
linkItem: MakeLink[defgfi, import, i],
expi: EXPNull, offset: i];
ENDLOOP};
Lookup: PROC [hti: HTIndex, cxi: CXIndex] RETURNS [sti: STIndex] = {
FOR sti ← cxb[cxi].link, stb[sti].link UNTIL sti = STNull DO
IF stb[sti].hti = hti THEN RETURN ENDLOOP;
RETURN [STNull]};
StiForContext: PROC [cxi: CXIndex] RETURNS [sti: STIndex] = {
stLimit: STIndex = table.Top[sttype];
FOR sti ← STIndex.FIRST, sti+STRecord.SIZE UNTIL sti = stLimit DO
WITH s:stb[sti] SELECT FROM
local => IF s.context = cxi THEN RETURN;
ENDCASE;
ENDLOOP;
RETURN [STNull]};
HtiForRelocation: PROC [rel: BcdBindDefs.RelocHandle] RETURNS [HTIndex] = {
sti: STIndex;
mti: MTIndex;
cti: CTIndex;
IF rel.type # $file THEN {
sti ← StiForContext[rel.context]; RETURN [stb[sti].hti]};
mti ← MTIndex.FIRST + rel.module; cti ← CTIndex.FIRST + rel.config;
RETURN [NameToHti[IF mtb[mti].config = cti THEN ctb[cti].name ELSE mtb[mti].name]]};
BindModules: PROC = {
saveIndex: CARDINAL = data.textIndex;
saveName: NameRecord = data.currentName;
mtLimit: MTIndex = table.Top[mttype];
rel ← relocationHead;
FOR mti: MTIndex ← MTIndex.FIRST,
mti + (WITH m: mtb[mti] SELECT FROM
direct => MTRecord.direct.SIZE + m.length*Link.SIZE,
indirect => MTRecord.indirect.SIZE,
multiple => MTRecord.multiple.SIZE,
ENDCASE => ERROR)
UNTIL mti = mtLimit DO
SetRelocationForModule[mti];
WITH m: mtb[mti] SELECT FROM
direct =>
FOR i: CARDINAL IN [0 .. m.length) DO
m.frag[i] ← RelocateLink[m.frag[i]
! BcdErrorDefs.GetModule => {RESUME [mti, i]}];
ENDLOOP;
indirect => BindFragment[mti, m.links];
multiple => BindFragment[mti, m.links];
ENDCASE => ERROR;
ENDLOOP;
data.textIndex ← saveIndex; data.currentName ← saveName};
SetRelocationForModule: PROC [mti: MTIndex] = {
gfi: GFTIndex = mtb[mti].gfi;
FOR rel ← rel, rel.link UNTIL rel = NIL DO
IF gfi IN [rel.firstgfi..rel.lastgfi] THEN GOTO found ENDLOOP;
FOR rel ← relocationHead, rel.link UNTIL rel = NIL DO
IF gfi IN [rel.firstgfi..rel.lastgfi] THEN GOTO found ENDLOOP;
Error[];
EXITS found => {
data.textIndex ← rel.textIndex;
data.currentName ← BcdUtilDefs.NameForSti[StiForContext[rel.context]]}};
BindFragment: PROC [mti: MTIndex, lfi: LFIndex] = {
IF lfi # LFNull THEN
FOR i: CARDINAL IN [0 .. lfb[lfi].length) DO
lfb[lfi].frag[i] ← RelocateLink[lfb[lfi].frag[i]
! BcdErrorDefs.GetModule => {RESUME [mti, i]}];
ENDLOOP};
RelocateLink: PROC [cl: BcdDefs.Link] RETURNS [BcdDefs.Link] = {
SELECT TRUE FROM
cl.vtag = type => ERROR;
(cl.gfi = 0) => NULL;
(cl.gfi < rel.originalfirstdummy) => cl.gfi ← cl.gfi + rel.firstgfi-1;
ENDCASE => {
gfi: CARDINAL;
expi: EXPIndex;
map: LONG POINTER TO GFMapItem;
gfi ← cl.gfi + rel.dummygfi-rel.originalfirstdummy;
DO
map ← @gfMap[gfi];
IF (expi←map.expi) # EXPNull THEN {
newCl: BcdDefs.Link = etb[expi].links[cl.ep + map.offset*EPLimit];
IF newCl # NullLink THEN RETURN [newCl]};
WITH map.linkItem SELECT FROM
m: LinkType[gfi] => {
IF (gfi←m.gfi) = 0 THEN GOTO unbindable;
IF gfi < finalFirstDummy AND cl.ep = 0 THEN
cl ← [variable[vgfi:0, var:0, vtag:var]];
EXIT};
m: LinkType[import] => gfi ← RelocatedGfi[m.impi]+map.offset;
ENDCASE;
REPEAT
unbindable => {
importName: NameRecord;
offset: CARDINAL;
importFti: FTIndex;
[importName, offset, importFti] ← LookupImport[cl.gfi];
BcdErrorDefs.ErrorInterface[
class: warning, s: "is unbindable"L,
import: [name: importName, fti: importFti], ep: (cl.ep + offset)];
RETURN [IF cl.vtag = var THEN NullLink ELSE UnboundLink]};
ENDLOOP;
cl.gfi ← gfi};
RETURN [cl]};
LookupImport: PROC [gfi: GFTIndex]
RETURNS [importName: NameRecord, offset: CARDINAL, importFti: FTIndex] = {
FOR iti: IMPIndex ← (IMPIndex.FIRST + rel.import),
(iti + IMPRecord.SIZE) UNTIL iti = rel.importLimit DO
OPEN imp: itb[iti];
IF gfi IN [imp.gfi..imp.gfi+imp.ngfi) THEN
RETURN[
importName: imp.name, offset: (gfi-imp.gfi)*EPLimit,
importFti: imp.file];
ENDLOOP;
RETURN [importName: NullName, offset: 0, importFti: FTNull]};
}.