<> <> <> DIRECTORY AMBridge USING [FHFromTV, GetWorld, GetWorldIncarnation, GFHFromTV, Loophole, RemoteFHFromTV, RemoteGFHFromTV, TVForFrame, TVForGFHReferent, TVForRemoteGFHReferent, TVToLC], AMModel USING [Context, ContextClass, MostRecentNamedContext, RootContext], AMTypes USING [Argument, Class, Domain, DynamicParent, EnclosingBody, Error, GlobalParent, Globals, IndexToDefaultInitialValue, IndexToName, IndexToTV, IndexToType, IsComputed, IsOverlaid, Locals, NameToIndex, NComponents, New, NValues, Procedure, Range, Referent, Result, Signal, Tag, TVSize, TVToName, TVToType, TVType, TypeClass, UnderClass, UnderType, Variant], BBContext USING [Context, ContextRep, FindAction, FrameAction], BBSafety USING [Mother], BBZones USING [GetPrefixedZone], Mopcodes USING [zLADRB], PilotLoadStateFormat USING [ConfigIndex, GFTIndex, LoadStateObject, ModuleInfo], PilotLoadStateOps USING [EnumerateBcds, GetModule, InputLoadState, ReleaseLoadState], PrincOps USING [FrameHandle, GFTIndex, GlobalFrameHandle], PrincOpsRuntime USING [EmptyGFTItem, GFT, GFTItem, GetFrame], Rope USING [Concat, Equal, Match, ROPE, Size], RTBasic USING [nullType, TV, Type], RTMiniModel USING [AcquireIRInstanceFromType], WorldVM USING [Address, CopyRead, CurrentIncarnation, Loadstate, LocalWorld, Long, World, WorldName, Incarnation]; BBContextImpl: CEDAR MONITOR IMPORTS AMBridge, AMModel, AMTypes, BBSafety, BBZones, PilotLoadStateOps, PrincOpsRuntime, Rope, RTMiniModel, WorldVM EXPORTS BBContext SHARES BBContext = BEGIN OPEN BBContext, Rope, RTBasic, AMTypes; <> <<>> AMContext: TYPE = AMModel.Context; World: TYPE = WorldVM.World; <> SearchOrder: TYPE = REF SearchOrderRep; SearchOrderList: TYPE = LIST OF SearchOrder; SearchOrderRep: TYPE = RECORD [ name: ROPE _ NIL, world: WorldVM.World _ NIL, incarnation: WorldVM.Incarnation _ 0, nBcds: CARDINAL _ 0, cache: GFTCache _ NIL, array: ARRAY PrincOps.GFTIndex OF PrincOps.GFTIndex _ ALL[0]]; GFTCache: TYPE = REF GFTCacheRep; GFTCacheRep: TYPE = ARRAY PrincOps.GFTIndex OF MyCacheInfo; MyCacheInfo: TYPE = RECORD [ name: ROPE _ NIL, gfh: PrincOps.GlobalFrameHandle _ NIL, tried, valid: BOOL _ FALSE]; NullCacheInfo: MyCacheInfo = [NIL, NIL, FALSE, FALSE]; <> pz: ZONE _ BBZones.GetPrefixedZone[]; DefaultContext: Context _ ContextForGlobalFrame[NIL]; LocalContext: Context _ ContextForWorld[NIL]; DefaultOrder: SearchOrder _ NIL; DefaultWorld: World _ NIL; activeOrders: SearchOrderList _ NIL; typeOfType: Type _ nullType; catchAny: BOOL _ TRUE; useAM: BOOL _ FALSE; lastWorld: World _ NIL; lastAMContext: AMContext _ NIL; addingImpl: BOOL _ TRUE; globalTrustCache: BOOL _ TRUE; <

