CedarExporterImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
exports a newly loaded bcd to the current set of interface records.
created & massaged by the dear departed (Maxwell, Levin, Birrell, Rovner)
Russ Atkinson (RRA) August 29, 1985 11:43:35 pm PDT
DIRECTORY
Atom USING [GetPName, GetProp, PutProp, MakeAtom, FindAtom],
BcdDefs USING [EVIndex, EVNull, EXPIndex, FTSelf, Link, MTIndex, MTRecord, NullVersion, TYPRecord, VarLimit, VersionStamp, BcdBase, EXPHandle, MTHandle, NameString, ModuleIndex],
BcdOps USING [ProcessExports, ProcessModules],
DebuggerSwap USING [CallDebugger],
IO USING [PutFR],
Loader USING [Error],
LoaderOps USING [Pending, IR, GetPendingList, IsNullLink, SetPendingList, PendingModule, OpenLinkSpace, WriteLink, CloseLinkSpace, pendingModules, IRRecord],
LoadState USING [local, Release, ConfigID, Acquire, EnumerateConfigs, ModuleInfo, ConfigInfo, BuildProcDescUsingModule],
PrincOps USING [ControlLink, GlobalFrameHandle, NullLink],
Rope USING [ROPE, Text, InlineLength, InlineFetch, FromProc],
SafeStorage USING [GetPermanentZone],
Table USING [Base];
CedarExporterImpl:
PROGRAM
IMPORTS Atom, BcdOps, DebuggerSwap, IO, Loader, LoaderOps, LoadState, Rope, SafeStorage
EXPORTS LoaderOps = {
OPEN BcdDefs, LoaderOps, Rope;
********************************************************************
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.
********************************************************************
Export:
PUBLIC
PROC [config: LoadState.ConfigID] = {
bcd: BcdBase = LoadState.local.ConfigInfo[config].bcd;
name: ROPE;
toBeProcessed: LIST OF Pending;
ftb: Table.Base = LOOPHOLE[bcd + bcd.ftOffset];
ssb: BcdDefs.NameString = LOOPHOLE[bcd + bcd.ssOffset];
ExportInterface:
PROC [exph: EXPHandle, expi: EXPIndex]
RETURNS [stop:
BOOL ←
FALSE] = {
interface: IR;
atom: ATOM;
pending: LIST OF Pending;
i: NAT ← 0;
p:
SAFE
PROC
RETURNS [c:
CHAR] =
TRUSTED{
c ← ssb.string.text[exph.name+i];
i ← i + 1;
};
IF exph.port = module
THEN
RETURN;
RRA: It appears that interface records for modules do not work (later code cannot construct the types), so we should not try to create them. This decision should be revisited some day.
get the name of the interface
name ← Rope.FromProc[ssb.size[exph.name], p];
get the interface record
atom ← Atom.MakeAtom[name];
interface ← GetIR[atom, ftb[exph.file].version, exph.size].interface;
export to the interface
FOR i:
NAT
IN [0..exph.size)
DO
IF IsNullLink[exph.links[i]] THEN LOOP;
export the item to the interface
SELECT exph.links[i].vtag
FROM
var => {
frame: PrincOps.GlobalFrameHandle;
[interface[i], frame] ← FindVariableLink[config, exph.links[i].gfi, exph.links[i]];
IF frame # NIL THEN SaveFrame[interface, i, frame];
};
proc0, proc1 =>
interface[i] ← LoadState.local.BuildProcDescUsingModule[config, exph.links[i].gfi, exph.links[i].ep];
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]};
};
START Export HERE
[] ← BcdOps.ProcessExports[bcd, ExportInterface];
IF toBeProcessed # NIL THEN ProcessPendingEntries[toBeProcessed];
IF pendingModules # NIL THEN ExportModules[bcd, config];
};
ExportModules:
PROC [bcd: BcdBase, config: LoadState.ConfigID] =
{
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: BcdDefs.NameString = LOOPHOLE[bcd + bcd.ssOffset];
Export:
PROC [mth: MTHandle, mti: MTIndex]
RETURNS [stop:
BOOL ←
FALSE] = {
FOR list ← pendingModules, list.rest
WHILE list #
NIL
DO
len: INT;
name: ROPE;
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;
name ← list.first.name;
len ← Rope.InlineLength[name];
IF len # ssb.size[mth.name] THEN LOOP;
{
FOR i:
NAT
IN
NAT[0..len)
DO
IF Rope.InlineFetch[name, i] # ssb.string.text[mth.name+i] THEN GO TO notFound;
ENDLOOP;
EXITS notFound => LOOP;
};
we have a match!!! Fill in the link.
link ← LoadState.local.ModuleInfo[config, mth.gfi].gfh;
OpenLinkSpace[list.first.frame, list.first.mth, list.first.bcd];
WriteLink[list.first.index, link];
CloseLinkSpace[list.first.frame];
nullify the entry (will be removed later)
list.first.frame ← NIL;
ENDLOOP;
};
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;
};
SaveResolvedEntries:
PROC [process, pending:
LIST
OF Pending, interface:
IR]
RETURNS [newProcess, newPending:
LIST
OF Pending] = {
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 IsNullLink[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;
};
ProcessPendingEntries:
PROC [list:
LIST
OF Pending] = {
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 {
frame ← list.first.frame;
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;
};
********************************************************************
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:
ROPE]
RETURNS [PrincOps.ControlLink] = {
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 ← 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: ROPE ← IO.PutFR["Exported Type Clash for interface %g, item#: %g", [rope[name]], [integer[i]] ];
ERROR Loader.Error[versionMismatch, typeError];
};
RETURN [LOOPHOLE[old]];
};
********************************************************************
utility procedures
********************************************************************
FindVariableLink:
PUBLIC
PROC [config: LoadState.ConfigID, mx: BcdDefs.ModuleIndex, mthLink: BcdDefs.Link]
RETURNS [link: PrincOps.ControlLink, frame: PrincOps.GlobalFrameHandle] = {
bcd: BcdBase = LoadState.local.ConfigInfo[config].bcd;
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 ← LoadState.local.ModuleInfo[config, mx].gfh;
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
};
FindModule:
PROC [bcd: BcdBase, gfi: BcdDefs.ModuleIndex]
RETURNS [mth: MTHandle, ep:
CARDINAL] =
{
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];
};
********************************************************************
a cache of frames for exported varables
********************************************************************
frameIndex: NAT ← 0;
frames: ExportedVariables ← NEW[ExportedVariablesSequence[500]];
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] = {
IF frame = NIL THEN RETURN;
IF frameIndex >= frames.size
THEN {
-- allocate a larger one
larger: ExportedVariables ←
NEW[ExportedVariablesSequence[frames.size + 100]];
FOR i:
NAT
IN [0..frames.size)
DO
larger[i].interface ← frames[i].interface;
larger[i].index ← frames[i].index;
larger[i].frame ← frames[i].frame;
ENDLOOP;
frames ← larger};
frames[frameIndex] ← [interface, index, frame];
frameIndex ← frameIndex + 1;
};
GetFrame:
PUBLIC
PROC [interface:
IR, index:
CARDINAL]
RETURNS [PrincOps.GlobalFrameHandle] = {
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];
};
********************************************************************
manipulating interface records
********************************************************************
Zone: ZONE ← SafeStorage.GetPermanentZone[];
suspect: ATOM ← NIL;
GetIR:
PUBLIC
PROC [atom:
ATOM, version: BcdDefs.VersionStamp, length:
CARDINAL]
RETURNS [name:
ATOM, interface:
IR, versionStamp: BcdDefs.VersionStamp] = {
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 interface record
old ← Zone.NEW[VersionStamp ← version];
Atom.PutProp[atom, $version, old];
}
ELSE
check version mismatch
IF version # old^ THEN Loader.Error[versionMismatch, 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 {
IF atom = suspect
THEN
RRA: We are trying to put an IR property on something bad! The load state is probably locked, so force a world swap debug with a typically cute message.
DebuggerSwap.CallDebugger["Follow that car!"L];
interface ← Zone.NEW[IRRecord[length]];
Atom.PutProp[atom, $IR, interface];
};
RETURN [atom, interface, IF old = NIL THEN NullVersion ELSE old^];
};
FindAtom:
PROC [version: BcdDefs.VersionStamp]
RETURNS [atom:
ATOM] = {
CheckVersion:
SAFE
PROC [atom:
ATOM]
RETURNS [stop:
BOOL] =
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 ← Atom.FindAtom[CheckVersion];
};
Initialize:
PROC = {
ENABLE UNWIND => {LoadState.local.Release[]};
proc: PROC [config: LoadState.ConfigID] RETURNS [stop: BOOL ← FALSE] = {Export[config]};
LoadState.local.Acquire[exclusive];
[] ← LoadState.local.EnumerateConfigs[oldestFirst, proc];
LoadState.local.Release[];
};
Initialize[];
} . . .