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, UnderClass, UnderType],
BrandXSymbolDefs USING [SymbolTableBase, rootBodyIndex, BodyIndex, nullBodyIndex, outerContextLevel],
BrandYSymbolDefs USING [SymbolTableBase, rootBodyIndex, BodyIndex, nullBodyIndex, outerContextLevel],
LoadState USING [GlobalFrameToType, local, Acquire, Release],
PrincOps USING [BytePC, ControlLink, CSegPrefix, EPRange, Frame, FrameHandle, GlobalFrame, GlobalFrameHandle, localbase, MaxNGfi, NullLink, ProcDesc, SignalDesc, StateVector, UnboundLink, SD, sSignal],
PrincOpsUtils USING [GlobalFrame, Codebase],
RemotePrincOpsUtils USING [RemoteGlobalFrame],
Rope USING [ROPE],
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, OuterFromGFH, ReleaseSTB],
RTTypesPrivate USING [BuildRecordFieldDescriptor, FieldDescriptor, GetIdConstantValue, GFHToName, RecordComponentISEI, TypedVariableRec, UnwindIndirectProcDesc],
RTTypesRemotePrivate USING [AcquireBTIFromRemoteFH, AcquireSTBFromRemoteGFH, GetRemoteEp, GetRemoteFrameHeader, GetRemoteGFHeader, IsRemoteCatchFrame, OuterFromRemoteGFH, RemoteGFHToName, RemoteSignalValues],
RuntimeError USING [UNCAUGHT],
SafeStorage USING [Type, nullType, fhType, gfhType],
WorldVM USING [CurrentIncarnation, Long, ShortAddress, World, LocalWorld];
RTTypedFramesImpl:
PROGRAM
IMPORTS AMBridge, AMProcessBasic, AMTypes, LoadState, PrincOpsUtils, RemotePrincOpsUtils, RTSymbolOps, RTSymbols, RTTypesPrivate, RTTypesRemotePrivate, RuntimeError, WorldVM
EXPORTS AMTypes, AMBridge, RTTypesPrivate
= BEGIN OPEN AMBridge, AMTypes, bx: BrandXSymbolDefs, by: BrandYSymbolDefs, RemotePrincOpsUtils, Rope, RTSymbolDefs, RTSymbolOps, RTSymbols, SafeStorage, RTTypesPrivate, RTTypesRemotePrivate, RuntimeError, WorldVM;
TVToSignal:
PUBLIC
PROC [tv:
TV]
RETURNS [
ERROR
ANY
RETURNS
ANY] = {
raises typeFault
SELECT UnderClass[TVType[tv]]
FROM
signal, error => NULL;
nil => RETURN[LOOPHOLE[PrincOps.UnboundLink, ERROR ANY RETURNS ANY]];
ENDCASE => RaiseClassError[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: BOOL ← FALSE;
IF fh = NIL THEN RETURN[NIL];
[isCatchFrame, bti] ← AcquireBTIFromFH[fh, contextPC
! Error => IF reason = noSymbols THEN {bti ← nullBodyIndex; CONTINUE}];
RETURN[
NEW[TypedVariableRec
← [referentType: [fhType],
head:
[fh[fh: fh, evalStack: evalStack,
bti: bti, isCatchFrame: isCatchFrame, return: return, contextPC: contextPC]],
status: mutable,
field: entire[]
]]];
};
FHFromTV:
PUBLIC
PROC [tv:
TV]
RETURNS [PrincOps.FrameHandle ←
NIL] = {
all such tvs have the same (distinguished) type: fhType
raises typeFault
IF tv = NIL THEN RETURN[NIL];
WITH tv
SELECT
FROM
tr:
REF TypedVariableRec =>
WITH tfh: tr.head
SELECT
FROM
fh => RETURN[tfh.fh];
ENDCASE => GO TO oops;
ENDCASE => GO TO oops;
EXITS oops => RaiseClassError[tv]
};
TVForGFHReferent:
PUBLIC
PROC [gfh: PrincOps.GlobalFrameHandle]
RETURNS [
TV ←
NIL] = {
IF gfh #
NIL
THEN
RETURN[
NEW[TypedVariableRec
← [referentType: [gfhType], head: [gfh[gfh: gfh]], status: mutable, field: entire[]]]];
};
GFHFromTV:
PUBLIC
PROC [tv:
TV]
RETURNS [PrincOps.GlobalFrameHandle ←
NIL] = {
raises typeFault
IF tv = NIL THEN RETURN[NIL];
WITH tv
SELECT
FROM
tr:
REF TypedVariableRec =>
WITH tgfh: tr.head
SELECT
FROM
gfh => RETURN[tgfh.gfh];
ENDCASE;
ENDCASE;
RaiseClassError[tv]
};
GlobalParent:
PUBLIC
SAFE
PROC [tv:
TV
--transfer or local frame--]
RETURNS [
TV
--globalFrame--] =
TRUSTED {
raises typeFault
IF IsRemote[tv]
THEN {
type: Type = TVType[tv];
gfh: RemoteGlobalFrameHandle ← nilRemoteGlobalFrameHandle;
SELECT UnderClass[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 = TVToRemoteProc[tv];
IF pd.pd = LOOPHOLE[PrincOps.NullLink, WORD] THEN RETURN[NIL];
gfh ←
[world: pd.world,
worldIncarnation: CurrentIncarnation[pd.world],
gfh: LOOPHOLE[RemoteGlobalFrame[pd.world, pd.pd], WorldVM.ShortAddress]];
};
signal, error => {
sed: RemoteSED = TVToRemoteSignal[tv];
IF sed.sed =
LOOPHOLE[PrincOps.NullLink,
WORD]
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 ← [
world: sed.world,
worldIncarnation: CurrentIncarnation[sed.world],
gfh: LOOPHOLE[RemoteGlobalFrame[sed.world, sed.sed], WorldVM.ShortAddress]];
};
nil => RETURN[NIL];
ENDCASE => ERROR Error[reason: typeFault, type: type];
RETURN[TVForRemoteGFHReferent[gfh]];
}
ELSE {
local case
type: Type = TVType[tv];
gfh: PrincOps.GlobalFrameHandle;
SELECT UnderClass[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 ← LOOPHOLE[PrincOpsUtils.GlobalFrame[sed], PrincOps.GlobalFrameHandle];
};
program, procedure => {
pd: PrincOps.ProcDesc = UnwindIndirectProcDesc[LOOPHOLE[TVToCardinal[tv], PrincOps.ControlLink]];
IF pd = PrincOps.NullLink THEN RETURN[NIL];
gfh ← LOOPHOLE[PrincOpsUtils.GlobalFrame[pd], PrincOps.GlobalFrameHandle];
};
nil => RETURN[NIL];
ENDCASE => ERROR Error[reason: typeFault, type: type];
RETURN[TVForGFHReferent[gfh]];
};
};
ContextPC:
PUBLIC
SAFE
PROC [tv:
TV
--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 => RaiseClassError[tv];
};
IsStarted:
PUBLIC
SAFE
PROC [tv:
TV
--globalFrame--]
RETURNS [
BOOL ←
FALSE] =
TRUSTED {
Note: the current method for detecting started rests with the 'out' bit in the codebase, not with the started bit, although we will take either.
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 => RaiseClassError[tv];
};
IsCopied:
PUBLIC
SAFE
PROC [tv:
TV
--globalFrame--]
RETURNS [
BOOL ←
FALSE] =
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 => RaiseClassError[tv];
};
Procedure:
PUBLIC
SAFE
PROC [tv:
TV
--localFrame--]
RETURNS [
TV
--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]
THEN {
last time there were no symbols for this turkey
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 RaiseClassError[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 RaiseClassError[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[[fh.world, CurrentIncarnation[fh.world], LOOPHOLE[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 RaiseClassError[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 ! UNCAUGHT => 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 RaiseClassError[tv];
}
ELSE ERROR AMTypes.Error[reason: noSymbols, msg: GFHToName[th.fh.accesslink]];
};
};
ENDCASE => RaiseClassError[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;
};
};
Signal:
PUBLIC
SAFE
PROC [tv:
TV
--localFrame--]
RETURNS [ans:
TV
--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: LOOPHOLE[sed]]]
}
ELSE ans ← TVForSignal[LOOPHOLE[RemoteSignalValues[tv].signal, ERROR ANY RETURNS ANY]]};
IsCatch:
PUBLIC
SAFE
PROC [tv:
TV]
RETURNS [
BOOL] =
TRUSTED {
type: Type = TVType[tv];
IF type = fhType
THEN
WITH tv
SELECT
FROM
rtr:
REF TypedVariableRec => {
bti: BodyIndex ← nullBodyIndex;
isCatch: BOOL ← FALSE;
WITH th: rtr.head
SELECT
FROM
remoteFH => {bti ← th.bti; isCatch ← th.isCatchFrame};
fh => {bti ← th.bti; isCatch ← th.isCatchFrame};
ENDCASE => RETURN [FALSE];
IF bti # nullBodyIndex THEN RETURN [isCatch];
It is possible that when last sampled, bti = nullBodyIndex, but that the symbols are now available. So, we try to examine said symbols again. In this case, we don't care that thngs are expensive, so we use Procedure to do our dirty work.
[] ← Procedure[tv
! AMTypes.Error => IF reason = typeFault THEN {isCatch ← FALSE; CONTINUE}];
RETURN [isCatch];
};
ENDCASE;
RETURN [FALSE];
};
Argument:
PUBLIC
SAFE
PROC [tv:
TV
--local or catch Frame--, index: Index]
RETURNS [
TV] =
TRUSTED {
RETURN[ArgOrResult[tv, index, Domain]];
};
Result:
PUBLIC
SAFE
PROC [tv:
TV
--local or catch Frame--, index: Index]
RETURNS [
TV] =
TRUSTED {
RETURN[ArgOrResult[tv, index, Range]];
};
ArgOrResult:
PROC [tv:
TV
--local or catch Frame--, index: Index, domainOrRange:
PROC [Type]
RETURNS [Type] ]
RETURNS [
TV] = {
type: Type;
catch: BOOL;
message: WORD;
world: World;
argsTV: REF TypedVariableRec;
tvr: REF TypedVariableRec ← NARROW[tv];
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:
TV]
RETURNS [type: Type ← nullType, catch:
BOOL ←
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 => RaiseClassError[tv];
};
IF tv = NIL THEN ERROR Error[reason: typeFault, type: nullType];
[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:
LONG
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 ←
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 ← NEW[TypedVariableRec ←
[referentType: [cType],
head:
(
WITH tv
SELECT
FROM
tr: REF TypedVariableRec => tr.head,
ENDCASE => ERROR),
status: const,
field: constant[value: GetIdConstantValue[tv, stb, isei]]]];
}
ELSE
argsTV ←
NEW[TypedVariableRec ←
[referentType: [cType],
head:
(
WITH tv
SELECT
FROM
tr:REF TypedVariableRec => tr.head,
ENDCASE => ERROR),
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
SELECT
TRUE
FROM
Size[type] = 1 => {
ws: WordSequence = NEW[WordSequenceRecord[1]];
ws[0] ← LOOPHOLE[message, CARDINAL];
argsTV ←
NEW[TypedVariableRec
← [referentType: [type],
head: tvr.head,
status: const,
field: constant[value: ws]]]
};
IsRemote[tv] =>
argsTV ←
NEW[TypedVariableRec
← [referentType: [type],
head:
[remotePointer
[remotePointer:
[world: world,
worldIncarnation: CurrentIncarnation[world],
ptr: Long[world: world, addr: message]]]],
status: readOnly,
field: entire[]]]
ENDCASE => argsTV ←
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:
TV
--localFrame--]
RETURNS [
TV
--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];
RaiseClassError[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]
THEN {ReleaseSTB[stb];
RETURN[
NIL]};
-- not in the scope of any locals
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 ReallyNastyError[];
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 ReallyNastyError[];
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[
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
}; -- end IF NullBTI[bti]
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 ReallyNastyError[];
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 ReallyNastyError[];
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[
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];
RaiseClassError[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] THEN {ReleaseSTB[stb]; RETURN[NIL]}; -- not in the scope of any locals
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 ReallyNastyError[];
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 ReallyNastyError[];
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[
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
}; -- end IF NullBTI[bti]
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 ReallyNastyError[];
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 ReallyNastyError[];
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[
NEW[TypedVariableRec ←
[referentType: [fhType],
head: [fh[fh: FHFromTV[tv], evalStack: evalStack, bti: bti, isCatchFrame: isCatchFrame, return: return, contextPC: contextPC]],
status: mutable,
field: entire[]]]];
}; -- end local case of EnclosingBody
}; -- end EnclosingBody
Locals:
PUBLIC
SAFE
PROC [tv:
TV]
RETURNS [
TV ←
NIL] =
TRUSTED {
rtr: REF TypedVariableRec ← NARROW[tv];
IF tv #
NIL
THEN {
bti: BodyIndex;
type: Type ← nullType;
inner:
PROC [stb: SymbolTableBase] = {
IF NullBTI[bti] OR IsRootBTI[bti] OR NullSEI[BodyType[stb, bti]] THEN RETURN;
type ← AcquireType[stb, BodyType[stb, bti]];
};
IF IsRemote[tv]
THEN {
fh: RemoteFrameHandle = RemoteFHFromTV[tv];
IF fh = nilRemoteFrameHandle THEN RETURN[NIL];
bti ← (WITH th: rtr.head SELECT FROM remoteFH => th.bti, ENDCASE => nullBodyIndex);
OuterFromRemoteGFH[
[world: fh.world,
worldIncarnation: CurrentIncarnation[fh.world],
gfh: LOOPHOLE[GetRemoteFrameHeader[fh].accesslink, WorldVM.ShortAddress]],
inner];
}
ELSE {
fh: PrincOps.FrameHandle = FHFromTV[tv];
IF fh = NIL THEN RETURN[NIL];
bti ← (WITH th: rtr.head SELECT FROM fh => th.bti, ENDCASE => nullBodyIndex);
OuterFromGFH[fh.accesslink, inner];
};
IF type # nullType
THEN
RETURN[
NEW[TypedVariableRec ←
[referentType: [type], head: rtr.head, status: mutable, field: entire[]]]];
};
};
DynamicParent:
PUBLIC
SAFE
PROC [tv:
TV
--localFrame--]
RETURNS [
TV ←
NIL] =
TRUSTED {
IF IsRemote[tv]
THEN {
remoteFH: RemoteFrameHandle = RemoteFHFromTV[tv];
cl: PrincOps.ControlLink;
IF remoteFH.fh = 0 THEN RETURN[NIL];
cl ← AMProcessBasic.ReturnLink
[remoteFH.world, LOOPHOLE[remoteFH.fh, PrincOps.FrameHandle]];
IF cl.proc
OR cl.indirect
THEN RETURN[NIL]
ELSE
RETURN[TVForRemoteFrame
[[world: remoteFH.world,
worldIncarnation: CurrentIncarnation[remoteFH.world],
fh: LOOPHOLE[cl.frame, WorldVM.ShortAddress]]]];
}
ELSE {
fh: PrincOps.FrameHandle ← FHFromTV[tv];
cl: PrincOps.ControlLink;
IF fh = NIL THEN RETURN[NIL];
cl ← AMProcessBasic.ReturnLink[WorldVM.LocalWorld[], fh];
IF cl.proc OR cl.indirect THEN RETURN[NIL] ELSE RETURN[TVForFrame[cl.frame]];
};
};
Globals:
PUBLIC
SAFE
PROC [tv:
TV]
RETURNS [
TV ←
NIL] =
TRUSTED {
rtr: REF TypedVariableRec ← NARROW[tv];
IF tv #
NIL
THEN {
type: Type ← nullType;
inner:
PROC [stb: SymbolTableBase] = {
type ← AcquireType[stb, RootBodyType[stb]];
};
IF IsRemote[tv]
THEN {
gfh: RemoteGlobalFrameHandle ← RemoteGFHFromTV[tv];
IF gfh # nilRemoteGlobalFrameHandle THEN OuterFromRemoteGFH[gfh, inner];
RETURN[
NEW[TypedVariableRec ←
[referentType: [type], head: rtr.head, status: mutable, field: entire[]]]];
}
ELSE {
gfh: PrincOps.GlobalFrameHandle ← GFHFromTV[tv];
IF gfh = NIL THEN RETURN[NIL];
LoadState.local.Acquire[];
type ← LoadState.local.GlobalFrameToType[gfh ! UNWIND => LoadState.local.Release[]];
LoadState.local.Release[];
IF type = nullType THEN OuterFromGFH[gfh, inner];
};
RETURN[
NEW[TypedVariableRec ←
[referentType: [type], head: rtr.head, status: mutable, field: entire[]]]];
};
};
IsBodyEncloser:
PROC [er:
TV, 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;
};
AcquireBTIFromFH:
PROC [fh: PrincOps.FrameHandle, contextPC:
BOOL]
RETURNS [isCatchFrame:
BOOL ← FALSE, bti: BodyIndex ← nullBodyIndex] = {
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
inner:
PROC [stb: SymbolTableBase] = {
bti ← SmallestBTIFromFH[fh, stb, contextPC];
if fh is for a catch phrase, bti might be for a proc that contains it.
[isCatchFrame, bti] ← IsCatchFrame[fh, bti];
};
OuterFromGFH[fh.accesslink, inner];
};
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
GetCBTI:
PUBLIC
PROC [stb: SymbolTableBase, epn:
CARDINAL]
RETURNS [cbti: CallableBodyIndex] = {
IsThisItX:
PROC [bti: bx.BodyIndex]
RETURNS [stop:
BOOL] = {
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:
BOOL] = {
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
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.
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:
BOOL] = {
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:
BOOL] = {
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: BOOL ← FALSE;
FOR i: EVRange
IN [0..FindMaxEI[]]
DO
Card:
PROC [pc: PrincOps.BytePC]
RETURNS [
CARDINAL] =
INLINE {RETURN[LOOPHOLE[pc, CARDINAL]]};
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;
};
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 = PrincOpsUtils.Codebase[gf];
wpc: CARDINAL = codeBase.entry[i].initialpc; -- GROAN
RETURN[LOOPHOLE[wpc*2, PrincOps.BytePC]];
};
IsCatchFrame:
PROC [frame: PrincOps.FrameHandle, bti: BodyIndex]
RETURNS [
BOOL, BodyIndex] = {
L0Frame: PrincOps.FrameHandle; -- will be the frame that encloses the catch frame
nextFrame: PrincOps.FrameHandle;
tr: REF TypedVariableRec;
IF frame = NIL THEN RETURN[FALSE, bti];
nextFrame ← AMProcessBasic.ReturnLink[WorldVM.LocalWorld[], frame].frame;
IF nextFrame = NIL THEN RETURN[FALSE, bti];
IF nextFrame.accesslink # sigGF OR ~nextFrame.mark THEN RETURN[FALSE, bti];
return FALSE if caller is not the signaller
IF frame.staticlink = NIL THEN ReallyNastyError[];
L0Frame ← LOOPHOLE[frame.staticlink - PrincOps.localbase, PrincOps.FrameHandle];
IF frame.accesslink # L0Frame.accesslink THEN RETURN[FALSE, bti];
detect situation where catch frame has no locals, thus no body table entry.
tr ← NARROW[TVForFrame[L0Frame], REF TypedVariableRec];
WITH hd: tr.head
SELECT
FROM
fh =>
IF bti = hd.bti
THEN
bti ← IF bti.brand = x THEN [x[bx.nullBodyIndex]] ELSE [y[by.nullBodyIndex]];
return nullBodyIndex if isCatchFrame and it has no locals
ENDCASE => ERROR;
RETURN[TRUE, bti];
};
RaiseClassError:
PROC [tv:
TV] = {
ERROR AMTypes.Error[reason: typeFault, type: AMTypes.TVType[tv]];
};
ReallyNastyError:
PROC = {
ERROR;
};