DIRECTORY
Atom: TYPE USING [GetPName],
BasicTime: TYPE USING [GMT, Now, Period],
BcdDefs:
TYPE
USING [
Base, BcdBase, EXPHandle, EXPIndex, FTHandle, IMPHandle, IMPIndex, Link,
ModuleIndex, MTHandle, MTIndex, NullLink, NullModule, ProcLimit],
BcdOps: TYPE USING [ProcessExports, ProcessImports, ProcessModules],
FS: TYPE USING [OpenFile, StreamOpen],
IO: TYPE USING [atom, card, Close, PutF, rope, STREAM],
LoaderOps: TYPE USING [IthLink, LinkSegmentLength],
LoaderOpsExtras: TYPE USING [AcquireFileProc],
Rope: TYPE USING [ROPE, Concat],
SMFI: TYPE USING [BcdFileInfo, SrcFileInfo],
SMBind:
TYPE
USING [
AllocateIR, AllocateVIR, BuildInterface, BuildFramePtrInterface, ImportLink,
ImportMap, ImportMapSeq, IR, IRSeq, IRSeqRecord, RIR, VIR, BindInfo, BindInfoRecord,
RelocateLink],
SMLDriver: TYPE USING [LoadMod, LoadModRecord],
SMModelBcd:
TYPE
USING [
Bcd, MTHandle,
BuildBcd, CloseLiterals, DeclareControl, DeclareExport, DeclareImport, DeleteBcd,
FillImport, ImportLiterals, OpenLinks, OpenLiterals, ReadLink, RopeFromNS,
WriteBcd, WriteLink],
SMProj: TYPE USING [Available, Fill, Find, Proj, Read],
SMTree:
TYPE Tree
USING [
ApplOp, BindOp, Handle, Id, Link, Name, NodeName, null, nullName],
SMTreeOps:
TYPE TreeOps
USING [
GetExt, GetName, GetNode, NSons, NthSon, OpName, PutExt, Scan, ScanSons, TM],
SMVal:
TYPE
USING [
Binding, BtoD, BtoG, GetExtFromParse, IdName, IdType, OuterBody, PutExtInParse,
ValOf, ValOfNthSon, VisitNodes],
TimeStamp: TYPE USING [Stamp, Null],
VM: TYPE USING [AddressForPageNumber, Interval];
InputActuals:
PROC[bs:
BS, formals: Tree.Link] ~ {
n: NAT ~ TreeOps.NSons[formals];
IF n = 0 THEN bs.configFormals ← NIL
ELSE {
bs.configFormals ← (bs.z).NEW[SMBind.IRSeqRecord[n+1]];
bs.configFormals[0] ← NIL; -- not used
FOR i:
NAT
IN [1 .. n]
DO
id: Tree.Id ~ NARROW[TreeOps.GetExt[TreeOps.NthSon[formals, i]]];
formalName: Tree.Name ~ SMVal.IdName[id];
type: Tree.Link ~ SMVal.IdType[id];
typeName: Tree.Name ~ (
WITH type
SELECT
FROM
id: Tree.Id => SMVal.IdName[id],
ENDCASE => formalName);
stamp: TimeStamp.Stamp ← TimeStamp.Null;
ir: SMBind.VIR;
examine first son, it is either an apply for a mesa or fiBcd for a bcd in the model
WITH SMVal.ValOf[type]
SELECT
FROM
node: Tree.Handle =>
WITH SMVal.ValOfNthSon[SMVal.ValOf[node], 1]
SELECT
FROM
fiSrc: SMFI.SrcFileInfo =>
stamp ← NARROW[TreeOps.GetExt[node], SMProj.Proj].stamp;
subNode: Tree.Handle =>
IF TreeOps.OpName[subNode]
IN Tree.ApplOp
THEN
stamp ← NARROW[TreeOps.GetExt[subNode], SMProj.Proj].stamp;
fiBcd: SMFI.BcdFileInfo => stamp ← fiBcd.stamp;
ENDCASE;
fiBcd: SMFI.BcdFileInfo => stamp ← fiBcd.stamp;
ENDCASE;
bs.configFormals[i] ← ir ← SMBind.AllocateVIR[stamp, typeName];
ir.index ← (bs.configBcd).DeclareImport[
Atom.GetPName[formalName], Atom.GetPName[typeName], stamp];
ENDLOOP;
};
};
GetInterface:
PROC[bs:
BS, bcdVersion: TimeStamp.Stamp]
RETURNS[ir: SMBind.
IR] ~ {
FOR i:
NAT
IN [1 .. bs.configFormals.size)
DO
IF bcdVersion = bs.configFormals[i].stamp THEN RETURN[bs.configFormals[i]];
ENDLOOP;
IF linkerIR = NIL THEN {
this is one of
1) an imported module from the loadstate (done lazily: see LookupFrame)
2) an imported interface that is all inlines
3) an imported interface that has not been exported to the load state (error)
ir ← NIL};
RETURN[NIL]};
ResolveImports:
PROC[bs:
BS, root: Tree.Link] ~ {
ForEachApply:
PROC[node, parent: Tree.Link] ~ {
IF TreeOps.OpName[node]
IN Tree.ApplOp
THEN
WITH SMVal.GetExtFromParse[node]
SELECT
FROM
loadMod: SMLDriver.LoadMod =>
IF ~loadMod.bindInfo.linksResolved
THEN {
rand: Tree.Link ~ SMVal.ValOfNthSon[node, 2];
args: Tree.Link ~ (IF SMVal.Binding[rand] THEN SMVal.BtoG[rand] ELSE rand);
FillInImports[loadMod, args]};
ENDCASE => NULL;
};
FillInImports:
PROC[loadMod: SMLDriver.LoadMod, args: Tree.Link] ~
TRUSTED {
bindInfo: SMBind.BindInfo ~ loadMod.bindInfo;
bcd: BcdDefs.BcdBase ~ bindInfo.bcd;
firstDummy: NAT ~ bcd.firstdummy;
importMap: SMBind.ImportMap ~
(bs.z).NEW[SMBind.ImportMapSeq[bcd.nDummies] ← [bias~firstDummy, map~]];
import: NAT ← 1;
relGfi: NAT ← 0;
ForEachImport:
PROC[ith: BcdDefs.IMPHandle, iti: BcdDefs.IMPIndex]
RETURNS[stop: BOOL←FALSE] ~ TRUSTED {
fth: BcdDefs.FTHandle ~ @LOOPHOLE[bcd + bcd.ftOffset, BcdDefs.Base][ith.file];
FOR i:
NAT
IN [0 .. ith.ngfi)
DO
importMap[(ith.gfi-firstDummy)+i] ← [index~import, whichOne~i];
ENDLOOP;
bindInfo.imports[import] ← (
IF import > TreeOps.NSons[args]
THEN
HiddenImport[bs, args, fth.version] ELSE LookupInterface[bs, args, import]);
WITH bindInfo.imports[import]
SELECT
FROM
formal: SMBind.
VIR =>
IF formal.dummyGfi = BcdDefs.NullModule
THEN
formal.dummyGfi ← (bs.configBcd).FillImport[formal.index, bcd, iti];
ENDCASE;
IF
FALSE
AND bindInfo.imports[import] =
NIL
THEN {
would get spurious warnings for NIL implementations
sym: Rope.ROPE ~ SMModelBcd.RopeFromNS[bcd, ith.name];
bs.out.PutF["Warning - cannot find exporter of %g anywhere.\n", IO.rope[sym]]};
import ← import + 1};
moduleBase: BcdDefs.ModuleIndex ~ bindInfo.moduleIndex;
ForEachModule:
PROC[mth: BcdDefs.MTHandle, mti: BcdDefs.MTIndex]
RETURNS[stop: BOOL←FALSE] ~ TRUSTED {
resolved: BOOL ← TRUE;
nLinks: NAT ~ LoaderOps.LinkSegmentLength[mth, bcd];
module: SMModelBcd.MTHandle ~ (bs.configBcd).OpenLinks[moduleBase, relGfi, nLinks];
FOR i:
CARDINAL
IN [0..nLinks)
DO
bound: BOOL;
link: BcdDefs.Link;
[link, bound] ← NewLink[
bcdLink~LoaderOps.IthLink[mth, i, bcd],
oldLink~(bs.configBcd).ReadLink[mth~module, offset~i],
bindInfo~loadMod.bindInfo, importMap~importMap];
IF bound THEN (bs.configBcd).WriteLink[mth~module, offset~i, link~link]
ELSE resolved ← FALSE;
ENDLOOP;
IF ~resolved THEN bindInfo.linksResolved ← FALSE;
(bs.configBcd).ImportLiterals[module, bcd, mti];
relGfi ← relGfi + mth.ngfi};
IF bcd.nImports = 0 THEN RETURN; ** Loader crock - can't handle LFNull !!!
bindInfo.imports ← (bs.z).NEW[SMBind.IRSeqRecord[bcd.nImports+1]];
bindInfo.imports[0] ← NIL; -- not used
[] ← BcdOps.ProcessImports[bcd, ForEachImport];
bindInfo.linksResolved ← TRUE;
(bs.configBcd).OpenLiterals[bcd];
[] ← BcdOps.ProcessModules[bcd, ForEachModule];
(bs.configBcd).CloseLiterals[bcd]};
SMVal.VisitNodes[bs.tm, root, ForEachApply]};
PossibleCoercion:
PROC[t: Tree.Link]
RETURNS[SMBind.
IR] ~ {
SELECT TreeOps.OpName[t]
FROM
IN Tree.ApplOp => {
this is a coercion not made explicit by the evaluator; simply use the first export
loadMod: SMLDriver.LoadMod ~ NARROW[SMVal.GetExtFromParse[t]];
IF loadMod #
NIL
THEN {
bindInfo: SMBind.BindInfo ~ loadMod.bindInfo;
RETURN[bindInfo.exports[1]]} -- check size before allowing coercion?
ELSE RETURN[NIL]};
$subscript, $then, $union => RETURN[NARROW[TreeOps.GetExt[t]]];
$nil => RETURN[NIL];
ENDCASE => RETURN[NIL] -- ERROR?
};
LookupInterface:
PROC[bs:
BS, args: Tree.Link, import:
NAT]
RETURNS[SMBind.
IR] ~ {
LookupOutside:
PROC[id: Tree.Id]
RETURNS[ir: SMBind.
IR] ~ {
ir ← bs.configFormals[id.p]; -- id must be a formal
IF ir =
NIL
THEN
bs.out.PutF["Can't import %g from loadstate\n.", IO.atom[SMVal.IdName[id]]];
RETURN};
RETURN [
WITH SMVal.ValOfNthSon[args, import]
SELECT
FROM
node: Tree.Handle => PossibleCoercion[node],
id: Tree.Id => LookupOutside[id],
ENDCASE => ERROR]
};
HiddenImport:
PROC[bs:
BS, args: Tree.Link, version: TimeStamp.Stamp]
RETURNS[ir: SMBind.IR ← NIL] ~ {
CheckArg: TreeOps.Scan ~ {
v: Tree.Link ~ SMVal.ValOf[t];
SELECT TreeOps.OpName[v]
FROM
IN Tree.ApplOp => {
CheckImport: TreeOps.Scan ~ {
WITH SMVal.ValOf[t]
SELECT
FROM
node: Tree.Handle => {
argIr: SMBind.IR ~ PossibleCoercion[node];
IF argIr ~=
NIL
AND argIr.stamp = version
THEN {
IF ir ~=
NIL
AND ir ~= argIr
THEN
bs.out.PutF["Ambiguous implicit import of %g\n", IO.atom[ir.name]];
ir ← argIr};
};
ENDCASE;
could be an export too?
};
TreeOps.ScanSons[SMVal.ValOfNthSon[v, 2], CheckImport]};
$subscript => CheckArg[TreeOps.NthSon[v, 1]];
$then, $union => {
CheckArg[TreeOps.NthSon[v, 1]]; CheckArg[TreeOps.NthSon[v, 2]]};
$nil => NULL;
ENDCASE;
};
TreeOps.ScanSons[args, CheckArg];
ir will be NIL here only if implicitly importing instance is a formal
IF ir = NIL THEN ir ← GetInterface[bs, version];
NewLink:
PROC[
bcdLink: BcdDefs.Link, oldLink: BcdDefs.Link,
bindInfo: SMBind.BindInfo, importMap: SMBind.ImportMap]
RETURNS[link: BcdDefs.Link, resolved: BOOL] ~ {
FindLink:
PROC[bcdLink: BcdDefs.Link]
RETURNS[link: BcdDefs.Link, resolved: BOOL] ~ TRUSTED {
bcdGfi: BcdDefs.ModuleIndex ~ (
SELECT bcdLink.vtag
FROM
$var => bcdLink.vgfi,
$proc0, $proc1 => bcdLink.gfi,
ENDCASE => ERROR);
IF bcdGfi < importMap.bias
THEN {
link ← SMBind.RelocateLink[bindInfo, bcdLink];
resolved ← ~EmptyLink[link]}
ELSE {
relGfi: NAT ~ bcdGfi - importMap.bias;
index: NAT ~ importMap[relGfi].index;
entryNo: CARDINAL ~ bcdLink.ep + (importMap[relGfi].whichOne*BcdDefs.ProcLimit);
WITH bindInfo.imports[index]
SELECT
FROM
ir: SMBind.
RIR => {
resolved ← ~EmptyLink[ir[entryNo].link];
IF resolved THEN link ← ir[entryNo].link};
ir: SMBind.
VIR => {
link ← SMBind.ImportLink[ir.dummyGfi, entryNo]; resolved ← TRUE};
ENDCASE => resolved ← FALSE;
IF ~resolved
THEN {
**** warning message here?
};
};
RETURN[link, resolved]};
RETURN (
SELECT bcdLink.vtag
FROM
$proc0, $proc1,
$var =>
IF EmptyLink[oldLink] THEN FindLink[bcdLink] ELSE [oldLink, TRUE],
ENDCASE => [LOOPHOLE[bcdLink.typeID], TRUE]) -- ***
};
ExportToBcd:
PROC[bs:
BS, body: Tree.Link] ~ {
ForEachItem:
PROC[t: Tree.Link] ~ {
WITH PossibleCoercion[SMVal.ValOf[t]]
SELECT
FROM
ir: SMBind.RIR => {
IthLink:
SAFE
PROC[i:
NAT]
RETURNS[BcdDefs.Link] ~
TRUSTED {
RETURN[ir[i].link]};
(bs.configBcd).DeclareExport[
name~Atom.GetPName[ir.name], stamp~ir.stamp, size~ir.size, getLink~IthLink]};
ir: SMBind.
VIR =>
NULL -- ****
ENDCASE
};
SELECT TreeOps.OpName[body]
FROM
$group => TreeOps.ScanSons[body, ForEachItem];
IN Tree.BindOp => {TreeOps.ScanSons[SMVal.BtoG[body], ForEachItem]};
$let => ExportToBcd[bs, TreeOps.NthSon[body, 2]];
ENDCASE => ForEachItem[body];
};