-- RTTypedFramesImpl.Mesa
-- last modified on December 21, 1982 3:07 pm by Paul Rovner

DIRECTORY
AMBridge USING[TVToCardinal, WordSequence, WordSequenceRecord, IsRemote, RemotePD,
RemoteSED, TVToRemoteSignal, TVToRemoteProc, TVForRemoteProc,
RemoteGlobalFrameHandle, RemoteFrameHandle, RemoteFHFromTV,
TVForRemoteGFHReferent, TVForRemoteSignal, TVForRemoteFrame,
RemoteGFHFromTV, nilRemoteFrameHandle,
nilRemoteGlobalFrameHandle, GetWorld, nilRemotePD],
AMTypes USING[TypeClass, TVType, Range, TypedVariable, Error, Domain,
Size, UnderType, IndexToTV, Index, TV,
TVStatus],
Mopcodes USING[zLADRB],
PrincOps USING[EPRange, SignalDesc, BytePC, CSegPrefix, GFTIndex, FrameHandle,
ControlLink, localbase, ProcDesc, NullLink, UnboundLink,
GlobalFrameHandle, GlobalFrame, StateVector],
PrincOpsRuntime USING[GetFrame, GFT, GFTItem],
Rope USING[ROPE],
RTLoader USING[GetGFRCType],
RTSD USING[SD, sGetCanonicalProcType, sGetCanonicalSignalType],
RTSymbolDefs USING[SymbolTableBase, CallableBodyIndex,
BlockContextLevel, BodyIndex, nullBodyIndex, rootBodyIndex,
SymbolIndex, SymbolIdIndex, SymbolConstructorIndex, nullSymbolIndex,
SymbolRecordIndex, outerContextLevel],
RTSymbolOps USING[EnumerateRecordIseis, AcquireType, AcquireRope],
RTSymbols USING[AcquireSTBFromGFH, ReleaseSTB],
RTTypesBasic USING[Type, nullType, fhType, gfhType, GetCanonicalType],
RTTypesPrivate USING[TypedVariableRec, GetTVZones, RecordComponentISEI,
BuildRecordFieldDescriptor, GetIdConstantValue,
FieldDescriptor, GFHToName],
RTTypesRemotePrivate USING[UnwindRemoteIndirectProcDesc, AcquireSTBFromRemoteGFH,
GetRemoteGFHandle, GetRemoteGFHeader,
GetRemoteFrameHeader, AcquireCBTHandleFromRemotePD,
ValidateRemoteFrame, RemoteSignalValues, RemoteGFHToName],
Runtime USING[ValidateFrame, ValidateGlobalFrame, GetTableBase],
RuntimeInternal USING[SendMsgSignal],
SDDefs USING[SD, sSignal],
WorldVM USING[CurrentIncarnation, Long, ShortAddress, World];

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

= BEGIN OPEN Rope, AMTypes, RTTypesPrivate, RTSymbolDefs, RTSymbolOps, RTSymbols,
AMBridge, RTTypesBasic, 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

TVForProc: PUBLIC PROC[proc: PROC ANY RETURNS ANY] RETURNS[TypedVariable] =
{ws: WordSequence = NEW[WordSequenceRecord[1]];
ws[0] ← LOOPHOLE[proc, CARDINAL];
RETURN[tvZone.NEW[TypedVariableRec
← [referentType: [GetProcedureType[LOOPHOLE[proc, PrincOps.ProcDesc]]],
head: [constant[]],
status: const,
field: constant[value: ws]]]]};

TVForSignal: PUBLIC PROC[signal: ERROR ANY RETURNS ANY] RETURNS[TypedVariable] =
{ws: WordSequence = NEW[WordSequenceRecord[1]];
ws[0] ← LOOPHOLE[signal, CARDINAL];
RETURN[tvZone.NEW[TypedVariableRec
← [referentType: [GetSignalType[LOOPHOLE[signal, PrincOps.SignalDesc]]],
head: [constant[]],
status: const,
field: constant[value: ws]]]]};

-- MOVE
PDToName: PUBLIC PROC[pd: PrincOps.ProcDesc] RETURNS[ans: ROPE] =
{ stb: SymbolTableBase;
cbti: CallableBodyIndex;
pd ← UnwindIndirectProcDesc[pd];
IF pd = PrincOps.NullLink THEN RETURN[NIL];
[stb, cbti] ← AcquireCBTHandleFromPD[pd];
ans ← AcquireRope[stb, stb.seb[stb.bb[cbti].id].hash ! UNWIND => ReleaseSTB[stb]];
ReleaseSTB[stb];
RETURN[ans]};

