-- AMFrameBridgeImpl.Mesa
-- Russ Atkinson, April 5, 1983 7:46 pm
-- changed StaticParent to work correctly, even for local & global frames
-- last modified on June 22, 1983 11:50 am by Paul Rovner

DIRECTORY
AMBridge USING[
-- OctalRead, GetWorld, TVForFrame, TVForRemoteFrame,
WordSequence, WordSequenceRecord, IsRemote, RemotePD,
TVToCardinal, TVToRemoteProc, TVForRemoteProc],
AMTypes USING[
-- Procedure, UnderClass,
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--, localbase--],
Rope USING[ROPE],
RTSD USING[SD, 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],
RTTypesBasic USING[Type, nullType, GetCanonicalType],
RTTypesPrivate USING[GetTVZones, TypedVariableRec, GFT, GetCBTI],
RTTypesRemotePrivate USING[
GetRemoteGFHeader, GetRemoteGFHandle, UnwindRemoteIndirectProcDesc,
AcquireCBTHandleFromRemotePD],
WorldVM USING[CurrentIncarnation, World];


AMFrameBridgeImpl: PROGRAM
IMPORTS AMBridge, AMTypes, RTSymbolOps, RTSymbols, RTTypesBasic, RTTypesPrivate,
RTTypesRemotePrivate, WorldVM
EXPORTS AMBridge, AMTypes, RTTypesPrivate

= BEGIN OPEN AMBridge, AMTypes, bx: BrandXSymbolDefs, by: BrandYSymbolDefs,
Rope, RTSymbolDefs, RTSymbolOps, RTSymbols, RTTypesBasic,
RTTypesPrivate, RTTypesRemotePrivate, WorldVM;

-- TYPES

-- CONSTANTS

-- VARIABLES
tvZone: ZONE;

-- PUBLIC PROCEDURES

TVForSignal: PUBLIC PROC[signal: ERROR ANY RETURNS ANY] RETURNS[TypedVariable] =
{ws: WordSequence = NEW[WordSequenceRecord[1]];
ws[0] ← LOOPHOLE[signal, CARDINAL];
RETURN[tvZone.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] =
{ pd ← UnwindIndirectProcDesc[pd];
stb ← AcquireSTBFromGFH[GFT[pd.gfi].frame];
cbti ← GetCBTI[stb, GFT[pd.gfi].epbase + pd.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;
proc: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOLEAN] =
{ 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: BOOLEAN] =
{ 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 (GFT[sed.gfi].epbase + sed.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: BOOLEAN] =
{ 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 (GFT[sed.gfi].epbase + sed.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]];

stb ← AcquireSTBFromGFH[GFT[sed.gfi].frame];
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;
stb: SymbolTableBase;

proc: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOLEAN] =
{ 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 (GFT[sed.gfi].epbase + sed.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 ← GFT[sed.gfi].frame;
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];
-- localFrame => {
-- procTV: TypedVariable ← NIL;
-- world: WorldVM.World ← AMBridge.GetWorld[tv];
-- link: CARDINAL ← 0;
-- procTV ← AMTypes.Procedure[
-- tv ! AMTypes.Error => IF reason = typeFault THEN CONTINUE ELSE REJECT];
-- IF procTV # NIL THEN {
-- nextProc: TypedVariable ← StaticParent[procTV];
-- SELECT AMTypes.UnderClass[AMTypes.TVType[nextProc]] FROM
-- procedure => {};
-- ENDCASE => RETURN [AMTypes.GlobalParent[tv]];
-- };
-- the static link is always in local 0
-- link ← AMBridge.OctalRead[tv, PrincOps.localbase];
-- IF link <= PrincOps.localbase THEN RETURN [AMTypes.GlobalParent[tv]];
-- the static link points to local 0 of the statically enclosing local frame
-- link ← link - PrincOps.localbase;
-- IF NOT remote
-- THEN RETURN [AMBridge.TVForFrame[LOOPHOLE[link]]]
-- ELSE RETURN [AMBridge.TVForRemoteFrame[[
-- world: world,
-- worldIncarnation: WorldVM.CurrentIncarnation[world],
-- fh: link]]];
-- };
procedure => {
-- 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
[GetRemoteGFHandle[world: pd.world,
gfi: LOOPHOLE[pd.pd, PrincOps.ProcDesc].gfi]
].gfi + entryIndex/PrincOps.EPRange;
sppd.ep ← entryIndex MOD PrincOps.EPRange;
ReleaseSTB[stb];
RETURN[TVForRemoteProc[[world: pd.world,
worldIncarnation: CurrentIncarnation[pd.world],
pd: 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 ← GFT[pd.gfi].frame.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[tvZone.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[RTTypesBasic.GetCanonicalType[GetSignalType[LOOPHOLE[sig, PrincOps.SignalDesc]]]];
};

-- START HERE

IF RTSD.SD[RTSD.sGetCanonicalProcType] # 0 THEN ERROR;
RTSD.SD[RTSD.sGetCanonicalProcType] ← LOOPHOLE[GetCanonicalProcType, CARDINAL];

IF RTSD.SD[RTSD.sGetCanonicalSignalType] # 0 THEN ERROR;
RTSD.SD[RTSD.sGetCanonicalSignalType] ← LOOPHOLE[GetCanonicalSignalType, CARDINAL];

[qz: tvZone] ← GetTVZones[];


END.