-- AMModelLocationImpl.mesa
-- Last Modified On March 29, 1983 3:17 pm By Paul Rovner

DIRECTORY
AMBridge USING[GFHFromTV, IsRemote, RemoteGFHFromTV, GetWorld, TVForGFHReferent,
TVForRemoteGFHReferent, RemoteGlobalFrameHandle,
nilRemoteGlobalFrameHandle],
AMModel USING[SectionObj, SectionClass, Context],
AMModelLocation USING[CodeLocation],
AMModelPrivate USING[SectionRec, EPI, FGIToEPI, FGIToFirstPC, EPIToFirstPC, EPIToLastPC,
PCOffset, z, GetModuleSTB],
AMTypes USING[Error],
BcdDefs USING[VersionStamp, MTIndex, FTSelf],
BcdOps USING[BcdBase, MTHandle, ProcessModules],
PilotLoadStateFormat USING[LoadState, LoadStateObject, ConfigIndex],
PilotLoadStateOps USING[InputLoadState, AcquireBcd, MapRealToConfig, ReleaseLoadState,
EnumerateBcds, Map, ReleaseMap, GetMap],
PilotLoadStatePrivate USING[InstallLoadState],
PrincOps USING[FrameCodeBase, BytePC, GFTIndex, GlobalFrameHandle],
RTSymbolDefs USING[SymbolTableBase],
RTSymbols USING[ReleaseSTB],
RTTypesPrivate USING[GetPc, GFT],
RTTypesRemotePrivate USING[GetRemoteGFHeader, GetRemotePc, AcquireRemoteBCD,
GetRemoteGFHandle, ReleaseRemoteBCD],
Table USING[Base],
WorldVM USING[World, NoWorld, LocalWorld, Lock, Unlock, Loadstate];

AMModelLocationImpl: PROGRAM
IMPORTS AMBridge, AMModel, AMModelPrivate, AMTypes, BcdOps, PilotLoadStateOps,
PilotLoadStatePrivate, RTSymbols, RTTypesPrivate, RTTypesRemotePrivate,
WorldVM
EXPORTS AMModel, AMModelLocation, AMModelPrivate

