-- RTTGFNameImpl.mesa, a module to convert gfh's to names
-- Russ Atkinson, 22-Oct-81 16:23:03
-- stolen from some stuff Roy Levin wrote for Alto Laurel (no kidding!)
-- Last Modified by Paul Rovner on August 12, 1982 3:27 pm

DIRECTORY
  BcdDefs: TYPE USING [GFTIndex, MTIndex], 
  BcdOps: TYPE USING [BcdBase, MTHandle, NameString, ProcessModules], 
  ConvertUnsafe: TYPE USING [ToRope], 
  LongString: TYPE USING 
    [AppendChar, AppendOctal, AppendSubString, SubStringDescriptor], 
  PilotLoadStateOps: TYPE USING 
    [AcquireBcd, ConfigIndex, InputLoadState, MapRealToConfig, NullConfig, 
     ReleaseBcd, ReleaseLoadState], 
  PrincOps: TYPE USING 
    [FrameCodeBase, GFTIndex, GlobalFrameHandle, NullGlobalFrame], 
  Rope: TYPE USING [ROPE], 
  RTTypesPrivate: TYPE USING [GFT], 
  SDDefs: TYPE USING [SD, sGFTLength];

RTTGFNameImpl: PROGRAM
  IMPORTS BcdOps, ConvertUnsafe, LongString, PilotLoadStateOps,
          RTTypesPrivate
  EXPORTS RTTypesPrivate
    
  = BEGIN OPEN Rope;
  
  -- the following goodies are here to convert from gfh's to module names
  
  GFHToName: PUBLIC PROC [f: PrincOps.GlobalFrameHandle] RETURNS [ROPE] = {
    s: STRING _ [80]; 
    cgfi: PrincOps.GFTIndex; 
    config: PilotLoadStateOps.ConfigIndex; 
    ssb: BcdOps.NameString; 
    bcd: BcdOps.BcdBase; 
    FindModuleString: PROC
         [mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex] RETURNS [BOOLEAN] = {
      ssd: LongString.SubStringDescriptor;
      IF cgfi IN [mth.gfi..mth.gfi + mth.ngfi) THEN 
         {ssd _ 
            [base: @ssb.string, offset: mth.name, length: ssb.size[mth.name]]; 
          LongString.AppendSubString[s, @ssd]; 
          IF f.copied THEN AppendBracketed[s, f.gfi]; 
          RETURN [TRUE]}; 
      RETURN [FALSE]
      };
    [] _ PilotLoadStateOps.InputLoadState[]; 
    [cgfi, config] _ 
      PilotLoadStateOps.MapRealToConfig
        [(IF f.copied THEN FindOriginal[f] ELSE f).gfi]; 
    IF config = PilotLoadStateOps.NullConfig THEN 
       {PilotLoadStateOps.ReleaseLoadState[]; RETURN [NIL]}; 
    bcd _ PilotLoadStateOps.AcquireBcd[config]; 
    {{ENABLE {
        ANY => GO TO oops};
      ssb _ LOOPHOLE[bcd + bcd.ssOffset]; 
      [] _ BcdOps.ProcessModules[bcd, FindModuleString]}
     EXITS
       oops => {s.length _ 0; AppendBracketed[s, cgfi]}}; 
    PilotLoadStateOps.ReleaseBcd[bcd]; 
    PilotLoadStateOps.ReleaseLoadState[]; 
    RETURN [ConvertUnsafe.ToRope[LONG[s]]]
    }; 
  
  AppendBracketed: PROC [s: STRING, value: UNSPECIFIED] = {
    LongString.AppendChar[s, '[]; 
    LongString.AppendOctal[s, value]; 
    LongString.AppendChar[s, ']]
    }; 
  
  FindOriginal: PROC
       [copy: PrincOps.GlobalFrameHandle] RETURNS [PrincOps.GlobalFrameHandle] = {
    Original: PROC [f: PrincOps.GlobalFrameHandle] RETURNS [BOOLEAN] = {
      RETURN [f # copy AND NOT f.copied AND SameModule[copy, f]]
      };
    RETURN [ReverseEnumerateGFT[Original]]
    }; 
  
  SameModule: PROC [f1, f2: PrincOps.GlobalFrameHandle] RETURNS [same: BOOLEAN] = {
    cb1: PrincOps.FrameCodeBase _ f1.code; 
    cb2: PrincOps.FrameCodeBase _ f2.code;
    cb1.out _ FALSE; 
    cb2.out _ FALSE; 
    RETURN [cb1.longbase = cb2.longbase]
    }; 
  
  ReverseEnumerateGFT: PROC
       [proc: PROC [PrincOps.GlobalFrameHandle] RETURNS [BOOLEAN]]
       RETURNS [frame: PrincOps.GlobalFrameHandle] = {
    ep: CARDINAL;
    FOR i: PrincOps.GFTIndex DECREASING IN [0..SDDefs.SD[SDDefs.sGFTLength]) DO 
        [frame, ep] _ RTTypesPrivate.GFT[i]; 
        IF frame # PrincOps.NullGlobalFrame AND ep = 0 AND proc[frame] THEN 
           RETURN
        ENDLOOP; 
    RETURN [PrincOps.NullGlobalFrame]
    };

  END.