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

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.


 AMFrameBridgeImpl.Mesa
last modified on July 11, 1983 10:41 am by Paul Rovner

START GetSignalType HERE

raises typeFault

raises typeFault


START HERE
Κš˜Iprocš
œ™Kš
œ6™6K˜š
Οk	˜	šœ	œ
˜Kš
œe˜e—KšœœC˜PKšœœ.˜DKšœœ.˜Dšœ	œ
˜Kšœ^œ˜b—Kšœœ(˜;Kšœœ˜-Kšœœ
œ˜Kšœ
œ1˜;šœ
œ
˜Kš
œu˜u—šœœ
˜Kš
œα
˜α
—Kšœ
œ ˜/Kšœœ˜0šœœ
˜Kš
œO˜O—Kšœœ#˜4Kšœœ*˜7—K˜šœ˜Kšœ
˜—
Kšœ"˜)—K˜šœ˜KšœΌ
˜ΐ
—K˜šΟnœœ
œ	œ
œ
œ
œœ˜RKšœœ˜.Kšœœ	œ˜#šœ
œ˜šœ œ ˜HKš
œ˜Kš
œ˜Kš
œ˜——Kš
œ˜—K˜šžœœœ˜EKš
œ˜Kš
œ˜Kš
œ)˜)š
œ˜Kš
œ˜šœ
œœ
˜Kšœ"œ(˜PKšœ!œ(˜OKšœœ
˜—Kšœœ˜Kš
œ˜—Kš
œ˜Kš
œ˜—K˜š
žœœ
œœœ˜CKš
œ˜Kš
œ˜Kš
œ ˜ Kšœœ
œ
œ˜+Kš
œ)˜)Kšœ-œ˜HKš
œ˜Kšœ˜Kš
œ˜K˜—šžœœ˜3Kšœ3˜:Kš
œ ˜ Kšœœ
˜
Kš
œ7˜7Kš
œ˜Kš
œ˜Kš
œ˜—K˜šžœœœ
œ˜>Kšœ
œ+˜2—K˜šž
œœœ˜EKš
œ˜Kš
œ ˜ Kšœœ
˜
šœœ,œœ˜Mšœ
˜šœœ
˜Kšœ#œ˜DKšœ#œ˜DKšœ˜—Kš
œ˜—Kš
œ˜—šœœ2œœ˜TKš
œ˜šœ˜KšœG˜Jš
˜šœ
œ˜Kšœœ
˜Kšœœ
˜——Kšœœ-˜J—Kšœ;œ
œ˜LKšœ
œ
œ˜Kš
œ˜—šœœ2œœ˜TKš
œ˜šœ˜KšœG˜Jš
˜šœ
œ˜Kšœœ
˜Kšœœ
˜——Kšœœ-˜J—Kšœ;œ
œ˜LKšœ
œ
œ˜Kš
œ˜—K™Kš
œ™šœ
œœ
Οc˜.Kšœ
œœœ
œœ
˜7Kšœ
œœœ
œœ
˜8—Kšœ
œ
œ
œ˜Kš
œ8˜8Kš
œ˜Kš
œ˜šœœ,˜SKšœœ˜—Kš
œ˜Kš
œ˜K˜—š
ž	œœ
œœœ˜GKš
œ ˜ Kšœœ
˜
Kš
œ˜šœœ,œœ˜MKš
œ˜šœ˜KšœK˜Nšœœœ˜AKšœœ
˜Kšœœœ
˜—š
˜š
œ˜š
œ˜šœ
˜	šœ
œœ
˜Kšœ œ#˜IKšœ œ#˜IKšœœ˜—Kš
œ˜—Kš
œ
˜
———Kšœ.œ
œ˜?—Kšœ
œ
œ˜Kš
œ˜—Kš
œ˜Kš
œœœ
œ
œ˜JKš
œ
œœœ
œ
˜:Kšœ
œœœ
œœœ
œ˜Nšœ
œœœ
œœ
˜8Kšœ
œ˜—Kš
œ8˜8Kš
œ˜Kšœœ'˜5Kšœœ
˜
šœ
œ	œ˜/Kšœ+œ˜F—Kš
œ˜KšœŸ˜—K˜š
žœœ
œ
œŸ
œ
˜>KšœŸ
œœ˜/Kš
œ˜Kš
œ˜Kš
œ˜Kšœœ˜šœ"˜,Kšœœœ˜Kšœ
œŸ!˜4Kšœœœ˜Kšœœ,˜<—Kš
œ
˜
šœœ˜Kš
œ@˜@Kšœœ
œ
œ˜.Kš
œ/˜/Kšœœ˜ šœ
œ%˜0šœœ˜KšœMœ˜Tš
œ2˜2Kšœœ˜@—š
œ˜Kš
œ˜Kš
œ'˜'Kš
œ2˜<Kš
œ%˜%—Kšœœ˜*Kš
œ˜KšœB˜HKš
œ˜—Kšœ
˜—Kšœ
œ˜Kš
œ
˜
—šœ˜š
œ˜Kšœœ&˜G—Kšœœ
œ
œ˜+Kš
œ)˜)Kšœœ˜ šœ
œ%˜0šœœ˜KšœMœ˜Tš
œ2˜2Kšœœ˜@—šœœ?˜RKš
œ!˜!—Kšœœ˜*Kš
œ˜Kšœœœ
œ
œ
œ˜8Kš
œ˜—Kšœ
˜—Kšœ
œ˜Kš
œ˜—Kšœ#œ˜KKš
œ˜KšœŸ˜—K™Kš
œ™šžœœ
œœ
œ
œ
œ
œ˜Jšœ"˜,Kš
œœ
œœ
œ
œ
œ˜DKšœœ
˜Kšœœ,˜<—Kšœ
œœ
œ
œ
œ˜9Kš
œ˜—K˜šž	œœ
œœ
œ
œ
œœ˜MKšœœ˜.Kšœœœ˜!šœ
œ˜Kšœ!œ˜EKš
œ˜Kš
œ˜Kš
œ˜—Kš
œ˜—K™Kš
œ™šžœœ
œ˜>Kšœ˜šœœ˜8Kšœ
œ
œ(˜<—šœ
˜Kšœœœ
œ)˜XKšœ
˜—Kšœ
œ˜)Kš
œ˜—K˜šžœœœœ
˜?Kš
œ5˜5Kšœœ
œ˜0Kšœ)˜/Kš
œ˜—K˜šžœœœœ
˜@Kšœ	œ
œ˜!Kšœ œ˜LKš
œ˜K™—K™Kš
œ
™
K˜Kš
œ
œ
œœ
œ
˜:Kš	œ	œ
œœœ˜SK˜Kš
œ
œ
œœ
œ
˜<Kš	œ	œ
œœœ˜WK˜Kšœ
˜K˜J˜—…—(V5