BBContextImpl.mesa
Russ Atkinson, July 6, 1983 8:56 pm
Paul Rovner, March 8, 1983 12:01 pm
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;
T Y P E S
AMContext: TYPE = AMModel.Context;
World: TYPE = WorldVM.World;
Types used in maintaining search order structures
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];
D A T A
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;
P R O C S
SetDefaultGlobalContext: PUBLIC ENTRY PROC
[context: Context] RETURNS [err: ROPE] = TRUSTED {
ENABLE UNWIND => NULL;
IF context = NIL THEN {
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.
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] = {
returns the default context tv
RETURN [DefaultContext];
};
ContextForMyFrame: PUBLIC PROC RETURNS [Context] = TRUSTED {
returns context for the frame of the caller
NIL if that cannot be done
context: Context ← NIL;
context ← ContextForLocalFrame[MyDynamicParent[TVForMyFrame[]]];
RETURN [context];
};
ContextForLocalFrame: PUBLIC PROC [lf: TV] RETURNS [context: Context] = {
returns context for the given local frame
gf: TV ← GlobalFromLocal[lf];
context ← ContextForGlobalFrame[gf];
context.headLF ← lf;
};
ContextForGlobalFrame: PUBLIC PROC [gf: TV] RETURNS [context: Context] = TRUSTED {
returns context for the given global frame
it is OK to have NIL for the global frame
context ← ContextForWorld[AMBridge.GetWorld[gf]];
context.headGF ← gf;
};
ContextForWorld: PUBLIC PROC [world: World] RETURNS [context: Context] = TRUSTED {
ContextForWorld returns context for the given world
there is no global frame or local frame
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 {
Atomic proc to examine a context; will return all NILs if the context is no longer active
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 {
check the validity of this world against the global frame
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];
Allow the user to be a little sloppy...
IF frameName = NIL THEN {frameName ← itemName; itemName ← NIL};
first, try to get the global frame as given
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};
last, try to get the global frame with "Impl" appended to the name
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 {
apply the action to each frame in the chain
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 {
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
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
search this local frame; abort the search if no symbols (or any other AMTypes error)
ENABLE AMTypes.Error => EXIT;
[gf, lf, tv] ← LocalFrameSearch[tlf, name, lastGF];
IF lf # NIL OR gf # NIL THEN RETURN;
search the next frame down
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 {
search our global frame
[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 {
this routine searches args and rtns for the given frame
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];
automatic dereferencing of refs to records
SELECT class FROM
ref, list, pointer, longPointer =>
record ← AMTypes.Referent[record];
type => {
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.
ENABLE {AMTypes.Error => EXIT};
typeValue: Type ← AMTypes.TVToType[record];
index: CARDINAL ← AMTypes.NameToIndex[typeValue, name];
IF index # 0 THEN {
There is a component of this name, so try to get its value...
world: WorldVM.World ← AMBridge.GetWorld[record];
instance: TV ← NIL;
First, try to get the exported instance using the Runtime Model...
instance ← RTMiniModel.AcquireIRInstanceFromType[
typeValue, world
! AMTypes.Error => CONTINUE];
IF instance # NIL
THEN
There is an exported instance, so use it
tv ← AMTypes.IndexToTV[instance, index]
ELSE
There is no exported instance, so use the default value for the component
tv ← AMTypes.IndexToDefaultInitialValue[typeValue, index];
IF tv = NIL THEN {
Last chance: try to instantiate the type and pull out the value this way...
record ← AMTypes.New[type: typeValue, world: world];
tv ← AMTypes.IndexToTV[record, index];
};
IF AMTypes.TVSize[tv] <= 2 AND AMBridge.TVToLC[tv] = 0 THEN {
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.
elemType: Type ← AMTypes.IndexToType[typeValue, index];
SELECT AMTypes.UnderClass[elemType] FROM
procedure, error, signal, program, port => RETURN [NIL, NIL];
ENDCASE;
};
We now have a valid TV in hand, so return it...
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 {
unnamed record component gets auto-selected IF it is not a union
record ← AMTypes.IndexToTV[record, 1];
LOOP};
index ← AMTypes.NameToIndex
[type, name
! AMTypes.Error => {index ← 0; CONTINUE}];
IF index # 0 THEN {
at this point we have been quite successful, so select the component
tv ← AMTypes.IndexToTV[record, index];
GO TO found};
the name does not match, so this could be a variant record that needs the variant bound
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 {
We want the tag of the sequence
tv ← AMTypes.Tag[AMTypes.IndexToTV[record, n]];
GO TO found};
};
ENDCASE => EXIT;
IF NOT overlaid AND name.Equal[AMTypes.IndexToName[lastType, 0]] THEN {
oh, we want the tag!
tv ← AMTypes.Tag[AMTypes.IndexToTV[record, n]];
GO TO found;
};
IF overlaid THEN {
we have to treat overlaid variant records as somewhat funny beasts
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;
we have found it! force AMTypes to assume the "right" type
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
search all of the current bodies
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 {
level change! need to search args & rtns
lastFH ← tlf;
[lf, tv] ← SearchArgsAndRtns[tlf, name];
IF lf # NIL THEN RETURN};
tlf ← rec;
ENDLOOP;
search arguments and results
IF NOT EqualLocalFrames[tlf, lastFH] THEN {
we need to search the current args & returns
[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;
};
START UpdateSearchOrder Here
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] = {
we assume that the cache info is valid, but will also check for validity
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 {
we assume that the cache info is valid, but will also check for validity
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 {
returns the current gfh from the given world & gfi
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 {
this procedure tries to make sure that we can get symbols for a frame
NIL is an OK frame, and is not checked further
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.