-- AMModelInterfaceImpl.mesa
-- Last Modified By Paul Rovner On March 4, 1983 4:49 pm
DIRECTORY
AMBridge USING[TVForGFHReferent, TVForRemoteGFHReferent],
AMTypes USING[TVType, IndexToTV, NameToIndex, TypeClass, UnderType, TVToName,
GlobalParent, Error],
Atom USING[GetProp, MapAtoms],
CedarLinkerOps USING[IR, GetIR, IRRecord],
PrincOps USING[GlobalFrameHandle],
Rope USING[ROPE, Concat, Find],
RTBasic USING[TypedVariable, Type],
RTCommon USING[ShortenLongPointer],
RTMiniModel USING[], -- exports only
RTOS USING[FindEnclosingGFH],
RTSymbolDefs USING[SymbolTableBase, SymbolIdIndex, SymbolIndex],
RTSymbolOps USING[EnumerateCtxIseis, AcquireType, ISEPublic, ISEType, STBDirectoryCTX],
RTSymbols USING[ReleaseSTB, AcquireSTBForDefs],
RTTypesBasicPrivate USING[MapTiTd],
RTTypesPrivate USING[TypedVariableRec],
WorldVM USING[World, LocalWorld];

AMModelInterfaceImpl: PROGRAM
IMPORTS AMBridge, AMTypes, Atom, CedarLinkerOps,
Rope, RTCommon, RTOS, RTSymbolOps, RTSymbols, RTTypesBasicPrivate, WorldVM
EXPORTS RTMiniModel

= BEGIN OPEN AMBridge, AMTypes, Rope, RTBasic, 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 ← AcquireIRInstance[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 => {gfh: PrincOps.GlobalFrameHandle -- NOTE XXX REMOTE
= RTOS.FindEnclosingGFH[RTCommon.ShortenLongPointer[h.ptr]];
IF gfh # NIL
THEN RETURN[TVToName[TVForGFHReferent[gfh]]]
ELSE RETURN[NIL]};
ENDCASE;
ENDCASE;
RETURN[NIL];

EXITS returnNil => RETURN[NIL];
};

AcquireIRInstance: PUBLIC SAFE PROC[defsName: ROPE, world: World ← LocalWorld[]]
RETURNS[TypedVariable] = TRUSTED
{IF world # LocalWorld[]
THEN ERROR Error[reason: notImplemented, msg: "access to remote IRs"];
RETURN[GetIRInstance[AcquireIRType[defsName, world], world]]};

AcquireIRInstanceFromType: PUBLIC SAFE PROC[type: Type, world: World ← LocalWorld[]]
RETURNS[TypedVariable] = TRUSTED
{IF world # LocalWorld[]
THEN ERROR Error[reason: notImplemented, msg: "access to remote IRs"];
RETURN[GetIRInstance[type, world]]};

GetIRInstance: PROC[irType: Type, world: World] RETURNS[tv: TypedVariable ← NIL] =
{ir: CedarLinkerOps.IR;
IF world # LocalWorld[]
THEN ERROR Error[reason: notImplemented, msg: "access to remote IRs"];
ir ← CedarLinkerOps.GetIR[version: RTTypesBasicPrivate.MapTiTd[irType].utf.umid].interface;
IF ir = NIL THEN RETURN;
tv ← NEW[TypedVariableRec
← [referentType: [type: irType],
head: [reference[ref: ir]],
field: embedded[fd: [wordOffset: SIZE[CedarLinkerOps.IRRecord],
extent: large[size: ir.size]]]]];
};

GetLoadstateDefsNames: PUBLIC SAFE PROC[world: World ← LocalWorld[]]
RETURNS[l: LIST OF ATOM ← NIL] = TRUSTED
{ p: SAFE PROC[atom: ATOM] = TRUSTED
{IF Atom.GetProp[atom, $IR] # NIL THEN l ← CONS[atom, l]};
IF world # LocalWorld[]
THEN ERROR Error[reason: notImplemented, msg: "access to remote IRs"];
Atom.MapAtoms[p];
};

AcquireIRType: PUBLIC SAFE PROC[defsName: ROPE, world: World ← LocalWorld[]]
RETURNS[type: Type] = TRUSTED
{stb: SymbolTableBase;
seIndex: SymbolIndex;

p: PROC[stb: SymbolTableBase, isei: SymbolIdIndex]
RETURNS[stop: BOOLEAN] =
{IF ISEPublic[stb, isei]
THEN {seIndex ← ISEType[stb, isei]; RETURN[TRUE]}
ELSE RETURN[FALSE]};

IF Rope.Find[defsName, "."] = -1 THEN defsName ← Rope.Concat[defsName, ".bcd"];
stb ← AcquireSTBForDefs[defsName];
IF NOT EnumerateCtxIseis[stb: stb,
ctx: STBDirectoryCTX[stb],
proc: p
! UNWIND => ReleaseSTB[stb]]
THEN ERROR;
type ← AcquireType[stb: stb,
seIndex: seIndex
! UNWIND => ReleaseSTB[stb]];
ReleaseSTB[stb];
};


END.