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 {
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.


FBBContextImpl.mesa
Russ Atkinson, July 6, 1983 8:56 pm
Paul Rovner, March 8, 1983 12:01 pm
T Y P E S

Types used in maintaining search order structures
D A T A
P R O C S
There has been a "booted" event.  First, flush all search order caches except for the local world.  Then toss away the default global context.  Then allow the world to continue, which will cause the event to make further progress.
returns the default context tv
returns context for the frame of the caller
NIL if that cannot be done
returns context for the given local frame
returns context for the given global frame
it is OK to have NIL for the global frame
ContextForWorld returns context for the given world
there is no global frame or local frame
Atomic proc to examine a context; will return all NILs if the context is no longer active
check the validity of this world against the global frame
Allow the user to be a little sloppy...
first, try to get the global frame as given
last, try to get the global frame with "Impl" appended to the name
apply the action to each frame in the chain
search for the given name in the given context; NIL is OK as a context here; we must rather aggresively protect against the lack of symbols (or any other AMTypes error), which is treated as simple search failure
search this local frame; abort the search if no symbols (or any other AMTypes error)
search the next frame down
search our global frame
this routine searches args and rtns for the given frame
automatic dereferencing of refs to records
If this thing is a type, then we try to get the value associated with its named component.  Of course, this only works for record and structure types, but that is good enough.  Other classes of type will get an AMTypes.Error somewhere, and we will exit, behaving as though there were no such component.
There is a component of this name, so try to get its value...
First, try to get the exported instance using the Runtime Model...
There is an exported instance, so use it
There is no exported instance, so use the default value for the component
Last chance: try to instantiate the type and pull out the value this way...
This is probably an unbound procedure.  If so, then we return [NIL, NIL], which should result in it being undefined.  I wish that we could do something else here.  This case usually results from not having the implementing module loaded or from not having the interface exported to the top level.
We now have a valid TV in hand, so return it...
unnamed record component gets auto-selected IF it is not a union
at this point we have been quite successful, so select the component
the name does not match, so this could be a variant record that needs the variant bound
We want the tag of the sequence
oh, we want the tag!
we have to treat overlaid variant records as somewhat funny beasts
we have found it!  force AMTypes to assume the "right" type
... 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). 
search all of the current bodies
level change! need to search args & rtns
search arguments and results
we need to search the current args & returns
START UpdateSearchOrder Here
we assume that the cache info is valid, but will also check for validity
we assume that the cache info is valid, but will also check for validity
returns the current gfh from the given world & gfi
this procedure tries to make sure that we can get symbols for a frame
NIL is an OK frame, and is not checked further
�Ê昚
œ™Jš
œ#™#Jš
œ#™#—J˜š
Ïk	˜	šœ	�˜Jš
œž
˜ž
—šœ�˜
Jš
œ=˜=—šœ�˜
Jš
œß˜ß—Jšœ
�œ0˜?Jšœ	�œ
˜Jšœ�œ˜ Jšœ	�œ
˜Jšœ�œ6˜PJšœ�œ>˜UJšœ	�œ,˜:Jšœ�œ�œ˜=Jšœ�œ�œ˜.Jšœ�œ�œ˜#Jšœ�œ˜.šœ�˜
Jš
œd˜d——J˜šÐbl
œ�œ
�˜š
�˜Jš
œm˜m—Jš�œ
˜Jš�œ
˜Jšœ�œ
�œ#˜/—J˜š
œ	™	J™Jšœ�œ˜"Jšœ�œ˜J˜Jš
œ1™1Jšœ
�œ�œ˜'Jšœ�œ�œ
�œ
˜,šœ�œ�œ˜Jšœ�œ�œ
˜Jšœ�œ
˜Jš
œ%˜%Jšœ�œ˜Jšœ�œ
˜Jšœ�œ�œ�œ˜>—Jšœ
�œ�œ
˜!Jšœ
�œ�œ�œ
˜;šœ
�œ�œ˜Jšœ�œ�œ
˜Jšœ"�œ
˜&Jšœ�œ�œ˜—Jš	œ�œ�œ�œ�œ˜6—J˜š
œ™J˜Jšœ�œ˜%Jšœ0�œ˜5Jšœ(�œ˜-Jšœ�œ
˜ Jšœ�œ
˜Jšœ �œ
˜$Jš
œ˜Jšœ
�œ�œ
˜Jšœ�œ�œ
˜Jšœ�œ
˜Jšœ�œ
˜Jšœ�œ�œ
˜Jšœ�œ�œ
˜J˜—™	J˜—šÏnœ�œ
�œ
�˜*Jšœ�œ�œ�œ˜2Jš�œ
�œ�œ
˜š�œ�œ
�œ˜Jš
Ͼ
™æ
Jš
œ$˜$Jš
œ˜Jš
œ3˜3Jšœ�œ˜"Jš
�˜J˜—Jš�œ�œ
�œ
�œ�œ
�œ˜CJ˜J˜J˜J˜J˜3J˜J˜—šŸœ�œ
�œ
�œ˜:Jš
œ™Jš�œ˜J˜J˜—š
Ÿœ�œ
�œ
�œ
�œ˜<Jš
œ+™+Jš
œ™Jšœ�œ
˜J˜@Jš�œ˜J˜J˜—š
Ÿœ�œ
�œ�œ�œ˜IJš
œ)™)Jšœ�œ˜J˜$J˜J˜J˜—šŸœ�œ
�œ�œ�œ�œ˜RJš
œ*™*Jš
œ)™)J˜1J˜J˜J˜—š
Ÿœ�œ
�œ�œ�œ˜RJš
œ3™3Jš
œ'™'Jš�œ	�œ
�œ˜1Jšœ
�œ˜.J˜J˜—šŸœ�œ
�œ
�˜Jšœ�œ�œ�œ˜@Jš
œY™YJš�œ
�œ�œ
˜Jš�œ�œ
�œ
�œ�œ
�œ�œ�œ�œ˜CJ˜J˜J˜š�œ�œ�œ
�œ˜3Jš
œ9™9š�œ?�œ˜GJšœ�œ
˜Jš�œ�œ�œ�œ˜——J˜J˜—šŸœ�œ
�œ˜2š�œ�œ
�œ˜#Jš�œ�œ�˜<Jšœ�œ
˜—J˜J˜—šŸœ�œ
�˜%Jšœ�œ�œ�œ˜CJ˜*š�œ�œ�˜0J˜(J˜%Jšœ�œ
˜Jš�œ�œ
�œ˜1Jš�œ�œ
�œ
�œ
˜š�œ�œ�œ˜$Jšœ�œ˜ Jš�œ�œ
�œ
�œ
˜Jš�œ�œ
�œ˜(—Jš�œ
˜—J˜J˜—šŸœ�œ
�˜Jš	œ'�œ�œ�œ�œ
˜EJš�œ
�œ�œ�œ˜&Jš�œ
�œ�œ
˜Jšœ�œ"�œ˜8Jšœ
�œ˜%Jšœ�œ
˜Jš�œ�œ
�œ˜-Jš
�œ�œ
�œ�œ
�œ
˜5J˜%J˜Jš
œ'™'Jš�œ
�œ
�œ#�œ˜@J˜Jš
œ+™+J˜2š�œ�œ
�œ˜Jš�œ
�œ
�œ
˜!J˜.Jš�œ�œ
�œ
�œ˜J˜—Jš
œB™BJš�œ�œ
�œ
�œ
˜+J˜%J˜2š�œ�œ
�œ˜Jš�œ
�œ
�œ
˜!J˜/—J˜J˜—šŸœ�œ
�˜%Jšœ4�œ˜=Jš
œ+™+Jš�œ�œ
�œ˜-Jš�œ
�œ�œ
�œ
˜"š
œ
˜
Jšœ�œ˜š�œ�œ
�˜Jš�œ�œ
�œ
˜J˜Jš�œ
˜—J˜J˜——šŸœ�œ
�˜Jš	œ�œ�œ�œ	�œ˜GJš�œ�œ�œ�œ˜(Jš
œÓ
™Ó
Jšœ
�œ�œ
˜Jšœ�œ�œ
˜š�œ�œ
�œ
�œ˜&Jš�œ˜Jš�œ˜—š
�œ�œ
�œ�œ�œ�œ
�˜6Jš
œT™TJš�œ�œ
˜Jš
œ3˜3Jš�œ�œ
�œ�œ
�œ
�œ
˜$Jš
œ™JšœÏc-˜LJ˜Jš�œ
˜—Jš�œ�œ
�œ
˜š
�œ�œ
�œ�œ
�œ˜7Jš
œ™JšœN�œ˜XJš�œ�œ
�œ
�œ˜—Jšœ,�œ�œ˜TJ˜—šŸœ�˜Jš
œ�œ�œ�œ�œ�œ�œ˜;Jš
œ7™7Jš
œ ˜ J˜J˜
šœ�œ�œ˜J˜Jšœ�œ�œ
˜Jšœ�œ˜Jšœ�œ˜Jšœ1�œ˜;š�œ
�œ
�˜Jšœ.�œ˜8—J˜-J˜$š�œ�˜˜,J˜6š�œ�œ(�œ˜GJšœ=�œ˜GJš�œ�œ/�œ˜I—š�œ�˜˜Jš
œ5˜5š�œ�œ(�œ˜GJšœ=�œ˜GJš�œ�œ.˜?—J˜—Jš�œ
˜—J˜—Jš�œ
˜—J˜—Jšœ�œ
˜
Jšœ�œ
˜
J˜ J˜!Jš
�œ�œ
�œ�œ
�œ
˜.J˜J˜J˜—šŸœ�œ
�œ
�˜Jš
œ	�œ�œ�œ�œ�œ�œ˜FJšœ6�œ�œ�œ˜Mš
œ˜J˜——šŸœ�˜Jš
œ	�œ�œ�œ�œ�œ�œ
˜EJš�œ�œ�œ�œ˜(J˜J˜
Jšœ�œ�œ 3˜HJšœ�œ˜Jšœ�œ�œ
˜š�œ�œ˜Jš�œ�œ˜#Jšœ�œ˜+J˜—š
�˜Jš�œ
�œ
�œ
�œ
˜J˜1š�œ�œ˜.Jš�œ
˜Jš�œ!˜%—Jš
œ*™*š�œ�˜˜"J˜"—˜	Jš
œ®™®Jš�œ�œ˜J˜+Jšœ�œ(˜7š�œ�œ˜Jš
œ=™=J˜1Jšœ
�œ�œ
˜Jš
œB™Bš
œ1˜1Jš
œ˜Jšœ�œ˜—š�œ�˜š
�˜Jš
œ(™(Jš
œ'˜'—š
�˜Jš
œI™IJš
œ:˜:——š�œ�œ
�œ˜Jš
œK™KJš
œ4˜4Jš
œ&˜&J˜—š�œ�œ�œ˜=Jš
œ¨™¨Jš
œ7˜7š�œ�˜(Jšœ+�œ�œ�œ˜=Jš�œ
˜—J˜—Jš
œ/™/Jš
œ˜Jš�œ
˜J˜—Jš�œ ˜J˜—š
œ˜Jšœ�œ˜#J˜"J˜Jšœ
�œ
˜Jš�œ�œ
�œ
˜šœ
�œ�œ
�œ˜)J˜(J˜'J˜(Jš�œ˜—š�œ�œ)�œ�œ˜QJš
œ@™@J˜&Jš�œ˜—˜˜Jšœ�œ˜*——š�œ�œ˜Jš
œD™DJ˜&Jš�œ
�œ˜
—Jš
œW™WJš�œ
�œ�œ
�œ
˜š�œ�˜J˜Jš�œ�œ
˜—J˜5š�œ�˜˜
Jš�œ(�œ
�œ
˜4Jšœ(�œ˜HJ˜—˜
Jš�œ�œ
�œ
˜*š�œ.�œ˜6Jš
œ™J˜/Jš�œ
�œ˜
—J˜—Jš�œ�œ
˜—š�œ
�œ
�œ.�œ˜GJš
œ™J˜/Jš�œ
�œ˜J˜—š�œ
�œ˜Jš
œB™BJšœ�œ�œ
˜š	�œ�œ
�œ�œ�˜@˜Jšœ:�œ˜@—Jšœ�œ�œ
˜š�œ�˜&J˜Jš�œ�œ
˜—Jšœ=�œ˜CJš�œ�œ
�œ
˜Jš
œ;™;J˜,Jšœ�œ
˜
Jš�œ
˜—Jš�œ�œ
�œ
˜Jš�œ
˜J˜—˜J˜	Jšœ�œ ˜1—Jšœ" !˜CJš�œ
˜š�œ˜Jš	œ�œ
�œ
�œ�œ˜5Jš�œ˜—J˜—˜J˜J˜!Jšœ
�œ˜—˜Jšœ�œ�œ
˜
Jšœ0�œ˜5Jš�œ�œ
�œ˜Jš�œ
˜Jš
œ˜—š�œ˜
Jš�œ
˜——Jš�œ
˜—Jš�œ�œ�œ˜J˜J˜—šŸœ�˜Jš	œ	�œ�œ
�œ�œ
˜*Jš�œ�œ�œ�œ˜(Jš
œ’™’Jšœ�œ
˜Jšœ�œ�œ
˜š�œ�œ
�˜Jš
œ ™ Jšœ�œ�œ
˜J˜5Jš�œ�œ
�œ�œ˜$Jšœ3�œ˜9š�œ�œ
�œ˜Jšœ-�œ˜3Jš�œ�œ
�œ
�œ
˜Jš
�œ
�œ
�œ �œ
�œ
˜?Jš
œ+˜+Jš�œ�œ
�œ
�œ
˜Jš�œ
˜Jš
œ˜—š�œ
�œ�œ˜(Jš
œ(™(J˜
Jš
œ(˜(Jš�œ�œ
�œ
�œ˜—J˜
Jš�œ
˜J˜—Jš
œ™š�œ
�œ�œ˜+Jš
œ,™,J˜(Jš�œ�œ
�œ
�œ
˜Jš
œ˜—J˜J˜—šŸœ�œ�œ�œ�œ�œ�œ˜AJš�œ�œ
�œ˜/J˜J˜—šŸœ�œ
�œ
�œ�	œ
�œ
�œ˜NJ˜J˜—š
Ÿœ�œ
�œ�œ�œ˜+Jšœ�œ"˜(Jš�œ˜J˜J˜—šŸœ�˜Jš	œ�œ�œ
�œ�œ˜TJš�œ	�œ
�œ˜1šœ�œ˜!Jš
œ˜Jš
œ
˜
Jš
œ,˜,Jš
œ	˜	Jšœ
�œ�œ˜0Jšœ�œ˜—Jš�œ�œ˜(J˜J˜—šŸ
œ�œ
�˜Jšœ�œ�œ�œ˜EJš�œ
�œ�œ
˜Jš�œ'˜-J˜J˜—šŸœ�˜Jš	œ�œ�œ�œ�œ˜RJš�œ	�œ
�œ˜)Jš�œ�œ˜2š�œ1�œ�œ
�˜GJš�œ�œ�œ˜<Jš�œ
˜—š�œ	�œ
�œ˜Jšœ�œ˜%Jšœ�œ˜*—Jš�œ�œ˜(J˜J˜—šŸœ�œ�œ˜8Jšœ�œ˜Jšœ
�œ˜!Jšœ�œ(�œ
˜:Jšœ�œ˜J˜#Jšœ	�œ ˜-J˜šœ�œ)�œ�œ�œ�œ˜Vš	�œ�œ
�
œ
�œ�˜2˜'š�œ˜
Jš�œ˜#Jš�œ˜——Jš�œ�œ
�œ
˜J˜J˜Jš�œ
˜—J˜—Jš
œ™š�œ˜
š�œ˜Jš
œ+˜+š�œ�œ˜Jšœ�œ˜J˜9J˜J˜—J˜%J˜J˜
—š�œ˜Jš
œ%˜%Jš
œ˜š�œ0�œ�œ˜LJšœ�œ˜Jš�œ�œ
�
œ
�œ�œ�œ
˜FJ˜J˜J˜—J˜——J˜J˜—šŸœ�œ�œ˜6J˜J˜#šœ�œ˜#Jš�œ7˜:—š�œ�
œ
�œ�˜;J˜7Jš
œ˜Jš
�œ�œ�œ�œ
�œ
˜:Jšœ ˜3š�œ�œ
�œ˜Jšœ ˜+Jšœ
�œ ˜/Jš
œ˜—Jšœ ˜(Jš�œ
˜—Jš
œ6˜6J˜J˜—šŸ
œ�˜Jšœ-�œ�œ�œ˜KJš
œH™HJšœ�œ�œ
˜J˜J˜Jš�œ
�œ�œ
�œ
˜Jš�œ�œ
�œ
�œ
˜(Jš�œ!�œ
�œ
�œ
˜3J˜0J˜J˜—šŸœ�˜Jš	œ-�œ�œ�œ�œ˜OJš
œH™HJ˜J˜J˜#Jšœ	�œ ˜-J˜9Jš�œ�œ�œ�œ˜:Jš�œ�œ
�œ
�œ�œ
�œ
˜+˜š�œ˜
Jš�œ˜#š�œ ˜$Jšœ%�œ˜5———J˜J˜—šŸ
œ�˜Jšœ�œ
˜%Jš�œ$�œ�œ˜;Jš
œ2™2˜Jšœ�œ�œ˜3—J˜=Jšœ�œ�œ˜4J˜EJš�œ�œ&˜=J˜J˜—šŸœ�˜Jšœ�œ�œ�œ
˜3Jš�œ�œ�œ�œ˜"š�œ�œ˜Jš
œ!˜!š�œ�˜J˜E—J˜4Jš�œ	�œ
�œ$�œ˜FJš�œ
˜J˜—š�œ�œ�˜0J˜(J˜%Jšœ�œ
˜Jš�œ
�œ�œ
�œ
˜Jš�œ�œ
�œ˜1š�œ�˜Jš�œ˜—Jš�œ
˜—J˜J˜—šŸœ�œ�œ�œ�œ�œ˜@Jš�œ�œ
�œ�œ˜ š
�œ�œ
�œ�œ
�œ˜!Jš
œ+˜+Jš�œ�œ
�œ�œ˜3š�œ˜Jš�œ
�œ4˜?Jš�œ
�œA˜L—J˜—Jš�œ�œ˜J˜J˜—šŸœ�œ�œ�œ�œ�œ˜?Jš�œ�œ
�œ�œ˜ š
�œ�œ
�œ�œ
�œ˜!Jš
œ+˜+Jš�œ�œ
�œ�œ˜3š�œ˜Jš�œ
�œ2˜=Jš�œ
�œ?˜J—J˜—Jš�œ�œ˜J˜J˜—šŸ
œ�œ�œ�œ˜%Jš
œE™EJš
œ.™.J˜Jš�œ�œ
�œ
�œ
˜š�œ'�˜1J˜&J˜(Jš�œ�œ)˜9—J˜-š�œ�˜#J˜4Jš�œ
˜—J˜J˜—šŸœ�œ�œ�œ�œ�œ˜5Jšœ�œ�œ˜1Jšœ�œ
˜
Jš�œ�œ
�œ
�œ
˜J˜J˜J˜—šŸ	œ�œ�œ�œ�œ�œ�œ˜<Jšœ�œ�œ˜2Jš�œ�œ
�œ
�œ
˜J˜J˜J˜—šŸœ�œ�œ�œ�œ�œ�œ˜BJšœ�œ�œ˜2Jš�œ�œ
�œ
�œ
˜J˜J˜J˜—šŸœ�œ�œ�œ�œ�œ˜<Jšœ�œ�œ#˜8Jšœ�œ
˜
Jš�œ�œ
�œ
�œ
˜J˜J˜J˜—š�œ˜	J˜$J˜J˜—Jš�œ
˜˜J˜——…—Oü{(