-- AMModelLocationImpl.mesa -- Last Modified On November 12, 1982 10:28 am 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], RTSymbols USING[SymbolTableBase, 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, 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 ! 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] 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 }.