-- RTTypedFramesImpl.Mesa
-- last modified on June 23, 1983 1:13 pm by Paul Rovner

DIRECTORY
AMBridge USING
[GetWorld, IsRemote, nilRemoteFrameHandle, nilRemoteGlobalFrameHandle,
RemoteFHFromTV, RemoteFrameHandle, RemoteGFHFromTV, RemoteGlobalFrameHandle,
RemotePD, RemoteSED, TVForProc, TVForRemoteFrame, TVForRemoteGFHReferent,
TVForRemoteProc, TVForRemoteSignal, TVForSignal, TVToCardinal, TVToRemoteProc,
TVToRemoteSignal, WordSequence, WordSequenceRecord],
AMProcessBasic USING[ReturnLink],
AMTypes USING
[Domain, Error, Index, IndexToTV, Range, Size, TV, TVStatus, TVType, TypeClass,
TypedVariable, UnderType],
BrandXSymbolDefs USING
[SymbolTableBase, rootBodyIndex, BodyIndex, nullBodyIndex, outerContextLevel],
BrandYSymbolDefs USING
[SymbolTableBase, rootBodyIndex, BodyIndex, nullBodyIndex, outerContextLevel],
Mopcodes USING[zLADRB],
PrincOps USING
[BytePC, ControlLink, CSegPrefix, EPRange, Frame, FrameHandle, GFTIndex,
GlobalFrame, GlobalFrameHandle, localbase, MaxNGfi, NullLink, ProcDesc,
SignalDesc, StateVector, UnboundLink],
PrincOpsRuntime USING[GetFrame, GFT, GFTItem],
Rope USING[ROPE],
RTLoader USING[GetGFRCType],
RTSymbolDefs USING
[BlockContextLevel, BodyIndex, CallableBodyIndex, nullBodyIndex,
SymbolConstructorIndex, SymbolIdIndex, SymbolIndex, SymbolTableBase],
RTSymbolOps USING
[AcquireType, BodyLevel, BodyType, CallableBodyEntryIndex, CallableBTI, ISEConstant,
ISEImmutable, ISEType, IsRootBTI, IsTypeSEI, NullBTI, NullSEI, ParentBody,
RootBodyType, SEUnderType],
RTSymbols USING[AcquireSTBFromGFH, ReleaseSTB],
RTTypesBasic USING[Type, nullType, fhType, gfhType],
RTTypesPrivate USING
[BuildRecordFieldDescriptor, FieldDescriptor, GetIdConstantValue, GetTVZones,
GFHToName, RecordComponentISEI, TypedVariableRec, UnwindIndirectProcDesc],
RTTypesRemotePrivate USING
[AcquireBTIFromRemoteFH, AcquireSTBFromRemoteGFH, GetRemoteEp,
GetRemoteFrameHeader, GetRemoteGFHandle, GetRemoteGFHeader, IsRemoteCatchFrame,
RemoteGFHToName, RemoteSignalValues, UnwindRemoteIndirectProcDesc,
ValidateRemoteFrame],
Runtime USING[ValidateFrame, ValidateGlobalFrame, GetTableBase, CallDebugger],
SDDefs USING[SD, sSignal],
WorldVM USING[CurrentIncarnation, Long, ShortAddress, World, LocalWorld];

RTTypedFramesImpl: PROGRAM
IMPORTS AMProcessBasic, AMTypes, PrincOpsRuntime, RTLoader, RTSymbolOps, RTSymbols,
AMBridge, RTTypesPrivate, RTTypesRemotePrivate, Runtime,
WorldVM
EXPORTS AMTypes, AMBridge, RTTypesPrivate

= BEGIN OPEN AMBridge, AMTypes, bx: BrandXSymbolDefs, by: BrandYSymbolDefs,
Rope, RTSymbolDefs, RTSymbolOps, RTSymbols, RTTypesBasic, RTTypesPrivate,
RTTypesRemotePrivate, WorldVM;

-- TYPES
EVRange: TYPE = [0..4*PrincOps.EPRange);

-- CONSTANTS
sigGF: PrincOps.GlobalFrameHandle=GFT[LOOPHOLE[SDDefs.SD[SDDefs.sSignal],
PrincOps.ProcDesc].gfi].frame;

-- VARIABLES
tvZone: ZONE;

-- PUBLIC PROCEDURES

-- raises typeFault
TVToSignal: PUBLIC PROC[tv: TypedVariable] RETURNS[ERROR ANY RETURNS ANY] =
{ SELECT TypeClass[UnderType[TVType[tv]]] FROM
signal, error => NULL;
nil => RETURN[LOOPHOLE[PrincOps.UnboundLink, ERROR ANY RETURNS ANY]];
ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]];
RETURN[LOOPHOLE[TVToCardinal[tv], ERROR ANY RETURNS ANY]]};

TVForFrame: PUBLIC PROC[fh: PrincOps.FrameHandle,
evalStack: POINTER TO PrincOps.StateVector ← NIL,
return: BOOL ← FALSE,
contextPC: BOOL ← FALSE]
RETURNS[ans: TV ← NIL] =
{ bti: BodyIndex;
isCatchFrame: BOOLEAN ← FALSE;
IF fh = NIL THEN RETURN[NIL];
Runtime.ValidateFrame[fh];
[isCatchFrame, bti] ← AcquireBTIFromFH[fh, contextPC
! Error => IF reason = noSymbols
THEN {bti ← nullBodyIndex; CONTINUE}];
RETURN[tvZone.NEW[TypedVariableRec
← [referentType: [fhType],
head: [fh[fh: fh,
evalStack: evalStack,
bti: bti,
isCatchFrame: isCatchFrame,
return: return,
contextPC: contextPC]],
status: mutable,
field: entire[]]]];
};

-- all such tvs have the same (distinguished) type: fhType
-- raises typeFault
FHFromTV: PUBLIC PROC[tv: TypedVariable] RETURNS[PrincOps.FrameHandle] =
{ IF tv = NIL THEN RETURN[NIL];
WITH tv SELECT FROM
tr: REF TypedVariableRec =>
WITH tfh: tr.head SELECT FROM
fh => { Runtime.ValidateFrame[tfh.fh];
RETURN[tfh.fh]};
ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]];
ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]]};

TVForGFHReferent: PUBLIC PROC[gfh: PrincOps.GlobalFrameHandle] RETURNS[TypedVariable] =
{ IF gfh = NIL THEN RETURN[NIL];
Runtime.ValidateGlobalFrame[gfh];
RETURN[tvZone.NEW[TypedVariableRec
← [referentType: [gfhType],
head: [gfh[gfh: gfh]],
status: mutable,
field: entire[]]]]};

-- raises typeFault
GFHFromTV: PUBLIC PROC[tv: TypedVariable] RETURNS[PrincOps.GlobalFrameHandle] =
{ IF tv = NIL THEN RETURN[NIL];
WITH tv SELECT FROM
tr: REF TypedVariableRec =>
WITH tgfh: tr.head SELECT FROM
gfh => {Runtime.ValidateGlobalFrame[tgfh.gfh]; RETURN[tgfh.gfh]};
ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]];
ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]]};

