CedarExporterImpl.mesa
exports a newly loaded bcd to the current set of interface records.
Last edited by: John Maxwell on: February 22, 1983 2:49 pm
Last edited by: Paul Rovner on: January 18, 1983 9:59 am
DIRECTORY
Atom USING [GetPName, GetProp, PutProp],
AtomsPrivate USING [EnumerateAtoms, UnsafeMakeAtom],
BcdDefs USING [
EVIndex, EVNull, EXPIndex, FTSelf, Link, MTIndex, MTRecord,
NullVersion, TYPRecord, VarLimit, VersionStamp],
BcdOps USING [
BcdBase, EXPHandle, MTHandle, NameString, ProcessExports, ProcessModules],
CedarLinkerOps,
List USING [AList, DottedPairNode],
Loader USING [Error],
LongString USING [AppendString, AppendDecimal],
PilotLoadStateOps USING [
AcquireBcd, ConfigIndex, InputLoadState,
GetMap, Map, ReleaseBcd, ReleaseLoadState, ReleaseMap],
PrincOps USING [
ControlLink, GFTIndex,
GlobalFrameHandle, NullLink],
PrincOpsRuntime USING [GetFrame, GFT],
Rope USING [Text],
SafeStorage USING [NewZone],
Table USING [Base];
CedarExporterImpl: PROGRAM
IMPORTS
Atom, AtomsPrivate, BcdOps, CedarLinkerOps, Loader, PilotLoadStateOps, PrincOpsRuntime, SafeStorage, String: LongString
EXPORTS CedarLinkerOps
SHARES Rope =
BEGIN
OPEN BcdDefs, BcdOps, CedarLinkerOps;
********************************************************************
Export: exports procedure descriptors, variables, and types to the appropriate interfaces.
Checks to see if anybody is waiting for the new entry. Sorts pending entries by frame and
assigns them all at once at the end. Modules are only exported if there is somebody
waiting for one. ('map' is a mapping between the bcd-relative gfi's and the real world.)
********************************************************************
Export: PUBLIC PROC[bcd: BcdBase, map: PilotLoadStateOps.Map] =
BEGIN
maxInterfaceNameLength: NAT = 40;
name: STRING = [maxInterfaceNameLength];
toBeProcessed: LIST OF Pending;
ftb: Table.Base = LOOPHOLE[bcd + bcd.ftOffset];
ssb: BcdOps.NameString = LOOPHOLE[bcd + bcd.ssOffset];
ExportInterface: PROC[exph: EXPHandle, expi: EXPIndex]
RETURNS[stop: BOOLEANFALSE] =
BEGIN
interface: IR;
atom: ATOM;
rgfi: PrincOps.GFTIndex;
pending: LIST OF Pending;
get the name of the interface
name.length ← 0;
FOR i: NAT IN [0..ssb.size[exph.name]) DO
m: STRING = "interface name too long";
IF name.length = maxInterfaceNameLength
THEN ERROR Loader.Error[type: invalidBcd, message: LOOPHOLE[LONG[m]]];
name[name.length] ← ssb.string.text[exph.name+i];
name.length ← name.length+1;
ENDLOOP;
get the interface record
atom ← AtomsPrivate.UnsafeMakeAtom[LOOPHOLE[LONG[name]]];
interface ← GetIR[atom, ftb[exph.file].version, exph.size].interface;
export to the interface
FOR i: NAT IN [0..exph.size) DO
IF NullLink[exph.links[i]] THEN LOOP;
export the item to the interface
rgfi ← map[exph.links[i].gfi]; -- determine the real gfi
SELECT exph.links[i].vtag FROM
var => {frame: PrincOps.GlobalFrameHandle;
[interface[i], frame] ← FindVariableLink[bcd, exph.links[i], rgfi];
IF frame # NIL THEN SaveFrame[interface, i, frame]};
proc0, proc1 => interface[i] ← [procedure[gfi: rgfi, ep: exph.links[i].ep, tag: TRUE]];
type => interface[i] ← CheckType[bcd, exph.links[i], LOOPHOLE[interface[i]], i, name];
ENDCASE => ERROR;
ENDLOOP;
put the resolved pending items on the toBeProcessed list
pending ← GetPendingList[atom];
IF pending # NIL THEN {
[toBeProcessed, pending] ← SaveResolvedEntries[toBeProcessed, pending, interface];
SetPendingList[atom, pending]};
END;
START Export HERE
[] ← BcdOps.ProcessExports[bcd, ExportInterface];
IF toBeProcessed # NIL THEN ProcessPendingEntries[toBeProcessed];
IF pendingModules # NIL THEN ExportModules[bcd, map];
END;
ExportModules: PROC[bcd: BcdBase, map: PilotLoadStateOps.Map] =
BEGIN -- check to see if this bcd has a module that someone is waiting for.
link: UNSPECIFIED;
list, lastPending: LIST OF PendingModule;
ftb: Table.Base = LOOPHOLE[bcd + bcd.ftOffset];
ssb: BcdOps.NameString = LOOPHOLE[bcd + bcd.ssOffset];
Export: PROC[mth: MTHandle, mti: MTIndex] RETURNS[stop: BOOLEANFALSE] =
BEGIN
found: BOOLEAN;
FOR list ← pendingModules, list.rest WHILE list # NIL DO
IF mth.file = BcdDefs.FTSelf
THEN IF list.first.version # bcd.version THEN LOOP ELSE NULL
ELSE IF list.first.version # ftb[mth.file].version THEN LOOP;
found ← TRUE;
IF list.first.name.length # ssb.size[mth.name] THEN LOOP;
FOR i: NAT IN [0..list.first.name.length) DO
IF list.first.name.text[i] # ssb.string.text[mth.name+i] THEN {found ← FALSE; EXIT};
ENDLOOP;
IF ~found THEN LOOP;
we have a match!!! Fill in the link.
link ← PrincOpsRuntime.GetFrame[PrincOpsRuntime.GFT[map[mth.gfi]]];
CedarLinkerOps.OpenLinkSpace[list.first.frame, list.first.mth, list.first.bcd];
CedarLinkerOps.WriteLink[list.first.index, link];
CedarLinkerOps.CloseLinkSpace[list.first.frame];
nullify the entry (will be removed later)
list.first.frame ← NIL;
ENDLOOP;
END;
START ExportModules HERE
[] ← BcdOps.ProcessModules[bcd, Export];
remove completed modules
FOR list ← pendingModules, list.rest WHILE list # NIL DO
IF list.first.frame # NIL THEN {lastPending ← list; LOOP};
IF lastPending = NIL
THEN pendingModules ← list.rest
ELSE lastPending.rest ← list.rest;
ENDLOOP;
END;
SaveResolvedEntries: PROC[process, pending: LIST OF Pending, interface: IR]
RETURNS[newProcess, newPending: LIST OF Pending] =
BEGIN -- move resolved pending items to the 'toBeProcessed' list.
the link slot is redefined to be the new interface element.
index: NAT;
next, lastPending: LIST OF Pending;
newProcess ← process;
newPending ← pending;
this is convoluted!
FOR pending ← pending, next WHILE pending # NIL DO
next ← pending.rest; -- 'rest' may be changed
index ← LOOPHOLE[pending.first.link];
IF NullLink[interface[index]] THEN {lastPending ← pending; LOOP};
pending.first.link ← interface[index]; -- redefines 'link'
remove resolved entry from pending list
IF lastPending # NIL
THEN lastPending.rest ← next
ELSE newPending ← next;
add the entry to the processed list, SORTED BY FRAME
does it go before the first element the processed list?
IF newProcess = NIL OR
LOOPHOLE[pending.first.frame, CARDINAL] <
LOOPHOLE[newProcess.first.frame, CARDINAL] THEN {
pending.rest ← newProcess;
newProcess ← pending;
LOOP};
put it where it belongs
FOR process ← newProcess, process.rest DO
IF process.rest = NIL OR
LOOPHOLE[pending.first.frame, CARDINAL] <
LOOPHOLE[process.rest.first.frame, CARDINAL] THEN {
pending.rest ← process.rest;
process.rest ← pending;
EXIT};
ENDLOOP;
ENDLOOP;
END;
ProcessPendingEntries: PROC[list: LIST OF Pending] =
BEGIN
OPEN CedarLinkerOps;
frame: PrincOps.GlobalFrameHandle ← NIL;
process all of the resolved pending items
FOR list ← list, list.rest WHILE list # NIL DO
IF list.first.frame # frame THEN OpenLinkSpace[list.first.frame, list.first.mth, list.first.bcd];
WriteLink[list.first.index, list.first.link];
IF list.rest = NIL OR list.rest.first.frame # frame THEN CloseLinkSpace[frame];
ENDLOOP;
END;
********************************************************************
CheckType: Concrete types are represented in the IR as an index into the sequence
'types'. We want to check that there is at most one concrete type for each opaque type.
Someday we will use an RTTypes.Type to represent the type. Currently exported types
are ignored by the importing module.
********************************************************************
typeIndex: NAT ← 0;
types: ExportedTypes ← NEW[ExportedTypesSequence[100]];
ExportedTypes: TYPE = REF ExportedTypesSequence;
ExportedTypesSequence: TYPE = RECORD[s: SEQUENCE size: NAT OF BcdDefs.TYPRecord];
CheckType: PROC[bcd: BcdBase, new, old: BcdDefs.Link, i: NAT, name: STRING]
RETURNS[PrincOps.ControlLink] =
BEGIN -- compare the old type with the one we want to export.
oldIndex: NAT = LOOPHOLE[old.typeID];
typb: Table.Base = LOOPHOLE[bcd + bcd.typOffset];
IF oldIndex = 0 THEN { -- first time exported.
look for an existing entry
FOR i: NAT IN [1..typeIndex) DO
IF types[i] # typb[new.typeID] THEN LOOP;
old ← [type[typeID: LOOPHOLE[i], type: new.type, proc: new.proc]];
RETURN[LOOPHOLE[old]];
ENDLOOP;
create a new entry
typeIndex ← typeIndex + 1;
IF typeIndex >= types.size THEN { -- allocate a large one
larger: ExportedTypes ← Zone.NEW[ExportedTypesSequence[types.size + 100]];
FOR i: NAT IN [0..types.size) DO
larger[i] ← types[i];
ENDLOOP;
types ← larger};
types[typeIndex] ← typb[new.typeID];
old ← [type[typeID: LOOPHOLE[typeIndex], type: new.type, proc: new.proc]];
RETURN[LOOPHOLE[old]]};
raise an error if there is a type clash
IF types[oldIndex] # typb[new.typeID] THEN {
typeError: STRING = [100];
String.AppendString[typeError, "Exported Type Clash for interface "L];
String.AppendString[typeError, name];
String.AppendString[typeError, ", item # "L];
String.AppendDecimal[typeError, i];
ERROR Loader.Error[versionMismatch, LOOPHOLE[LONG[typeError]]]};
RETURN[LOOPHOLE[old]];
END;
********************************************************************
utility procedures
********************************************************************
FindVariableLink: PUBLIC PROC[
bcd: BcdBase, mthLink: BcdDefs.Link, rgfi: PrincOps.GFTIndex]
RETURNS [link: PrincOps.ControlLink, frame: PrincOps.GlobalFrameHandle] =
BEGIN
ep: CARDINAL;
evi: EVIndex;
evb: Table.Base;
mth: MTHandle;
[mth, ep] ← FindModule[bcd, mthLink.vgfi];
IF mth = NIL THEN RETURN[PrincOps.NullLink, NIL];
evb ← LOOPHOLE[bcd + bcd.evOffset, Table.Base];
frame ← PrincOpsRuntime.GetFrame[PrincOpsRuntime.GFT[rgfi]];
IF (ep ← ep + mthLink.var) = 0 THEN RETURN[LOOPHOLE[frame], NIL];
an imported program
IF (evi ← mth.variables) = EVNull THEN RETURN[PrincOps.NullLink, NIL];
RETURN[LOOPHOLE[frame + evb[evi].offsets[ep]], frame];
a pointer to the variable in the frame
END; -- end FindVariableLink
FindModule: PROC[bcd: BcdBase, gfi: PrincOps.GFTIndex]
RETURNS[mth: MTHandle, ep: CARDINAL] =
BEGIN -- expansion of BcdOps.ProcessModules[bcd, FindModule]
mti: MTIndex;
mtb: Table.Base = LOOPHOLE[bcd + bcd.mtOffset];
i: CARDINAL;
mti ← FIRST[MTIndex];
FOR i IN [0..bcd.nModules) DO
mth ← @mtb[mti];
~~~~~~~~~~~~~~~~~~~~~~~~
IF gfi IN [mth.gfi..mth.gfi+mth.ngfi) THEN
RETURN[mth, VarLimit*(gfi - mth.gfi)];
~~~~~~~~~~~~~~~~~~~~~~~~
mti ← mti + (WITH m: mtb[mti] SELECT FROM
direct => SIZE[MTRecord[direct]] + m.length*SIZE[Link],
indirect => SIZE[MTRecord[indirect]],
multiple => SIZE[MTRecord[multiple]],
ENDCASE => ERROR)
ENDLOOP;
RETURN[NIL, 0];
END;
********************************************************************
a cache of frames for exported varables
********************************************************************
frameIndex: NAT ← 0;
frames: ExportedVariables ← NEW[ExportedVariablesSequence[10]];
ExportedVariables: TYPE = REF ExportedVariablesSequence;
ExportedVariablesSequence: TYPE = RECORD[s: SEQUENCE size: NAT OF VariableRecord];
VariableRecord: TYPE = RECORD[
interface: IR,
index: CARDINAL,
frame: PrincOps.GlobalFrameHandle];
SaveFrame: PROC[interface: IR, index: CARDINAL, frame: PrincOps.GlobalFrameHandle] =
BEGIN
IF frame = NIL THEN RETURN;
IF frameIndex >= frames.size THEN { -- allocate a larger one
larger: ExportedVariables ← Zone.NEW[ExportedVariablesSequence[frames.size + 10]];
FOR i: NAT IN [0..frames.size) DO
larger[i] ← frames[i];
ENDLOOP;
frames ← larger};
frames[frameIndex] ← [interface, index, frame];
frameIndex ← frameIndex + 1;
END;
GetFrame: PUBLIC PROC[interface: IR, index: CARDINAL]
RETURNS[PrincOps.GlobalFrameHandle] =
BEGIN
FOR i: CARDINAL DECREASING IN [0..frameIndex) DO -- decreasing to catch last export
IF frames[i].interface # interface THEN LOOP;
IF frames[i].index # index THEN LOOP;
RETURN[frames[i].frame];
ENDLOOP;
RETURN[NIL];
END;
********************************************************************
manipulating interface records
********************************************************************
Zone: ZONE ← SafeStorage.NewZone[];
GetIR: PUBLIC PROCEDURE[
atom: ATOM,
version: BcdDefs.VersionStamp,
length: CARDINAL] -- in case a new one must be created
RETURNS[name: ATOM, interface: IR, versionStamp: BcdDefs.VersionStamp] =
BEGIN
old: REF BcdDefs.VersionStamp;
IF atom = NIL THEN atom ← FindAtom[version];
IF atom = NIL THEN RETURN[NIL, NIL, NullVersion];
IF version # NullVersion THEN
IF (old ← NARROW[Atom.GetProp[atom, $version]]) = NIL
THEN {-- create a new one
old ← Zone.NEW[VersionStamp ← version];
Atom.PutProp[atom, $version, old]}
ELSE IF version # old^ THEN -- check version mismatch
Loader.Error[versionMismatch, LOOPHOLE[Atom.GetPName[atom]]];
interface ← NARROW[Atom.GetProp[atom, $IR]];
IF length = 0 THEN
RETURN[atom, interface, IF old = NIL THEN NullVersion ELSE old^];
IF interface = NIL THEN {
interface ← Zone.NEW[IRRecord[length]];
Atom.PutProp[atom, $IR, interface]};
RETURN[atom, interface, IF old = NIL THEN NullVersion ELSE old^];
END;
FindAtom: PROCEDURE[version: BcdDefs.VersionStamp] RETURNS[atom: ATOM] =
BEGIN
CheckVersion: SAFE PROC[atom: ATOM] RETURNS[stop: BOOLEAN] = TRUSTED {
old: REF BcdDefs.VersionStamp;
old ← NARROW[Atom.GetProp[atom, $version]];
IF old = NIL THEN RETURN[stop: FALSE];
RETURN[stop: old^ = version]};
IF version = BcdDefs.NullVersion THEN RETURN[NIL];
atom ← AtomsPrivate.EnumerateAtoms[CheckVersion];
END;
Initialize: PROC =
BEGIN
OPEN PilotLoadStateOps;
ENABLE UNWIND => {ReleaseLoadState[]};
map: Map;
bcd: BcdBase;
nbcds: ConfigIndex ← InputLoadState[];
FOR i: NAT IN [0..nbcds) DO
bcd ← AcquireBcd[i];
map ← GetMap[i];
Export[bcd, map];
ReleaseMap[map];
ReleaseBcd[bcd];
ENDLOOP;
ReleaseLoadState[];
END;
Initialize[];
END . . .