DIRECTORY
AMBridge USING [WordSequence, WordSequenceRecord, IsRemote, RemotePD, TVToCardinal, TVToRemoteProc, TVForRemoteProc],
AMTypes USING [Error, GlobalParent, TVType, TypedVariable, UnderClass],
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];
};

StaticParent: PUBLIC SAFE PROC [tv: TypedVariable--procedure--] RETURNS [TypedVariable--procedure--] = TRUSTED {
stb: SymbolTableBase;
bti: BodyIndex;
cbti: CallableBodyIndex;
remote: BOOL _ IsRemote[tv];
SELECT UnderClass[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 = LOOPHOLE[PrincOps.NullLink, WORD] 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], LOOPHOLE[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 UnderClass[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
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Rovner, July 11, 1983 10:41 am
Russ Atkinson (RRA) February 11, 1985 7:11:52 pm PST

START GetSignalType HERE

raises typeFault

raises typeFault


START HERE
Κ˜
codeš
œ™Kšœ
Οm
œ1™<Kš
œ™K™4—K˜š
Οk	˜	Kšœ	žœg˜uKšœžœ:˜GKšœžœ/˜EKšœžœ/˜EKšœ	žœ`žœ˜rKšœžœ)˜<Kšœžœ˜.Kšœžœžœ˜Kšžœ
žœ2˜<Kšœ
žœw˜‰
Kšœžœγ
˜τ
Kšœ
žœ!˜0Kšœžœ˜1KšœžœQ˜kKšœžœ$˜5Kšœžœ+˜8—K˜šœž˜Kšžœ
˜—
Kšžœ"˜)Kšœž
œΌ
˜Θ
—K˜šΟnœžœ
žœ
žœ
žœ
žœ
žœžœ˜TKšœžœ˜.Kšœžœ	žœ˜#šžœ
žœ˜šœ žœ ˜HKš
œ˜Kš
œ˜Kš
œ˜——Kš
œ˜—K˜šŸœžœžœ˜GKš
œ˜Kš
œ˜Kš
œ)˜)š
œ˜Kš
œ˜šœ
žœžœ
ž˜Kšœ"žœ(˜PKšœ!žœ(˜OKšžœžœ
˜—Kšœžœ˜Kš
œ˜—Kš
œ˜Kš
œ˜—K˜š
Ÿœžœ
žœžœžœ˜EKš
œ˜Kš
œ˜Kš
œ ˜ Kšžœžœ
žœ
žœ˜+Kš
œ)˜)Kšœ-žœ˜HKš
œ˜Kšžœ˜Kš
œ˜K˜—šŸœžœžœ4˜pKš
œ ˜ Kšœžœ
˜
Kš
œ7˜7Kš
œ˜Kš
œ˜Kš
œ˜—K˜š
Ÿœžœžœžœž
œ
˜BKšžœ*˜0Kš
œ˜—K˜šŸ
œžœžœ˜GKš
œ˜Kš
œ ˜ Kšœžœ
˜
šœžœ-žœžœ˜Ošžœ
˜šžœžœ
ž˜Kšœ#žœ˜DKšœ#žœ˜DKšžœž˜—Kš
œ˜—Kš
œ˜—šœžœ3žœžœ˜VKš
œ˜šžœ˜KšžœG˜Jš
ž˜šœ
žœž˜Kšœžœ
˜Kšžœžœ
˜——Kšžœžœ-˜J—Kšžœ;žœ
žœ˜LKšžœ
žœ
žœ˜Kš
œ˜—šœžœ3žœžœ˜VKš
œ˜šžœ˜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˜—š
Ÿ	œžœ
žœžœžœ˜IKš
œ ˜ Kšœžœ
˜
Kš
œ˜šœžœ-žœžœ˜OKš
œ˜šžœ˜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˜šŸœžœ
žœ
žœ 
œ
žœ 
œžœ˜pKš
œ˜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šžœ:žœ
˜RKš
œ˜—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š
œ™šŸœžœ
žœžœžœ
žœ
žœ
žœ˜Lšžœž˜"Kš
œžœ
žœžœ
žœ
žœ
žœ˜DKšœžœ
˜Kšžœžœ,˜<—Kšžœ
žœžœ
žœ
žœ
žœ˜9Kš
œ˜—K˜šŸ	œžœ
žœžœ
žœ
žœ
žœžœ˜OKšœžœ˜.Kšœžœžœ˜!šžœ
žœ˜Kšœ!žœ˜EKš
œ˜Kš
œ˜Kš
œ˜—Kš
œ˜—K™Kš
œ™šŸœžœ
žœ˜?Kšžœ˜šžœžœ˜8Kšžœ
žœ
žœ(˜<—šžœ
ž˜Kšžœžœžœ
žœ)˜XKšžœ
˜—Kšžœ
žœ˜)Kš
œ˜—K˜šŸœžœžœžœ˜AKš
œ5˜5Kšžœžœ
žœ˜0Kšžœ)˜/Kš
œ˜—K˜šŸœžœžœžœ˜BKšžœ	žœ
žœ˜!Kšžœ žœ˜LKš
œ˜K™—K™Kš
œ
™
K˜Kš
žœ
žœ
žœžœ
žœ
˜:Kš	œ	žœ
žœžœžœ˜SK˜Kš
žœ
žœ
žœžœ
žœ
˜<Kš	œ	žœ
žœžœžœ˜WK˜Kšžœ
˜K˜K˜—…—(p5λ