-- 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: BOOL _ FALSE] =
     {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 ATOM _ NIL] = 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.