-- 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.