-- MOVE
SEDToName: PUBLIC PROC[sed: PrincOps.SignalDesc] RETURNS[ans: ROPE] =
{ gfh: PrincOps.GlobalFrameHandle;
stb: SymbolTableBase;

proc: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOLEAN] =
{ tsei: SymbolIndex;
IF stb.seb[isei].constant
AND stb.seb[tsei ← stb.UnderType[stb.seb[isei].idType]].typeTag = transfer
AND (SELECT stb.XferMode[tsei] FROM
error, signal => TRUE,
ENDCASE => FALSE)
AND (GFT[sed.gfi].epbase + sed.ep) =
STInfoToEPN[LOOPHOLE[stb.seb[isei].idValue, PrincOps.SignalDesc]]
THEN {ans ← AcquireRope[stb, stb.seb[isei].hash]; RETURN[TRUE]}
ELSE RETURN[FALSE]};
sei: SymbolRecordIndex;
IF sed = PrincOps.NullLink OR sed = PrincOps.UnboundLink THEN RETURN[NIL];
IF LOOPHOLE[sed, CARDINAL] = 177777B THEN RETURN["ERROR"];
IF LOOPHOLE[sed, CARDINAL] = LOOPHOLE[UNWIND, CARDINAL] THEN RETURN["UNWIND"];
IF LOOPHOLE[sed, CARDINAL] = LOOPHOLE[ABORTED, CARDINAL]
THEN RETURN["ABORTED"];

gfh ← GFT[sed.gfi].frame;
stb ← AcquireSTBFromGFH[gfh];
sei ← stb.bb[rootBodyIndex].type;
ans ← NIL;
IF sei # nullSymbolIndex THEN
[] ← EnumerateRecordIseis[stb, sei, proc ! UNWIND => ReleaseSTB[stb]];
ReleaseSTB[stb]};

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

-- 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]]};

-- MOVE
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
StaticParent: PUBLIC SAFE PROC[tv: TypedVariable--procedure--]
RETURNS[TypedVariable--procedure--] = TRUSTED
{IF IsRemote[tv]
THEN
{ pd: RemotePD ← nilRemotePD;
stb: SymbolTableBase;
bti: BodyIndex;

pd ← UnwindRemoteIndirectProcDesc[TVToRemoteProc[tv]];
IF pd.pd = PrincOps.NullLink THEN RETURN[NIL];
IF TypeClass[UnderType[TVType[tv]]] # procedure
THEN ERROR Error[reason: typeFault, type: TVType[tv]];
[stb, bti] ← AcquireCBTHandleFromRemotePD[pd];
FOR bti ← bti, stb.ParentBti[bti] UNTIL bti = nullBodyIndex DO
WITH stb.bb[bti] SELECT FROM
Callable =>
{ sppd: PrincOps.ProcDesc ← PrincOps.ControlLink[procedure[gfi: 0, ep: 0, tag: TRUE]];
sppd.gfi ← GetRemoteGFHeader
[GetRemoteGFHandle[world: pd.world,
gfi: LOOPHOLE[pd.pd, PrincOps.ProcDesc].gfi]
].gfi + entryIndex/PrincOps.EPRange;
sppd.ep ← entryIndex MOD PrincOps.EPRange;
ReleaseSTB[stb];
RETURN[TVForRemoteProc[[world: pd.world,
worldIncarnation: CurrentIncarnation[pd.world],
pd: sppd]]]};
ENDCASE;
ENDLOOP;
ReleaseSTB[stb];
RETURN[NIL]}
ELSE
{ pd: PrincOps.ProcDesc;
stb: SymbolTableBase;
bti: BodyIndex;

pd ← UnwindIndirectProcDesc[LOOPHOLE[TVToProc[tv], PrincOps.ControlLink]];
IF pd = PrincOps.NullLink THEN RETURN[NIL];
IF TypeClass[UnderType[TVType[tv]]] # procedure
THEN ERROR Error[reason: typeFault, type: TVType[tv]];
[stb, bti] ← AcquireCBTHandleFromPD[pd];
FOR bti ← bti, stb.ParentBti[bti] UNTIL bti = nullBodyIndex DO
WITH stb.bb[bti] SELECT FROM
Callable =>
{ sppd: PrincOps.ProcDesc ← PrincOps.ControlLink[procedure[gfi: 0, ep: 0, tag: TRUE]];
sppd.gfi ← GFT[pd.gfi].frame.gfi + entryIndex/PrincOps.EPRange;
sppd.ep ← entryIndex MOD PrincOps.EPRange;
ReleaseSTB[stb];
RETURN[TVForProc[LOOPHOLE[sppd, PROC ANY RETURNS ANY]]]};
ENDCASE;
ENDLOOP;
ReleaseSTB[stb];
RETURN[NIL]}}; -- end StaticParent