-- MOVE
-- raises typeFault
GlobalParent: PUBLIC SAFE PROC[tv: TypedVariable--transfer or local frame--]
RETURNS[TypedVariable--globalFrame--] = TRUSTED
{IF IsRemote[tv]
THEN
{type: Type = TVType[tv];
gfh: RemoteGlobalFrameHandle ← nilRemoteGlobalFrameHandle;
SELECT TypeClass[UnderType[type]] FROM
localFrame => {fh: RemoteFrameHandle = RemoteFHFromTV[tv];
IF fh.fh = 0 THEN RETURN[NIL];
gfh ← [world: fh.world,
worldIncarnation: CurrentIncarnation[fh.world],
gfh: LOOPHOLE[GetRemoteFrameHeader[fh].accesslink,
WorldVM.ShortAddress]]};
program, procedure =>
{pd: RemotePD = UnwindRemoteIndirectProcDesc[TVToRemoteProc[tv]];
IF pd.pd = PrincOps.NullLink THEN RETURN[NIL];
gfh ← GetRemoteGFHandle[world: pd.world,
gfi: LOOPHOLE[pd.pd, PrincOps.ProcDesc].gfi]};
signal, error =>
{sed: RemoteSED = TVToRemoteSignal[tv];
IF sed.sed = PrincOps.NullLink
OR LOOPHOLE[sed.sed, CARDINAL] = 177777B
OR LOOPHOLE[sed.sed, CARDINAL] = LOOPHOLE[UNWIND, CARDINAL]
OR LOOPHOLE[sed.sed, CARDINAL] = LOOPHOLE[ABORTED, CARDINAL]
THEN RETURN[NIL];
gfh ← GetRemoteGFHandle[world: sed.world,
gfi: LOOPHOLE[sed.sed, PrincOps.ProcDesc].gfi]};
nil => RETURN[NIL];
ENDCASE => ERROR Error[reason: typeFault, type: type];
RETURN[TVForRemoteGFHReferent[gfh]]}
ELSE -- local case
{type: Type = TVType[tv];
gfh: PrincOps.GlobalFrameHandle;
SELECT TypeClass[UnderType[type]] FROM
localFrame => {fh: PrincOps.FrameHandle = FHFromTV[tv];
IF fh = NIL THEN RETURN[NIL];
gfh ← fh.accesslink};
signal, error =>
{sed: PrincOps.ProcDesc = LOOPHOLE[TVToSignal[tv], PrincOps.ProcDesc];
IF sed = PrincOps.NullLink
OR LOOPHOLE[sed, CARDINAL] = 177777B
OR LOOPHOLE[sed, CARDINAL] = LOOPHOLE[UNWIND, CARDINAL]
OR LOOPHOLE[sed, CARDINAL] = LOOPHOLE[ABORTED, CARDINAL]
THEN RETURN[NIL];
gfh ← GFT[sed.gfi].frame};
program, procedure =>
{pd: PrincOps.ProcDesc = UnwindIndirectProcDesc
[LOOPHOLE[TVToCardinal[tv],
PrincOps.ControlLink]];
IF pd = PrincOps.NullLink THEN RETURN[NIL];
gfh ← GFT[pd.gfi].frame};
nil => RETURN[NIL];
ENDCASE => ERROR Error[reason: typeFault, type: type];
RETURN[TVForGFHReferent[gfh]]}}; -- end GlobalParent

ContextPC: PUBLIC SAFE PROC[tv: TypedVariable--localFrame--]
RETURNS[ans: PrincOps.BytePC] = TRUSTED
{WITH th: NARROW[tv, REF TypedVariableRec].head SELECT FROM
remoteFH => ans ← [GetRemoteFrameHeader[RemoteFHFromTV[tv]].pc
- (IF th.contextPC THEN 0 ELSE 1)];
fh => ans ← [th.fh.pc - (IF th.contextPC THEN 0 ELSE 1)];
ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]]};

IsStarted: PUBLIC SAFE PROC[tv: TypedVariable--globalFrame--] RETURNS[BOOL] = TRUSTED
{rtr: REF TypedVariableRec ← NARROW[tv];
IF IsRemote[tv]
THEN {rgfh: REF PrincOps.GlobalFrame = GetRemoteGFHeader[RemoteGFHFromTV[tv]];
RETURN[(NOT rgfh.code.out) OR rgfh.started]}
ELSE
WITH th: rtr.head SELECT FROM
gfh => RETURN[(NOT th.gfh.code.out) OR th.gfh.started];
ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]]};

IsCopied: PUBLIC SAFE PROC[tv: TypedVariable--globalFrame--] RETURNS[BOOL] = TRUSTED
{rtr: REF TypedVariableRec ← NARROW[tv];
IF IsRemote[tv]
THEN {rgfh: REF PrincOps.GlobalFrame = GetRemoteGFHeader[RemoteGFHFromTV[tv]];
RETURN[rgfh.copied]}
ELSE
WITH th: rtr.head SELECT FROM
gfh => RETURN[th.gfh.copied];
ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]]};

-- MOVE
Procedure: PUBLIC SAFE PROC[tv: TypedVariable--localFrame--]
RETURNS [TypedVariable--procedure--] =
TRUSTED {IF IsRemote[tv]
THEN
{stb: SymbolTableBase;
rtr: REF TypedVariableRec;
bti: BodyIndex;
fh: RemoteFrameHandle ← nilRemoteFrameHandle;

IF tv = NIL THEN RETURN[NIL];
rtr ← NARROW[tv];
WITH th: rtr.head SELECT FROM
remoteFH => IF th.isCatchFrame
THEN bti ← nullBodyIndex
ELSE {bti ← th.bti;
IF NullBTI[bti] -- last time there were no symbols for this turkey
THEN {name: ROPE;
fh ← RemoteFHFromTV[tv];
bti ← th.bti ← AcquireBTIFromRemoteFH[fh, th.contextPC];
-- returns BTNull if still no symbols
IF NOT NullBTI[th.bti]
THEN {[th.isCatchFrame, th.bti]
← IsRemoteCatchFrame[fh, bti];
bti ← th.bti;
IF th.isCatchFrame THEN bti ← nullBodyIndex}
ELSE {name ← RemoteGFHToName
[[world: fh.world,
worldIncarnation:
CurrentIncarnation[fh.world],
gfh:
LOOPHOLE
[GetRemoteFrameHeader[fh].accesslink,
WorldVM.ShortAddress]]];
ERROR AMTypes.Error
[reason: noSymbols, msg: name]};
};
};
ENDCASE => bti ← nullBodyIndex;
IF NullBTI[bti] THEN ERROR Error[reason: typeFault, type: TVType[tv]];
fh ← RemoteFHFromTV[tv];
IF fh.fh = 0 THEN RETURN[NIL];
stb ← AcquireSTBFromRemoteGFH[[world: fh.world,
worldIncarnation: CurrentIncarnation[fh.world],
gfh: LOOPHOLE[GetRemoteFrameHeader[fh].accesslink,
WorldVM.ShortAddress]]];
FOR bti ← bti, ParentBody[stb, bti] UNTIL NullBTI[bti] DO
IF CallableBTI[stb, bti]
THEN
{sppd: PrincOps.ProcDesc ← LOOPHOLE[PrincOps.UnboundLink, PrincOps.ProcDesc];
entryIndex: [0..PrincOps.EPRange*PrincOps.MaxNGfi)
← CallableBodyEntryIndex[stb, LOOPHOLE[bti, CallableBodyIndex]];
IF entryIndex = 0 THEN ERROR Error[reason: typeFault, type: TVType[tv]];
-- start proc frame
sppd.gfi ← GetRemoteGFHeader[[world: fh.world,
worldIncarnation: CurrentIncarnation[fh.world],
gfh: LOOPHOLE[GetRemoteFrameHeader[fh].accesslink,
WorldVM.ShortAddress]]
].gfi
+ entryIndex/PrincOps.EPRange;
sppd.ep ← entryIndex MOD PrincOps.EPRange;
ReleaseSTB[stb];
RETURN[TVForRemoteProc[[world: fh.world,
worldIncarnation: CurrentIncarnation[fh.world],
pd: sppd]]]};
ENDLOOP;
ReleaseSTB[stb];
RETURN[NIL]}
ELSE -- non-remote localFrame TV arg to Procedure
{stb: SymbolTableBase;
rtr: REF TypedVariableRec;
bti: BodyIndex;
fh: PrincOps.FrameHandle;

IF tv = NIL THEN RETURN[NIL];
rtr ← NARROW[tv];
WITH th: rtr.head SELECT FROM
fh => IF th.isCatchFrame
THEN ERROR Error[reason: typeFault, type: TVType[tv]]
ELSE {bti ← th.bti;
-- XXX be careful about access via assign to RC variables that appear to be in a local frame (startproc)
-- but really live in the GF. Also remote case
IF NullBTI[bti] -- no symbols for this localFrame TV
THEN {fh ← FHFromTV[tv];
bti ← th.bti ← AcquireBTIFromFH[fh, th.contextPC ! ANY => CONTINUE].bti;
-- returns BTNull if still no symbols
IF NOT NullBTI[th.bti]
THEN {[th.isCatchFrame, th.bti] ← IsCatchFrame[fh, bti];
bti ← th.bti;
IF th.isCatchFrame
THEN ERROR Error[reason: typeFault, type: TVType[tv]];
}
ELSE ERROR AMTypes.Error
[reason: noSymbols,
msg: GFHToName[th.fh.accesslink]];
};
};
ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]];

