AMModelInterfaceImpl.mesa
Last Modified By Paul Rovner On December 13, 1983 11:59 am
Last Modified By Richard Koo on July 2, 1984 8:34:22 pm PDT
DIRECTORY
AMBridge USING[TVForGFHReferent, TVForRemoteGFHReferent],
AMMiniModel USING[], -- exports only
AMTypes USING[TVType, IndexToTV, NameToIndex, TypeClass, UnderType, TVToName, GlobalParent, Error, TypedVariable],
Atom USING[GetProp, MapAtoms, MakeAtom, PutProp, GetPName],
BcdDefs USING[VersionStamp, NullVersion],
LoaderOps USING[IR, GetIR, IRRecord],
LoadState USING[ConfigID, ModuleIndex, CopiesList, local, ModuleInfo, Acquire, EnumerateAllModules, Release],
PrincOps USING[GlobalFrameHandle],
Rope USING[ROPE, Concat, Find, Substr, Index],
RTCommon USING[ShortenLongPointer],
RTSymbolDefs USING[SymbolTableBase, SymbolTableHandle, nullHandle, SymbolIdIndex, SymbolIndex],
RTSymbolOps USING[EnumerateCtxIseis, AcquireType, ISEPublic, ISEType, STBDirectoryCTX],
RTSymbols USING[AcquireSTB, ReleaseSTB, GetSTHForModule],
RTTypesBasicPrivate USING[MapTiTd],
RTTypesPrivate USING[TypedVariableRec],
SafeStorage USING[Type],
WorldVM USING[World, LocalWorld];
AMModelInterfaceImpl:
PROGRAM
IMPORTS AMBridge, AMTypes, Atom, LoaderOps, LoadState, Rope, RTCommon, RTSymbolOps, RTSymbols, RTTypesBasicPrivate, WorldVM
EXPORTS AMMiniModel
= BEGIN OPEN AMBridge, AMTypes, Rope, SafeStorage, RTSymbolDefs, RTSymbolOps, RTSymbols, RTTypesPrivate, WorldVM;
ImplementorName:
PUBLIC
SAFE
PROC[defsName, itemName:
ROPE, world: World ← LocalWorld[]]
RETURNS[ROPE] = TRUSTED {
inst: TypedVariable;
type: Type;
item: TypedVariable;
inst ← GetInterfaceRecord[defsName, world ! ANY => GOTO returnNil];
type ← TVType[inst ! ANY => GOTO returnNil];
item ← IndexToTV[inst, NameToIndex[type, itemName !
ANY =>
GOTO returnNil]
! ANY => GOTO returnNil];
IF item = NIL THEN GOTO returnNil;
SELECT TypeClass[UnderType[TVType[item]]]
FROM
procedure, signal, error => RETURN[TVToName[GlobalParent[item]]];
program => RETURN[TVToName[item]];
type, opaque => RETURN[defsName]; -- opaque types: not yet NOTE
nil => RETURN[defsName]; -- may be an INLINE
ENDCASE =>
WITH item
SELECT
FROM
rtr:
REF TypedVariableRec =>
WITH h: rtr.head
SELECT
FROM
gfh => RETURN[TVToName[TVForGFHReferent[h.gfh]]];
remoteGFH =>
RETURN[TVToName[TVForRemoteGFHReferent[h.remoteGlobalFrameHandle]]];
pointer => {
FindEnclosingGFH:
PROC[p:
POINTER]
RETURNS[gfh: PrincOps.GlobalFrameHandle ← NIL] = {
pInt: INT = LOOPHOLE[LONG[p], INT];
minDel: INT ← 200000B; -- some large number
proc:
PROC [ci: LoadState.ConfigID, mx: LoadState.ModuleIndex]
RETURNS [stop: BOOL ← FALSE] = {
tgfh: PrincOps.GlobalFrameHandle;
copies: LoadState.CopiesList;
del, gfhInt: INT;
[gfh: tgfh, copies: copies] ← LoadState.local.ModuleInfo[ci, mx];
gfhInt ← LOOPHOLE[LONG[tgfh], INT];
del ← pInt-gfhInt;
IF del >= 0 AND del < minDel THEN {gfh ← tgfh; minDel ← del};
FOR c: LoadState.CopiesList ← copies, c.rest
UNTIL c =
NIL
DO
gfhInt ← LOOPHOLE[LONG[c.first], INT];
del ← pInt-gfhInt;
IF del >= 0 AND del < minDel THEN {gfh ← c.first; minDel ← del};
ENDLOOP;
};
IF p = NIL THEN RETURN[NIL];
LoadState.local.Acquire[];
[] ← LoadState.local.EnumerateAllModules[newestFirst, proc
! UNWIND => LoadState.local.Release[]];
LoadState.local.Release[];
};
gfh: PrincOps.GlobalFrameHandle
= FindEnclosingGFH[RTCommon.ShortenLongPointer[h.ptr]];
IF gfh #
NIL
THEN RETURN[TVToName[TVForGFHReferent[gfh]]]
ELSE RETURN[NIL];
};
ENDCASE;
ENDCASE;
RETURN[NIL];
EXITS returnNil => RETURN[NIL];
};
GetInterfaceRecord:
PUBLIC
SAFE
PROC[defsName:
ROPE, world: World ← LocalWorld[]]
RETURNS[tv: TypedVariable ← NIL] = TRUSTED {
ir: LoaderOps.IR;
irType: REF Type;
atom: ATOM = Atom.MakeAtom[defsName];
version: BcdDefs.VersionStamp;
IF world # LocalWorld[]
THEN ERROR Error[reason: notImplemented, msg: "access to remote IRs"];
[interface: ir, versionStamp: version] ← LoaderOps.GetIR[atom: atom];
IF ir = NIL THEN RETURN;
irType ← NARROW[Atom.GetProp[atom, $IRType]];
IF irType =
NIL
THEN {
irType ← NEW[Type ← AcquireIRType[defsName, version]];
Atom.PutProp[atom, $IRType, irType];
};
tv ←
NEW[TypedVariableRec
← [referentType: [type: irType^],
head: [reference[ref: ir]],
field: embedded[fd: [wordOffset: SIZE[LoaderOps.IRRecord],
extent: large[size: ir.size]]]]];
};
GetInterfaceRecordFromType:
PUBLIC
SAFE
PROC[type: Type, world: World ← LocalWorld[]]
RETURNS[tv: TypedVariable ← NIL] = TRUSTED {
ir: LoaderOps.IR;
atom: ATOM;
IF world # LocalWorld[]
THEN ERROR Error[reason: notImplemented, msg: "access to remote IRs"];
[name: atom, interface: ir]
← LoaderOps.GetIR[version: RTTypesBasicPrivate.MapTiTd[type].utf.umid];
IF ir = NIL THEN RETURN;
IF
NARROW[Atom.GetProp[atom, $IRType], REF Type] =
NIL
THEN {
Atom.PutProp[atom, $IRType, NEW[Type ← type]];
};
tv ←
NEW[TypedVariableRec
← [referentType: [type: type],
head: [reference[ref: ir]],
field: embedded[fd: [wordOffset: SIZE[LoaderOps.IRRecord],
extent: large[size: ir.size]]]]];
};
GetInterfaceRecordNames:
PUBLIC
SAFE
PROC[world: World ← LocalWorld[]]
RETURNS[l: LIST OF ROPE ← NIL] = TRUSTED {
p:
SAFE
PROC[atom:
ATOM] =
TRUSTED
{IF Atom.GetProp[atom, $IR] # NIL THEN l ← CONS[Atom.GetPName[atom], l]};
IF world # LocalWorld[]
THEN ERROR Error[reason: notImplemented, msg: "access to remote IRs"];
Atom.MapAtoms[p];
};
AcquireIRType:
PUBLIC
SAFE
PROC
[defsName: ROPE, version: BcdDefs.VersionStamp ← BcdDefs.NullVersion]
RETURNS[type: Type] = TRUSTED {
irType: REF Type;
irVersion: REF BcdDefs.VersionStamp;
atom: ATOM = Atom.MakeAtom[defsName];
stb: SymbolTableBase;
seIndex: SymbolIndex;
p:
PROC[stb: SymbolTableBase, isei: SymbolIdIndex]
RETURNS[stop:
BOOL] = {
IF ISEPublic[stb, isei] THEN {seIndex ← ISEType[stb, isei]; RETURN[TRUE]}
ELSE RETURN[FALSE];
};
irType ← NARROW[Atom.GetProp[atom, $IRType]];
irVersion ← NARROW[Atom.GetProp[atom, $version]];
IF irType #
NIL
AND irVersion #
NIL
AND (version = BcdDefs.NullVersion OR version = irVersion^)
THEN RETURN[irType^];
IF version = BcdDefs.NullVersion AND irVersion # NIL THEN version ← irVersion^;
stb ← AcquireSTBForDefs[defsName, version];
{
ENABLE
UNWIND => ReleaseSTB[stb];
IF NOT EnumerateCtxIseis[stb: stb, ctx: STBDirectoryCTX[stb], proc: p] THEN ERROR;
type ← AcquireType[stb: stb, seIndex: seIndex];
}; -- end ENABLE UNWIND => ReleaseSTB[stb];
ReleaseSTB[stb];
};
AcquireSTBForDefs:
PROC[fileName: ROPE, version: BcdDefs.VersionStamp ← BcdDefs.NullVersion]
RETURNS[stb: SymbolTableBase] = {
sth: SymbolTableHandle ← nullHandle;
IF fileName.Find["."] = -1 THEN fileName ← fileName.Concat[".bcd"];
sth ← GetSTHForModule[
stamp: version,
fileName: fileName,
moduleName: fileName.Substr[start: 0, len: fileName.Index[pos1: 0, s2: "."]]
];
stb ← AcquireSTB[sth];
IF
NOT (
WITH stb
SELECT
FROM
t: SymbolTableBase.x => t.e.stHandle.definitionsFile,
t: SymbolTableBase.y => t.e.stHandle.definitionsFile,
ENDCASE => ERROR)
THEN {
ReleaseSTB[stb];
ERROR AMTypes.Error[
reason: noSymbols,
msg: Rope.Concat[fileName, " not a defs module"]
];
};
};
END.