-- 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 bti = nullBodyIndex
THEN {name: ROPE;
fh ← RemoteFHFromTV[tv];
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 bti = nullBodyIndex 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, stb.ParentBti[bti] UNTIL bti = nullBodyIndex DO
WITH stb.bb[bti] SELECT FROM
Callable =>
{sppd: PrincOps.ProcDesc ← LOOPHOLE[PrincOps.UnboundLink, PrincOps.ProcDesc];
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]]]};
ENDCASE;
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 bti = nullBodyIndex -- no symbols for this localFrame TV
THEN 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, stb.ParentBti[bti] UNTIL bti = nullBodyIndex DO
WITH stb.bb[bti] SELECT FROM
Callable =>
{sppd: PrincOps.ProcDesc ← LOOPHOLE[PrincOps.UnboundLink, PrincOps.ProcDesc];

-- 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]]]};
ENDCASE;
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[SignalValues[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 = stb.seb[isei].idType;
csei: SymbolConstructorIndex ← stb.UnderType[sei];
bitsForType: CARDINAL ← stb.BitsForType[csei]; -- bits for the value in the field
fieldBits: CARDINAL ← stb.seb[isei].idInfo; -- bits for the field
fieldBitOffset: CARDINAL ← stb.seb[isei].idValue;
-- bit offset of the field within the local frame
cType: Type ← AcquireType[stb, sei];

IF stb.seb[isei].constant
THEN 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 stb.seb[isei].immutable
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

IF IsRemote[tv]
THEN [world: world, message: message] ← RemoteSignalValues[tv]
ELSE message ← SignalValues[tv].message;
-- 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

-- break up and MOVE
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 ← nullBodyIndex;
evalStack: WordSequence ← NIL;
isCatchFrame: BOOLEAN;
remoteFH: RemoteFrameHandle ← nilRemoteFrameHandle;
level, nlevel: BlockContextLevel;
return, contextPC: BOOL;

WITH th: rtr.head SELECT FROM
remoteFH => {bti ← th.bti;
evalStack ← evalStack;
isCatchFrame ← th.isCatchFrame;
remoteFH ← th.remoteFrameHandle;
return ← th.return;
contextPC ← th.contextPC};
ENDCASE => ERROR;

IF bti = nullBodyIndex
THEN {ReleaseSTB[stb]; ERROR Error[reason: typeFault, type: TVType[tv]]};
level ← stb.bb[bti].level;
WITH stb.bb[bti] SELECT FROM
Callable => {ReleaseSTB[stb]; RETURN[NIL]};
ENDCASE;
bti ← stb.ParentBti[bti];
IF bti = rootBodyIndex THEN bti ← nullBodyIndex;
IF bti = nullBodyIndex THEN nlevel ← level ELSE nlevel ← stb.bb[bti].level;
ReleaseSTB[stb];

IF isCatchFrame AND nlevel # level
THEN
{-- when the level changes inside of a catchPhrase
-- then we have to go through the static link (local 0)
-- to get to the real frame for this bti
-- NOTE: the static link points at local 0, not the frame base
tv ← TVForRemoteFrame
[[world: remoteFH.world,
worldIncarnation: CurrentIncarnation[remoteFH.world],
fh: LOOPHOLE[GetRemoteFrameHeader[remoteFH].staticlink
- PrincOps.localbase, WorldVM.ShortAddress]]];
rtr ← NARROW[tv];
WITH th: rtr.head SELECT FROM
remoteFH =>
{-- quick kill if we are already at the right bti
-- otherwise get the new value of isCatchFrame
IF bti = th.bti THEN RETURN[tv];
isCatchFrame ← th.isCatchFrame};
ENDCASE => ERROR};

-- The Callable bt entry also describes the outer block locals. If it is the enclosing
-- body for the incoming tv, return it. Otherwise the locals are not available.
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 XXX fix above case
{ 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 bti = nullBodyIndex 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 bti = nullBodyIndex
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 bti = rootBodyIndex -- 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
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
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
};

WITH stb.bb[bti] SELECT FROM
Callable => -- No more enclosing blocks: this one is callable and not a catch frame
IF stb.bb[bti].level <= outerContextLevel -- TRUE => not a nested procedure
THEN {ReleaseSTB[stb]; RETURN[NIL]}
ELSE { -- this is a frame for a nested procedure
ReleaseSTB[stb];
RETURN[TVForFrame
[LOOPHOLE[FHFromTV[tv].staticlink - PrincOps.localbase,
PrincOps.FrameHandle]]];
};
ENDCASE;

level ← stb.bb[bti].level;
bti ← stb.ParentBti[bti]; -- A Callable bt entry also describes the outer block locals
IF bti = rootBodyIndex 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 bti # nullBodyIndex AND level # stb.bb[bti].level
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
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 bti = nullBodyIndex OR bti = rootBodyIndex THEN {ReleaseSTB[stb]; RETURN[NIL]};
IF stb.bb[bti].type = nullSymbolIndex THEN {ReleaseSTB[stb]; RETURN[NIL]};
type ← AcquireType[stb, stb.bb[bti].type ! 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 bti = nullBodyIndex OR bti = rootBodyIndex THEN {ReleaseSTB[stb]; RETURN[NIL]};
IF stb.bb[bti].type = nullSymbolIndex THEN {ReleaseSTB[stb]; RETURN[NIL]};
type ← AcquireType[stb, stb.bb[bti].type ! 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[GetRemoteFrameHeader[fh].returnlink,
WorldVM.ShortAddress]]
! ANY => GOTO nope]; EXITS nope => RETURN[NIL]};
RETURN[TVForRemoteFrame
[[world: fh.world,
worldIncarnation: CurrentIncarnation[fh.world],
fh: LOOPHOLE[GetRemoteFrameHeader[fh].returnlink,
WorldVM.ShortAddress]]]]}
ELSE
{ fh: PrincOps.FrameHandle = FHFromTV[tv];
IF fh = NIL THEN RETURN[NIL];
{Runtime.ValidateFrame[fh.returnlink
! ANY => GOTO nope]; EXITS nope => RETURN[NIL]};
RETURN[TVForFrame[fh.returnlink.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, stb.bb[rootBodyIndex].type ! 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, stb.bb[rootBodyIndex].type ! UNWIND => ReleaseSTB[stb]];
ReleaseSTB[stb]};
RETURN[tvZone.NEW[TypedVariableRec ← [referentType: [type],
head: tvr.head,
status: mutable,
field: entire[]]]]}};