-- here with bti # nullBodyIndex
fh ← FHFromTV[tv];
IF fh = NIL THEN RETURN[NIL];
stb ← AcquireSTBFromGFH[fh.accesslink];
-- search up thru enclosing blocks till a callable one
FOR bti ← bti, ParentBody[stb, bti] UNTIL NullBTI[bti] DO
IF CallableBTI[stb, bti]
THEN
{sppd: PrincOps.ProcDesc ← LOOPHOLE[PrincOps.UnboundLink, PrincOps.ProcDesc];
entryIndex: [0..PrincOps.EPRange*PrincOps.MaxNGfi)
← CallableBodyEntryIndex[stb, LOOPHOLE[bti, CallableBodyIndex]];

-- IF entryIndex = 0 THEN ERROR Error[reason: typeFault, type: TVType[tv]];
-- going up from a block or a body inside a startproc.

sppd.gfi ← fh.accesslink.gfi + entryIndex/PrincOps.EPRange;
sppd.ep ← entryIndex MOD PrincOps.EPRange;
ReleaseSTB[stb];
RETURN[TVForProc[LOOPHOLE[sppd, PROC ANY RETURNS ANY]]]};
ENDLOOP;
ReleaseSTB[stb];
-- here if the local frame has no enclosing callable body.
-- This can't happen.
ERROR;
-- RETURN[NIL];
}}; -- end Procedure

Signal: PUBLIC SAFE PROC[tv: TypedVariable--localFrame--]
RETURNS[ans: TypedVariable--signal descriptor--] =
TRUSTED {IF IsRemote[tv]
THEN {world: World;
sed: PrincOps.SignalDesc;
[world: world, signal: sed] ← RemoteSignalValues[tv];
ans ← TVForRemoteSignal[[world: world,
worldIncarnation: CurrentIncarnation[world],
sed: sed]]}
ELSE ans ← TVForSignal[LOOPHOLE[RemoteSignalValues[tv].signal,
ERROR ANY RETURNS ANY]]};

Argument: PUBLIC SAFE PROC[tv: TypedVariable--local or catch Frame--, index: Index]
RETURNS[TypedVariable] =
TRUSTED {RETURN[ArgOrResult[tv, index, Domain]]};

Result: PUBLIC SAFE PROC[tv: TypedVariable--local or catch Frame--, index: Index]
RETURNS[TypedVariable] =
TRUSTED {RETURN[ArgOrResult[tv, index, Range]]};

-- break up and MOVE
ArgOrResult: PROC[tv: TypedVariable--local or catch Frame--,
index: Index,
domainOrRange: PROC[Type] RETURNS [Type]]
RETURNS[TypedVariable] =
{type: Type;
catch: BOOLEAN;
message: UNSPECIFIED;
world: World;
argsTV: REF TypedVariableRec;
tvr: REF TypedVariableRec;
offset: INTEGER ← 0;

-- returns a signal type if tv is for a catch frame,
-- a procedure type if tv is for a local frame,
-- raises TypeFault otherwise.
GetSignalOrProcType: PROC[tv: TypedVariable]
RETURNS [type: Type ← nullType, catch: BOOLEAN ← FALSE] =
{rtr: REF TypedVariableRec ← NARROW[tv];
WITH th: rtr.head SELECT FROM
fh => {catch ← th.isCatchFrame;
type ← TVType[IF catch THEN Signal[tv] ELSE Procedure[tv]]};
remoteFH => {catch ← th.isCatchFrame;
type ← TVType[IF catch THEN Signal[tv] ELSE Procedure[tv]]};
ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]]};

IF tv = NIL THEN ERROR Error[reason: typeFault, type: nullType];

tvr ← NARROW[tv];
[type, catch] ← GetSignalOrProcType[tv];
IF type = nullType THEN ERROR Error[reason: badIndex];
type ← domainOrRange[type];
IF type = nullType THEN ERROR Error[reason: badIndex];

WITH tvh: tvr.head SELECT FROM
fh, remoteFH => NULL;
ENDCASE => ERROR Error[reason: typeFault, type: type];

IF ~catch OR domainOrRange = Range
THEN -- find the specified element in the frame, create a TV for it
{BuildEmbeddedTV: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] =
{sei: SymbolIndex = ISEType[stb, isei];
csei: SymbolConstructorIndex ← SEUnderType[stb, sei];
bitsForType: CARDINAL ← (WITH stb SELECT FROM
t: SymbolTableBase.x =>
t.e.BitsForType[NARROW[csei,
SymbolConstructorIndex.x].e],
t: SymbolTableBase.y =>
t.e.BitsForType[NARROW[csei,
SymbolConstructorIndex.x].e],
ENDCASE => ERROR); -- bits for the value in the field
fieldBits: CARDINAL ← (WITH stb SELECT FROM
t: SymbolTableBase.x =>
t.e.seb[NARROW[isei, SymbolIdIndex.x].e].idInfo,
t: SymbolTableBase.y =>
t.e.seb[NARROW[isei, SymbolIdIndex.x].e].idInfo,
ENDCASE => ERROR); -- bits for the field
fieldBitOffset: CARDINAL ← (WITH stb SELECT FROM
t: SymbolTableBase.x =>
t.e.seb[NARROW[isei, SymbolIdIndex.x].e].idValue,
t: SymbolTableBase.y =>
t.e.seb[NARROW[isei, SymbolIdIndex.x].e].idValue,
ENDCASE => ERROR);
-- bit offset of the field within the local frame
cType: Type ← AcquireType[stb, sei];

IF ISEConstant[stb, isei]
THEN {
IF IsRemote[tv] AND IsTypeSEI[ISEType[stb, isei]]
THEN argsTV ← tvZone.NEW[TypedVariableRec ←
[ referentType: [cType],
head: [constant[]], -- type code is valid in local world
status: const,
field: constant[value: GetIdConstantValue[tv, stb, isei]]]]
ELSE -- either a constant component of a local tv or not a type constant
argsTV ← tvZone.NEW[TypedVariableRec ←
[ referentType: [cType],
head: (WITH tv SELECT FROM
tr: REF TypedVariableRec => tr.head,
ENDCASE => [reference[ref: tv]]),
status: const,
field: constant[value: GetIdConstantValue[tv, stb, isei]]]];
}
ELSE argsTV ← tvZone.NEW[TypedVariableRec ←
[ referentType: [cType],
head: (WITH tv SELECT FROM
tr:REF TypedVariableRec => tr.head,
ENDCASE => [reference[ref: tv]]),
status: (IF ISEImmutable[stb, isei]
THEN readOnly
ELSE TVStatus[tv]),
field: embedded[fd: BuildRecordFieldDescriptor
[tv, fieldBitOffset, fieldBits, bitsForType]]]];
}; -- END BuildEmbeddedTV

