-- AMModelContextImpl.mesa
-- Last Modified On December 21, 1982 2:49 pm By Paul Rovner
-- moduleName, configName should not be source name
-- loadstate, UNWIND shoulda oughta use ANY

DIRECTORY
AMBridge USING [TVForGFHReferent, GFHFromTV, TVToProc, FHFromTV, ContextPC,
GetWorld, RemoteGlobalFrameHandle, IsRemote, RemoteGFHFromTV,
RemoteFHFromTV, TVToRemoteProc, GetWorldIncarnation,
nilRemoteGlobalFrameHandle, TVForRemoteGFHReferent],
AMMiniModelPrivate USING [AcquireIRInstanceFromType],
AMModel USING [Class, Context, PartialInterfaceInstance],
AMModelPrivate USING [FGIndex, FGNull, EPI, PCToFGI, SectionRec, RefTVRec,
ConfigContext, ConfigContextObj, StatementContext,
StatementContextObj, GetLocalBCD, GetRemoteBCD],
AMTypes USING [GlobalParent, Procedure, TVType, Error, TVToName, TypeToName],
BBContext USING [FindAction, FindMatchingGlobalFrames],
BcdDefs USING [NullVersion, VersionStamp, MTIndex, FTSelf, NameRecord,
IMPIndex, EXPIndex, CTIndex, CTNull],
BcdOps USING [BcdBase, MTHandle, ProcessModules, NameString, IMPHandle, ProcessImports,
EXPHandle, ProcessExports, ProcessConfigs, CTHandle],
Convert USING [ValueToRope],
ConvertUnsafe USING [ToRope],
PilotLoadStateFormat USING [ConfigIndex, NullConfig, ModuleInfo, LoadState,
LoadStateObject],
PilotLoadStateOps USING [MapRealToConfig, Map, GetMap, ReleaseMap,
InputLoadState, ReleaseLoadState, NullConfig, AcquireBcd],
PilotLoadStatePrivate USING [InstallLoadState],
PrincOps USING [GlobalFrameHandle, ControlLink, GFTIndex,
FrameCodeBase, NullGlobalFrame, BytePC],
Rope USING [ROPE, Concat, Substr, SkipTo, Index, Length, Match],
RTBasic USING [Type, TV],
RTSymbolDefs USING [SymbolTableBase, SymbolTableHandle, SymbolIndex, SymbolIdIndex,
SymbolConstructorIndex],
RTSymbolOps USING [EnumerateCtxIseis, STBToModuleName, AcquireType],
RTSymbols USING [GetTypeSymbols, AcquireSTB, ReleaseSTB, AcquireSTBFromSGI,
AcquireSTBFromGFH],
RTSymbolsPrivate USING [AcquireBCDFromVersion, ReleaseBCD, GetSTHForModule],
RTTypesBasic USING [fhType, gfhType],
RTTypesPrivate USING [GFT, UnwindIndirectProcDesc, GetEp],
RTTypesRemotePrivate USING [UnwindRemoteIndirectProcDesc, GetRemoteGFHandle,
AcquireRemoteBCDAndModule, GetRemoteGFHeader,
AcquireRemoteBCD, GetRemoteEp, AcquireSTBFromRemoteGFH,
ReleaseRemoteBCD],
SafeStorage USING [NewZone],
SDDefs USING [sGFTLength, SD],
Strings USING [SubStringDescriptor, AppendSubString],
Table USING [Base],
TimeStamp USING [Stamp],
WorldVM USING [LocalWorld, World, WorldName, CurrentIncarnation, Lock, Unlock,
Loadstate];

AMModelContextImpl: PROGRAM
IMPORTS AMBridge, AMMiniModelPrivate, AMTypes, BBContext, BcdOps, Convert,
ConvertUnsafe, PilotLoadStateOps, PilotLoadStatePrivate, Rope, AMModelPrivate,
RTSymbolOps, RTSymbols, RTSymbolsPrivate, RTTypesPrivate, RTTypesRemotePrivate,
Strings, SafeStorage, WorldVM
EXPORTS AMModel, AMModelPrivate