> SetDefaultGlobalContext: PUBLIC ENTRY PROC [context: Context] RETURNS [err: ROPE] = TRUSTED { ENABLE UNWIND => NULL; IF context = NIL THEN { <> DefaultWorld _ WorldVM.LocalWorld[]; DefaultContext _ LocalContext; DefaultOrder _ InternalOrderForWorld[DefaultWorld]; activeOrders _ LIST[DefaultOrder]; RETURN }; IF context = NIL OR NOT context.active THEN RETURN ["bad context"]; TouchFrame[context.headGF]; TouchFrame[context.headLF]; DefaultContext _ context; DefaultWorld _ context.world; DefaultOrder _ InternalOrderForWorld[DefaultWorld]; }; GetDefaultGlobalContext: PUBLIC PROC RETURNS [Context] = { <> RETURN [DefaultContext]; }; ContextForMyFrame: PUBLIC PROC RETURNS [Context] = TRUSTED { <> <> context: Context _ NIL; context _ ContextForLocalFrame[MyDynamicParent[TVForMyFrame[]]]; RETURN [context]; }; ContextForLocalFrame: PUBLIC PROC [lf: TV] RETURNS [context: Context] = { <> gf: TV _ GlobalFromLocal[lf]; context _ ContextForGlobalFrame[gf]; context.headLF _ lf; }; ContextForGlobalFrame: PUBLIC PROC [gf: TV] RETURNS [context: Context] = TRUSTED { <> <> context _ ContextForWorld[AMBridge.GetWorld[gf]]; context.headGF _ gf; }; ContextForWorld: PUBLIC PROC [world: World] RETURNS [context: Context] = TRUSTED { <> <> IF world = NIL THEN world _ WorldVM.LocalWorld[]; context _ pz.NEW[ContextRep _ [world: world]]; }; GetContents: PUBLIC ENTRY PROC [context: Context] RETURNS [world: World, gf,lf: TV] = TRUSTED { <> ENABLE UNWIND => NULL; IF context = NIL OR NOT context.active THEN RETURN [NIL, NIL, NIL]; world _ context.world; gf _ context.headGF; lf _ context.headLF; IF world # WorldVM.LocalWorld[] AND gf # NIL THEN { <> IF world.CurrentIncarnation[] # AMBridge.GetWorldIncarnation[gf] THEN { context.active _ FALSE; RETURN [NIL, NIL, NIL]}}; }; DestroyContext: PUBLIC PROC [context: Context] = { IF context # NIL AND context.active AND context # DefaultContext AND context # LocalContext THEN context.active _ FALSE; }; FindMatchingGlobalFrames: PUBLIC PROC [world: World, pattern: ROPE _ NIL, action: FindAction] = TRUSTED { order: SearchOrder _ OrderForWorld[world]; FOR i: PrincOps.GFTIndex IN PrincOps.GFTIndex DO gfi: PrincOps.GFTIndex _ order.array[i]; info: MyCacheInfo _ order.cache[gfi]; each: ROPE _ info.name; IF each = NIL THEN each _ FillInName[order, gfi]; IF each = NIL THEN LOOP; IF pattern.Match[each, FALSE] THEN { gfTV: TV _ TVForGfi[order, gfi]; IF gfTV = NIL THEN LOOP; IF action[gfTV, each] = quit THEN EXIT}; ENDLOOP; }; GlobalFrameSearch: PUBLIC PROC [context: Context, frameName,itemName: ROPE _ NIL, case: BOOL _ TRUE] RETURNS [gf, tv: TV _ NIL] = TRUSTED { ENABLE UNWIND => NULL; implMatch: BOOL _ Rope.Match["*Impl", frameName, FALSE]; nullItem: BOOL _ itemName.Size[] = 0; order: SearchOrder _ NIL; IF context = NIL THEN context _ LocalContext; IF context = NIL OR frameName.Size[] = 0 THEN RETURN; order _ OrderForWorld[context.world]; <> IF frameName = NIL THEN {frameName _ itemName; itemName _ NIL}; <> gf _ InternalGlobalSearch[order, frameName, case]; IF gf # NIL THEN { IF nullItem THEN RETURN [gf, gf]; [gf, tv] _ InternalRecordSearch[gf, itemName]; IF gf # NIL THEN RETURN}; <> IF implMatch OR NOT addingImpl THEN RETURN; frameName _ frameName.Concat["Impl"]; gf _ InternalGlobalSearch[order, frameName, case]; IF gf # NIL THEN { IF nullItem THEN RETURN [gf, gf]; [gf, tv] _ InternalRecordSearch[gf, itemName]}; }; EnumerateFramesInContext: PUBLIC PROC [context: Context, action: BBContext.FrameAction] = TRUSTED { <> IF context = NIL THEN context _ LocalContext; IF NOT context.active THEN RETURN; { lf: TV _ context.headLF; UNTIL lf = NIL DO IF action[lf] = quit THEN EXIT; lf _ MyDynamicParent[lf]; ENDLOOP; }}; StackSearch: PUBLIC PROC [context: Context, name: ROPE, case: BOOL _ TRUE, depth: INTEGER _ 100] RETURNS [gf,lf,tv: TV _ NIL] = TRUSTED { <> tlf, tgf: TV _ NIL; lastGF: TV _ NIL; IF context = NIL OR NOT context.active THEN context _ LocalContext ELSE tlf _ context.headLF; FOR i: INTEGER IN [0..MAX[depth,1]) WHILE tlf # NIL DO <> ENABLE AMTypes.Error => EXIT; [gf, lf, tv] _ LocalFrameSearch[tlf, name, lastGF]; IF lf # NIL OR gf # NIL THEN RETURN; <> lastGF _ GlobalFromLocal[tlf]; -- optimization to avoid frequent GF searches tlf _ MyDynamicParent[tlf]; ENDLOOP; IF depth = 0 THEN RETURN; IF context.headLF = NIL AND context.headGF # NIL THEN { <> [gf, tv] _ InternalRecordSearch[context.headGF, name, case ! AMTypes.Error => CONTINUE]; IF gf # NIL THEN RETURN}; [gf, tv] _ GlobalFrameSearch[context, name, NIL, case ! AMTypes.Error => CONTINUE]}; SearchArgsAndRtns: PROC [lf: TV, name: ROPE] RETURNS [nlf: TV, ntv: TV] = TRUSTED { <> type: Type = AMTypes.TVType[lf]; under: Type; class: Class; inner: PROC = TRUSTED { procType, recType: Type; procTV: TV _ NIL; n: CARDINAL _ 0; index: CARDINAL _ 0; procTV _ AMTypes.Procedure[lf ! AMTypes.Error => CONTINUE]; IF procTV = NIL THEN procTV _ AMTypes.Signal[lf ! AMTypes.Error => CONTINUE]; procType _ AMTypes.UnderType[TVType[procTV]]; class _ AMTypes.TypeClass[procType]; SELECT class FROM procedure, signal, error, program, port => { recType _ AMTypes.UnderType[AMTypes.Domain[procType]]; IF recType # nullType AND (n _ AMTypes.NComponents[recType]) # 0 THEN { index _ AMTypes.NameToIndex[recType, name ! AMTypes.Error => CONTINUE]; IF index # 0 THEN {nlf _ lf; ntv _ AMTypes.Argument[lf, index]; RETURN}}; SELECT class FROM procedure, signal => { recType _ AMTypes.UnderType[AMTypes.Range[procType]]; IF recType # nullType AND (n _ AMTypes.NComponents[recType]) # 0 THEN { index _ AMTypes.NameToIndex[recType, name ! AMTypes.Error => CONTINUE]; IF index # 0 THEN {nlf _ lf; ntv _ AMTypes.Result[lf, index]}}; }; ENDCASE; }; ENDCASE; }; nlf _ NIL; ntv _ NIL; under _ AMTypes.UnderType[type]; class _ AMTypes.TypeClass[under]; IF lf = NIL OR class # localFrame THEN RETURN; [] _ BBSafety.Mother[inner]; }; RecordSearch: PUBLIC ENTRY PROC [record: TV, name: ROPE, case: BOOL _ TRUE] RETURNS [base, tv: TV] = { [base, tv] _ InternalRecordSearch[record, name, case, TRUE ! UNWIND => NULL]; }; InternalRecordSearch: PROC [record: TV, name: ROPE, case: BOOL _ TRUE, tryVariant: BOOL _ FALSE] RETURNS [base, tv: TV _ NIL] = TRUSTED { type: Type; class: Class; lastFrame: TV _ NIL; -- indicate that we have not encountered any frames index: NAT _ 0; ok: BOOL _ FALSE; IF typeOfType = nullType THEN { ENABLE {AMTypes.Error => CONTINUE}; typeOfType _ AMTypes.UnderType[CODE[Type]]; }; DO IF record = NIL THEN EXIT; type _ AMTypes.UnderType[AMTypes.TVType[record]]; IF type = typeOfType AND typeOfType # nullType THEN class _ type ELSE class _ AMTypes.TypeClass[type]; <> SELECT class FROM ref, list, pointer, longPointer => record _ AMTypes.Referent[record]; type => { <> ENABLE {AMTypes.Error => EXIT}; typeValue: Type _ AMTypes.TVToType[record]; index: CARDINAL _ AMTypes.NameToIndex[typeValue, name]; IF index # 0 THEN { <> world: WorldVM.World _ AMBridge.GetWorld[record]; instance: TV _ NIL; <> instance _ RTMiniModel.AcquireIRInstanceFromType[ typeValue, world ! AMTypes.Error => CONTINUE]; IF instance # NIL THEN <> tv _ AMTypes.IndexToTV[instance, index] ELSE <> tv _ AMTypes.IndexToDefaultInitialValue[typeValue, index]; IF tv = NIL THEN { <> record _ AMTypes.New[type: typeValue, world: world]; tv _ AMTypes.IndexToTV[record, index]; }; IF AMTypes.TVSize[tv] <= 2 AND AMBridge.TVToLC[tv] = 0 THEN { <> elemType: Type _ AMTypes.IndexToType[typeValue, index]; SELECT AMTypes.UnderClass[elemType] FROM procedure, error, signal, program, port => RETURN [NIL, NIL]; ENDCASE; }; <> base _ record; RETURN; }; EXIT; -- no such component }; record, structure => { n: NAT _ AMTypes.NComponents[type]; lastType, domain: Type _ nullType; lastClass: Class _ nil; overlaid: BOOL; IF n = 0 THEN EXIT; {ENABLE AMTypes.Error => GO TO dontWorry; lastType _ AMTypes.IndexToType[type, n]; lastType _ AMTypes.UnderType[lastType]; lastClass _ AMTypes.TypeClass[lastType]; EXITS dontWorry => {}}; IF n = 1 AND AMTypes.IndexToName[type, 1].Size[] = 0 AND lastClass # union THEN { <> record _ AMTypes.IndexToTV[record, 1]; LOOP}; index _ AMTypes.NameToIndex [type, name ! AMTypes.Error => {index _ 0; CONTINUE}]; IF index # 0 THEN { <> tv _ AMTypes.IndexToTV[record, index]; GO TO found}; <> IF NOT tryVariant THEN EXIT; SELECT lastClass FROM union, sequence => {}; ENDCASE => EXIT; domain _ AMTypes.UnderType[AMTypes.Domain[lastType]]; SELECT lastClass FROM union => { IF AMTypes.TypeClass[domain] # enumerated THEN EXIT; overlaid _ AMTypes.IsOverlaid[lastType] OR AMTypes.IsComputed[lastType]; }; sequence => { IF AMTypes.IsComputed[lastType] THEN EXIT; IF name.Equal[AMTypes.IndexToName[lastType, 0]] THEN { <> tv _ AMTypes.Tag[AMTypes.IndexToTV[record, n]]; GO TO found}; }; ENDCASE => EXIT; IF NOT overlaid AND name.Equal[AMTypes.IndexToName[lastType, 0]] THEN { <> tv _ AMTypes.Tag[AMTypes.IndexToTV[record, n]]; GO TO found; }; IF overlaid THEN { <> found: BOOL _ FALSE; FOR armIndex: NAT IN [1..AMTypes.NValues[domain]] UNTIL found DO armType: Type _ AMTypes.IndexToType[lastType, armIndex ! AMTypes.Error => LOOP]; tag: TV _ NIL; SELECT AMTypes.TypeClass[armType] FROM record, structure => {}; ENDCASE => LOOP; index _ AMTypes.NameToIndex[armType, name ! AMTypes.Error => LOOP]; IF index = 0 THEN LOOP; <> record _ AMBridge.Loophole[record, armType]; found _ TRUE; ENDLOOP; IF found THEN LOOP; EXIT; }; record _ AMTypes.IndexToTV [ record, n ! AMTypes.Error => EXIT]; -- get the last element record _ AMTypes.Variant[record]; -- bind the variant and try again LOOP; EXITS found => { base _ IF lastFrame = NIL THEN record ELSE lastFrame; RETURN}; }; globalFrame => { lastFrame _ record; record _ InternalGlobals[record]; tryVariant _ FALSE}; localFrame => { gf: TV _ NIL; [gf, base, tv] _ LocalFrameSearch[record, name, NIL]; IF gf # NIL THEN base _ gf; RETURN; }; ENDCASE => EXIT; ENDLOOP; RETURN [NIL, NIL]; }; LocalFrameSearch: PROC [lframe: TV, name: ROPE, lastGF: TV _ NIL] RETURNS [gf,lf,tv: TV _ NIL] = TRUSTED { <<... searches the given local frame for the given name. The search will include all levels of variables, including those in statically enclosing local frames and the global frame (UNLESS the global frame is equivalent to lastGF, which will inhibit the global frame search). >> tlf: TV _ lframe; lastFH: TV _ NIL; WHILE tlf # NIL DO <> rec: TV _ NIL; [lf, tv] _ InternalRecordSearch[MyLocals[tlf], name]; IF lf # NIL THEN {lf _ tlf; RETURN}; rec _ AMTypes.EnclosingBody[tlf ! AMTypes.Error => EXIT]; IF rec = NIL THEN { rec _ GlobalFromLocal[tlf ! AMTypes.Error => EXIT]; IF rec = NIL THEN EXIT; IF lastGF # NIL AND EqualGlobalFrames[rec, lastGF] THEN RETURN; [gf, tv] _ InternalRecordSearch[rec, name]; IF gf # NIL THEN RETURN; EXIT; }; IF NOT EqualLocalFrames[tlf, rec] THEN { <> lastFH _ tlf; [lf, tv] _ SearchArgsAndRtns[tlf, name]; IF lf # NIL THEN RETURN}; tlf _ rec; ENDLOOP; <> IF NOT EqualLocalFrames[tlf, lastFH] THEN { <> [lf, tv] _ SearchArgsAndRtns[tlf, name]; IF lf # NIL THEN RETURN; }; }; GlobalFromLocal: PROC [lf: TV] RETURNS [tv: TV _ NIL] = TRUSTED { IF lf # NIL THEN tv _ AMTypes.GlobalParent[lf]; }; MyFrame: UNSAFE PROC RETURNS [PrincOps.FrameHandle] = UNCHECKED MACHINE CODE { Mopcodes.zLADRB, 0}; TVForMyFrame: PROC RETURNS [TV] = TRUSTED { tv: TV _ AMBridge.TVForFrame[MyFrame[]]; RETURN [MyDynamicParent[tv]]; }; NewSearchOrder: PROC [world: WorldVM.World, update: BOOL _ TRUE] RETURNS [order: SearchOrder] = TRUSTED { IF world = NIL THEN world _ WorldVM.LocalWorld[]; order _ pz.NEW[SearchOrderRep _ [ name: WorldVM.WorldName[world], world: world, incarnation: world.CurrentIncarnation[] - 1, nBcds: 0, cache: pz.NEW[GFTCacheRep _ ALL[NullCacheInfo]], array: ALL[0]]]; IF update THEN UpdateSearchOrder[order]; }; OrderForWorld: ENTRY PROC [world: WorldVM.World, update: BOOL _ TRUE] RETURNS [SearchOrder] = { ENABLE UNWIND => NULL; RETURN[InternalOrderForWorld[world, update]]; }; InternalOrderForWorld: PROC [world: WorldVM.World, update: BOOL _ TRUE] RETURNS [order: SearchOrder _ NIL] = { IF world = NIL THEN world _ DefaultWorld; IF world = DefaultWorld THEN order _ DefaultOrder; FOR list: SearchOrderList _ activeOrders, list.rest UNTIL list = NIL DO IF list.first.world = world THEN {order _ list.first; EXIT}; ENDLOOP; IF order = NIL THEN { order _ NewSearchOrder[world, FALSE]; activeOrders _ CONS[order, activeOrders]}; IF update THEN UpdateSearchOrder[order]; }; UpdateSearchOrder: PROC [order: SearchOrder] = TRUSTED { nBcds: CARDINAL _ 0; oldNBcds: CARDINAL _ order.nBcds; loadstate: REF PilotLoadStateFormat.LoadStateObject _ NIL; pos: CARDINAL _ 0; world: WorldVM.World _ order.world; isLocal: BOOL _ world = WorldVM.LocalWorld[]; visit: PROC [cfi: PilotLoadStateFormat.ConfigIndex] RETURNS [BOOL _ FALSE] = TRUSTED { FOR i: CARDINAL DECREASING IN PrincOps.GFTIndex DO info: PilotLoadStateFormat.ModuleInfo _ IF isLocal THEN PilotLoadStateOps.GetModule[i] ELSE loadstate.gft[i]; IF info.config # cfi THEN LOOP; order.array[pos] _ i; pos _ pos + 1; ENDLOOP; }; <> IF isLocal THEN { nBcds _ PilotLoadStateOps.InputLoadState[]; IF nBcds # oldNBcds THEN { order.array _ ALL[0]; [] _ PilotLoadStateOps.EnumerateBcds[recentfirst, visit]; order.nBcds _ nBcds }; PilotLoadStateOps.ReleaseLoadState[]; UpdateCacheInfo[order]; } ELSE { loadstate _ WorldVM.Loadstate[world]; nBcds _ loadstate.nBcds; IF order.incarnation # world.CurrentIncarnation[] OR nBcds # oldNBcds THEN { order.array _ ALL[0]; FOR cfi: CARDINAL DECREASING IN [0..nBcds) DO [] _ visit[cfi] ENDLOOP; order.nBcds _ nBcds; UpdateCacheInfo[order]; }; }; }; UpdateCacheInfo: PROC [order: SearchOrder] = TRUSTED { cache: GFTCache _ order.cache; world: WorldVM.World _ order.world; trustCache: BOOL _ globalTrustCache AND WorldVM.CurrentIncarnation[world] = order.incarnation; FOR i: PrincOps.GFTIndex DECREASING IN PrincOps.GFTIndex DO gfh: PrincOps.GlobalFrameHandle _ GFHFromGFI[world, i]; info: MyCacheInfo _ cache[i]; IF trustCache AND info.valid AND info.gfh = gfh THEN LOOP; info _ NullCacheInfo; -- cache will be made invalid IF gfh # NIL THEN { info.gfh _ gfh; -- only the frame is OK now info.valid _ TRUE; -- the name is updated later }; cache[i] _ info; -- cache is now invalid ENDLOOP; order.incarnation _ WorldVM.CurrentIncarnation[world]; }; FillInName: PROC [order: SearchOrder, gfi: PrincOps.GFTIndex] RETURNS [name: ROPE _ NIL] = { <> gfTV: TV _ NIL; cache: GFTCache _ order.cache; info: MyCacheInfo _ cache[gfi]; IF NOT info.valid THEN RETURN; IF (name _ info.name) # NIL THEN RETURN; IF (gfTV _ TVForGfi[order, gfi]) = NIL THEN RETURN; name _ cache[gfi].name _ AMTypes.TVToName[gfTV]; }; TVForGfi: PROC [order: SearchOrder, gfi: PrincOps.GFTIndex] RETURNS [tv: TV _ NIL] = TRUSTED { <> cache: GFTCache _ order.cache; info: MyCacheInfo _ cache[gfi]; world: WorldVM.World _ order.world; isLocal: BOOL _ world = WorldVM.LocalWorld[]; gfh: PrincOps.GlobalFrameHandle _ GFHFromGFI[world, gfi]; IF gfh # info.gfh THEN {cache[gfi].valid _ FALSE; RETURN}; IF gfh = NIL OR NOT info.valid THEN RETURN; tv _ IF isLocal THEN AMBridge.TVForGFHReferent[gfh] ELSE AMBridge.TVForRemoteGFHReferent [[world, world.CurrentIncarnation[], LOOPHOLE[gfh]]]; }; GFHFromGFI: PROC [world: WorldVM.World, gfi: CARDINAL] RETURNS [gfh: PrincOps.GlobalFrameHandle _ NIL] = TRUSTED { <> gftBase: WorldVM.Address _ WorldVM.Long[world, LOOPHOLE[PrincOpsRuntime.GFT]]; item: PrincOpsRuntime.GFTItem _ PrincOpsRuntime.EmptyGFTItem; itemWords: CARDINAL = SIZE[PrincOpsRuntime.GFTItem]; WorldVM.CopyRead[world, gftBase + gfi * itemWords, itemWords, @item]; IF item.epbias = 0 THEN gfh _ PrincOpsRuntime.GetFrame[item]; }; InternalGlobalSearch: PROC [order: SearchOrder, name: ROPE, case: BOOL _ TRUE] RETURNS [tv: TV _ NIL] = TRUSTED { IF useAM THEN { amCtx: AMContext _ lastAMContext; IF order.world # lastWorld THEN amCtx _ lastAMContext _ AMModel.RootContext[lastWorld _ order.world]; amCtx _ AMModel.MostRecentNamedContext[name, amCtx]; IF amCtx # NIL AND AMModel.ContextClass[amCtx] = prog THEN tv _ amCtx; RETURN; }; FOR i: PrincOps.GFTIndex IN PrincOps.GFTIndex DO gfi: PrincOps.GFTIndex _ order.array[i]; info: MyCacheInfo _ order.cache[gfi]; each: ROPE _ info.name; IF NOT info.valid THEN LOOP; IF each = NIL THEN each _ FillInName[order, gfi]; IF each.Equal[name, case] THEN RETURN [TVForGfi[order, gfi]]; ENDLOOP; }; EqualGlobalFrames: PROC [gf1,gf2: TV] RETURNS [BOOL] = TRUSTED { IF gf1 = gf2 THEN RETURN [TRUE]; IF gf1 # NIL AND gf2 # NIL THEN { w1: WorldVM.World _ AMBridge.GetWorld[gf1]; IF w1 = AMBridge.GetWorld[gf2] THEN RETURN [FALSE]; IF w1 = WorldVM.LocalWorld[] THEN RETURN [AMBridge.GFHFromTV[gf1] = AMBridge.GFHFromTV[gf2]] ELSE RETURN [AMBridge.RemoteGFHFromTV[gf1] = AMBridge.RemoteGFHFromTV[gf2]]; }; RETURN [FALSE]; }; EqualLocalFrames: PROC [lf1,lf2: TV] RETURNS [BOOL] = TRUSTED { IF lf1 = lf2 THEN RETURN [TRUE]; IF lf1 # NIL AND lf2 # NIL THEN { w1: WorldVM.World _ AMBridge.GetWorld[lf1]; IF w1 # AMBridge.GetWorld[lf2] THEN RETURN [FALSE]; IF w1 = WorldVM.LocalWorld[] THEN RETURN [AMBridge.FHFromTV[lf1] = AMBridge.FHFromTV[lf2]] ELSE RETURN [AMBridge.RemoteFHFromTV[lf1] = AMBridge.RemoteFHFromTV[lf2]]; }; RETURN [FALSE]; }; TouchFrame: PROC [tv: TV] = TRUSTED { <> <> type: Type; IF tv = NIL THEN RETURN; SELECT AMTypes.TypeClass[AMTypes.TVType[tv]] FROM localFrame => tv _ AMTypes.Locals[tv]; globalFrame => tv _ AMTypes.Globals[tv]; ENDCASE => ERROR AMTypes.Error[typeFault, "not a frame"]; type _ AMTypes.UnderType[AMTypes.TVType[tv]]; SELECT AMTypes.TypeClass[type] FROM record, structure => [] _ AMTypes.NComponents[type]; ENDCASE; }; MyLocals: PROC [lf: TV] RETURNS [rec: TV] = TRUSTED { inner: PROC = TRUSTED {rec _ AMTypes.Locals[lf]}; rec _ NIL; IF lf = NIL THEN RETURN; [] _ BBSafety.Mother[inner]; }; MyGlobals: PROC [gf: TV] RETURNS [rec: TV _ NIL] = TRUSTED { inner: PROC = TRUSTED {rec _ AMTypes.Globals[gf]}; IF gf = NIL THEN RETURN; [] _ BBSafety.Mother[inner]; }; InternalGlobals: PROC [gf: TV] RETURNS [rec: TV _ NIL] = TRUSTED { inner: PROC = TRUSTED {rec _ AMTypes.Globals[gf]}; IF gf = NIL THEN RETURN; [] _ BBSafety.Mother[inner]; }; MyDynamicParent: PROC [lf: TV] RETURNS [nlf: TV] = TRUSTED { inner: PROC = TRUSTED {nlf _ AMTypes.DynamicParent[lf]}; nlf _ NIL; IF lf = NIL THEN RETURN; [] _ BBSafety.Mother[inner]; }; TRUSTED { DefaultWorld _ WorldVM.LocalWorld[]; }; END.