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.