-- Begin Here
RTTypesPrivate.RecordComponentISEI[UnderType[type], index, BuildEmbeddedTV];
RETURN[argsTV]}; -- END ~catch OR domainOrRange = Range


-- gotta do something different if this is an arg to a catch phrase

[world: world, message: message] ← RemoteSignalValues[tv];
-- message is either a pointer to a long arg record OR a single word value

IF Size[type] = 1
THEN {ws: WordSequence = NEW[WordSequenceRecord[1]];
ws[0] ← LOOPHOLE[message, CARDINAL];
argsTV ← tvZone.NEW[TypedVariableRec
← [referentType: [type],
head: tvr.head,
status: const,
field: constant[value: ws]]]}
ELSE IF IsRemote[tv]
THEN argsTV ← tvZone.NEW
[TypedVariableRec
← [referentType: [type],
head: [remotePointer
[remotePointer:
[world: world,
worldIncarnation: CurrentIncarnation[world],
ptr: Long[world: world, addr: message]]]],
status: readOnly,
field: entire[]]]
ELSE argsTV ← tvZone.NEW
[TypedVariableRec
← [referentType: [type],
head: [pointer[ptr: LONG
[LOOPHOLE[message, POINTER]]]],
status: readOnly,
field: entire[]]];
RETURN[IndexToTV[argsTV, index]]}; -- end ArgOrResult

EnclosingBody: PUBLIC SAFE PROC[tv: TypedVariable--localFrame--]
RETURNS[TypedVariable--localFrame--] = TRUSTED -- maybe NIL
--// NOTE: if tv represents a block within a catch phrase, EnclosingBody
--// may return the wrong context; i.e., the one enclosing the catch phrase.
--// This won't come up if there is no block in the catch phrase at all;
--// TVForFrame will detect it and do the right thing. It's harder to do
--// the right thing here.
--// The right solution is to put catch phrases in the body table!!!

