AMFrameBridgeImpl.Mesa
last modified on July 11, 1983 10:41 am by Paul Rovner
DIRECTORY
AMBridge
USING[
WordSequence, WordSequenceRecord, IsRemote, RemotePD, TVToCardinal, TVToRemoteProc, TVForRemoteProc],
AMTypes USING[Error, GlobalParent, TVType, TypedVariable, TypeClass, UnderType],
BrandXSymbolDefs USING[SymbolTableBase, SymbolIdIndex, SymbolIndex],
BrandYSymbolDefs USING[SymbolTableBase, SymbolIdIndex, SymbolIndex],
PrincOps
USING[
ProcDesc, NullLink, SignalDesc, ControlLink, UnboundLink, EPRange,GlobalFrameHandle, MaxNGfi, SD],
PrincOpsUtils USING[GlobalFrame, GlobalFrameAndEntryPoint],
RemotePrincOpsUtils USING[RemoteGlobalFrame],
Rope USING[ROPE],
RTSD USING[sGetCanonicalProcType, sGetCanonicalSignalType],
RTSymbolDefs
USING[
SymbolTableBase, CallableBodyIndex, SymbolIdIndex,SymbolRecordIndex, SymbolConstructorIndex, BodyIndex, SymbolIndex],
RTSymbolOps
USING[
AcquireType, BodyName, AcquireRope, EnumerateRecordIseis, RootBodyType, ISEConstant, IsTransferConstructorSEI, SEUnderType, SETypeXferMode, ISEName, NullSEI, ParentBody, CallableBTI, NullBTI, CallableBodyEntryIndex, ISEType],
RTSymbols USING[ReleaseSTB, AcquireSTBFromGFH],
RTTypesPrivate USING[TypedVariableRec, GetCBTI],
RTTypesRemotePrivate
USING[
GetRemoteGFHeader, UnwindRemoteIndirectProcDesc, AcquireCBTHandleFromRemotePD],
SafeStorage USING[Type, nullType, GetCanonicalType],
WorldVM USING[CurrentIncarnation, World, ShortAddress];
AMFrameBridgeImpl:
PROGRAM
IMPORTS AMBridge, AMTypes, PrincOpsUtils, RemotePrincOpsUtils, RTSymbolOps, RTSymbols, SafeStorage, RTTypesPrivate, RTTypesRemotePrivate, WorldVM
EXPORTS AMBridge, AMTypes, RTTypesPrivate
=
BEGIN
OPEN AMBridge, AMTypes, bx: BrandXSymbolDefs, by: BrandYSymbolDefs, RemotePrincOpsUtils, Rope, RTSymbolDefs, RTSymbolOps, RTSymbols, SafeStorage, RTTypesPrivate, RTTypesRemotePrivate, WorldVM;
TVForSignal:
PUBLIC
PROC[signal:
ERROR
ANY
RETURNS
ANY]
RETURNS[TypedVariable] = {
ws: WordSequence = NEW[WordSequenceRecord[1]];
ws[0] ← LOOPHOLE[signal, CARDINAL];
RETURN[
NEW[TypedVariableRec
← [referentType: [GetSignalType[
LOOPHOLE[signal, PrincOps.SignalDesc]]],
head: [constant[]],
status: const,
field: constant[value: ws]]]];
};
GetProcedureType:
PROC[pd: PrincOps.ProcDesc]
RETURNS[type: Type] = {
stb: SymbolTableBase;
cbti: CallableBodyIndex;
[stb, cbti] ← AcquireCBTHandleFromPD[pd];
type ← AcquireType[
stb,
(
WITH stb
SELECT
FROM
t: SymbolTableBase.x => [x[t.e.bb[NARROW[cbti, CallableBodyIndex.x].e].ioType]],
t: SymbolTableBase.y =>[y[t.e.bb[NARROW[cbti, CallableBodyIndex.y].e].ioType]],
ENDCASE => ERROR)
! UNWIND => ReleaseSTB[stb]
];
ReleaseSTB[stb];
};
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, BodyName[stb, cbti] ! UNWIND => ReleaseSTB[stb]];
ReleaseSTB[stb];
RETURN[ans];
};
AcquireCBTHandleFromPD:
PROC[pd: PrincOps.ProcDesc]
RETURNS[stb: SymbolTableBase, cbti: CallableBodyIndex] = {
gfh: PrincOps.GlobalFrameHandle;
ep: CARDINAL;
[gfh, ep] ← PrincOpsUtils.GlobalFrameAndEntryPoint[pd];
stb ← AcquireSTBFromGFH[gfh];
cbti ← GetCBTI[stb, ep];
};
STInfoToEPN:
PROC[cl: PrincOps.SignalDesc]
RETURNS[
CARDINAL] =
{RETURN[(cl.gfi - 1) * PrincOps.EPRange + cl.ep]};
GetSignalType:
PROC[sed: PrincOps.SignalDesc]
RETURNS[type: Type] = {
stb: SymbolTableBase;
gfh: PrincOps.GlobalFrameHandle;
ep: CARDINAL;
proc:
PROC[stb: SymbolTableBase, isei: SymbolIdIndex]
RETURNS[stop:
BOOL] = {
RETURN[
WITH stb
SELECT
FROM
t: SymbolTableBase.x => procX[t.e, NARROW[isei, SymbolIdIndex.x].e],
t: SymbolTableBase.y => procY[t.e, NARROW[isei, SymbolIdIndex.y].e],
ENDCASE => ERROR
];
};
procX:
PROC[stb: bx.SymbolTableBase, isei: bx.SymbolIdIndex]
RETURNS[stop:
BOOL] = {
tsei: bx.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 ep = STInfoToEPN[LOOPHOLE[stb.seb[isei].idValue, PrincOps.SignalDesc]]
THEN {type ← AcquireType[[x[stb]], [x[stb.seb[isei].idType]]]; RETURN[TRUE]}
ELSE RETURN[FALSE];
};
procY:
PROC[stb: by.SymbolTableBase, isei: by.SymbolIdIndex]
RETURNS[stop:
BOOL] = {
tsei: by.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 ep = STInfoToEPN[LOOPHOLE[stb.seb[isei].idValue, PrincOps.SignalDesc]]
THEN {type ← AcquireType[[y[stb]], [y[stb.seb[isei].idType]]]; RETURN[TRUE]}
ELSE RETURN[FALSE];
};
START GetSignalType 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]];
[gfh, ep] ← PrincOpsUtils.GlobalFrameAndEntryPoint[sed];
stb ← AcquireSTBFromGFH[gfh];
type ← nullType;
[] ← EnumerateRecordIseis[stb,
LOOPHOLE[RootBodyType[stb], SymbolRecordIndex], proc
! UNWIND => ReleaseSTB[stb]];
ReleaseSTB[stb];
};
SEDToName:
PUBLIC
PROC[sed: PrincOps.SignalDesc]
RETURNS[ans:
ROPE] = {
gfh: PrincOps.GlobalFrameHandle;
ep: CARDINAL;
stb: SymbolTableBase;
proc:
PROC[stb: SymbolTableBase, isei: SymbolIdIndex]
RETURNS[stop:
BOOL] = {
tsei: SymbolConstructorIndex;
IF ISEConstant[stb, isei]
AND IsTransferConstructorSEI[stb, tsei ← SEUnderType[stb, ISEType[stb, isei]]]
AND (
SELECT SETypeXferMode[stb,
LOOPHOLE[tsei, SymbolIndex]]
FROM
signalOrError => TRUE,
ENDCASE => FALSE)
AND
ep =
STInfoToEPN[
LOOPHOLE[
(
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.y].e].idValue,
ENDCASE => ERROR),
PrincOps.SignalDesc]
]
THEN {ans ← AcquireRope[stb, ISEName[stb, isei]]; 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, ep] ← PrincOpsUtils.GlobalFrameAndEntryPoint[sed];
stb ← AcquireSTBFromGFH[gfh];
sei ← LOOPHOLE[RootBodyType[stb], SymbolRecordIndex];
ans ← NIL;
IF
NOT NullSEI[
LOOPHOLE[sei, SymbolIndex]]
THEN
[] ← EnumerateRecordIseis[stb, sei, proc ! UNWIND => ReleaseSTB[stb]];
ReleaseSTB[stb];
}; -- end SEDToName
StaticParent:
PUBLIC
SAFE
PROC[tv: TypedVariable
--procedure--]
RETURNS[TypedVariable--procedure--] = TRUSTED {
stb: SymbolTableBase;
bti: BodyIndex;
cbti: CallableBodyIndex;
remote: BOOL ← IsRemote[tv];
SELECT TypeClass[UnderType[TVType[tv]]]
FROM
globalFrame => RETURN [NIL];
procedure => NULL; -- fall through to a complex case
nil => RETURN [NIL];
ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]];
{
IF remote
THEN {
pd: RemotePD = UnwindRemoteIndirectProcDesc[TVToRemoteProc[tv]];
IF pd.pd = PrincOps.NullLink THEN RETURN[NIL];
[stb, cbti] ← AcquireCBTHandleFromRemotePD[pd];
bti ← LOOPHOLE[cbti, BodyIndex];
WHILE
NOT NullBTI[bti ← ParentBody[stb, bti]]
DO
IF CallableBTI[stb, bti]
THEN {
sppd: PrincOps.ProcDesc ← PrincOps.ControlLink[procedure[gfi: 0, ep: 0, tag: TRUE]];
entryIndex: [0..PrincOps.EPRange*PrincOps.MaxNGfi)
← CallableBodyEntryIndex[stb, LOOPHOLE[bti, CallableBodyIndex]];
sppd.gfi ← GetRemoteGFHeader
[[pd.world,
WorldVM.CurrentIncarnation[pd.world],
LOOPHOLE[RemoteGlobalFrame[pd.world, pd.pd], ShortAddress]
]].gfi + entryIndex/PrincOps.EPRange;
sppd.ep ← entryIndex MOD PrincOps.EPRange;
ReleaseSTB[stb];
RETURN[TVForRemoteProc[[pd.world, CurrentIncarnation[pd.world], sppd]]];
};
ENDLOOP;
GO TO globalReturn;
}
ELSE {
pd: PrincOps.ProcDesc
← UnwindIndirectProcDesc[LOOPHOLE[TVToProc[tv], PrincOps.ControlLink]];
IF pd = PrincOps.NullLink THEN RETURN[NIL];
[stb, cbti] ← AcquireCBTHandleFromPD[pd];
bti ← LOOPHOLE[cbti, BodyIndex];
WHILE
NOT NullBTI[bti ← ParentBody[stb, bti]]
DO
IF CallableBTI[stb, bti]
THEN {
sppd: PrincOps.ProcDesc ← PrincOps.ControlLink[procedure[gfi: 0, ep: 0, tag: TRUE]];
entryIndex: [0..PrincOps.EPRange*PrincOps.MaxNGfi)
← CallableBodyEntryIndex[stb, LOOPHOLE[bti, CallableBodyIndex]];
sppd.gfi ←
LOOPHOLE[PrincOpsUtils.GlobalFrame[pd], PrincOps.GlobalFrameHandle].gfi
+ entryIndex/PrincOps.EPRange;
sppd.ep ← entryIndex MOD PrincOps.EPRange;
ReleaseSTB[stb];
RETURN[TVForProc[LOOPHOLE[sppd, PROC ANY RETURNS ANY]]];
};
ENDLOOP;
GO TO globalReturn;
};
EXITS globalReturn => {ReleaseSTB[stb]; RETURN [AMTypes.GlobalParent[tv]]};
};
}; -- end StaticParent
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]];
};
TVForProc:
PUBLIC
PROC[proc:
PROC
ANY
RETURNS
ANY]
RETURNS[TypedVariable] = {
ws: WordSequence = NEW[WordSequenceRecord[1]];
ws[0] ← LOOPHOLE[proc, CARDINAL];
RETURN[
NEW[TypedVariableRec ←
[referentType: [GetProcedureType[LOOPHOLE[proc, PrincOps.ProcDesc]]],
head: [constant[]],
status: const,
field: constant[value: ws]]]];
};
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]];
};
GetCanonicalProcType:
PROC[proc:
UNSPECIFIED]
RETURNS[Type] = {
pd: PrincOps.ProcDesc = UnwindIndirectProcDesc[proc];
IF pd = PrincOps.NullLink THEN RETURN[nullType];
RETURN[GetCanonicalType[GetProcedureType[pd]]];
};
GetCanonicalSignalType:
PROC[sig:
UNSPECIFIED]
RETURNS[Type] = {
IF sig = 0 THEN RETURN[nullType];
RETURN[GetCanonicalType[GetSignalType[LOOPHOLE[sig, PrincOps.SignalDesc]]]];
};
START HERE
IF PrincOps.SD[RTSD.sGetCanonicalProcType] # 0 THEN ERROR;
PrincOps.SD[RTSD.sGetCanonicalProcType] ← LOOPHOLE[GetCanonicalProcType, CARDINAL];
IF PrincOps.SD[RTSD.sGetCanonicalSignalType] # 0 THEN ERROR;
PrincOps.SD[RTSD.sGetCanonicalSignalType] ← LOOPHOLE[GetCanonicalSignalType, CARDINAL];
END.