= { OPEN AMBridge, AMMiniModelPrivate, AMModel, AMModelPrivate, AMTypes,
PilotLoadStateFormat, PrincOps, Rope, RTBasic, RTSymbolDefs, RTSymbolOps,
RTSymbols, RTTypesBasic, RTTypesPrivate, RTTypesRemotePrivate, WorldVM;


-- TYPEs

-- either binder output bundle for a config, or compiler output bundle
-- for a prog module, DEFs module, proc, or statement
Section: TYPE = REF SectionObj;
SectionObj: PUBLIC TYPE = SectionRec;

z: PUBLIC ZONE ← SafeStorage.NewZone[quantized];

-- PROCs dealing with Contexts (loadstate entries, global or local frames, statements, IR instances)


RootContext: PUBLIC PROC[world: World] RETURNS[Context] =
-- a "rootContext" represents a Loadstate.
-- Immediate children are the Contexts of loadstate configs for
-- individually loaded program modules and bound configs.
{RETURN[z.NEW[ConfigContextObj ← [world: world,
worldIncarnation: CurrentIncarnation[world],
configIndex: NullConfig]]]};

ContextClass: PUBLIC PROC[context: Context] RETURNS[Class] =
{WITH context SELECT FROM
sc: StatementContext => RETURN[statement];
mc: ConfigContext => IF mc.configIndex = NullConfig
THEN RETURN[world]
ELSE RETURN[model];
tv: RefTVRec =>
{SELECT TVType[tv] FROM
gfhType => RETURN[prog];
fhType => RETURN[proc];
ENDCASE => RETURN[interface];
};
ENDCASE => ERROR AMTypes.Error[reason: notImplemented];
};

ContextWorld: PUBLIC PROC[context: Context] RETURNS[World] =
{WITH context SELECT FROM
sc: StatementContext => RETURN[GetWorld[sc.localFrameTV]];
cc: ConfigContext => RETURN[cc.world];
ENDCASE => RETURN[GetWorld[context]];
};

-- SectionName with instance info
ContextName: PUBLIC PROC[context: Context] RETURNS[ans: ROPE ← NIL] =
{WITH context SELECT FROM
sc: StatementContext =>
{ans ← Rope.Concat[Rope.Concat[ContextName[sc.localFrameTV], ":FGT#"],
Convert.ValueToRope
[[unsigned[NARROW
[ContextSection[context],
REF statement SectionObj].fgtIndex.fgCard]]]
]};
tv: RefTVRec =>
{SELECT TVType[tv] FROM
gfhType => {gfhBits: CARDINAL
= IF GetWorld[tv] # LocalWorld[]
THEN LOOPHOLE[RemoteGFHFromTV[tv].gfh, CARDINAL]
ELSE LOOPHOLE[GFHFromTV[tv], CARDINAL];
ans ← Rope.Concat[TVToName[tv],
Rope.Concat
[":gfh#",
Convert.ValueToRope
[[unsigned[gfhBits]]]
]
];
IF GetWorld[tv] # LocalWorld[]
THEN ans ← Rope.Concat[Rope.Concat[ans, ",world:"],
WorldName[GetWorld[tv]]];
};

fhType => {fhBits: CARDINAL
= IF GetWorld[tv] # LocalWorld[]
THEN LOOPHOLE[RemoteFHFromTV[tv].fh, CARDINAL]
ELSE LOOPHOLE[FHFromTV[tv], CARDINAL];
ans ← Rope.Concat[TVToName[Procedure[tv]],
Rope.Concat
[":fh#",
Convert.ValueToRope
[[unsigned[fhBits]]]]
];
IF GetWorld[tv] # LocalWorld[]
THEN ans ← Rope.Concat[Rope.Concat[ans, ",world:"],
WorldName[GetWorld[tv]]];
};

ENDCASE => {ans ← TypeToName[TVType[tv]];
ans ← Rope.Concat["Interface:", ans];
IF GetWorld[tv] # LocalWorld[]
THEN ans ← Rope.Concat[Rope.Concat[ans, ",world:"],
WorldName[GetWorld[tv]]];
}; -- assume an IR
};

mc: ConfigContext => IF mc.configIndex = NullConfig
THEN ans ← WorldName[mc.world]
ELSE {bcd: BcdOps.BcdBase;
ctHandle: BcdOps.CTHandle;
FindRootConfig: PROC[cth: BcdOps.CTHandle,
cti: BcdDefs.CTIndex]
RETURNS[stop: BOOL ← FALSE] =
{IF cth.config = BcdDefs.CTNull THEN RETURN[TRUE]};

IF mc.world = LocalWorld[]
THEN
{[] ← PilotLoadStateOps.InputLoadState[];
bcd ← PilotLoadStateOps.AcquireBcd[mc.configIndex];
PilotLoadStateOps.ReleaseLoadState[];
[ctHandle,] ← BcdOps.ProcessConfigs[bcd, FindRootConfig];
ans ← Rope.Concat[BcdNameToRope[bcd, ctHandle.name],
Rope.Concat
[":ConfigIndex#",
Convert.ValueToRope
[[signed[mc.configIndex]]]
]]}
ELSE
{ Lock[mc.world];
{ ENABLE UNWIND => Unlock[mc.world];
oldState: PilotLoadStateFormat.LoadState;
newState: REF PilotLoadStateFormat.LoadStateObject;
loadstateHeld: BOOL ← FALSE;

newState ← Loadstate[mc.world];
[] ← PilotLoadStateOps.InputLoadState[];
loadstateHeld ← TRUE;
oldState ← PilotLoadStatePrivate.InstallLoadState
[LOOPHOLE[newState]];
-- no error raised


bcd ← AcquireRemoteBCD
[mc.world,
PilotLoadStateOps.AcquireBcd[mc.configIndex]
! ANY =>
{[] ← PilotLoadStatePrivate.InstallLoadState
[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadstateHeld ← FALSE}];
IF loadstateHeld
THEN {[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadstateHeld ← FALSE};
IF bcd = NIL THEN ERROR;

{ ENABLE UNWIND => ReleaseRemoteBCD[bcd];
[ctHandle,] ← BcdOps.ProcessConfigs[bcd, FindRootConfig];
ans ← BcdNameToRope[bcd, ctHandle.name];
}; -- end ENABLE UNWIND => ... FREE ...
ReleaseRemoteBCD[bcd];
ans ← Rope.Concat[ans, Rope.Concat
[":ConfigIndex#",
Convert.ValueToRope
[[signed[mc.configIndex]]]
]];
ans ← Rope.Concat[Rope.Concat[ans, ",world:"],
WorldName[mc.world]];
}; -- end ENABLE UNWIND => Unlock[mc.world];
Unlock[mc.world];
}; -- end ELSE arm (remote world)
}; -- end ELSE arm (mc.configIndex # NullConfig)

ENDCASE => ERROR AMTypes.Error[reason: notImplemented];
}; -- end ContextName

-- EXAMPLE USAGE: given a module name and a world context, this returns
-- a Context for the most recently loaded global frame for a program with that name.
-- name must identify
-- a model or prog (someday interface) if context identifies a world, or
-- a prog (someday interface) if context identifies a model.
-- The format of the name should be the same as that produced by ContextName,
-- with elided fields meaning "don't care".
-- The result will be either a model or prog (someday interface) context.
MostRecentNamedContext: PUBLIC PROC[name: ROPE, context: --world or model-- Context]
RETURNS[ans: Context ← NIL] =
{WITH context SELECT FROM
mc: ConfigContext =>
{IF mc.configIndex = NullConfig -- the model of a world
THEN
{p: BBContext.FindAction
--PROC[gf: TV, name: ROPE] RETURNS[ActionContinuation ← continue]--
= TRUSTED {ans ← gf; RETURN[quit]};
BBContext.FindMatchingGlobalFrames
[world: ContextWorld[context],
pattern: name,
action: p];
IF ans # NIL THEN RETURN};

-- here to look for a named config or a module of a config
{ p: PROC[c: Context] RETURNS[stop: BOOL ← FALSE] =
{ n: ROPE = ContextName[c];
len: INT ← Rope.Index[s1: n, s2: ":"];
nPart: ROPE ← IF len = Rope.Length[n]
THEN n
ELSE Rope.Substr[base: n, len: len];
IF name.Match[nPart, FALSE] --Rope.Equal[name, nPart]
THEN {ans ← c; stop ← TRUE};
};
[] ← ContextChildren[context, p];
};
};
ENDCASE => ERROR AMTypes.Error
[reason: notImplemented,
msg: "MostRecentNamedContext for other than a world or model Context"];
};

-- an enumerator.
-- Like MostRecentNamedContext, but gets 'em all.
NamedContexts: PUBLIC PROC[name: ROPE,
context: --worldRoot or model--Context,
proc: PROC[Context] RETURNS[stop: BOOL]]
RETURNS[ans: Context ← NIL--NIL if not stopped--] =
{ lookForNamedContext: PROC[c: Context] RETURNS[stop: BOOL ← FALSE] =
{n: ROPE = ContextName[c];
len: INT ← Rope.Index[s1: n, s2: ":"];
nPart: ROPE ← IF len = Rope.Length[n] THEN n ELSE Rope.Substr[base: n, len: len];
IF name.Match[nPart, FALSE] --Rope.Equal[name, nPart]
THEN {stop ← proc[c]; IF stop THEN ans ← c}
ELSE SELECT ContextClass[c] FROM
model => {ans ← NamedContexts[name, c, proc];
IF ans # NIL THEN stop ← TRUE};
ENDCASE;
};

-- start HERE
[] ← ContextChildren[context, lookForNamedContext];
};

--param to creator of context
ContextSection: PUBLIC PROC[context: Context] RETURNS[ans: Section ← NIL] =
{ WITH context SELECT FROM
sc: StatementContext => {parentContext: Context ← ParentContext[context];
UNTIL ContextClass[parentContext] = prog
DO parentContext ← ParentContext[parentContext];
ENDLOOP;
RETURN[z.NEW[SectionObj
← [statement[prog: NARROW
[ContextSection
[parentContext],
REF prog SectionObj],
fgtIndex: StatementContextToFGI
[sc]]
]]]};
tv: RefTVRec =>
{SELECT TVType[tv] FROM
gfhType => -- program module
RETURN
[z.NEW
[SectionObj
← [prog
[moduleName: TVToName[tv],
versionStamp: IF IsRemote[tv]
THEN RemoteGFHToVersionStamp
[RemoteGFHFromTV[tv]]
ELSE GFHToVersionStamp[GFHFromTV[tv]],
someGFHTV: tv]]]];
fhType => {procTV: RefTVRec = NARROW[Procedure[tv]]; -- procedure
RETURN
[z.NEW
[SectionObj
← [proc[prog:
NARROW[ContextSection[GlobalParent[tv]]],
entryPointIndex:
IF IsRemote[procTV]
THEN LOOPHOLE
[UnwindRemoteIndirectProcDesc
[TVToRemoteProc[procTV]].pd,
PrincOps.ControlLink
].ep
ELSE
UnwindIndirectProcDesc
[LOOPHOLE[TVToProc[procTV],
PrincOps.ControlLink]
].ep,
procTV: procTV]]]]};
ENDCASE => -- better be a TV for an interface record
{type: Type = TVType[tv];
stb: SymbolTableBase;
sei: SymbolIndex;
mn: ROPE;
vs: BcdDefs.VersionStamp;
[stb, sei] ← GetTypeSymbols[type];
{ENABLE UNWIND => ReleaseSTB[stb];
csei: SymbolConstructorIndex = stb.UnderType[sei];
WITH ser: stb.seb[csei] SELECT FROM
definition => NULL;
ENDCASE => ERROR;
mn ← STBToModuleName[stb];
vs ← stb.stHandle.version;
ReleaseSTB[stb]};

RETURN[z.NEW[SectionObj ← [interface[moduleName: mn,
versionStamp: vs]]]]};
};

mc: ConfigContext =>
IF mc.world = LocalWorld[]
THEN
{ bcd: BcdOps.BcdBase;
IF mc.configIndex = NullConfig THEN RETURN[NIL];


[] ← PilotLoadStateOps.InputLoadState[];
bcd ← PilotLoadStateOps.AcquireBcd[mc.configIndex];
PilotLoadStateOps.ReleaseLoadState[];
IF bcd = NIL THEN ERROR;
ans ← z.NEW[SectionObj ← [model[configName: StripExtension
[BcdNameToRope
[bcd, bcd.source]],
versionStamp: bcd.version,
configContext: mc]]];
}
ELSE
{ IF mc.configIndex = NullConfig THEN RETURN[NIL];
Lock[mc.world];
{ ENABLE UNWIND => Unlock[mc.world];
oldState: PilotLoadStateFormat.LoadState;
newState: REF PilotLoadStateFormat.LoadStateObject;
bcd: BcdOps.BcdBase;
loadstateHeld: BOOL ← FALSE;

newState ← Loadstate[mc.world];
[] ← PilotLoadStateOps.InputLoadState[];
loadstateHeld ← TRUE;
oldState ← PilotLoadStatePrivate.InstallLoadState[LOOPHOLE[newState]];
-- no error raised

bcd ← AcquireRemoteBCD[mc.world,
PilotLoadStateOps.AcquireBcd[mc.configIndex]
! ANY => {[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadstateHeld ← FALSE}];
IF loadstateHeld
THEN {[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadstateHeld ← FALSE};
IF bcd = NIL THEN ERROR;

{ ENABLE UNWIND => ReleaseRemoteBCD[bcd];
ans ← z.NEW[SectionObj ← [model[configName: StripExtension
[BcdNameToRope
[bcd, bcd.source]],
versionStamp: bcd.version,
configContext: mc]]];
}; -- end ENABLE UNWIND => ... FREE ...
ReleaseRemoteBCD[bcd];
}; -- end ENABLE UNWIND => Unlock[mc.world];
Unlock[mc.world];
};

ENDCASE => ERROR AMTypes.Error[reason: notImplemented];
}; -- end ContextSection

-- world => NIL
-- model => world
-- prog => model
-- proc => prog
-- statement => proc
ParentContext: PUBLIC PROC[context: Context] RETURNS[Context] =
{ WITH context SELECT FROM
sc: StatementContext => RETURN[sc.localFrameTV];
mc: ConfigContext =>
IF mc.configIndex = NullConfig
THEN RETURN[NIL]
ELSE RETURN -- the loadsatate has only one level of structure
[z.NEW[ConfigContextObj ← [world: mc.world,
worldIncarnation:
mc.worldIncarnation,
configIndex: NullConfig]]];
tv: RefTVRec =>
{SELECT TVType[tv] FROM
gfhType =>
IF NOT IsRemote[tv]
THEN
{ci: ConfigIndex;
gfi: PrincOps.GFTIndex;

[] ← PilotLoadStateOps.InputLoadState[];
gfi ← GFHFromTV[tv].gfi;
ci ← PilotLoadStateOps.MapRealToConfig[gfi].config;
PilotLoadStateOps.ReleaseLoadState[];
RETURN[z.NEW[ConfigContextObj ← [world: LocalWorld[],
worldIncarnation: GetWorldIncarnation[tv],
configIndex: ci]]]}
ELSE -- remote case
{ci: ConfigIndex;
world: World = GetWorld[tv];
Lock[world];
{ ENABLE UNWIND => Unlock[world];
oldState: PilotLoadStateFormat.LoadState;
newState: REF PilotLoadStateFormat.LoadStateObject;
gfi: PrincOps.GFTIndex;
loadstateHeld: BOOL ← FALSE;

newState ← Loadstate[world];
[] ← PilotLoadStateOps.InputLoadState[];
loadstateHeld ← TRUE;
oldState ← PilotLoadStatePrivate.InstallLoadState[LOOPHOLE[newState]];
-- no error raised

{ ENABLE ANY => {[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadstateHeld ← FALSE};
gfh: RemoteGlobalFrameHandle = RemoteGFHFromTV[tv];
IF NOT loadstateHeld THEN ERROR;
gfi ← GetRemoteGFHeader[gfh].gfi;
};
IF NOT loadstateHeld THEN ERROR;
ci ← PilotLoadStateOps.MapRealToConfig[gfi].config;
[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[];
}; -- end ENABLE UNWIND => Unlock[world];
Unlock[world];
RETURN[z.NEW[ConfigContextObj ← [world: world,
worldIncarnation: GetWorldIncarnation[tv],
configIndex: ci]]]};
fhType => RETURN[GlobalParent[tv]];
ENDCASE => ERROR AMTypes.Error[reason: typeFault, type: TVType[tv]];};

ENDCASE => ERROR AMTypes.Error[reason: notImplemented];
}; -- end ParentContext

-- world -> model or prog (TV for a global frame)
-- model -> prog
-- proc -> statement
ContextChildren: PUBLIC PROC[context: Context, proc: PROC[Context] RETURNS[stop: BOOL]]
RETURNS[ans: Context ← NIL--NIL if not stopped--] =
{FOR c: Context ← FirstChildContext[context], NextSiblingContext[c]
UNTIL c = NIL DO IF proc[c] THEN RETURN[c]; ENDLOOP;
};

FirstChildContext: PROC[context: Context] RETURNS[ans: Context] =
{ WITH context SELECT FROM

sc: StatementContext =>
RETURN[NIL]; -- do statements have substructure?

tv: RefTVRec =>
SELECT TVType[tv] FROM
fhType => RETURN[z.NEW[StatementContextObj ← [localFrameTV: tv]]];
gfhType => RETURN[NIL];
ENDCASE => ERROR AMTypes.Error[reason: typeFault, type: TVType[tv]];

mc: ConfigContext =>
IF mc.configIndex = NullConfig
THEN {IF mc.world = LocalWorld[]
THEN
{ nbcds: PilotLoadStateFormat.ConfigIndex ← PilotLoadStateOps.InputLoadState[];
bcd: BcdOps.BcdBase ← PilotLoadStateOps.AcquireBcd[nbcds-1];
composite: BOOL ← IsComposite[bcd];

IF composite
THEN {PilotLoadStateOps.ReleaseLoadState[];
RETURN[z.NEW[ConfigContextObj ←
[world: mc.world,
worldIncarnation: mc.worldIncarnation,
configIndex: nbcds-1]]]}
ELSE {map: PilotLoadStateOps.Map = PilotLoadStateOps.GetMap[nbcds-1];
gfh: GlobalFrameHandle ← NIL;

FOR j: GFTIndex IN [1 .. LENGTH[map])
DO IF map[j] # 0
THEN {gfh ← GFT[map[j]].frame;
EXIT};
ENDLOOP;

IF gfh = NIL
THEN {PilotLoadStateOps.ReleaseMap[map];
PilotLoadStateOps.ReleaseLoadState[];
ERROR};
PilotLoadStateOps.ReleaseMap[map];
PilotLoadStateOps.ReleaseLoadState[];
RETURN[TVForGFHReferent[gfh]]};
}
ELSE -- remote world
{nbcds: ConfigIndex;
Lock[mc.world];
{ ENABLE UNWIND => Unlock[mc.world];
oldState: PilotLoadStateFormat.LoadState;
newState: REF PilotLoadStateFormat.LoadStateObject;
loadstateHeld: BOOL ← FALSE;

newState ← Loadstate[mc.world];
[] ← PilotLoadStateOps.InputLoadState[];
loadstateHeld ← TRUE;
oldState ← PilotLoadStatePrivate.InstallLoadState[LOOPHOLE[newState]];
nbcds ← newState.nBcds;
-- no error raised

{ ENABLE ANY => IF loadstateHeld
THEN {[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadstateHeld ← FALSE};
{bcd: BcdOps.BcdBase
← AcquireRemoteBCD[mc.world,
PilotLoadStateOps.AcquireBcd[nbcds-1]];
{ ENABLE UNWIND => ReleaseRemoteBCD[bcd];
IF NOT IsComposite[bcd] -- single module loadstate entry
THEN {gfh: RemoteGlobalFrameHandle ← nilRemoteGlobalFrameHandle;
map: PilotLoadStateOps.Map;
IF NOT loadstateHeld THEN ERROR;
map ← PilotLoadStateOps.GetMap[nbcds-1];

{ ENABLE UNWIND => PilotLoadStateOps.ReleaseMap[map];
FOR j: GFTIndex IN [1.. LENGTH[map])
DO IF map[j] # 0
THEN {gfh ← GetRemoteGFHandle[mc.world, map[j]];
EXIT};
ENDLOOP;

IF gfh = nilRemoteGlobalFrameHandle THEN ERROR;
--UNWIND releases the map, bcd, loadstate, and the world lock
}; -- end ENABLE UNWIND for releasing the map
PilotLoadStateOps.ReleaseMap[map];
ans ← TVForRemoteGFHReferent[gfh]}
ELSE ans ← z.NEW[ConfigContextObj
← [world: mc.world,
worldIncarnation: mc.worldIncarnation,
configIndex: nbcds-1]];
}; -- end ENABLE UNWIND => ... FREE ...
ReleaseRemoteBCD[bcd];
};
}; -- end ENABLE UNWIND => ReleaseLoadState
IF loadstateHeld
THEN {[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadstateHeld ← FALSE};
}; -- end ENABLE UNWIND => Unlock[mc.world];
Unlock[mc.world];
RETURN};
} -- end world config case
ELSE {IF mc.world = LocalWorld[]
THEN
{ map: PilotLoadStateOps.Map;
gfh: GlobalFrameHandle;

[] ← PilotLoadStateOps.InputLoadState[];
map ← PilotLoadStateOps.GetMap[mc.configIndex];
gfh ← NIL;

FOR i: GFTIndex DECREASING IN [1.. LENGTH[map])
DO IF map[i] # 0
THEN {gfh ← GFT[map[i]].frame;
EXIT};
ENDLOOP;
PilotLoadStateOps.ReleaseMap[map];
PilotLoadStateOps.ReleaseLoadState[];
IF gfh = NIL THEN RETURN[NIL];
RETURN[TVForGFHReferent[gfh]]}
ELSE
{gfh: RemoteGlobalFrameHandle ← nilRemoteGlobalFrameHandle;
Lock[mc.world];
{ ENABLE UNWIND => Unlock[mc.world];
oldState: PilotLoadStateFormat.LoadState;
newState: REF PilotLoadStateFormat.LoadStateObject;
map: PilotLoadStateOps.Map;
loadstateHeld: BOOL ← FALSE;

newState ← Loadstate[mc.world];
[] ← PilotLoadStateOps.InputLoadState[];
loadstateHeld ← TRUE;
oldState ← PilotLoadStatePrivate.InstallLoadState[LOOPHOLE[newState]];
-- no error raised

map ← PilotLoadStateOps.GetMap[mc.configIndex];

{ ENABLE ANY => {PilotLoadStateOps.ReleaseMap[map];
[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadstateHeld ← FALSE};
FOR i: GFTIndex DECREASING IN [1 .. LENGTH[map])
DO IF map[i] # 0
THEN {gfh ← GetRemoteGFHandle[mc.world, map[i]];
EXIT};
ENDLOOP;
}; -- end ENABLE UNWIND
PilotLoadStateOps.ReleaseMap[map];

IF loadstateHeld
THEN {[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadstateHeld ← FALSE};
}; -- end ENABLE UNWIND => Unlock[mc.world];
Unlock[mc.world];
IF gfh = nilRemoteGlobalFrameHandle THEN RETURN[NIL];
RETURN[TVForRemoteGFHReferent[gfh]]}};


ENDCASE => ERROR AMTypes.Error[reason: notImplemented];
}; -- end FirstChildContext

-- model -> model or prog (TV for a global frame)
-- prog -> model or prog
-- returns NIL if nomore
NextSiblingContext: PROC[context: Context] RETURNS[ans: Context ← NIL] =
{ IF context = NIL THEN RETURN[NIL];
WITH context SELECT FROM
sc: StatementContext => RETURN[NIL]; -- substructure?

mc: ConfigContext =>
{IF mc.configIndex = NullConfig THEN RETURN[NIL];
IF mc.world = LocalWorld[]
THEN
{nbcds: ConfigIndex;
nbcds ← PilotLoadStateOps.InputLoadState[];
IF mc.configIndex > 0
THEN {bcd: BcdOps.BcdBase = PilotLoadStateOps.AcquireBcd[mc.configIndex-1];
IF NOT IsComposite[bcd] -- single module loadstate entry
THEN {map: PilotLoadStateOps.Map = PilotLoadStateOps.GetMap
[mc.configIndex-1];
gfh: GlobalFrameHandle ← NIL;

FOR j: GFTIndex DECREASING IN [1 .. LENGTH[map])
DO IF map[j] # 0
THEN {gfh ← GFT[map[j]].frame;
EXIT};
ENDLOOP;

IF gfh = NIL
THEN {PilotLoadStateOps.ReleaseMap[map];
PilotLoadStateOps.ReleaseLoadState[];
ERROR};
PilotLoadStateOps.ReleaseMap[map];
ans ← TVForGFHReferent[gfh
! UNWIND => PilotLoadStateOps.ReleaseLoadState[]]}
ELSE ans ← z.NEW[ConfigContextObj
← [world: mc.world,
worldIncarnation: mc.worldIncarnation,
configIndex: mc.configIndex-1]];
};
PilotLoadStateOps.ReleaseLoadState[];
RETURN}
ELSE -- remote ConfigContext
{nbcds: ConfigIndex;
Lock[mc.world];
{ ENABLE UNWIND => Unlock[mc.world];
oldState: PilotLoadStateFormat.LoadState;
newState: REF PilotLoadStateFormat.LoadStateObject;
loadstateHeld: BOOL ← FALSE;

newState ← Loadstate[mc.world];
[] ← PilotLoadStateOps.InputLoadState[];
loadstateHeld ← TRUE;
oldState ← PilotLoadStatePrivate.InstallLoadState[LOOPHOLE[newState]];
nbcds ← newState.nBcds;
-- no error raised

{ ENABLE ANY => IF loadstateHeld
THEN {[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadstateHeld ← FALSE};
IF mc.configIndex > 0
THEN {bcd: BcdOps.BcdBase
← AcquireRemoteBCD[mc.world,
PilotLoadStateOps.AcquireBcd
[mc.configIndex-1]];
{ ENABLE UNWIND => ReleaseRemoteBCD[bcd];
IF NOT IsComposite[bcd] -- single module loadstate entry
THEN {gfh: RemoteGlobalFrameHandle ← nilRemoteGlobalFrameHandle;
map: PilotLoadStateOps.Map;
IF NOT loadstateHeld THEN ERROR;
map ← PilotLoadStateOps.GetMap[mc.configIndex-1];


FOR j: GFTIndex DECREASING IN [1 .. LENGTH[map])
DO IF map[j] # 0
THEN {gfh ← GetRemoteGFHandle[mc.world, map[j]];
EXIT};
ENDLOOP;

IF gfh = nilRemoteGlobalFrameHandle
THEN {PilotLoadStateOps.ReleaseMap[map];
ERROR--UNWIND releases the bcd, loadstate, and the world lock--};
PilotLoadStateOps.ReleaseMap[map];
ans ← TVForRemoteGFHReferent[gfh]}
ELSE ans ← z.NEW[ConfigContextObj
← [world: mc.world,
worldIncarnation: mc.worldIncarnation,
configIndex: mc.configIndex-1]];
}; -- end ENABLE UNWIND => ... FREE ...
ReleaseRemoteBCD[bcd];
};
}; -- end ENABLE UNWIND => ReleaseLoadState
IF loadstateHeld
THEN {[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadstateHeld ← FALSE};
}; -- end ENABLE UNWIND => Unlock[mc.world];
Unlock[mc.world];
RETURN}};

tv: RefTVRec =>
{SELECT TVType[tv] FROM
gfhType =>
IF IsRemote[tv]
THEN
{gfh: RemoteGlobalFrameHandle = RemoteGFHFromTV[tv];
rgfi: GFTIndex = GetRemoteGFHeader[gfh].gfi;
config: ConfigIndex;
map: PilotLoadStateOps.Map;
siblingGFH: RemoteGlobalFrameHandle ← nilRemoteGlobalFrameHandle;
bcd: BcdOps.BcdBase;
world: World = GetWorld[tv];
nbcds: ConfigIndex;
loadstateHeld: BOOL ← FALSE;

Lock[world];
{ ENABLE UNWIND => Unlock[world];
oldState: PilotLoadStateFormat.LoadState;
newState: REF PilotLoadStateFormat.LoadStateObject;

newState ← Loadstate[world];
[] ← PilotLoadStateOps.InputLoadState[];
loadstateHeld ← TRUE;
oldState ← PilotLoadStatePrivate.InstallLoadState[LOOPHOLE[newState]];
nbcds ← newState.nBcds;
-- no error raised

{ ENABLE ANY => IF loadstateHeld
THEN {[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadstateHeld ← FALSE};
config ← PilotLoadStateOps.MapRealToConfig[rgfi].config;
bcd ← AcquireRemoteBCD[world,
PilotLoadStateOps.AcquireBcd[config]];

{ ENABLE UNWIND => ReleaseRemoteBCD[bcd];
IF NOT IsComposite[bcd] -- want sibling one level up
THEN {siblingBCD: BcdOps.BcdBase;
IF config = 0 -- last config in loadstate
THEN {IF loadstateHeld
THEN {[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadstateHeld ← FALSE};
ReleaseRemoteBCD[bcd];
Unlock[world];
RETURN[NIL]};
IF NOT loadstateHeld THEN ERROR;
siblingBCD ← AcquireRemoteBCD
[world,
PilotLoadStateOps.AcquireBcd[config-1]];
{ ENABLE UNWIND =>
ReleaseRemoteBCD[siblingBCD];
IF NOT loadstateHeld THEN ERROR;
IF NOT IsComposite[siblingBCD]
THEN
{siblingMap: PilotLoadStateOps.Map
= PilotLoadStateOps.GetMap[config-1];
{ENABLE UNWIND => PilotLoadStateOps.ReleaseMap[siblingMap];
FOR i: GFTIndex DECREASING IN [1 .. LENGTH[siblingMap])
DO IF siblingMap[i] # 0
THEN {siblingGFH ← GetRemoteGFHandle[world,
siblingMap[i]];
EXIT};
ENDLOOP;
}; -- end ENABLE UNWIND => ReleaseMap[siblingMap];
PilotLoadStateOps.ReleaseMap[siblingMap];
IF siblingGFH = nilRemoteGlobalFrameHandle
THEN ans ← NIL
ELSE ans ← TVForRemoteGFHReferent[siblingGFH]}
ELSE ans ← z.NEW[ConfigContextObj
← [world: GetWorld[tv],
worldIncarnation:
GetWorldIncarnation[tv],
configIndex: config-1]];
}; -- end ENABLE UNWIND => ... FREE[@siblingBCD]
ReleaseRemoteBCD[siblingBCD];
IF loadstateHeld
THEN {[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadstateHeld ← FALSE};
ReleaseRemoteBCD[bcd];
Unlock[world];
RETURN;
};

-- here to get prog sibling of this composite config
map ← PilotLoadStateOps.GetMap[config];
{ ENABLE UNWIND => PilotLoadStateOps.ReleaseMap[map];
FOR i: GFTIndex DECREASING IN [1 .. LENGTH[map])
DO IF map[i] = rgfi
THEN {FOR j: GFTIndex DECREASING IN [1 .. i)
DO IF map[j] # 0
AND GetRemoteGFHandle[world, map[j]] # gfh
THEN {siblingGFH ← GetRemoteGFHandle[world, map[j]];
EXIT};
ENDLOOP;
EXIT};
ENDLOOP;
}; -- end ENABLE UNWIND => PilotLoadStateOps.ReleaseMap[map];
PilotLoadStateOps.ReleaseMap[map];
}; -- end ENABLE UNWIND => ... FREE ...
ReleaseRemoteBCD[bcd];
}; -- end ENABLE UNWIND => ...ReleaseLoadState[];
[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[];
}; -- end ENABLE UNWIND => Unlock[world];
Unlock[world];

IF siblingGFH = nilRemoteGlobalFrameHandle
THEN RETURN[NIL]
ELSE RETURN[TVForRemoteGFHReferent[siblingGFH]]
}
ELSE -- local case
{gfh: GlobalFrameHandle = GFHFromTV[tv];
rgfi: GFTIndex = gfh.gfi;
config: ConfigIndex;
map: PilotLoadStateOps.Map;
siblingGFH: GlobalFrameHandle ← NIL;
bcd: BcdOps.BcdBase;

nbcds: ConfigIndex = PilotLoadStateOps.InputLoadState[];
config ← PilotLoadStateOps.MapRealToConfig[rgfi].config;
bcd ← PilotLoadStateOps.AcquireBcd[config];
IF NOT IsComposite[bcd] -- want sibling one level up
THEN {siblingBCD: BcdOps.BcdBase;
IF config = 0 -- last config in loadstate
THEN {PilotLoadStateOps.ReleaseLoadState[];
RETURN[NIL]};
siblingBCD ← PilotLoadStateOps.AcquireBcd[config-1];
IF NOT IsComposite[siblingBCD]
THEN
{ siblingMap: PilotLoadStateOps.Map
= PilotLoadStateOps.GetMap[config-1];
FOR i: GFTIndex DECREASING IN [1 .. LENGTH[siblingMap])
DO IF siblingMap[i] # 0
THEN {siblingGFH ← GFT[siblingMap[i]].frame;
EXIT};
ENDLOOP;
PilotLoadStateOps.ReleaseMap[siblingMap];
PilotLoadStateOps.ReleaseLoadState[];
IF siblingGFH = NIL
THEN RETURN[NIL]
ELSE RETURN[TVForGFHReferent[siblingGFH]]}
ELSE {PilotLoadStateOps.ReleaseLoadState[];
RETURN[z.NEW[ConfigContextObj
← [world: LocalWorld[],
worldIncarnation:
CurrentIncarnation[LocalWorld[]],
configIndex: config-1]]]}};

-- here to get prog sibling of this composite config
map ← PilotLoadStateOps.GetMap[config];

FOR i: GFTIndex DECREASING IN [1 .. LENGTH[map])
DO IF map[i] = rgfi
THEN {FOR j: GFTIndex DECREASING IN [1 .. i)
DO IF map[j] # 0
AND GFT[map[j]].frame # gfh
THEN {siblingGFH ← GFT[map[j]].frame; EXIT};
ENDLOOP;
EXIT};
ENDLOOP;
PilotLoadStateOps.ReleaseMap[map];
PilotLoadStateOps.ReleaseLoadState[];
IF siblingGFH = NIL
THEN RETURN[NIL]
ELSE RETURN[TVForGFHReferent[siblingGFH]]};
ENDCASE => ERROR AMTypes.Error[reason: typeFault, type: TVType[tv]];
};
ENDCASE => ERROR;
}; -- end NextSiblingContext


-- ... dealing with PartialInterfaceInstances

-- Implemented only for loadstate entries and global frames
-- sharing
Imports: PUBLIC PROC[context: Context] RETURNS[ans: LIST OF PartialInterfaceInstance ← NIL] =
{WITH context SELECT FROM
mc: ConfigContext =>
{bcd: BcdOps.BcdBase;
ftb: Table.Base;
AcquireIR: PROC [imph: BcdOps.IMPHandle, impi: BcdDefs.IMPIndex]
RETURNS [stop: BOOLEAN ← FALSE] =
{type: Type;
seIndex: SymbolIndex;
stb: SymbolTableBase ← AcquireSTB
[RTSymbolsPrivate.GetSTHForModule
[stamp: ftb[imph.file].version,
fileName: BcdNameToRope[bcd,
ftb[imph.file].name],
moduleName: BcdNameToRope[bcd,
imph.name]]];
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]};

IF NOT EnumerateCtxIseis[stb: stb,
ctx: stb.stHandle.directoryCtx,
proc: p
! UNWIND => ReleaseSTB[stb]]
THEN {ReleaseSTB[stb]; ERROR};
type ← AcquireType[stb: stb, seIndex: seIndex ! UNWIND => ReleaseSTB[stb]];
ReleaseSTB[stb];
ans ← z.CONS[[ir: AcquireIRInstanceFromType[type], -- NOTE remote
usingList: NIL], -- NOTE
ans];
};

IF mc.configIndex = NullConfig THEN RETURN[NIL];
IF mc.world # LocalWorld[]
THEN
{ Lock[mc.world];
{ ENABLE UNWIND => Unlock[mc.world];
oldState: PilotLoadStateFormat.LoadState;
newState: REF PilotLoadStateFormat.LoadStateObject;
bcd: BcdOps.BcdBase;
loadstateHeld: BOOL ← FALSE;

newState ← Loadstate[mc.world];
[] ← PilotLoadStateOps.InputLoadState[];
loadstateHeld ← TRUE;
oldState ← PilotLoadStatePrivate.InstallLoadState[LOOPHOLE[newState]];
-- no error raised

bcd ← AcquireRemoteBCD[mc.world, PilotLoadStateOps.AcquireBcd[mc.configIndex]
! UNWIND => {[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadstateHeld ← FALSE}];
IF loadstateHeld
THEN {[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadstateHeld ← FALSE};
IF bcd = NIL THEN ERROR;

{ ENABLE UNWIND => ReleaseRemoteBCD[bcd];
ftb ← LOOPHOLE[bcd + bcd.ftOffset];
IF NOT IsComposite[bcd] THEN ERROR; -- single module loadstate entry
[] ← BcdOps.ProcessImports[bcd, AcquireIR];
}; -- end ENABLE UNWIND => ... FREE ...
ReleaseRemoteBCD[bcd];
}; -- end ENABLE UNWIND => Unlock[mc.world];
Unlock[mc.world];
}
ELSE -- local case
{[] ← PilotLoadStateOps.InputLoadState[];
bcd ← PilotLoadStateOps.AcquireBcd[mc.configIndex];
PilotLoadStateOps.ReleaseLoadState[];
ftb ← LOOPHOLE[bcd + bcd.ftOffset];
IF NOT IsComposite[bcd] THEN ERROR; -- single module loadstate entry
[] ← BcdOps.ProcessImports[bcd, AcquireIR]};
};

tv: RefTVRec =>
{SELECT TVType[tv] FROM
gfhType => -- gets top level imports from the loadstate, via the minimodel
-- encapsulation awaits the modeller.
{bcd: BcdOps.BcdBase = RTSymbolsPrivate.AcquireBCDFromVersion
[versionStamp: GFHToVersionStamp[GFHFromTV[tv]],
shortFileNameHint: Rope.Concat[TVToName[tv],
".bcd"]];
ftb: Table.Base = LOOPHOLE[bcd + bcd.ftOffset];
AcquireIR: PROC[imph: BcdOps.IMPHandle, impi: BcdDefs.IMPIndex]
RETURNS [stop: BOOLEAN ← FALSE] =
{type: Type;
seIndex: SymbolIndex;
stb: SymbolTableBase ← AcquireSTB
[RTSymbolsPrivate.GetSTHForModule
[stamp: ftb[imph.file].version,
fileName: BcdNameToRope[bcd,
ftb[imph.file].name],
moduleName: BcdNameToRope[bcd,
imph.name]]];
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]};

IF NOT EnumerateCtxIseis[stb: stb,
ctx: stb.stHandle.directoryCtx,
proc: p
! UNWIND => ReleaseSTB[stb]]
THEN {ReleaseSTB[stb]; ERROR};
type ← AcquireType[stb: stb, seIndex: seIndex ! UNWIND => ReleaseSTB[stb]];
ReleaseSTB[stb];
ans ← z.CONS[[ir: AcquireIRInstanceFromType[type], -- NOTE remote
usingList: NIL], -- NOTE
ans];
};

IF IsComposite[bcd]
THEN {RTSymbolsPrivate.ReleaseBCD[bcd]; ERROR}--disaster--;
-- single module bcd

[] ← BcdOps.ProcessImports[bcd, AcquireIR
! UNWIND => RTSymbolsPrivate.ReleaseBCD[bcd]];
RTSymbolsPrivate.ReleaseBCD[bcd];
};
ENDCASE => ERROR AMTypes.Error[reason: typeFault, type: TVType[tv]];
-- NOTE interface modules import stuff.
};
ENDCASE => ERROR;
}; -- end Imports

-- Implemented only for loadstate entries and global frames
-- sharing!
Exports: PUBLIC PROC[context: Context] RETURNS[ans: LIST OF PartialInterfaceInstance ← NIL] =
{ WITH context SELECT FROM
mc: ConfigContext =>
{bcd: BcdOps.BcdBase;
ftb: Table.Base;
AcquireIR: PROC [exph: BcdOps.EXPHandle, expi: BcdDefs.EXPIndex]
RETURNS [stop: BOOLEAN ← FALSE] =
{type: Type;
seIndex: SymbolIndex;
stb: SymbolTableBase ← AcquireSTB
[RTSymbolsPrivate.GetSTHForModule
[stamp: ftb[exph.file].version,
fileName: BcdNameToRope[bcd,
ftb[exph.file].name],
moduleName: BcdNameToRope[bcd, exph.name]]];
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]};

IF NOT EnumerateCtxIseis[stb: stb,
ctx: stb.stHandle.directoryCtx,
proc: p
! UNWIND => ReleaseSTB[stb]]
THEN {ReleaseSTB[stb]; ERROR};
type ← AcquireType[stb: stb, seIndex: seIndex ! UNWIND => ReleaseSTB[stb]];
ReleaseSTB[stb];
ans ← z.CONS[[ir: AcquireIRInstanceFromType[type], -- NOTE remote
usingList: NIL], -- NOTE
ans];
};

IF mc.configIndex = NullConfig THEN RETURN[NIL];
IF mc.world # LocalWorld[]
THEN
{ Lock[mc.world];
{ ENABLE UNWIND => Unlock[mc.world];
oldState: PilotLoadStateFormat.LoadState;
newState: REF PilotLoadStateFormat.LoadStateObject;
bcd: BcdOps.BcdBase;
loadstateHeld: BOOL ← FALSE;

newState ← Loadstate[mc.world];
[] ← PilotLoadStateOps.InputLoadState[];
loadstateHeld ← TRUE;
oldState ← PilotLoadStatePrivate.InstallLoadState[LOOPHOLE[newState]];
-- no error raised

{ ENABLE ANY => {[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadstateHeld ← FALSE};
bcd ← AcquireRemoteBCD[mc.world, PilotLoadStateOps.AcquireBcd[mc.configIndex]];
};
IF loadstateHeld
THEN {[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadstateHeld ← FALSE};
IF bcd = NIL THEN ERROR;

{ ENABLE UNWIND => ReleaseRemoteBCD[bcd];
ftb ← LOOPHOLE[bcd + bcd.ftOffset];
IF NOT IsComposite[bcd] THEN ERROR; -- single module loadstate entry
[] ← BcdOps.ProcessExports[bcd, AcquireIR];
}; -- end ENABLE UNWIND => ... FREE ...
ReleaseRemoteBCD[bcd];
}; -- end ENABLE UNWIND => Unlock[mc.world];
Unlock[mc.world];
}
ELSE -- local case
{[] ← PilotLoadStateOps.InputLoadState[];
bcd ← PilotLoadStateOps.AcquireBcd[mc.configIndex];
PilotLoadStateOps.ReleaseLoadState[];
ftb ← LOOPHOLE[bcd + bcd.ftOffset];
IF NOT IsComposite[bcd] THEN ERROR; -- single module loadstate entry
[] ← BcdOps.ProcessExports[bcd, AcquireIR]};
};
tv: RefTVRec =>
{SELECT TVType[tv] FROM
gfhType => -- gets top level imports from the loadstate, via the minimodel
-- encapsulation awaits the modeller.
{bcd: BcdOps.BcdBase = RTSymbolsPrivate.AcquireBCDFromVersion
[versionStamp: GFHToVersionStamp[GFHFromTV[tv]],
shortFileNameHint: Rope.Concat[TVToName[tv],
".bcd"]];
ftb: Table.Base = LOOPHOLE[bcd + bcd.ftOffset];
AcquireIR: PROC[exph: BcdOps.EXPHandle, expi: BcdDefs.EXPIndex]
RETURNS [stop: BOOLEAN ← FALSE] =
{type: Type;
seIndex: SymbolIndex;
stb: SymbolTableBase ← AcquireSTB
[RTSymbolsPrivate.GetSTHForModule
[stamp: ftb[exph.file].version,
fileName: BcdNameToRope[bcd,
ftb[exph.file].name],
moduleName: BcdNameToRope[bcd, exph.name]]];
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]};

IF NOT EnumerateCtxIseis[stb: stb,
ctx: stb.stHandle.directoryCtx,
proc: p
! UNWIND => ReleaseSTB[stb]]
THEN {ReleaseSTB[stb]; ERROR};
type ← AcquireType[stb: stb, seIndex: seIndex ! UNWIND => ReleaseSTB[stb]];
ReleaseSTB[stb];
ans ← z.CONS[[ir: AcquireIRInstanceFromType[type], -- NOTE remote
usingList: NIL], -- NOTE
ans];
};

IF IsComposite[bcd]
THEN {RTSymbolsPrivate.ReleaseBCD[bcd]; ERROR}--disaster--;
-- single module bcd

[] ← BcdOps.ProcessExports[bcd, AcquireIR
! UNWIND => RTSymbolsPrivate.ReleaseBCD[bcd]];
RTSymbolsPrivate.ReleaseBCD[bcd];
};
ENDCASE => ERROR AMTypes.Error[reason: typeFault, type: TVType[tv]];
};
ENDCASE => ERROR;
}; -- end Exports


-- Private Procedures

StripExtension: PROC[name: ROPE] RETURNS[ROPE] =
{RETURN[Rope.Substr[base: name, start: 0, len: Rope.SkipTo[s: name, pos: 0, skip: "."]]]};

IsComposite: PROC[bcd: BcdOps.BcdBase] RETURNS[BOOL] = {RETURN[bcd.nConfigs # 0]};

BcdNameToRope: PROC[bcd: BcdOps.BcdBase, n: BcdDefs.NameRecord] RETURNS[ROPE] =
{nameString: STRING = [100];
ssb: BcdOps.NameString = LOOPHOLE[bcd + bcd.ssOffset];
ssd: Strings.SubStringDescriptor ← [base: @ssb.string,
offset: n,
length: MIN[ssb.size[n], 100]];
nameString.length ← 0;
Strings.AppendSubString[nameString, @ssd];
RETURN[ConvertUnsafe.ToRope[LONG[nameString]]]};

RemoteGFHToVersionStamp: PROC[gfh: RemoteGlobalFrameHandle]
RETURNS[version: BcdDefs.VersionStamp ← BcdDefs.NullVersion] =
{ mappedBCD: BcdOps.BcdBase;
module: PilotLoadStateFormat.ModuleInfo; -- a loadstate.gft entry
mth: BcdOps.MTHandle;
ftb: Table.Base;

FindModule: PROC [mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
RETURNS [BOOLEAN] =
{RETURN[module.gfi IN [mth.gfi .. mth.gfi + mth.ngfi)]};

[mappedBCD, module] ← AcquireRemoteBCDAndModule[gfh];

-- here with the copied remote BCD. Now poke around in the remote bcd to find
-- the version stamp
ftb ← LOOPHOLE[LOOPHOLE[mappedBCD, LONG POINTER] + mappedBCD.ftOffset];

[mth, ] ← BcdOps.ProcessModules[LOOPHOLE[mappedBCD], FindModule];
IF mth = NIL THEN {ReleaseRemoteBCD[mappedBCD];
ERROR}--disaster--;

version ← IF mth.file = BcdDefs.FTSelf
THEN mappedBCD.version
ELSE ftb[mth.file].version;
ReleaseRemoteBCD[mappedBCD];
};


GFHToVersionStamp: PROC[f: PrincOps.GlobalFrameHandle]
RETURNS[version: BcdDefs.VersionStamp ← BcdDefs.NullVersion] =
{ cgfi: PrincOps.GFTIndex;
config: ConfigIndex;
bcd: BcdOps.BcdBase;
ftb: Table.Base;

FindModuleVersion: PROC[mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
RETURNS[BOOLEAN] =
{IF cgfi IN [mth.gfi..mth.gfi + mth.ngfi)
THEN {version ← IF mth.file = BcdDefs.FTSelf
THEN bcd.version
ELSE ftb[mth.file].version;
RETURN[TRUE]}
ELSE RETURN[FALSE]};

-- start GFHToVersionStamp here
[] ← PilotLoadStateOps.InputLoadState[];
[cgfi, config] ← PilotLoadStateOps.MapRealToConfig
[(IF f.copied THEN FindOriginal[f] ELSE f).gfi];
IF config = PilotLoadStateOps.NullConfig
THEN {PilotLoadStateOps.ReleaseLoadState[]; RETURN};

bcd ← PilotLoadStateOps.AcquireBcd[config];
ftb ← LOOPHOLE[bcd + bcd.ftOffset];
[] ← BcdOps.ProcessModules[bcd, FindModuleVersion];
PilotLoadStateOps.ReleaseLoadState[];
};

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[BOOL]]
RETURNS [frame: PrincOps.GlobalFrameHandle] =
{FOR i: PrincOps.GFTIndex DECREASING IN [0..SDDefs.SD[SDDefs.sGFTLength])
DO ep: CARDINAL;
[frame, ep] ← GFT[i];
IF frame # PrincOps.NullGlobalFrame AND ep = 0 AND proc[frame]
THEN RETURN
ENDLOOP;
RETURN [PrincOps.NullGlobalFrame]
};

ProgPCToFGI: PUBLIC PROC[prog: RTBasic.TV--globalFrame--, pc: PrincOps.BytePC]
RETURNS[ans: FGIndex ← FGNull] =
{stb: SymbolTableBase;
IF IsRemote[prog]
THEN stb ← AcquireSTBFromRemoteGFH[RemoteGFHFromTV[prog]]
ELSE stb ← AcquireSTBFromGFH[GFHFromTV[prog]];

{ENABLE UNWIND => ReleaseSTB[stb];
--now compute the epi and the relative pc
epi: EPI;
startPC: PrincOps.BytePC;

IF IsRemote[prog]
THEN [epi, startPC] ← RTTypesRemotePrivate.GetRemoteEp
[pc: pc,
gf: RemoteGFHFromTV[prog],
stb: stb]
ELSE [epi, startPC] ← RTTypesPrivate.GetEp
[pc: pc,
gf: GFHFromTV[prog],
stb: stb];
ans ← PCToFGI[stb, epi, pc - startPC];
}; -- end ENABLE UNWIND => ReleaseSTB[stb];

ReleaseSTB[stb];
};

-- [local frame, PC] => FGIndex (wrt prog module bcd)
StatementContextToFGI: PROC[sc: StatementContext] RETURNS[ans: FGIndex ← FGNull] =
{prog: REF prog SectionObj ← NIL;
bcd: BcdOps.BcdBase;
c: Context ← sc;
world: World;
local: BOOL ← FALSE;

UNTIL ContextClass[c] = prog DO c ← ParentContext[c]; ENDLOOP;
world ← GetWorld[c];
prog ← NARROW[ContextSection[c]];

local ← (world = LocalWorld[]);

IF local
THEN bcd ← GetLocalBCD[rgfi: GFHFromTV[c].gfi]
ELSE bcd ← GetRemoteBCD[world: world, rgfi: GetRemoteGFHeader[RemoteGFHFromTV[c]].gfi];

{ENABLE UNWIND => IF NOT local THEN ReleaseRemoteBCD[bcd];
mth: BcdOps.MTHandle;
stb: SymbolTableBase;

GetModule: PROC[mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex] RETURNS[BOOL] =
{RETURN[TRUE]};

[mth,] ← BcdOps.ProcessModules[bcd, GetModule];
IF mth = NIL THEN ERROR;
stb ← AcquireSTBFromSGI[bcd: bcd, sgi: mth.sseg];

{ENABLE UNWIND => ReleaseSTB[stb];
--now compute the epi and the relative pc
pc: PrincOps.BytePC = AMBridge.ContextPC[sc.localFrameTV];
epi: EPI;
startPC: PrincOps.BytePC;

IF IsRemote[sc.localFrameTV]
THEN [epi, startPC] ← RTTypesRemotePrivate.GetRemoteEp
[pc: pc,
gf: RemoteGFHFromTV[GlobalParent[sc.localFrameTV]],
stb: stb]
ELSE [epi, startPC] ← RTTypesPrivate.GetEp
[pc: pc,
gf: FHFromTV[sc.localFrameTV].accesslink,
stb: stb];
ans ← PCToFGI[stb, epi, pc - startPC];
}; -- end ENABLE UNWIND => ReleaseSTB[stb];

ReleaseSTB[stb];
}; -- end ENABLE UNWIND => ... ReleaseRemoteBCD;

IF NOT local THEN ReleaseRemoteBCD[bcd];
}; -- end StatementContextToFGI

}.