{IF IsRemote[tv]
THEN
{ stb: SymbolTableBase
= AcquireSTBFromRemoteGFH
[[world: GetWorld[tv],
worldIncarnation: CurrentIncarnation[GetWorld[tv]],
gfh: LOOPHOLE[GetRemoteFrameHeader[RemoteFHFromTV[tv]].accesslink,
WorldVM.ShortAddress]]];
rtr: REF TypedVariableRec ← NARROW[tv ! UNWIND => ReleaseSTB[stb]];
bti: BodyIndex;
evalStack: WordSequence;
isCatchFrame: BOOL;
remoteFH: RemoteFrameHandle ← nilRemoteFrameHandle;
contextPC: BOOL;
level: BlockContextLevel;
return: BOOL;

-- static nesting level, associated with a CTX (optimization: blocks, instead of
-- counting up, get level of enclosing proc).
-- 0 (lZ)=> off in the heap (not part of a frame...lifetime determined by
-- some sort of runtime storage management, e.g. records, ctx for names
-- of guys in an emum);
-- 1 (lG) => global frame, outermost proc
-- 2 (lL) and >2 => nested procedure.
-- catch phrase in main prog would have a level of 2 (tho these are not recorded,
-- because there are not symbol table entries for catch phrases.

WITH th: rtr.head SELECT FROM
remoteFH =>
{bti ← th.bti;
evalStack ← th.evalStack;
isCatchFrame ← th.isCatchFrame;
remoteFH ← th.remoteFrameHandle;
contextPC ← th.contextPC;
return ← th.return};
ENDCASE => {ReleaseSTB[stb];
ERROR Error[reason: typeFault, type: TVType[tv]]};

-- a fh tv will have NullBTI[bti] if there are no symbols for its referent or if it
-- represents a frame for a startproc or catch phrase at a point outside the scope
-- of locals
IF NullBTI[bti]
THEN {IF isCatchFrame
THEN -- get the bti of the smallest body that encloses the PC
-- (if it's rootBodyIndex then RETURN[NIL]). Verify that this body
-- is a body contained (not necessarily properly) within a
-- frame somewhere up the static link. Return a tv for such a frame.
{ rfh: RemoteFrameHandle = RemoteFHFromTV[tv];
rgfh: WorldVM.ShortAddress
← LOOPHOLE[GetRemoteFrameHeader[rfh].accesslink];

bti ← SmallestBTIFromRemoteFH[rfh, stb, contextPC
! UNWIND => ReleaseSTB[stb]];
IF IsRootBTI[bti] -- not in the scope of any locals
THEN {ReleaseSTB[stb]; RETURN[NIL]};

-- starting with the frame of the most recent instance of the smallest
-- enclosing static parent of the catch frame, search up the static chain
-- to find the first frame that encloses the catch frame
IF GetRemoteFrameHeader[remoteFH].staticlink = NIL
THEN Runtime.CallDebugger["Please call Paul Rovner"];
tv ← TVForRemoteFrame
[[world: remoteFH.world,
worldIncarnation: CurrentIncarnation[remoteFH.world],
fh: LOOPHOLE[GetRemoteFrameHeader[remoteFH].staticlink
- PrincOps.localbase, WorldVM.ShortAddress]]];
UNTIL IsBodyEncloser[er: tv, ee: bti, stb: stb]
-- look up the static chain to find an encloser of bti
DO
rmtFH: RemoteFrameHandle ← RemoteFHFromTV[tv];
IF LOOPHOLE[GetRemoteFrameHeader[rmtFH].accesslink,
WorldVM.ShortAddress] # rgfh
THEN {ReleaseSTB[stb]; ERROR};
-- (bti # rootBodyIndex) => one better exist
IF GetRemoteFrameHeader[rmtFH].staticlink = NIL
THEN Runtime.CallDebugger["Please call Paul Rovner"];
tv ← TVForRemoteFrame
[[world: rmtFH.world,
worldIncarnation: CurrentIncarnation[rmtFH.world],
fh: LOOPHOLE[GetRemoteFrameHeader[rmtFH].staticlink
- PrincOps.localbase, WorldVM.ShortAddress]]];
ENDLOOP;
rtr ← NARROW[tv, REF TypedVariableRec];
WITH th: rtr.head SELECT FROM
remoteFH =>
{ -- Easy if we already have the right bti,
-- otherwise get the new value of isCatchFrame
IF bti = th.bti THEN RETURN[tv];
evalStack ← NIL; -- NOTE
isCatchFrame ← th.isCatchFrame;
return ← th.return;
contextPC ← th.contextPC};
ENDCASE => ERROR;
ReleaseSTB[stb];
RETURN[tvZone.NEW[TypedVariableRec ←
[referentType: [fhType],
head:
[remoteFH[remoteFrameHandle: RemoteFHFromTV[tv],
evalStack: evalStack,
bti: bti,
isCatchFrame: isCatchFrame,
return: return,
contextPC: contextPC]],
status: mutable,
field: entire[]]]]}
ELSE {ReleaseSTB[stb]; RETURN[NIL]} -- either no symbols or no locals
};

IF CallableBTI[stb, bti]
THEN -- No more enclosing blocks: this one is callable and not a catch frame
IF (WITH BodyLevel[stb, bti] SELECT FROM -- TRUE => not a nested procedure
t: BlockContextLevel.x => t.e <= bx.outerContextLevel,
t: BlockContextLevel.y => t.e <= by.outerContextLevel,
ENDCASE => ERROR)
THEN {ReleaseSTB[stb]; RETURN[NIL]}
ELSE { -- this is a frame for a nested procedure
ReleaseSTB[stb];
IF GetRemoteFrameHeader[remoteFH].staticlink = NIL
THEN Runtime.CallDebugger["Please call Paul Rovner"];
RETURN
[TVForRemoteFrame
[[world: remoteFH.world,
worldIncarnation: CurrentIncarnation[remoteFH.world],
fh: LOOPHOLE[GetRemoteFrameHeader[remoteFH].staticlink
- PrincOps.localbase, WorldVM.ShortAddress]]]];
};

level ← BodyLevel[stb, bti];
bti ← ParentBody[stb, bti]; -- A Callable bt entry also describes the outer block locals
IF IsRootBTI[bti] THEN bti ← nullBodyIndex;
-- means either that tv represents a frame for a startproc or catch phrase at
-- a place outside the scope of locals.

IF isCatchFrame AND (NOT NullBTI[bti]) AND level # BodyLevel[stb, bti]
THEN
{-- When the level changes inside of a catch phrase
-- then we have to go through the static link (local 0)
-- to get to the frame that corresponds to this bti.
-- The static link points at local 0, not the frame base (=> subtract localbase).
ReleaseSTB[stb]; -- we no longer need the stb
IF GetRemoteFrameHeader[remoteFH].staticlink = NIL
THEN Runtime.CallDebugger["Please call Paul Rovner"];
tv ← TVForRemoteFrame
[[world: remoteFH.world,
worldIncarnation: CurrentIncarnation[remoteFH.world],
fh: LOOPHOLE[GetRemoteFrameHeader[remoteFH].staticlink
- PrincOps.localbase, WorldVM.ShortAddress]]];
rtr ← NARROW[tv, REF TypedVariableRec];
WITH th: rtr.head SELECT FROM
remoteFH =>
{ -- Easy if we already have the right bti,
-- otherwise get the new value of isCatchFrame
IF bti = th.bti THEN RETURN[tv];
evalStack ← NIL; -- NOTE
isCatchFrame ← th.isCatchFrame;
return ← th.return;
contextPC ← th.contextPC};
ENDCASE => ERROR
}
ELSE ReleaseSTB[stb];

RETURN[tvZone.NEW[TypedVariableRec ←
[referentType: [fhType],
head: [remoteFH[remoteFrameHandle: RemoteFHFromTV[tv],
evalStack: evalStack,
bti: bti,
isCatchFrame: isCatchFrame,
return: return,
contextPC: contextPC]],
status: mutable,
field: entire[]]]];
}
ELSE -- local case of EnclosingBody
{ stb: SymbolTableBase = AcquireSTBFromGFH[FHFromTV[tv].accesslink];
rtr: REF TypedVariableRec ← NARROW[tv ! UNWIND => ReleaseSTB[stb]];
bti: BodyIndex;
evalStack: POINTER TO PrincOps.StateVector;
isCatchFrame: BOOL;
contextPC: BOOL;
level: BlockContextLevel;
return: BOOL;

-- static nesting level, associated with a CTX (optimization: blocks, instead of
-- counting up, get level of enclosing proc).
-- 0 (lZ)=> off in the heap (not part of a frame...lifetime determined by
-- some sort of runtime storage management, e.g. records, ctx for names
-- of guys in an emum);
-- 1 (lG) => global frame, outermost proc
-- 2 (lL) and >2 => nested procedure.
-- catch phrase in main prog would have a level of 2 (tho these are not recorded,
-- because there are not symbol table entries for catch phrases.

WITH th: rtr.head SELECT FROM
fh => {bti ← th.bti;
evalStack ← th.evalStack;
isCatchFrame ← th.isCatchFrame;
contextPC ← th.contextPC;
return ← th.return};
ENDCASE => {ReleaseSTB[stb];
ERROR Error[reason: typeFault, type: TVType[tv]]};

-- a fh tv will have NullBTI[bti] if there are no symbols for its referent or if it
-- represents a frame for a startproc or catch phrase at a point outside the scope
-- of locals
IF NullBTI[bti]
THEN {IF isCatchFrame
THEN -- get the bti of the smallest body that encloses the PC
-- (if it's rootBodyIndex then RETURN[NIL]). Verify that this body
-- is a body contained (not necessarily properly) within a
-- frame somewhere up the static link. Return a tv for such a frame.
{ fh: PrincOps.FrameHandle = FHFromTV[tv];
gfh: PrincOps.GlobalFrameHandle ← fh.accesslink;

bti ← SmallestBTIFromFH[fh, stb, contextPC ! UNWIND => ReleaseSTB[stb]];
IF IsRootBTI[bti] -- not in the scope of any locals
THEN {ReleaseSTB[stb]; RETURN[NIL]};

-- starting with the frame of the most recent instance of the smallest
-- enclosing static parent of the catch frame, search up the static chain
-- to find the first frame that encloses the catch frame
IF fh.staticlink = NIL
THEN Runtime.CallDebugger["Please call Paul Rovner"];
tv ← TVForFrame[LOOPHOLE[fh.staticlink - PrincOps.localbase,
PrincOps.FrameHandle]];
UNTIL IsBodyEncloser[er: tv, ee: bti, stb: stb]
-- look up the static chain to find an encloser of bti
DO
IF FHFromTV[tv].accesslink # gfh
THEN {ReleaseSTB[stb]; ERROR};
-- (bti # rootBodyIndex) => one better exist
IF FHFromTV[tv].staticlink = NIL
THEN Runtime.CallDebugger["Please call Paul Rovner"];
tv ← TVForFrame
[LOOPHOLE[FHFromTV[tv].staticlink - PrincOps.localbase,
PrincOps.FrameHandle]];
ENDLOOP;
rtr ← NARROW[tv, REF TypedVariableRec];
WITH th: rtr.head SELECT FROM
fh => { -- Easy if we already have the right bti,
-- otherwise get the new value of isCatchFrame
IF bti = th.bti THEN RETURN[tv];
evalStack ← NIL; -- NOTE
isCatchFrame ← th.isCatchFrame;
return ← th.return;
contextPC ← th.contextPC};
ENDCASE => ERROR;
ReleaseSTB[stb];
RETURN[tvZone.NEW[TypedVariableRec ←
[referentType: [fhType],
head: [fh[fh: FHFromTV[tv],
evalStack: evalStack,
bti: bti,
isCatchFrame: isCatchFrame,
return: return,
contextPC: contextPC]],
status: mutable,
field: entire[]]]]}
ELSE {ReleaseSTB[stb]; RETURN[NIL]} -- either no symbols or no locals
};

IF CallableBTI[stb, bti]
THEN -- No more enclosing blocks: this one is callable and not a catch frame
IF (WITH BodyLevel[stb, bti] SELECT FROM -- TRUE => not a nested procedure
t: BlockContextLevel.x => t.e <= bx.outerContextLevel,
t: BlockContextLevel.y => t.e <= by.outerContextLevel,
ENDCASE => ERROR)
THEN {ReleaseSTB[stb]; RETURN[NIL]}
ELSE { -- this is a frame for a nested procedure
ReleaseSTB[stb];
IF FHFromTV[tv].staticlink = NIL
THEN Runtime.CallDebugger["Please call Paul Rovner"];
RETURN[TVForFrame
[LOOPHOLE[FHFromTV[tv].staticlink - PrincOps.localbase,
PrincOps.FrameHandle]]];
};

level ← BodyLevel[stb, bti];
bti ← ParentBody[stb, bti]; -- A Callable bt entry also describes the outer block locals
IF IsRootBTI[bti] THEN bti ← nullBodyIndex;
-- means either that tv represents a frame for a startproc or catch phrase at
-- a place outside the scope of locals.

IF isCatchFrame AND (NOT NullBTI[bti]) AND level # BodyLevel[stb, bti]
THEN
{-- When the level changes inside of a catch phrase
-- then we have to go through the static link (local 0)
-- to get to the frame that corresponds to this bti.
-- The static link points at local 0, not the frame base (=> subtract localbase).
ReleaseSTB[stb]; -- we no longer need the stb
IF FHFromTV[tv].staticlink = NIL
THEN Runtime.CallDebugger["Please call Paul Rovner"];
tv ← TVForFrame
[LOOPHOLE[FHFromTV[tv].staticlink - PrincOps.localbase,
PrincOps.FrameHandle]];
rtr ← NARROW[tv, REF TypedVariableRec];
WITH th: rtr.head SELECT FROM
fh => { -- Easy if we already have the right bti,
-- otherwise get the new value of isCatchFrame
IF bti = th.bti THEN RETURN[tv];
evalStack ← NIL; -- NOTE
isCatchFrame ← th.isCatchFrame;
return ← th.return;
contextPC ← th.contextPC};
ENDCASE => ERROR
}
ELSE ReleaseSTB[stb];

RETURN[tvZone.NEW[TypedVariableRec ←
[referentType: [fhType],
head: [fh[fh: FHFromTV[tv],
evalStack: evalStack,
bti: bti,
isCatchFrame: isCatchFrame,
return: return,
contextPC: contextPC]],
status: mutable,
field: entire[]]]];
}}; -- end EnclosingBody

-- MOVE
Locals: PUBLIC SAFE PROC[tv: TypedVariable--localFrame--]
RETURNS[TypedVariable--record--] = -- maybe NIL
TRUSTED {IF IsRemote[tv]
THEN
{ stb: SymbolTableBase;
rtr: REF TypedVariableRec;
bti: BodyIndex;
fh: RemoteFrameHandle = RemoteFHFromTV[tv];
type: Type;

IF fh = nilRemoteFrameHandle THEN RETURN[NIL];
stb ← AcquireSTBFromRemoteGFH
[[world: fh.world,
worldIncarnation: CurrentIncarnation[fh.world],
gfh: LOOPHOLE[GetRemoteFrameHeader[fh].accesslink, WorldVM.ShortAddress]]];
rtr ← NARROW[tv ! UNWIND => ReleaseSTB[stb]];
bti ← (WITH th: rtr.head SELECT FROM remoteFH => th.bti, ENDCASE => nullBodyIndex);
IF NullBTI[bti] OR IsRootBTI[bti] THEN {ReleaseSTB[stb]; RETURN[NIL]};
IF NullSEI[BodyType[stb, bti]] THEN {ReleaseSTB[stb]; RETURN[NIL]};
type ← AcquireType[stb, BodyType[stb, bti] ! UNWIND => ReleaseSTB[stb]];
ReleaseSTB[stb];
RETURN[tvZone.NEW[TypedVariableRec ←
[referentType: [type],
head: rtr.head,
status: mutable, field: entire[]]]]}
ELSE
{ stb: SymbolTableBase;
rtr: REF TypedVariableRec;
bti: BodyIndex;
fh: PrincOps.FrameHandle = FHFromTV[tv];
type: Type;

IF fh = NIL THEN RETURN[NIL];
stb ← AcquireSTBFromGFH[fh.accesslink];
rtr ← NARROW[tv ! UNWIND => ReleaseSTB[stb]];
bti ← (WITH th: rtr.head SELECT FROM fh => th.bti, ENDCASE => nullBodyIndex);
IF NullBTI[bti] OR IsRootBTI[bti] THEN {ReleaseSTB[stb]; RETURN[NIL]};
IF NullSEI[BodyType[stb, bti]] THEN {ReleaseSTB[stb]; RETURN[NIL]};
type ← AcquireType[stb, BodyType[stb, bti] ! UNWIND => ReleaseSTB[stb]];
ReleaseSTB[stb];
RETURN[tvZone.NEW[TypedVariableRec ←
[referentType: [type],
head: rtr.head,
status: mutable, field: entire[]]]]}};

DynamicParent: PUBLIC SAFE PROC[tv: TypedVariable--localFrame--]
RETURNS[TypedVariable--localFrame--] =
TRUSTED {IF IsRemote[tv]
THEN
{ fh: RemoteFrameHandle = RemoteFHFromTV[tv];
IF fh = nilRemoteFrameHandle THEN RETURN[NIL];
{ValidateRemoteFrame[[world: fh.world,
worldIncarnation: CurrentIncarnation[fh.world],
fh: LOOPHOLE[AMProcessBasic.ReturnLink
[fh.world,
LOOPHOLE[fh.fh, PrincOps.FrameHandle]],
WorldVM.ShortAddress]]
! ANY => GOTO nope]; EXITS nope => RETURN[NIL]};
RETURN[TVForRemoteFrame
[[world: fh.world,
worldIncarnation: CurrentIncarnation[fh.world],
fh: LOOPHOLE[AMProcessBasic.ReturnLink
[fh.world,
LOOPHOLE[fh.fh, PrincOps.FrameHandle]],
WorldVM.ShortAddress]]]]}
ELSE
{ fh: PrincOps.FrameHandle = FHFromTV[tv];
IF fh = NIL THEN RETURN[NIL];
{Runtime.ValidateFrame
[AMProcessBasic.ReturnLink[WorldVM.LocalWorld[], fh ! ANY => GOTO nope]
! ANY => GOTO nope];
EXITS nope => RETURN[NIL];
};
RETURN[TVForFrame
[AMProcessBasic.ReturnLink[WorldVM.LocalWorld[], fh].frame]]}};


-- break up and MOVE
Globals: PUBLIC SAFE PROC[tv: TypedVariable--globalFrame--]
RETURNS[TypedVariable--record--] =
TRUSTED {IF IsRemote[tv]
THEN
{ tvr: REF TypedVariableRec;
gfh: RemoteGlobalFrameHandle ← nilRemoteGlobalFrameHandle;
type: Type;

IF tv = NIL THEN RETURN[NIL];
tvr ← NARROW[tv];
gfh ← RemoteGFHFromTV[tv];
IF gfh = nilRemoteGlobalFrameHandle THEN RETURN[NIL];
{stb: SymbolTableBase = AcquireSTBFromRemoteGFH[gfh];
type ← AcquireType[stb, RootBodyType[stb] ! UNWIND => ReleaseSTB[stb]];
ReleaseSTB[stb]};
RETURN[tvZone.NEW[TypedVariableRec ← [referentType: [type],
head: tvr.head,
status: mutable,
field: entire[]]]]}
ELSE
{ tvr: REF TypedVariableRec;
gfh: PrincOps.GlobalFrameHandle;
type: Type;

IF tv = NIL THEN RETURN[NIL];
tvr ← NARROW[tv];
gfh ← GFHFromTV[tv];
IF gfh = NIL THEN RETURN[NIL];
IF (type ← RTLoader.GetGFRCType[gfh.gfi]) = nullType
THEN {stb: SymbolTableBase = AcquireSTBFromGFH[gfh];
type ← AcquireType[stb, RootBodyType[stb] ! UNWIND => ReleaseSTB[stb]];
ReleaseSTB[stb]};
RETURN[tvZone.NEW[TypedVariableRec ← [referentType: [type],
head: tvr.head,
status: mutable,
field: entire[]]]]}};

-- NOTE
--SignalValues: PROC[tv: TypedVariable]
--catch Frame
-- RETURNS [message: UNSPECIFIED, signal: PrincOps.SignalDesc] =
-- {rtr: REF TypedVariableRec ← NARROW[tv];
-- WITH th: rtr.head SELECT FROM
-- fh =>
-- IF th.isCatchFrame
-- THEN {mlf: PrincOps.FrameHandle;
-- mlfrl: PrincOps.ControlLink;
-- sig: UNSPECIFIED;
-- Runtime.ValidateFrame[th.fh];
-- now convince the signaller to give back either a single word arg to the signal
-- or a pointer to the long arg record, in such a way that this works in a
-- different process than the signal was raised.
-- mlf ← MyLocalFrame[];
-- mlfrl ← mlf.returnlink;
-- mlf.returnlink ← th.fh.returnlink;
-- [message, sig] ← SIGNAL RuntimeInternal.SendMsgSignal;
-- mlf.returnlink ← mlfrl;
-- signal ← LOOPHOLE[sig, PrincOps.SignalDesc];
-- RETURN}
-- ELSE ERROR Error[reason: typeFault, type: TVType[tv]];
-- ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]]};

-- MOVE
IsBodyEncloser: PROC[er: TypedVariable, ee: BodyIndex, stb: SymbolTableBase]
RETURNS[ans: BOOL ← FALSE] =
{rtr: REF TypedVariableRec ← NARROW[er];
WITH th: rtr.head SELECT FROM
fh => {-- does th.bti enclose ee?
WITH stb SELECT FROM
t: SymbolTableBase.x =>
FOR bti: bx.BodyIndex ← NARROW[th.bti, BodyIndex.x].e, t.e.SonBti[bti]
UNTIL bti = bx.nullBodyIndex
DO IF bti = NARROW[ee, BodyIndex.x].e THEN RETURN[TRUE];
ENDLOOP;
t: SymbolTableBase.y =>
FOR bti: by.BodyIndex ← NARROW[th.bti, BodyIndex.y].e, t.e.SonBti[bti]
UNTIL bti = by.nullBodyIndex
DO IF bti = NARROW[ee, BodyIndex.y].e THEN RETURN[TRUE];
ENDLOOP;
ENDCASE => ERROR;
};
remoteFH => {-- does th.bti enclose ee?
WITH stb SELECT FROM
t: SymbolTableBase.x =>
FOR bti: bx.BodyIndex ← NARROW[th.bti, BodyIndex.x].e, t.e.SonBti[bti]
UNTIL bti = bx.nullBodyIndex
DO IF bti = NARROW[ee, BodyIndex.x].e THEN RETURN[TRUE];
ENDLOOP;
t: SymbolTableBase.y =>
FOR bti: by.BodyIndex ← NARROW[th.bti, BodyIndex.y].e, t.e.SonBti[bti]
UNTIL bti = by.nullBodyIndex
DO IF bti = NARROW[ee, BodyIndex.y].e THEN RETURN[TRUE];
ENDLOOP;
ENDCASE => ERROR;
};
ENDCASE => ERROR;
};


-- MOVE
GFT: PUBLIC PROC [gftx: PrincOps.GFTIndex]
RETURNS [frame: PrincOps.GlobalFrameHandle, epbase: CARDINAL] =
-- NOTE assumption about conversion of epbias to epbase
-- we assume that it is supposed to be shifted to agree with the Alto world
-- to make the entry point (ep) numbers come out right
{item: PrincOpsRuntime.GFTItem = PrincOpsRuntime.GFT[gftx];
RETURN [frame: PrincOpsRuntime.GetFrame[item],
epbase: item.epbias * PrincOps.EPRange]};

-- Cases: normal, startproc, block in startproc, catch frame, block in catch frame,
-- catch frame in startproc. Possibly no symbols.
-- all cases below can raise Error[noSymbols]
-- normal: returns a vanilla-flavored (maybe callable) bti
-- catch frame: returns a non-callable bti or nullBodyIndex (if outside scope of locals)
-- startproc: returns a vanilla-flavored bti, maybe rootBodyIndex
-- MOVE
AcquireBTIFromFH: PROC[fh: PrincOps.FrameHandle, contextPC: BOOL]
RETURNS[isCatchFrame: BOOL, bti: BodyIndex] =
{stb: SymbolTableBase = AcquireSTBFromGFH[fh.accesslink];

bti ← SmallestBTIFromFH[fh, stb, contextPC ! UNWIND => ReleaseSTB[stb]];

-- if fh is for a catch phrase, bti might be for a proc that contains it.
[isCatchFrame, bti] ← IsCatchFrame[fh, bti ! UNWIND => ReleaseSTB[stb]];

ReleaseSTB[stb];
RETURN[isCatchFrame, bti]};

-- MOVE
SmallestBTIFromFH: PROC[fh: PrincOps.FrameHandle, stb: SymbolTableBase, contextPC: BOOL]
RETURNS[bti: BodyIndex] =
{start: PrincOps.BytePC;
epn: CARDINAL;
framePC: PrincOps.BytePC = [(fh.pc - (IF contextPC THEN 0 ELSE 1))];

[epn, start] ← GetEp[framePC, fh.accesslink, stb];

-- if epn = 0 then this is a frame for the startproc or for a catchframe in the startproc
bti ← ConvertCbti[base: stb,
pc: framePC,
start: start,
lastBti: LOOPHOLE[GetCBTI[stb, epn], BodyIndex]]};

SmallestBTIFromRemoteFH: PROC[rfh: RemoteFrameHandle,
stb: SymbolTableBase,
contextPC: BOOL]
RETURNS[bti: BodyIndex] =
{start: PrincOps.BytePC;
epn: CARDINAL;
remoteFrame: REF PrincOps.Frame = GetRemoteFrameHeader[rfh];
framePC: PrincOps.BytePC = [(remoteFrame.pc - (IF contextPC THEN 0 ELSE 1))];

[epn, start] ← GetRemoteEp[pc: framePC,
gf: [world: rfh.world,
worldIncarnation: CurrentIncarnation[rfh.world],
gfh: LOOPHOLE[remoteFrame.accesslink, ShortAddress]],
stb: stb];

-- if epn = 0 then this is a frame for the startproc or for a catchframe in the startproc
bti ← ConvertCbti[base: stb,
pc: framePC,
start: start,
lastBti: LOOPHOLE[GetCBTI[stb, epn], BodyIndex]]};

-- finds the cbti for the specified entrypoint
-- MOVE
GetCBTI: PUBLIC PROC[stb: SymbolTableBase, epn: CARDINAL] RETURNS[cbti: CallableBodyIndex] =
{ IsThisItX: PROC[bti: bx.BodyIndex] RETURNS[stop: BOOLEAN] =
{ WITH NARROW[stb, SymbolTableBase.x].e.bb[bti] SELECT FROM
Callable => RETURN[(NOT inline) AND (epn = entryIndex)];
ENDCASE => RETURN[FALSE]};
IsThisItY: PROC[bti: by.BodyIndex] RETURNS[stop: BOOLEAN] =
{ WITH NARROW[stb, SymbolTableBase.y].e.bb[bti] SELECT FROM
Callable => RETURN[(NOT inline) AND (epn = entryIndex)];
ENDCASE => RETURN[FALSE]};
bi: BodyIndex = WITH stb SELECT FROM
t: SymbolTableBase.x =>
[x[t.e.EnumerateBodies[bx.rootBodyIndex, IsThisItX]]],
t: SymbolTableBase.y =>
[y[t.e.EnumerateBodies[by.rootBodyIndex, IsThisItY]]],
ENDCASE => ERROR;
RETURN[LOOPHOLE[bi, CallableBodyIndex]]};

-- finds the bti for the smallest enclosing block
-- MOVE
ConvertCbti: PUBLIC PROC[lastBti: BodyIndex,
pc, start: PrincOps.BytePC,
base: SymbolTableBase]
RETURNS[bti: BodyIndex] =
{WITH base SELECT FROM
t: SymbolTableBase.x =>
RETURN[[x[ConvertCbtiX[NARROW[lastBti, BodyIndex.x].e, pc, start, t.e]]]];
t: SymbolTableBase.y =>
RETURN[[y[ConvertCbtiY[NARROW[lastBti, BodyIndex.y].e, pc, start, t.e]]]];
ENDCASE => ERROR};

ConvertCbtiX: PROC[lastBti: bx.BodyIndex,
pc, start: PrincOps.BytePC,
base: bx.SymbolTableBase]
RETURNS[bti: bx.BodyIndex] =
{ bodyStart: PrincOps.BytePC;
bti ← lastBti;
DO
FOR lastBti ← base.SonBti[bti], base.SiblingBti[lastBti]
UNTIL lastBti = bx.nullBodyIndex DO
WITH body: base.bb[lastBti] SELECT FROM
Callable => LOOP;
Other =>
{ bodyStart ← [start + body.relOffset];
WITH body.info SELECT FROM
External => IF pc IN [bodyStart..bodyStart+bytes) THEN {bti ← lastBti; EXIT};
ENDCASE};
ENDCASE;
REPEAT
FINISHED => RETURN
ENDLOOP;
ENDLOOP};

ConvertCbtiY: PROC[lastBti: by.BodyIndex,
pc, start: PrincOps.BytePC,
base: by.SymbolTableBase]
RETURNS[bti: by.BodyIndex] =
{ bodyStart: PrincOps.BytePC;
bti ← lastBti;
DO
FOR lastBti ← base.SonBti[bti], base.SiblingBti[lastBti]
UNTIL lastBti = by.nullBodyIndex DO
WITH body: base.bb[lastBti] SELECT FROM
Callable => LOOP;
Other =>
{ bodyStart ← [start + body.relOffset];
WITH body.info SELECT FROM
External => IF pc IN [bodyStart..bodyStart+bytes) THEN {bti ← lastBti; EXIT};
ENDCASE};
ENDCASE;
REPEAT
FINISHED => RETURN
ENDLOOP;
ENDLOOP};

-- finds the entrypoint index and its start pc for the proc containing the specified pc.
-- BEWARE that if the pc is in a catch phrase, this returns the epn for the statically
-- enclosing procedure of the catch phrase.
-- MOVE
GetEp: PUBLIC PROC[pc: PrincOps.BytePC,
gf: PrincOps.GlobalFrameHandle,
stb: SymbolTableBase]
RETURNS [ep: EVRange, start: PrincOps.BytePC] =
{ FindMaxEI: PROC RETURNS [max: EVRange] =
{ GetMaxX: PROC [bti: bx.BodyIndex] RETURNS [stop: BOOLEAN] =
{WITH NARROW[stb, SymbolTableBase.x].e.bb[bti] SELECT FROM
Callable => IF ~inline THEN max ← MAX[max, entryIndex];
ENDCASE;
RETURN[FALSE]};
GetMaxY: PROC [bti: by.BodyIndex] RETURNS [stop: BOOLEAN] =
{WITH NARROW[stb, SymbolTableBase.y].e.bb[bti] SELECT FROM
Callable => IF ~inline THEN max ← MAX[max, entryIndex];
ENDCASE;
RETURN[FALSE]};
max ← 0;
WITH stb SELECT FROM
t: SymbolTableBase.x => [] ← t.e.EnumerateBodies[bx.rootBodyIndex, GetMaxX];
t: SymbolTableBase.y => [] ← t.e.EnumerateBodies[by.rootBodyIndex, GetMaxY];
ENDCASE => ERROR};

-- body of GetEp begins here
diff: CARDINAL ← LAST[CARDINAL];
anyProcedure: BOOLEAN ← FALSE;
FOR i: EVRange IN [0..FindMaxEI[]] DO
last: PrincOps.BytePC ← GetPc[gf, i];
IF Card[last] > Card[pc] THEN LOOP;
IF Card[pc] - Card[last] > diff THEN LOOP;
diff ← Card[pc] - Card[last];
ep ← i; start ← last;
anyProcedure ← TRUE;
ENDLOOP;
IF ~anyProcedure THEN ERROR; -- SIGNAL NotInAnyProcedure;
RETURN};

-- finds the start (byte) pc for the specified entrypoint index and GF
GetPc: PUBLIC PROC[gf: PrincOps.GlobalFrameHandle, i: EVRange]
RETURNS [PrincOps.BytePC] =
{codeBase: LONG POINTER TO PrincOps.CSegPrefix
= LOOPHOLE[Runtime.GetTableBase[LOOPHOLE[gf, PROGRAM]],
LONG POINTER TO PrincOps.CSegPrefix];
wpc: CARDINAL = codeBase.entry[i].initialpc; -- GROAN
RETURN[LOOPHOLE[wpc*2, PrincOps.BytePC]]};

-- MOVE ???
IsCatchFrame: PROC[frame: PrincOps.FrameHandle, bti: BodyIndex]
RETURNS[isCatchFrame: BOOLEAN ← TRUE, revisedBti: BodyIndex] =
{revisedBti ← bti;
Runtime.ValidateFrame[frame
! ANY => GOTO notCatch]; -- return FALSE if frame invalid

{nextFrame: PrincOps.FrameHandle
← AMProcessBasic.ReturnLink[WorldVM.LocalWorld[], frame].frame;
Runtime.ValidateFrame[nextFrame
! ANY => GOTO notCatch]; -- return FALSE if calling frame is invalid
IF nextFrame.accesslink # sigGF OR ~nextFrame.mark
THEN GOTO notCatch; -- return FALSE if caller not signaller

{L0Frame: PrincOps.FrameHandle ← NIL;
IF frame.staticlink = NIL THEN Runtime.CallDebugger["Please call Paul Rovner"];
L0Frame ← LOOPHOLE[frame.staticlink - PrincOps.localbase, PrincOps.FrameHandle];
-- L0Frame is the frame that encloses the catch frame
Runtime.ValidateFrame[L0Frame
! ANY => GOTO notCatch]; -- return FALSE if enclosing frame not valid
IF frame.accesslink # L0Frame.accesslink THEN GOTO notCatch;
{ -- detect situation where catch frame has no locals, thus no body table entry.
tr: REF TypedVariableRec = NARROW[TVForFrame[L0Frame], REF TypedVariableRec];
WITH hd: tr.head SELECT FROM
fh => IF bti = hd.bti
THEN revisedBti ← IF bti.brand = x
THEN [x[bx.nullBodyIndex]]
ELSE [y[by.nullBodyIndex]];
-- return nullBodyIndex if isCatchFrame and it has no locals
ENDCASE => ERROR
}
}
};
EXITS notCatch => isCatchFrame ← FALSE}; -- end IsCatchFrame

Card: PROC[pc: PrincOps.BytePC] RETURNS[CARDINAL] =
INLINE {RETURN[LOOPHOLE[pc, CARDINAL]]};

MyLocalFrame: PROCEDURE RETURNS [PrincOps.FrameHandle] =
MACHINE CODE BEGIN Mopcodes.zLADRB, 0 END;

-- START HERE

[qz: tvZone] ← GetTVZones[];

END.