<> <> <> <> DIRECTORY AMBridge USING [GetWorld, IsRemote, nilRemoteFrameHandle, nilRemoteGlobalFrameHandle, RemoteFHFromTV, RemoteFrameHandle, RemoteGFHFromTV, RemoteGlobalFrameHandle, RemotePD, RemoteSED, TVForProc, TVForRemoteFrame, TVForRemoteGFHReferent, TVForRemoteProc, TVForRemoteSignal, TVForSignal, TVToCardinal, TVToRemoteProc,TVToRemoteSignal, WordSequence, WordSequenceRecord], AMProcessBasic USING [ReturnLink], AMTypes USING [Domain, Error, Index, IndexToTV, Range, Size, TV, TVStatus, TVType, UnderClass, UnderType], BrandXSymbolDefs USING [SymbolTableBase, rootBodyIndex, BodyIndex, nullBodyIndex, outerContextLevel], BrandYSymbolDefs USING [SymbolTableBase, rootBodyIndex, BodyIndex, nullBodyIndex, outerContextLevel], LoadState USING [GlobalFrameToType, local, Acquire, Release], PrincOps USING [BytePC, ControlLink, CSegPrefix, EPRange, Frame, FrameHandle, GlobalFrame, GlobalFrameHandle, localbase, MaxNGfi, NullLink, ProcDesc, SignalDesc, StateVector, UnboundLink, SD, sSignal], PrincOpsUtils USING [GlobalFrame, Codebase], RemotePrincOpsUtils USING [RemoteGlobalFrame], Rope USING [ROPE], RTSymbolDefs USING [BlockContextLevel, BodyIndex, CallableBodyIndex, nullBodyIndex, SymbolConstructorIndex, SymbolIdIndex, SymbolIndex, SymbolTableBase], RTSymbolOps USING [AcquireType, BodyLevel, BodyType, CallableBodyEntryIndex, CallableBTI, ISEConstant, ISEImmutable, ISEType, IsRootBTI, IsTypeSEI, NullBTI, NullSEI, ParentBody, RootBodyType, SEUnderType], RTSymbols USING [AcquireSTBFromGFH, OuterFromGFH, ReleaseSTB], RTTypesPrivate USING [BuildRecordFieldDescriptor, FieldDescriptor, GetIdConstantValue, GFHToName, RecordComponentISEI, TypedVariableRec, UnwindIndirectProcDesc], RTTypesRemotePrivate USING [AcquireBTIFromRemoteFH, AcquireSTBFromRemoteGFH, GetRemoteEp, GetRemoteFrameHeader, GetRemoteGFHeader, IsRemoteCatchFrame, OuterFromRemoteGFH, RemoteGFHToName, RemoteSignalValues], RuntimeError USING [UNCAUGHT], SafeStorage USING [Type, nullType, fhType, gfhType], WorldVM USING [CurrentIncarnation, Long, ShortAddress, World, LocalWorld]; RTTypedFramesImpl: PROGRAM IMPORTS AMBridge, AMProcessBasic, AMTypes, LoadState, PrincOpsUtils, RemotePrincOpsUtils, RTSymbolOps, RTSymbols, RTTypesPrivate, RTTypesRemotePrivate, RuntimeError, WorldVM EXPORTS AMTypes, AMBridge, RTTypesPrivate = BEGIN OPEN AMBridge, AMTypes, bx: BrandXSymbolDefs, by: BrandYSymbolDefs, RemotePrincOpsUtils, Rope, RTSymbolDefs, RTSymbolOps, RTSymbols, SafeStorage, RTTypesPrivate, RTTypesRemotePrivate, RuntimeError, WorldVM; <<>> <> EVRange: TYPE = [0..4*PrincOps.EPRange); <<>> <> sigGF: PrincOps.GlobalFrameHandle = LOOPHOLE[ PrincOpsUtils.GlobalFrame[LOOPHOLE[PrincOps.SD[PrincOps.sSignal], PrincOps.ProcDesc]]]; <<>> <> <<>> TVToSignal: PUBLIC PROC [tv: TV] RETURNS [ERROR ANY RETURNS ANY] = { <> SELECT UnderClass[TVType[tv]] FROM signal, error => NULL; nil => RETURN[LOOPHOLE[PrincOps.UnboundLink, ERROR ANY RETURNS ANY]]; ENDCASE => RaiseClassError[tv]; RETURN[LOOPHOLE[TVToCardinal[tv], ERROR ANY RETURNS ANY]]; }; TVForFrame: PUBLIC PROC [ fh: PrincOps.FrameHandle, evalStack: POINTER TO PrincOps.StateVector _ NIL, return: BOOL _ FALSE, contextPC: BOOL _ FALSE] RETURNS [ans: TV _ NIL] = { bti: BodyIndex; isCatchFrame: BOOL _ FALSE; IF fh = NIL THEN RETURN[NIL]; [isCatchFrame, bti] _ AcquireBTIFromFH[fh, contextPC ! Error => IF reason = noSymbols THEN {bti _ nullBodyIndex; CONTINUE}]; RETURN[NEW[TypedVariableRec _ [referentType: [fhType], head: [fh[fh: fh, evalStack: evalStack, bti: bti, isCatchFrame: isCatchFrame, return: return, contextPC: contextPC]], status: mutable, field: entire[] ]]]; }; <<>> FHFromTV: PUBLIC PROC [tv: TV] RETURNS [PrincOps.FrameHandle _ NIL] = { <> <> IF tv = NIL THEN RETURN[NIL]; WITH tv SELECT FROM tr: REF TypedVariableRec => WITH tfh: tr.head SELECT FROM fh => RETURN[tfh.fh]; ENDCASE => GO TO oops; ENDCASE => GO TO oops; EXITS oops => RaiseClassError[tv] }; TVForGFHReferent: PUBLIC PROC [gfh: PrincOps.GlobalFrameHandle] RETURNS [TV _ NIL] = { IF gfh # NIL THEN RETURN[NEW[TypedVariableRec _ [referentType: [gfhType], head: [gfh[gfh: gfh]], status: mutable, field: entire[]]]]; }; <<>> GFHFromTV: PUBLIC PROC [tv: TV] RETURNS [PrincOps.GlobalFrameHandle _ NIL] = { <> IF tv = NIL THEN RETURN[NIL]; WITH tv SELECT FROM tr: REF TypedVariableRec => WITH tgfh: tr.head SELECT FROM gfh => RETURN[tgfh.gfh]; ENDCASE; ENDCASE; RaiseClassError[tv] }; <<>> GlobalParent: PUBLIC SAFE PROC [tv: TV--transfer or local frame--] RETURNS [TV--globalFrame--] = TRUSTED { <> IF IsRemote[tv] THEN { type: Type = TVType[tv]; gfh: RemoteGlobalFrameHandle _ nilRemoteGlobalFrameHandle; SELECT UnderClass[type] FROM localFrame => { fh: RemoteFrameHandle = RemoteFHFromTV[tv]; IF fh.fh = 0 THEN RETURN[NIL]; gfh _ [world: fh.world, worldIncarnation: CurrentIncarnation[fh.world], gfh: LOOPHOLE[GetRemoteFrameHeader[fh].accesslink, WorldVM.ShortAddress]]; }; program, procedure => { pd: RemotePD = TVToRemoteProc[tv]; IF pd.pd = LOOPHOLE[PrincOps.NullLink, WORD] THEN RETURN[NIL]; gfh _ [world: pd.world, worldIncarnation: CurrentIncarnation[pd.world], gfh: LOOPHOLE[RemoteGlobalFrame[pd.world, pd.pd], WorldVM.ShortAddress]]; }; signal, error => { sed: RemoteSED = TVToRemoteSignal[tv]; IF sed.sed = LOOPHOLE[PrincOps.NullLink, WORD] OR LOOPHOLE[sed.sed, CARDINAL] = 177777B OR LOOPHOLE[sed.sed, CARDINAL] = LOOPHOLE[UNWIND, CARDINAL] OR LOOPHOLE[sed.sed, CARDINAL] = LOOPHOLE[ABORTED, CARDINAL] THEN RETURN[NIL]; gfh _ [ world: sed.world, worldIncarnation: CurrentIncarnation[sed.world], gfh: LOOPHOLE[RemoteGlobalFrame[sed.world, sed.sed], WorldVM.ShortAddress]]; }; nil => RETURN[NIL]; ENDCASE => ERROR Error[reason: typeFault, type: type]; RETURN[TVForRemoteGFHReferent[gfh]]; } ELSE { <> type: Type = TVType[tv]; gfh: PrincOps.GlobalFrameHandle; SELECT UnderClass[type] FROM localFrame => { fh: PrincOps.FrameHandle = FHFromTV[tv]; IF fh = NIL THEN RETURN[NIL]; gfh _ fh.accesslink; }; signal, error => { sed: PrincOps.ProcDesc = LOOPHOLE[TVToSignal[tv], PrincOps.ProcDesc]; IF sed = PrincOps.NullLink OR LOOPHOLE[sed, CARDINAL] = 177777B OR LOOPHOLE[sed, CARDINAL] = LOOPHOLE[UNWIND, CARDINAL] OR LOOPHOLE[sed, CARDINAL] = LOOPHOLE[ABORTED, CARDINAL] THEN RETURN[NIL]; gfh _ LOOPHOLE[PrincOpsUtils.GlobalFrame[sed], PrincOps.GlobalFrameHandle]; }; program, procedure => { pd: PrincOps.ProcDesc = UnwindIndirectProcDesc[LOOPHOLE[TVToCardinal[tv], PrincOps.ControlLink]]; IF pd = PrincOps.NullLink THEN RETURN[NIL]; gfh _ LOOPHOLE[PrincOpsUtils.GlobalFrame[pd], PrincOps.GlobalFrameHandle]; }; nil => RETURN[NIL]; ENDCASE => ERROR Error[reason: typeFault, type: type]; RETURN[TVForGFHReferent[gfh]]; }; }; ContextPC: PUBLIC SAFE PROC [tv: TV--localFrame--] RETURNS [ans: PrincOps.BytePC] = TRUSTED { WITH th: NARROW[tv, REF TypedVariableRec].head SELECT FROM remoteFH => ans _ [GetRemoteFrameHeader[RemoteFHFromTV[tv]].pc - (IF th.contextPC THEN 0 ELSE 1)]; fh => ans _ [th.fh.pc - (IF th.contextPC THEN 0 ELSE 1)]; ENDCASE => RaiseClassError[tv]; }; IsStarted: PUBLIC SAFE PROC [tv: TV--globalFrame--] RETURNS [BOOL _ FALSE] = TRUSTED { <> rtr: REF TypedVariableRec _ NARROW[tv]; IF IsRemote[tv] THEN { rgfh: REF PrincOps.GlobalFrame = GetRemoteGFHeader[RemoteGFHFromTV[tv]]; RETURN[(NOT rgfh.code.out) OR rgfh.started]; } ELSE WITH th: rtr.head SELECT FROM gfh => RETURN[(NOT th.gfh.code.out) OR th.gfh.started]; ENDCASE => RaiseClassError[tv]; }; IsCopied: PUBLIC SAFE PROC [tv: TV--globalFrame--] RETURNS [BOOL _ FALSE] = TRUSTED { rtr: REF TypedVariableRec _ NARROW[tv]; IF IsRemote[tv] THEN { rgfh: REF PrincOps.GlobalFrame = GetRemoteGFHeader[RemoteGFHFromTV[tv]]; RETURN[rgfh.copied]; } ELSE WITH th: rtr.head SELECT FROM gfh => RETURN[th.gfh.copied]; ENDCASE => RaiseClassError[tv]; }; Procedure: PUBLIC SAFE PROC [tv: TV--localFrame--] RETURNS [TV--procedure--] = TRUSTED { IF IsRemote[tv] THEN { stb: SymbolTableBase; rtr: REF TypedVariableRec; bti: BodyIndex; fh: RemoteFrameHandle _ nilRemoteFrameHandle; IF tv = NIL THEN RETURN[NIL]; rtr _ NARROW[tv]; WITH th: rtr.head SELECT FROM remoteFH => IF th.isCatchFrame THEN bti _ nullBodyIndex ELSE { bti _ th.bti; IF NullBTI[bti] THEN { <> name: ROPE; fh _ RemoteFHFromTV[tv]; bti _ th.bti _ AcquireBTIFromRemoteFH[fh, th.contextPC]; <> IF NOT NullBTI[th.bti] THEN { [th.isCatchFrame, th.bti] _ IsRemoteCatchFrame[fh, bti]; bti _ th.bti; IF th.isCatchFrame THEN bti _ nullBodyIndex; } ELSE { name _ RemoteGFHToName [[world: fh.world, worldIncarnation: CurrentIncarnation[fh.world], gfh: LOOPHOLE[GetRemoteFrameHeader[fh].accesslink, WorldVM.ShortAddress]]]; ERROR AMTypes.Error[reason: noSymbols, msg: name]; }; }; }; ENDCASE => bti _ nullBodyIndex; IF NullBTI[bti] THEN RaiseClassError[tv]; fh _ RemoteFHFromTV[tv]; IF fh.fh = 0 THEN RETURN[NIL]; stb _ AcquireSTBFromRemoteGFH [[world: fh.world, worldIncarnation: CurrentIncarnation[fh.world], gfh: LOOPHOLE[GetRemoteFrameHeader[fh].accesslink, WorldVM.ShortAddress]]]; FOR bti _ bti, ParentBody[stb, bti] UNTIL NullBTI[bti] DO IF CallableBTI[stb, bti] THEN { sppd: PrincOps.ProcDesc _ LOOPHOLE[PrincOps.UnboundLink, PrincOps.ProcDesc]; entryIndex: [0..PrincOps.EPRange*PrincOps.MaxNGfi) _ CallableBodyEntryIndex[stb, LOOPHOLE[bti, CallableBodyIndex]]; IF entryIndex = 0 THEN RaiseClassError[tv]; <> sppd.gfi _ GetRemoteGFHeader [[world: fh.world, worldIncarnation: CurrentIncarnation[fh.world], gfh: LOOPHOLE[GetRemoteFrameHeader[fh].accesslink, WorldVM.ShortAddress] ]].gfi + entryIndex/PrincOps.EPRange; sppd.ep _ entryIndex MOD PrincOps.EPRange; ReleaseSTB[stb]; RETURN[TVForRemoteProc[[fh.world, CurrentIncarnation[fh.world], LOOPHOLE[sppd]]]]; }; ENDLOOP; ReleaseSTB[stb]; RETURN[NIL]; } ELSE { <> stb: SymbolTableBase; rtr: REF TypedVariableRec; bti: BodyIndex; fh: PrincOps.FrameHandle; IF tv = NIL THEN RETURN[NIL]; rtr _ NARROW[tv]; WITH th: rtr.head SELECT FROM fh => IF th.isCatchFrame THEN RaiseClassError[tv] ELSE { bti _ th.bti; <> <> IF NullBTI[bti] -- no symbols for this localFrame TV THEN { fh _ FHFromTV[tv]; bti _ th.bti _ AcquireBTIFromFH[fh, th.contextPC ! UNCAUGHT => CONTINUE].bti; <> IF NOT NullBTI[th.bti] THEN { [th.isCatchFrame, th.bti] _ IsCatchFrame[fh, bti]; bti _ th.bti; IF th.isCatchFrame THEN RaiseClassError[tv]; } ELSE ERROR AMTypes.Error[reason: noSymbols, msg: GFHToName[th.fh.accesslink]]; }; }; ENDCASE => RaiseClassError[tv]; <> fh _ FHFromTV[tv]; IF fh = NIL THEN RETURN[NIL]; stb _ AcquireSTBFromGFH[fh.accesslink]; <> FOR bti _ bti, ParentBody[stb, bti] UNTIL NullBTI[bti] DO IF CallableBTI[stb, bti] THEN { sppd: PrincOps.ProcDesc _ LOOPHOLE[PrincOps.UnboundLink, PrincOps.ProcDesc]; entryIndex: [0..PrincOps.EPRange*PrincOps.MaxNGfi) _ CallableBodyEntryIndex[stb, LOOPHOLE[bti, CallableBodyIndex]]; <> <> sppd.gfi _ fh.accesslink.gfi + entryIndex/PrincOps.EPRange; sppd.ep _ entryIndex MOD PrincOps.EPRange; ReleaseSTB[stb]; RETURN[TVForProc[LOOPHOLE[sppd, PROC ANY RETURNS ANY]]]; }; ENDLOOP; ReleaseSTB[stb]; <> <> ERROR; }; }; Signal: PUBLIC SAFE PROC [tv: TV--localFrame--] RETURNS [ans: TV--signal descriptor--] = TRUSTED { IF IsRemote[tv] THEN { world: World; sed: PrincOps.SignalDesc; [world: world, signal: sed] _ RemoteSignalValues[tv]; ans _ TVForRemoteSignal[[world: world, worldIncarnation: CurrentIncarnation[world], sed: LOOPHOLE[sed]]] } ELSE ans _ TVForSignal[LOOPHOLE[RemoteSignalValues[tv].signal, ERROR ANY RETURNS ANY]]}; IsCatch: PUBLIC SAFE PROC [tv: TV] RETURNS [BOOL] = TRUSTED { type: Type = TVType[tv]; IF type = fhType THEN WITH tv SELECT FROM rtr: REF TypedVariableRec => { bti: BodyIndex _ nullBodyIndex; isCatch: BOOL _ FALSE; WITH th: rtr.head SELECT FROM remoteFH => {bti _ th.bti; isCatch _ th.isCatchFrame}; fh => {bti _ th.bti; isCatch _ th.isCatchFrame}; ENDCASE => RETURN [FALSE]; IF bti # nullBodyIndex THEN RETURN [isCatch]; <> [] _ Procedure[tv ! AMTypes.Error => IF reason = typeFault THEN {isCatch _ FALSE; CONTINUE}]; RETURN [isCatch]; }; ENDCASE; RETURN [FALSE]; }; Argument: PUBLIC SAFE PROC [tv: TV--local or catch Frame--, index: Index] RETURNS [TV] = TRUSTED { RETURN[ArgOrResult[tv, index, Domain]]; }; Result: PUBLIC SAFE PROC [tv: TV--local or catch Frame--, index: Index] RETURNS [TV] = TRUSTED { RETURN[ArgOrResult[tv, index, Range]]; }; ArgOrResult: PROC [tv: TV--local or catch Frame--, index: Index, domainOrRange: PROC [Type] RETURNS [Type] ] RETURNS [TV] = { type: Type; catch: BOOL; message: WORD; world: World; argsTV: REF TypedVariableRec; tvr: REF TypedVariableRec _ NARROW[tv]; offset: INTEGER _ 0; <<>> <> GetSignalOrProcType: PROC [tv: TV] RETURNS [type: Type _ nullType, catch: BOOL _ FALSE] = { rtr: REF TypedVariableRec _ NARROW[tv]; WITH th: rtr.head SELECT FROM fh => { catch _ th.isCatchFrame; type _ TVType[IF catch THEN Signal[tv] ELSE Procedure[tv]]; }; remoteFH => { catch _ th.isCatchFrame; type _ TVType[IF catch THEN Signal[tv] ELSE Procedure[tv]]; }; ENDCASE => RaiseClassError[tv]; }; IF tv = NIL THEN ERROR Error[reason: typeFault, type: nullType]; [type, catch] _ GetSignalOrProcType[tv]; IF type = nullType THEN ERROR Error[reason: badIndex]; type _ domainOrRange[type]; IF type = nullType THEN ERROR Error[reason: badIndex]; WITH tvh: tvr.head SELECT FROM fh, remoteFH => NULL; ENDCASE => ERROR Error[reason: typeFault, type: type]; IF ~catch OR domainOrRange = Range THEN { <> BuildEmbeddedTV: PROC [stb: SymbolTableBase, isei: SymbolIdIndex] = { sei: SymbolIndex = ISEType[stb, isei]; csei: SymbolConstructorIndex _ SEUnderType[stb, sei]; bitsForType: LONG CARDINAL _ (WITH stb SELECT FROM t: SymbolTableBase.x => t.e.BitsForType[NARROW[csei, SymbolConstructorIndex.x].e], t: SymbolTableBase.y => t.e.BitsForType[NARROW[csei, SymbolConstructorIndex.x].e], ENDCASE => ERROR); -- bits for the value in the field fieldBits: CARDINAL _ (WITH stb SELECT FROM t: SymbolTableBase.x => t.e.seb[NARROW[isei, SymbolIdIndex.x].e].idInfo, t: SymbolTableBase.y => t.e.seb[NARROW[isei, SymbolIdIndex.x].e].idInfo, ENDCASE => ERROR); -- bits for the field fieldBitOffset: CARDINAL _ (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.x].e].idValue, ENDCASE => ERROR); <> cType: Type _ AcquireType[stb, sei]; IF ISEConstant[stb, isei] THEN { IF IsRemote[tv] AND IsTypeSEI[ISEType[stb, isei]] THEN argsTV _ NEW[TypedVariableRec _ [referentType: [cType], head: [constant[]], -- type code is valid in local world status: const, field: constant[value: GetIdConstantValue[tv, stb, isei]]]] ELSE -- either a constant component of a local tv or not a type constant argsTV _ NEW[TypedVariableRec _ [referentType: [cType], head: (WITH tv SELECT FROM tr: REF TypedVariableRec => tr.head, ENDCASE => ERROR), status: const, field: constant[value: GetIdConstantValue[tv, stb, isei]]]]; } ELSE argsTV _ NEW[TypedVariableRec _ [referentType: [cType], head: (WITH tv SELECT FROM tr:REF TypedVariableRec => tr.head, ENDCASE => ERROR), status: (IF ISEImmutable[stb, isei] THEN readOnly ELSE TVStatus[tv]), field: embedded[ fd: BuildRecordFieldDescriptor[tv, fieldBitOffset, fieldBits, bitsForType]]]]; }; -- END BuildEmbeddedTV <> RTTypesPrivate.RecordComponentISEI[UnderType[type], index, BuildEmbeddedTV]; RETURN[argsTV]; }; -- END ~catch OR domainOrRange = Range <<>> <> [world: world, message: message] _ RemoteSignalValues[tv]; <> SELECT TRUE FROM Size[type] = 1 => { ws: WordSequence = NEW[WordSequenceRecord[1]]; ws[0] _ LOOPHOLE[message, CARDINAL]; argsTV _ NEW[TypedVariableRec _ [referentType: [type], head: tvr.head, status: const, field: constant[value: ws]]] }; IsRemote[tv] => argsTV _ NEW[TypedVariableRec _ [referentType: [type], head: [remotePointer [remotePointer: [world: world, worldIncarnation: CurrentIncarnation[world], ptr: Long[world: world, addr: message]]]], status: readOnly, field: entire[]]] ENDCASE => argsTV _ NEW[TypedVariableRec _ [referentType: [type], head: [pointer[ptr: LONG[LOOPHOLE[message, POINTER]]]], status: readOnly, field: entire[]]]; RETURN[IndexToTV[argsTV, index]]; }; -- end ArgOrResult EnclosingBody: PUBLIC SAFE PROC [tv: TV--localFrame--] RETURNS [TV--localFrame--] = TRUSTED { <> <> IF IsRemote[tv] THEN { stb: SymbolTableBase = AcquireSTBFromRemoteGFH [[world: GetWorld[tv], worldIncarnation: CurrentIncarnation[GetWorld[tv]], gfh: LOOPHOLE[GetRemoteFrameHeader[RemoteFHFromTV[tv]].accesslink, WorldVM.ShortAddress]]]; rtr: REF TypedVariableRec _ NARROW[tv ! UNWIND => ReleaseSTB[stb]]; bti: BodyIndex; evalStack: WordSequence; isCatchFrame: BOOL; remoteFH: RemoteFrameHandle _ nilRemoteFrameHandle; contextPC: BOOL; level: BlockContextLevel; return: BOOL; <> <<0 (lZ)=> off in the heap (not part of a frame...lifetime determined by some sort of runtime storage management, e.g. records, ctx for names of guys in an emum);>> <<1 (lG) => global frame, outermost proc>> <<2 (lL) and >2 => nested procedure.>> <> WITH th: rtr.head SELECT FROM remoteFH => { bti _ th.bti; evalStack _ th.evalStack; isCatchFrame _ th.isCatchFrame; remoteFH _ th.remoteFrameHandle; contextPC _ th.contextPC; return _ th.return; }; ENDCASE => { ReleaseSTB[stb]; RaiseClassError[tv]; }; <<>> <> IF NullBTI[bti] THEN { IF isCatchFrame THEN { <> rfh: RemoteFrameHandle = RemoteFHFromTV[tv]; rgfh: WorldVM.ShortAddress _ LOOPHOLE[GetRemoteFrameHeader[rfh].accesslink]; bti _ SmallestBTIFromRemoteFH[rfh, stb, contextPC ! UNWIND => ReleaseSTB[stb]]; IF IsRootBTI[bti] THEN {ReleaseSTB[stb]; RETURN[NIL]}; -- not in the scope of any locals <> IF GetRemoteFrameHeader[remoteFH].staticlink = NIL THEN ReallyNastyError[]; tv _ TVForRemoteFrame [[world: remoteFH.world, worldIncarnation: CurrentIncarnation[remoteFH.world], fh: LOOPHOLE[GetRemoteFrameHeader[remoteFH].staticlink - PrincOps.localbase, WorldVM.ShortAddress]]]; UNTIL IsBodyEncloser[er: tv, ee: bti, stb: stb] <> DO rmtFH: RemoteFrameHandle _ RemoteFHFromTV[tv]; IF LOOPHOLE[GetRemoteFrameHeader[rmtFH].accesslink, WorldVM.ShortAddress] # rgfh THEN {ReleaseSTB[stb]; ERROR}; <<(bti # rootBodyIndex) => one better exist>> IF GetRemoteFrameHeader[rmtFH].staticlink = NIL THEN ReallyNastyError[]; tv _ TVForRemoteFrame [[world: rmtFH.world, worldIncarnation: CurrentIncarnation[rmtFH.world], fh: LOOPHOLE[GetRemoteFrameHeader[rmtFH].staticlink - PrincOps.localbase, WorldVM.ShortAddress]]]; ENDLOOP; rtr _ NARROW[tv, REF TypedVariableRec]; WITH th: rtr.head SELECT FROM remoteFH => { <> IF bti = th.bti THEN RETURN[tv]; evalStack _ NIL; -- NOTE isCatchFrame _ th.isCatchFrame; return _ th.return; contextPC _ th.contextPC; }; ENDCASE => ERROR; ReleaseSTB[stb]; RETURN[NEW[TypedVariableRec _ [referentType: [fhType], head: [remoteFH[remoteFrameHandle: RemoteFHFromTV[tv], evalStack: evalStack, bti: bti, isCatchFrame: isCatchFrame, return: return, contextPC: contextPC]], status: mutable, field: entire[]]]]; } ELSE {ReleaseSTB[stb]; RETURN[NIL]} -- either no symbols or no locals }; -- end IF NullBTI[bti] IF CallableBTI[stb, bti] THEN <> IF (WITH BodyLevel[stb, bti] SELECT FROM -- TRUE => not a nested procedure t: BlockContextLevel.x => t.e <= bx.outerContextLevel, t: BlockContextLevel.y => t.e <= by.outerContextLevel, ENDCASE => ERROR) THEN {ReleaseSTB[stb]; RETURN[NIL]} ELSE { <> ReleaseSTB[stb]; IF GetRemoteFrameHeader[remoteFH].staticlink = NIL THEN ReallyNastyError[]; RETURN [TVForRemoteFrame [[world: remoteFH.world, worldIncarnation: CurrentIncarnation[remoteFH.world], fh: LOOPHOLE[GetRemoteFrameHeader[remoteFH].staticlink - PrincOps.localbase, WorldVM.ShortAddress]]]]; }; level _ BodyLevel[stb, bti]; bti _ ParentBody[stb, bti]; -- A Callable bt entry also describes the outer block locals IF IsRootBTI[bti] THEN bti _ nullBodyIndex; <> IF isCatchFrame AND (NOT NullBTI[bti]) AND level # BodyLevel[stb, bti] THEN { < subtract localbase).>> ReleaseSTB[stb]; -- we no longer need the stb IF GetRemoteFrameHeader[remoteFH].staticlink = NIL THEN ReallyNastyError[]; tv _ TVForRemoteFrame [[world: remoteFH.world, worldIncarnation: CurrentIncarnation[remoteFH.world], fh: LOOPHOLE[GetRemoteFrameHeader[remoteFH].staticlink- PrincOps.localbase, WorldVM.ShortAddress]]]; rtr _ NARROW[tv, REF TypedVariableRec]; WITH th: rtr.head SELECT FROM remoteFH => { <> IF bti = th.bti THEN RETURN[tv]; evalStack _ NIL; -- NOTE isCatchFrame _ th.isCatchFrame; return _ th.return; contextPC _ th.contextPC; }; ENDCASE => ERROR } ELSE ReleaseSTB[stb]; RETURN[NEW[TypedVariableRec _ [referentType: [fhType], head: [remoteFH[remoteFrameHandle: RemoteFHFromTV[tv], evalStack: evalStack, bti: bti, isCatchFrame: isCatchFrame, return: return, contextPC: contextPC]], status: mutable, field: entire[]]]]; } ELSE { <> stb: SymbolTableBase = AcquireSTBFromGFH[FHFromTV[tv].accesslink]; rtr: REF TypedVariableRec _ NARROW[tv ! UNWIND => ReleaseSTB[stb]]; bti: BodyIndex; evalStack: POINTER TO PrincOps.StateVector; isCatchFrame: BOOL; contextPC: BOOL; level: BlockContextLevel; return: BOOL; <> <<0 (lZ)=> off in the heap (not part of a frame...lifetime determined by some sort of runtime storage management, e.g. records, ctx for names of guys in an emum);>> <<1 (lG) => global frame, outermost proc>> <<2 (lL) and >2 => nested procedure.>> <> WITH th: rtr.head SELECT FROM fh => { bti _ th.bti; evalStack _ th.evalStack; isCatchFrame _ th.isCatchFrame; contextPC _ th.contextPC; return _ th.return; }; ENDCASE => { ReleaseSTB[stb]; RaiseClassError[tv]; }; <> IF NullBTI[bti] THEN { IF isCatchFrame THEN { <> fh: PrincOps.FrameHandle = FHFromTV[tv]; gfh: PrincOps.GlobalFrameHandle _ fh.accesslink; bti _ SmallestBTIFromFH[fh, stb, contextPC ! UNWIND => ReleaseSTB[stb]]; IF IsRootBTI[bti] THEN {ReleaseSTB[stb]; RETURN[NIL]}; -- not in the scope of any locals <> IF fh.staticlink = NIL THEN ReallyNastyError[]; tv _ TVForFrame[LOOPHOLE[fh.staticlink - PrincOps.localbase, PrincOps.FrameHandle]]; UNTIL IsBodyEncloser[er: tv, ee: bti, stb: stb] <> DO IF FHFromTV[tv].accesslink # gfh THEN {ReleaseSTB[stb]; ERROR}; <<(bti # rootBodyIndex) => one better exist>> IF FHFromTV[tv].staticlink = NIL THEN ReallyNastyError[]; tv _ TVForFrame[LOOPHOLE[FHFromTV[tv].staticlink - PrincOps.localbase, PrincOps.FrameHandle]]; ENDLOOP; rtr _ NARROW[tv, REF TypedVariableRec]; WITH th: rtr.head SELECT FROM fh => { <> IF bti = th.bti THEN RETURN[tv]; evalStack _ NIL; -- NOTE isCatchFrame _ th.isCatchFrame; return _ th.return; contextPC _ th.contextPC; }; ENDCASE => ERROR; ReleaseSTB[stb]; RETURN[NEW[TypedVariableRec _ [referentType: [fhType], head: [fh[fh: FHFromTV[tv], evalStack: evalStack, bti: bti, isCatchFrame: isCatchFrame, return: return, contextPC: contextPC]], status: mutable, field: entire[]]]]; } ELSE {ReleaseSTB[stb]; RETURN[NIL]} -- either no symbols or no locals }; -- end IF NullBTI[bti] IF CallableBTI[stb, bti] THEN <> IF (WITH BodyLevel[stb, bti] SELECT FROM -- TRUE => not a nested procedure t: BlockContextLevel.x => t.e <= bx.outerContextLevel, t: BlockContextLevel.y => t.e <= by.outerContextLevel, ENDCASE => ERROR) THEN {ReleaseSTB[stb]; RETURN[NIL]} ELSE { -- this is a frame for a nested procedure ReleaseSTB[stb]; IF FHFromTV[tv].staticlink = NIL THEN ReallyNastyError[]; RETURN[TVForFrame[LOOPHOLE[FHFromTV[tv].staticlink - PrincOps.localbase, PrincOps.FrameHandle]]]; }; level _ BodyLevel[stb, bti]; bti _ ParentBody[stb, bti]; -- A Callable bt entry also describes the outer block locals IF IsRootBTI[bti] THEN bti _ nullBodyIndex; <> IF isCatchFrame AND (NOT NullBTI[bti]) AND level # BodyLevel[stb, bti] THEN { < subtract localbase).>> ReleaseSTB[stb]; -- we no longer need the stb IF FHFromTV[tv].staticlink = NIL THEN ReallyNastyError[]; tv _ TVForFrame[LOOPHOLE[FHFromTV[tv].staticlink - PrincOps.localbase, PrincOps.FrameHandle]]; rtr _ NARROW[tv, REF TypedVariableRec]; WITH th: rtr.head SELECT FROM fh => { <> IF bti = th.bti THEN RETURN[tv]; evalStack _ NIL; -- NOTE isCatchFrame _ th.isCatchFrame; return _ th.return; contextPC _ th.contextPC; }; ENDCASE => ERROR } ELSE ReleaseSTB[stb]; RETURN[NEW[TypedVariableRec _ [referentType: [fhType], head: [fh[fh: FHFromTV[tv], evalStack: evalStack, bti: bti, isCatchFrame: isCatchFrame, return: return, contextPC: contextPC]], status: mutable, field: entire[]]]]; }; -- end local case of EnclosingBody }; -- end EnclosingBody <<>> Locals: PUBLIC SAFE PROC [tv: TV] RETURNS [TV _ NIL] = TRUSTED { rtr: REF TypedVariableRec _ NARROW[tv]; IF tv # NIL THEN { bti: BodyIndex; type: Type _ nullType; inner: PROC [stb: SymbolTableBase] = { IF NullBTI[bti] OR IsRootBTI[bti] OR NullSEI[BodyType[stb, bti]] THEN RETURN; type _ AcquireType[stb, BodyType[stb, bti]]; }; IF IsRemote[tv] THEN { fh: RemoteFrameHandle = RemoteFHFromTV[tv]; IF fh = nilRemoteFrameHandle THEN RETURN[NIL]; bti _ (WITH th: rtr.head SELECT FROM remoteFH => th.bti, ENDCASE => nullBodyIndex); OuterFromRemoteGFH[ [world: fh.world, worldIncarnation: CurrentIncarnation[fh.world], gfh: LOOPHOLE[GetRemoteFrameHeader[fh].accesslink, WorldVM.ShortAddress]], inner]; } ELSE { fh: PrincOps.FrameHandle = FHFromTV[tv]; IF fh = NIL THEN RETURN[NIL]; bti _ (WITH th: rtr.head SELECT FROM fh => th.bti, ENDCASE => nullBodyIndex); OuterFromGFH[fh.accesslink, inner]; }; IF type # nullType THEN RETURN[NEW[TypedVariableRec _ [referentType: [type], head: rtr.head, status: mutable, field: entire[]]]]; }; }; DynamicParent: PUBLIC SAFE PROC [tv: TV--localFrame--] RETURNS [TV _ NIL] = TRUSTED { IF IsRemote[tv] THEN { remoteFH: RemoteFrameHandle = RemoteFHFromTV[tv]; cl: PrincOps.ControlLink; IF remoteFH.fh = 0 THEN RETURN[NIL]; cl _ AMProcessBasic.ReturnLink [remoteFH.world, LOOPHOLE[remoteFH.fh, PrincOps.FrameHandle]]; IF cl.proc OR cl.indirect THEN RETURN[NIL] ELSE RETURN[TVForRemoteFrame [[world: remoteFH.world, worldIncarnation: CurrentIncarnation[remoteFH.world], fh: LOOPHOLE[cl.frame, WorldVM.ShortAddress]]]]; } ELSE { fh: PrincOps.FrameHandle _ FHFromTV[tv]; cl: PrincOps.ControlLink; IF fh = NIL THEN RETURN[NIL]; cl _ AMProcessBasic.ReturnLink[WorldVM.LocalWorld[], fh]; IF cl.proc OR cl.indirect THEN RETURN[NIL] ELSE RETURN[TVForFrame[cl.frame]]; }; }; <<>> Globals: PUBLIC SAFE PROC [tv: TV] RETURNS [TV _ NIL] = TRUSTED { rtr: REF TypedVariableRec _ NARROW[tv]; IF tv # NIL THEN { type: Type _ nullType; inner: PROC [stb: SymbolTableBase] = { type _ AcquireType[stb, RootBodyType[stb]]; }; IF IsRemote[tv] THEN { gfh: RemoteGlobalFrameHandle _ RemoteGFHFromTV[tv]; IF gfh # nilRemoteGlobalFrameHandle THEN OuterFromRemoteGFH[gfh, inner]; RETURN[NEW[TypedVariableRec _ [referentType: [type], head: rtr.head, status: mutable, field: entire[]]]]; } ELSE { gfh: PrincOps.GlobalFrameHandle _ GFHFromTV[tv]; IF gfh = NIL THEN RETURN[NIL]; LoadState.local.Acquire[]; type _ LoadState.local.GlobalFrameToType[gfh ! UNWIND => LoadState.local.Release[]]; LoadState.local.Release[]; IF type = nullType THEN OuterFromGFH[gfh, inner]; }; RETURN[NEW[TypedVariableRec _ [referentType: [type], head: rtr.head, status: mutable, field: entire[]]]]; }; }; <<>> IsBodyEncloser: PROC [er: TV, ee: BodyIndex, stb: SymbolTableBase] RETURNS [ans: BOOL _ FALSE] = { rtr: REF TypedVariableRec _ NARROW[er]; WITH th: rtr.head SELECT FROM fh => {-- does th.bti enclose ee? WITH stb SELECT FROM t: SymbolTableBase.x => FOR bti: bx.BodyIndex _ NARROW[th.bti, BodyIndex.x].e, t.e.SonBti[bti] UNTIL bti = bx.nullBodyIndex DO IF bti = NARROW[ee, BodyIndex.x].e THEN RETURN[TRUE]; ENDLOOP; t: SymbolTableBase.y => FOR bti: by.BodyIndex _ NARROW[th.bti, BodyIndex.y].e, t.e.SonBti[bti] UNTIL bti = by.nullBodyIndex DO IF bti = NARROW[ee, BodyIndex.y].e THEN RETURN[TRUE]; ENDLOOP; ENDCASE => ERROR; }; remoteFH => {-- does th.bti enclose ee? WITH stb SELECT FROM t: SymbolTableBase.x => FOR bti: bx.BodyIndex _ NARROW[th.bti, BodyIndex.x].e, t.e.SonBti[bti] UNTIL bti = bx.nullBodyIndex DO IF bti = NARROW[ee, BodyIndex.x].e THEN RETURN[TRUE]; ENDLOOP; t: SymbolTableBase.y => FOR bti: by.BodyIndex _ NARROW[th.bti, BodyIndex.y].e, t.e.SonBti[bti] UNTIL bti = by.nullBodyIndex DO IF bti = NARROW[ee, BodyIndex.y].e THEN RETURN[TRUE]; ENDLOOP; ENDCASE => ERROR; }; ENDCASE => ERROR; }; <<>> AcquireBTIFromFH: PROC [fh: PrincOps.FrameHandle, contextPC: BOOL] RETURNS [isCatchFrame: BOOL _ FALSE, bti: BodyIndex _ nullBodyIndex] = { <> inner: PROC [stb: SymbolTableBase] = { bti _ SmallestBTIFromFH[fh, stb, contextPC]; <> [isCatchFrame, bti] _ IsCatchFrame[fh, bti]; }; OuterFromGFH[fh.accesslink, inner]; }; SmallestBTIFromFH: PROC [fh: PrincOps.FrameHandle, stb: SymbolTableBase, contextPC: BOOL] RETURNS [bti: BodyIndex] = { start: PrincOps.BytePC; epn: CARDINAL; framePC: PrincOps.BytePC = [(fh.pc - (IF contextPC THEN 0 ELSE 1))]; [epn, start] _ GetEp[framePC, fh.accesslink, stb]; <> bti _ ConvertCbti[ base: stb, pc: framePC, start: start, lastBti: LOOPHOLE[GetCBTI[stb, epn], BodyIndex] ]; }; SmallestBTIFromRemoteFH: PROC [rfh: RemoteFrameHandle, stb: SymbolTableBase, contextPC: BOOL] RETURNS [bti: BodyIndex] = { start: PrincOps.BytePC; epn: CARDINAL; remoteFrame: REF PrincOps.Frame = GetRemoteFrameHeader[rfh]; framePC: PrincOps.BytePC = [(remoteFrame.pc - (IF contextPC THEN 0 ELSE 1))]; [epn, start] _ GetRemoteEp[ pc: framePC, gf: [world: rfh.world, worldIncarnation: CurrentIncarnation[rfh.world], gfh: LOOPHOLE[remoteFrame.accesslink, ShortAddress]], stb: stb]; <> bti _ ConvertCbti[ base: stb, pc: framePC, start: start, lastBti: LOOPHOLE[GetCBTI[stb, epn], BodyIndex]]; }; <<>> <> GetCBTI: PUBLIC PROC [stb: SymbolTableBase, epn: CARDINAL] RETURNS [cbti: CallableBodyIndex] = { IsThisItX: PROC [bti: bx.BodyIndex] RETURNS [stop: BOOL] = { WITH NARROW[stb, SymbolTableBase.x].e.bb[bti] SELECT FROM Callable => RETURN[(NOT inline) AND (epn = entryIndex)]; ENDCASE => RETURN[FALSE]; }; IsThisItY: PROC [bti: by.BodyIndex] RETURNS [stop: BOOL] = { WITH NARROW[stb, SymbolTableBase.y].e.bb[bti] SELECT FROM Callable => RETURN[(NOT inline) AND (epn = entryIndex)]; ENDCASE => RETURN[FALSE]; }; bi: BodyIndex = WITH stb SELECT FROM t: SymbolTableBase.x => [x[t.e.EnumerateBodies[bx.rootBodyIndex, IsThisItX]]], t: SymbolTableBase.y => [y[t.e.EnumerateBodies[by.rootBodyIndex, IsThisItY]]], ENDCASE => ERROR; RETURN[LOOPHOLE[bi, CallableBodyIndex]]; }; <<>> <> ConvertCbti: PUBLIC PROC [lastBti: BodyIndex, pc, start: PrincOps.BytePC, base: SymbolTableBase] RETURNS [bti: BodyIndex] = { WITH base SELECT FROM t: SymbolTableBase.x => RETURN[[x[ConvertCbtiX[NARROW[lastBti, BodyIndex.x].e, pc, start, t.e]]]]; t: SymbolTableBase.y => RETURN[[y[ConvertCbtiY[NARROW[lastBti, BodyIndex.y].e, pc, start, t.e]]]]; ENDCASE => ERROR; }; ConvertCbtiX: PROC [lastBti: bx.BodyIndex, pc, start: PrincOps.BytePC, base: bx.SymbolTableBase] RETURNS [bti: bx.BodyIndex] = { bodyStart: PrincOps.BytePC; bti _ lastBti; DO FOR lastBti _ base.SonBti[bti], base.SiblingBti[lastBti] UNTIL lastBti = bx.nullBodyIndex DO WITH body: base.bb[lastBti] SELECT FROM Callable => LOOP; Other => { bodyStart _ [start + body.relOffset]; WITH body.info SELECT FROM External => IF pc IN [bodyStart..bodyStart+bytes) THEN {bti _ lastBti; EXIT}; ENDCASE; }; ENDCASE; REPEAT FINISHED => RETURN ENDLOOP; ENDLOOP; }; ConvertCbtiY: PROC [lastBti: by.BodyIndex, pc, start: PrincOps.BytePC, base: by.SymbolTableBase] RETURNS [bti: by.BodyIndex] = { bodyStart: PrincOps.BytePC; bti _ lastBti; DO FOR lastBti _ base.SonBti[bti], base.SiblingBti[lastBti] UNTIL lastBti = by.nullBodyIndex DO WITH body: base.bb[lastBti] SELECT FROM Callable => LOOP; Other => { bodyStart _ [start + body.relOffset]; WITH body.info SELECT FROM External => IF pc IN [bodyStart..bodyStart+bytes) THEN {bti _ lastBti; EXIT}; ENDCASE; }; ENDCASE; REPEAT FINISHED => RETURN ENDLOOP; ENDLOOP; }; <<>> <> GetEp: PUBLIC PROC [pc: PrincOps.BytePC, gf: PrincOps.GlobalFrameHandle, stb: SymbolTableBase] RETURNS [ep: EVRange, start: PrincOps.BytePC] = { FindMaxEI: PROC RETURNS [max: EVRange] = { GetMaxX: PROC [bti: bx.BodyIndex] RETURNS [stop: BOOL] = { WITH NARROW[stb, SymbolTableBase.x].e.bb[bti] SELECT FROM Callable => IF ~inline THEN max _ MAX[max, entryIndex]; ENDCASE; RETURN[FALSE]; }; GetMaxY: PROC [bti: by.BodyIndex] RETURNS [stop: BOOL] = { WITH NARROW[stb, SymbolTableBase.y].e.bb[bti] SELECT FROM Callable => IF ~inline THEN max _ MAX[max, entryIndex]; ENDCASE; RETURN[FALSE]; }; max _ 0; WITH stb SELECT FROM t: SymbolTableBase.x => [] _ t.e.EnumerateBodies[bx.rootBodyIndex, GetMaxX]; t: SymbolTableBase.y => [] _ t.e.EnumerateBodies[by.rootBodyIndex, GetMaxY]; ENDCASE => ERROR; }; <> diff: CARDINAL _ LAST[CARDINAL]; anyProcedure: BOOL _ FALSE; FOR i: EVRange IN [0..FindMaxEI[]] DO Card: PROC [pc: PrincOps.BytePC] RETURNS [CARDINAL] = INLINE {RETURN[LOOPHOLE[pc, CARDINAL]]}; last: PrincOps.BytePC _ GetPc[gf, i]; IF Card[last] > Card[pc] THEN LOOP; IF Card[pc] - Card[last] > diff THEN LOOP; diff _ Card[pc] - Card[last]; ep _ i; start _ last; anyProcedure _ TRUE; ENDLOOP; IF ~anyProcedure THEN ERROR; -- SIGNAL NotInAnyProcedure; }; <<>> <> GetPc: PUBLIC PROC [gf: PrincOps.GlobalFrameHandle, i: EVRange] RETURNS [PrincOps.BytePC] = { codeBase: LONG POINTER TO PrincOps.CSegPrefix = PrincOpsUtils.Codebase[gf]; wpc: CARDINAL = codeBase.entry[i].initialpc; -- GROAN RETURN[LOOPHOLE[wpc*2, PrincOps.BytePC]]; }; IsCatchFrame: PROC [frame: PrincOps.FrameHandle, bti: BodyIndex] RETURNS [BOOL, BodyIndex] = { L0Frame: PrincOps.FrameHandle; -- will be the frame that encloses the catch frame nextFrame: PrincOps.FrameHandle; tr: REF TypedVariableRec; IF frame = NIL THEN RETURN[FALSE, bti]; nextFrame _ AMProcessBasic.ReturnLink[WorldVM.LocalWorld[], frame].frame; IF nextFrame = NIL THEN RETURN[FALSE, bti]; IF nextFrame.accesslink # sigGF OR ~nextFrame.mark THEN RETURN[FALSE, bti]; <> IF frame.staticlink = NIL THEN ReallyNastyError[]; L0Frame _ LOOPHOLE[frame.staticlink - PrincOps.localbase, PrincOps.FrameHandle]; IF frame.accesslink # L0Frame.accesslink THEN RETURN[FALSE, bti]; <> tr _ NARROW[TVForFrame[L0Frame], REF TypedVariableRec]; WITH hd: tr.head SELECT FROM fh => IF bti = hd.bti THEN bti _ IF bti.brand = x THEN [x[bx.nullBodyIndex]] ELSE [y[by.nullBodyIndex]]; <> ENDCASE => ERROR; RETURN[TRUE, bti]; }; RaiseClassError: PROC [tv: TV] = { ERROR AMTypes.Error[reason: typeFault, type: AMTypes.TVType[tv]]; }; ReallyNastyError: PROC = { ERROR; }; END.