= { OPEN AMBridge, AMModel, AMModelLocation, AMModelPrivate,
AMTypes, BcdOps, RTSymbolDefs, RTSymbols, RTTypesPrivate,
RTTypesRemotePrivate, PrincOps, 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;

EntryLocations: PUBLIC PROC[section: Section]
RETURNS[world: World, list: LIST OF CodeLocation ← NIL] =
{[world: world, list: list] ← GetLocations[section]};

ExitLocations: PUBLIC PROC[section: Section]
RETURNS[world: World, list: LIST OF CodeLocation ← NIL] =
{[world: world, list: list] ← GetLocations[section: section, entry: FALSE]};

GetLocations: PROC[section: Section, entry: BOOL ← TRUE]
RETURNS[world: World ← NoWorld[], list: LIST OF CodeLocation ← NIL] =
{epi: EPI;
firstPC: PCOffset;
progContexts: LIST OF Context ← NIL;
context: Context ← NIL;
version: BcdDefs.VersionStamp;

SELECT SectionClass[section] FROM
statement =>
{statementSect: REF statement SectionObj = NARROW[section];
context ← statementSect.prog.someGFHTV;
IF context = NIL THEN RETURN; -- section is not loaded
version ← statementSect.prog.versionStamp;

world ← GetWorld[context];
IF world = LocalWorld[]
THEN {bcd: BcdOps.BcdBase = GetLocalBCD[rgfi: GFHFromTV[context].gfi];
stb: SymbolTableBase
← GetModuleSTB[bcd, statementSect.prog.versionStamp];
epi ← FGIToEPI[stb, statementSect.fgtIndex
! UNWIND => ReleaseSTB[stb]];
firstPC ← FGIToFirstPC[stb, statementSect.fgtIndex
! UNWIND => ReleaseSTB[stb]];
ReleaseSTB[stb]}
ELSE { bcd: BcdOps.BcdBase
← GetRemoteBCD[world,
RTTypesRemotePrivate.GetRemoteGFHeader
[AMBridge.RemoteGFHFromTV[context]].gfi];
stb: SymbolTableBase
← GetModuleSTB[bcd, statementSect.prog.versionStamp
! UNWIND => ReleaseRemoteBCD[bcd]];
{ ENABLE UNWIND => ReleaseSTB[stb];
ReleaseRemoteBCD[bcd];
epi ← FGIToEPI[stb, statementSect.fgtIndex];
firstPC ← FGIToFirstPC[stb, statementSect.fgtIndex];
}; -- end ENABLE UNWIND => ReleaseSTB
ReleaseSTB[stb];
}
};
proc =>
{procSect: REF proc SectionObj = NARROW[section];
context ← procSect.prog.someGFHTV;
IF context = NIL THEN RETURN; -- section is not loaded
version ← procSect.prog.versionStamp;
epi ← procSect.entryPointIndex;

world ← GetWorld[context];
IF world = LocalWorld[]
THEN {bcd: BcdOps.BcdBase ← GetLocalBCD[rgfi: GFHFromTV[context].gfi];
stb: SymbolTableBase
← GetModuleSTB[bcd, procSect.prog.versionStamp];
IF entry
THEN firstPC ← EPIToFirstPC[stb, epi, TRUE
! UNWIND => ReleaseSTB[stb]]
ELSE firstPC ← EPIToLastPC[stb, epi ! UNWIND => ReleaseSTB[stb]];
ReleaseSTB[stb]}
ELSE { bcd: BcdOps.BcdBase
← GetRemoteBCD[world,
RTTypesRemotePrivate.GetRemoteGFHeader
[AMBridge.RemoteGFHFromTV[context]].gfi];
stb: SymbolTableBase
← GetModuleSTB[bcd, procSect.prog.versionStamp
! UNWIND => ReleaseRemoteBCD[bcd]];
{ ENABLE UNWIND => ReleaseSTB[stb];
ReleaseRemoteBCD[bcd];
IF entry
THEN firstPC ← EPIToFirstPC[stb, epi, TRUE]
ELSE firstPC ← EPIToLastPC[stb, epi];
}; -- end ENABLE UNWIND => ReleaseSTB
ReleaseSTB[stb];
}
};
ENDCASE =>
ERROR Error[reason: typeFault,
msg: "EntryLocation applied to a section neither for a statement nor a proc"];

progContexts ← ProgContextsForVersion[world: world, version: version];
-- was: progContexts ← SourceSection[SectionSource[section], RootContext[world]].contexts;
-- could be (restrict to one gf): progContexts ← z.CONS[context, NIL];
-- want to find all gf's for the indicated section
IF progContexts = NIL THEN ERROR;

-- Here with epi, firstPC and all progContext loadings of the section
-- in the specified world
FOR contextList: LIST OF Context ← progContexts, contextList.rest UNTIL contextList = NIL
DO
codeBase: PrincOps.FrameCodeBase;
pc: PrincOps.BytePC;
context: Context = contextList.first;
found: BOOL ← FALSE;

IF IsRemote[context]
THEN {codeBase ← GetRemoteGFHeader[RemoteGFHFromTV[context]].code;
pc ← [firstPC + GetRemotePc[RemoteGFHFromTV[context], epi]]}
ELSE {codeBase ← GFHFromTV[context].code;
pc ← [firstPC + GetPc[GFHFromTV[context], epi]]};

FOR cll: LIST OF CodeLocation ← list, cll.rest UNTIL cll = NIL
DO IF cll.first.codeBase = codeBase THEN {found ← TRUE; EXIT};
ENDLOOP;
IF NOT found THEN list ← z.CONS[[codeBase: codeBase, pc: pc], list];
ENDLOOP;
}; -- end EntryLocations


ProgContextsForVersion: PROC[world: World, version: BcdDefs.VersionStamp]
RETURNS[contexts: LIST OF Context ← NIL] =
{ IF world = LocalWorld[]
THEN
{ ForEachConfig: PROC[ci: PilotLoadStateFormat.ConfigIndex]
RETURNS[stop: BOOL ← FALSE] =
{ ForEachModule: PROC[mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
RETURNS[stop: BOOL ← FALSE] =
{ IF NOT loadStateHeld THEN ERROR;
IF (IF mth.file = BcdDefs.FTSelf
THEN bcd.version
ELSE ftb[mth.file].version) = version
THEN {gfh: GlobalFrameHandle;
IF BASE[map] = NIL THEN map ← PilotLoadStateOps.GetMap[ci];
gfh ← RTTypesPrivate.GFT[map[mth.gfi]].frame;
contexts ← z.CONS[TVForGFHReferent[gfh], contexts]};
};
map: PilotLoadStateOps.Map ← DESCRIPTOR[NIL, 0];
bcd: BcdOps.BcdBase ← PilotLoadStateOps.AcquireBcd[ci];
ftb: Table.Base ← LOOPHOLE[bcd + bcd.ftOffset];
[] ← BcdOps.ProcessModules[bcd, ForEachModule
! UNWIND => IF BASE[map] # NIL THEN PilotLoadStateOps.ReleaseMap[map]];
IF BASE[map] # NIL THEN PilotLoadStateOps.ReleaseMap[map];
};

loadStateHeld: BOOL ← FALSE;
[] ← PilotLoadStateOps.InputLoadState[];
loadStateHeld ← TRUE;
[] ← PilotLoadStateOps.EnumerateBcds[recentfirst, ForEachConfig
! ANY => {PilotLoadStateOps.ReleaseLoadState[];
loadStateHeld ← FALSE}];
IF loadStateHeld THEN PilotLoadStateOps.ReleaseLoadState[];
} -- end local case of ProgContextsForVersion
ELSE -- remote world case of ProgContextsForVersion
{ Lock[world];
{ ENABLE UNWIND => Unlock[world];
oldState: PilotLoadStateFormat.LoadState;
loadstateHeld: BOOL ← FALSE;
newState: REF PilotLoadStateFormat.LoadStateObject ← Loadstate[world];
[] ← PilotLoadStateOps.InputLoadState[];
loadstateHeld ← TRUE;
oldState ← PilotLoadStatePrivate.InstallLoadState[LOOPHOLE[newState]]; -- no error raised
{ ENABLE ANY => IF loadstateHeld
THEN {[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadstateHeld ← FALSE};
ForEachConfig: PROC[ci: PilotLoadStateFormat.ConfigIndex]
RETURNS[stop: BOOL ← FALSE] =
{ ForEachModule: PROC[mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
RETURNS[stop: BOOL ← FALSE] =
{ IF NOT loadstateHeld THEN ERROR;
IF (IF mth.file = BcdDefs.FTSelf
THEN bcd.version
ELSE ftb[mth.file].version) = version
THEN {gfh: RemoteGlobalFrameHandle ← nilRemoteGlobalFrameHandle;
IF BASE[map] = NIL THEN map ← PilotLoadStateOps.GetMap[ci];
gfh ← GetRemoteGFHandle[world, map[mth.gfi]];
contexts ← z.CONS[TVForRemoteGFHReferent[gfh], contexts]};
}; -- end ForEachModule
bcd: BcdOps.BcdBase ← AcquireRemoteBCD[world, PilotLoadStateOps.AcquireBcd[ci]];
map: PilotLoadStateOps.Map ← DESCRIPTOR[NIL, 0];
ftb: Table.Base ← LOOPHOLE[bcd + bcd.ftOffset];
{ ENABLE UNWIND => {IF BASE[map] # NIL THEN PilotLoadStateOps.ReleaseMap[map];
ReleaseRemoteBCD[bcd]};
[] ← BcdOps.ProcessModules[bcd, ForEachModule];
}; -- end ENABLE UNWIND =>
IF BASE[map] # NIL THEN PilotLoadStateOps.ReleaseMap[map];
ReleaseRemoteBCD[bcd];
}; -- end ForEachConfig

[] ← PilotLoadStateOps.EnumerateBcds[recentfirst, ForEachConfig];
}; -- end ENABLE ANY

IF loadstateHeld
THEN {[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadstateHeld ← FALSE};
}; -- end ENABLE UNWIND => Unlock[world];
Unlock[world];
}; -- end remote world case of ProgContextsForVersion
}; -- end ProgContextsForVersion

-- doesn't have to be released. Enjoy.
GetLocalBCD: PUBLIC PROC[rgfi: PrincOps.GFTIndex] RETURNS[bcd: BcdOps.BcdBase ← NIL] =
{[] ← PilotLoadStateOps.InputLoadState[];
bcd ← PilotLoadStateOps.AcquireBcd[PilotLoadStateOps.MapRealToConfig[rgfi].config];
PilotLoadStateOps.ReleaseLoadState[];
};

-- This guy uses RTTypesRemotePrivate.AcquireRemoteBCD.
-- BEWARE. Don't forget to release it via RTTypesRemotePrivate.ReleaseRemoteBCD
GetRemoteBCD: PUBLIC PROC[world: World, rgfi: PrincOps.GFTIndex]
RETURNS[bcd: BcdOps.BcdBase ← NIL] =
{ Lock[world];
{ ENABLE UNWIND => Unlock[world];
oldState: PilotLoadStateFormat.LoadState;
newState: REF PilotLoadStateFormat.LoadStateObject;
loadstateHeld: BOOL ← FALSE;

newState ← Loadstate[world];
[] ← PilotLoadStateOps.InputLoadState[];
loadstateHeld ← TRUE;
oldState ← PilotLoadStatePrivate.InstallLoadState[LOOPHOLE[newState]];
-- no error raised
bcd ← AcquireRemoteBCD[world,
PilotLoadStateOps.AcquireBcd
[PilotLoadStateOps.MapRealToConfig[rgfi].config]
! ANY => {[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadstateHeld ← FALSE}];
IF loadstateHeld THEN {[] ← PilotLoadStatePrivate.InstallLoadState[oldState];
PilotLoadStateOps.ReleaseLoadState[];
loadstateHeld ← FALSE};
IF bcd = NIL THEN ERROR;
}; -- end ENABLE UNWIND => Unlock[world];
Unlock[world];
}; -- end GetRemoteBCD



}.