-- raises typeFault
UnwindIndirectProcDesc: PUBLIC PROC[icl: PrincOps.ControlLink]
RETURNS[PrincOps.ProcDesc] =
{IF icl = PrincOps.NullLink OR icl = PrincOps.UnboundLink
THEN RETURN[LOOPHOLE[PrincOps.NullLink, PrincOps.ProcDesc]];
UNTIL icl.proc DO
IF icl.indirect THEN icl ← icl.link^ ELSE ERROR Error[reason: typeFault, type: nullType]
ENDLOOP;
RETURN[LOOPHOLE[icl, PrincOps.ProcDesc]]};

-- MOVE
GetProcedureType: PROC[pd: PrincOps.ProcDesc] RETURNS[type: Type] =
{ stb: SymbolTableBase;
cbti: CallableBodyIndex;
[stb, cbti] ← AcquireCBTHandleFromPD[pd];
type ← AcquireType[stb, stb.bb[cbti].ioType ! UNWIND => ReleaseSTB[stb]];
ReleaseSTB[stb]};

STInfoToEPN: PROC[cl: PrincOps.SignalDesc] RETURNS[CARDINAL] =
{RETURN[(cl.gfi - 1) * PrincOps.EPRange + cl.ep]};

-- MOVE
GetSignalType: PROC[sed: PrincOps.SignalDesc] RETURNS[type: Type] =
{ proc: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOLEAN] =
{ tsei: SymbolIndex;
IF stb.seb[isei].constant
AND stb.seb[tsei ← stb.UnderType[stb.seb[isei].idType]].typeTag = transfer
AND (SELECT stb.XferMode[tsei] FROM
error, signal => TRUE,
ENDCASE => FALSE)
AND (GFT[sed.gfi].epbase + sed.ep) =
STInfoToEPN[LOOPHOLE[stb.seb[isei].idValue, PrincOps.SignalDesc]]
THEN {type ← AcquireType[stb, stb.seb[isei].idType]; RETURN[TRUE]}
ELSE RETURN[FALSE]};
stb: SymbolTableBase;

