-- RTMiniModelImpl.mesa
-- Last Modified By Paul Rovner On December 20, 1982 4:33 pm
DIRECTORY
AMBridge USING[TVForGFHReferent],
AMMiniModelPrivate USING[], -- exports only: AcquireIRInstanceFromType
AMTypes USING[TVType, IndexToTV, NameToIndex, TypeClass, UnderType, TVToName,
GlobalParent],
Atom USING[GetProp, MapAtoms],
CedarLinkerOps USING[IR, GetIR, IRRecord],
PilotLoadStateFormat USING[ModuleInfo],
PilotLoadStateOps USING[EnumerateModules],
PrincOps USING[GFTIndex, GlobalFrameHandle, CSegPrefix, MainBodyIndex],
Rope USING[ROPE, Concat],
RTBasic USING[TypedVariable, Type],
RTCommon USING[ShortenLongPointer],
RTMiniModel USING[], -- exports only
RTSymbols USING[ReleaseSTB, EnumerateCtxIseis, AcquireSTBForDefs, AcquireType,
SymbolTableBase, SymbolIdIndex, SymbolIndex],
RTTypesBasicPrivate USING[MapTiTd],
RTTypesPrivate USING[TypedVariableRec, GFT],
RuntimeInternal USING[Codebase];

RTMiniModelImpl: PROGRAM
IMPORTS AMBridge, AMTypes, Atom, CedarLinkerOps, PilotLoadStateOps,
Rope, RTCommon, RTSymbols, RTTypesBasicPrivate, RTTypesPrivate, RuntimeInternal
EXPORTS AMMiniModelPrivate, RTMiniModel

= BEGIN OPEN AMBridge, AMTypes, Rope, RTBasic, RTSymbols, RTTypesPrivate;

ImplementorName: PUBLIC SAFE PROC[defsName, itemName: ROPE] RETURNS[ROPE] = TRUSTED
{inst: TypedVariable;
type: Type;
item: TypedVariable;

inst ← AcquireIRInstance[defsName ! 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]]];
pointer => {gfh: PrincOps.GlobalFrameHandle = FindEnclosingGFH[h.ptr];
IF gfh # NIL
THEN RETURN[TVToName[TVForGFHReferent[gfh]]]
ELSE RETURN[NIL]};
ENDCASE;
ENDCASE;
RETURN[NIL];

EXITS returnNil => RETURN[NIL];
};

FindEnclosingGFH: PROC[ptr: LONG POINTER]
RETURNS[gfh: PrincOps.GlobalFrameHandle ← NIL] =
{p: POINTER = RTCommon.ShortenLongPointer[ptr];
gfSize: PROC[f: PrincOps.GlobalFrameHandle] RETURNS[nWords: CARDINAL ← 0] =
{cp: LONG POINTER TO PrincOps.CSegPrefix
← RuntimeInternal.Codebase[LOOPHOLE[f, PROGRAM]];
pbody: LONG POINTER ← cp + CARDINAL[cp.entry[PrincOps.MainBodyIndex].initialpc];
nWords ← (pbody - 1)^;
};
proc: PROC[rgfi: PrincOps.GFTIndex, module: PilotLoadStateFormat.ModuleInfo]
RETURNS[stop: BOOLFALSE] =
{IF rgfi # 0
THEN {nGFH: PrincOps.GlobalFrameHandle = RTTypesPrivate.GFT[rgfi].frame;
IF (LOOPHOLE[p, CARDINAL] >= LOOPHOLE[nGFH, CARDINAL])
AND (LOOPHOLE[p, CARDINAL] < (LOOPHOLE[nGFH, CARDINAL] + gfSize[nGFH]))
THEN {gfh ← nGFH; stop ← TRUE}};
};
[] ← PilotLoadStateOps.EnumerateModules[proc];
};

AcquireIRInstanceFromType: PUBLIC SAFE PROC[type: Type]
RETURNS[TypedVariable] = TRUSTED
{RETURN[GetIRInstance[type]]};

GetIRInstance: PROC[irType: Type] RETURNS[tv: TypedVariable ← NIL] =
{ir: CedarLinkerOps.IR = CedarLinkerOps.GetIR
[version: RTTypesBasicPrivate.MapTiTd[irType].utf.umid].interface;
tv ← NEW[TypedVariableRec
← [referentType: [type: irType],
head: [reference[ref: ir]],
field: embedded[fd: [wordOffset: SIZE[CedarLinkerOps.IRRecord],
extent: large[size: ir.size]]]]];
};

AcquireIRInstance: PUBLIC SAFE PROC[defsName: ROPE] RETURNS[TypedVariable] = TRUSTED
{RETURN[GetIRInstance[AcquireIRType[defsName]]]};

GetLoadstateDefsNames: PUBLIC SAFE PROC RETURNS[l: LIST OF ATOMNIL] = TRUSTED
{ p: SAFE PROC[atom: ATOM] = TRUSTED
{IF Atom.GetProp[atom, $IR] # NIL THEN l ← CONS[atom, l]};
Atom.MapAtoms[p];
};

-- MOVE
AcquireIRType: PUBLIC SAFE PROC[defsName: ROPE] RETURNS[type: Type] = TRUSTED
{stb: SymbolTableBase;
seIndex: SymbolIndex;

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

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


END.