-- START HERE
IF LOOPHOLE[sed, CARDINAL] = 177777B -- ERROR
OR LOOPHOLE[sed, CARDINAL] = LOOPHOLE[UNWIND, CARDINAL]
OR LOOPHOLE[sed, CARDINAL] = LOOPHOLE[ABORTED, CARDINAL]
THEN RETURN[CODE[ERROR]];

stb ← AcquireSTBFromGFH[GFT[sed.gfi].frame];
type ← nullType;
[] ← EnumerateRecordIseis[stb, stb.bb[rootBodyIndex].type, proc ! UNWIND => ReleaseSTB[stb]];
ReleaseSTB[stb]};

-- 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?
FOR bti: BodyIndex ← th.bti, stb.SonBti[bti] UNTIL bti = nullBodyIndex
DO IF bti = ee THEN RETURN[TRUE];
ENDLOOP;
};
ENDCASE => ERROR;
};


-- MOVE
AcquireCBTHandleFromPD: PROC[pd: PrincOps.ProcDesc]
RETURNS[stb: SymbolTableBase, cbti: CallableBodyIndex] =
{ pd ← UnwindIndirectProcDesc[pd];
stb ← AcquireSTBFromGFH[GFT[pd.gfi].frame];
cbti ← GetCBTI[stb, GFT[pd.gfi].epbase + pd.ep]};

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: GetCBTI[stb, epn]]};

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

-- finds the bti for the smallest enclosing block
-- MOVE
ConvertCbti: PUBLIC PROC[lastBti: BodyIndex,
pc, start: PrincOps.BytePC,
base: SymbolTableBase]
RETURNS[bti: BodyIndex] =
{ bodyStart: PrincOps.BytePC;
bti ← lastBti;
DO
FOR lastBti ← base.SonBti[bti], base.SiblingBti[lastBti]
UNTIL lastBti = 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] =
{ GetMax: PROC [bti: BodyIndex] RETURNS [stop: BOOLEAN] =
{WITH stb.bb[bti] SELECT FROM
Callable => IF ~inline THEN max ← MAX[max, entryIndex];
ENDCASE;
RETURN[FALSE]};
max ← 0;
[] ← stb.EnumerateBodies[rootBodyIndex, GetMax]};

-- 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 ← frame.returnlink.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 ← 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 ← 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;

GetCanonicalProcType: PROC[proc: UNSPECIFIED] RETURNS[Type] =
{ pd: PrincOps.ProcDesc = UnwindIndirectProcDesc[proc];
IF pd = PrincOps.NullLink THEN RETURN[nullType];
RETURN[RTTypesBasic.GetCanonicalType[GetProcedureType[pd]]];
};


GetCanonicalSignalType: PROC[sig: UNSPECIFIED] RETURNS[Type] =
{ IF sig = 0 THEN RETURN[nullType];
RETURN[RTTypesBasic.GetCanonicalType[GetSignalType[LOOPHOLE[sig, PrincOps.SignalDesc]]]];
};

-- START HERE

IF RTSD.SD[RTSD.sGetCanonicalProcType] # 0 THEN ERROR;
RTSD.SD[RTSD.sGetCanonicalProcType] ← LOOPHOLE[GetCanonicalProcType, CARDINAL];

IF RTSD.SD[RTSD.sGetCanonicalSignalType] # 0 THEN ERROR;
RTSD.SD[RTSD.sGetCanonicalSignalType] ← LOOPHOLE[GetCanonicalSignalType, CARDINAL];

[qz: tvZone] ← GetTVZones[];

END.