-- RTTypedFramesImpl.Mesa -- last modified on June 23, 1983 1:13 pm by Paul Rovner 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, TypeClass, TypedVariable, UnderType], BrandXSymbolDefs USING [SymbolTableBase, rootBodyIndex, BodyIndex, nullBodyIndex, outerContextLevel], BrandYSymbolDefs USING [SymbolTableBase, rootBodyIndex, BodyIndex, nullBodyIndex, outerContextLevel], Mopcodes USING[zLADRB], PrincOps USING [BytePC, ControlLink, CSegPrefix, EPRange, Frame, FrameHandle, GFTIndex, GlobalFrame, GlobalFrameHandle, localbase, MaxNGfi, NullLink, ProcDesc, SignalDesc, StateVector, UnboundLink], PrincOpsRuntime USING[GetFrame, GFT, GFTItem], Rope USING[ROPE], RTLoader USING[GetGFRCType], 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, ReleaseSTB], RTTypesBasic USING[Type, nullType, fhType, gfhType], RTTypesPrivate USING [BuildRecordFieldDescriptor, FieldDescriptor, GetIdConstantValue, GetTVZones, GFHToName, RecordComponentISEI, TypedVariableRec, UnwindIndirectProcDesc], RTTypesRemotePrivate USING [AcquireBTIFromRemoteFH, AcquireSTBFromRemoteGFH, GetRemoteEp, GetRemoteFrameHeader, GetRemoteGFHandle, GetRemoteGFHeader, IsRemoteCatchFrame, RemoteGFHToName, RemoteSignalValues, UnwindRemoteIndirectProcDesc, ValidateRemoteFrame], Runtime USING[ValidateFrame, ValidateGlobalFrame, GetTableBase, CallDebugger], SDDefs USING[SD, sSignal], WorldVM USING[CurrentIncarnation, Long, ShortAddress, World, LocalWorld]; RTTypedFramesImpl: PROGRAM IMPORTS AMProcessBasic, AMTypes, PrincOpsRuntime, RTLoader, RTSymbolOps, RTSymbols, AMBridge, RTTypesPrivate, RTTypesRemotePrivate, Runtime, WorldVM EXPORTS AMTypes, AMBridge, RTTypesPrivate = BEGIN OPEN AMBridge, AMTypes, bx: BrandXSymbolDefs, by: BrandYSymbolDefs, Rope, RTSymbolDefs, RTSymbolOps, RTSymbols, RTTypesBasic, RTTypesPrivate, RTTypesRemotePrivate, WorldVM; -- TYPES EVRange: TYPE = [0..4*PrincOps.EPRange); -- CONSTANTS sigGF: PrincOps.GlobalFrameHandle=GFT[LOOPHOLE[SDDefs.SD[SDDefs.sSignal], PrincOps.ProcDesc].gfi].frame; -- VARIABLES tvZone: ZONE; -- PUBLIC PROCEDURES -- raises typeFault TVToSignal: PUBLIC PROC[tv: TypedVariable] RETURNS[ERROR ANY RETURNS ANY] = { SELECT TypeClass[UnderType[TVType[tv]]] FROM signal, error => NULL; nil => RETURN[LOOPHOLE[PrincOps.UnboundLink, ERROR ANY RETURNS ANY]]; ENDCASE => ERROR Error[reason: typeFault, type: TVType[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: BOOLEAN _ FALSE; IF fh = NIL THEN RETURN[NIL]; Runtime.ValidateFrame[fh]; [isCatchFrame, bti] _ AcquireBTIFromFH[fh, contextPC ! Error => IF reason = noSymbols THEN {bti _ nullBodyIndex; CONTINUE}]; RETURN[tvZone.NEW[TypedVariableRec _ [referentType: [fhType], head: [fh[fh: fh, evalStack: evalStack, bti: bti, isCatchFrame: isCatchFrame, return: return, contextPC: contextPC]], status: mutable, field: entire[]]]]; }; -- all such tvs have the same (distinguished) type: fhType -- raises typeFault FHFromTV: PUBLIC PROC[tv: TypedVariable] RETURNS[PrincOps.FrameHandle] = { IF tv = NIL THEN RETURN[NIL]; WITH tv SELECT FROM tr: REF TypedVariableRec => WITH tfh: tr.head SELECT FROM fh => { Runtime.ValidateFrame[tfh.fh]; RETURN[tfh.fh]}; ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]]; ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]]}; TVForGFHReferent: PUBLIC PROC[gfh: PrincOps.GlobalFrameHandle] RETURNS[TypedVariable] = { IF gfh = NIL THEN RETURN[NIL]; Runtime.ValidateGlobalFrame[gfh]; RETURN[tvZone.NEW[TypedVariableRec _ [referentType: [gfhType], head: [gfh[gfh: gfh]], status: mutable, field: entire[]]]]}; -- raises typeFault GFHFromTV: PUBLIC PROC[tv: TypedVariable] RETURNS[PrincOps.GlobalFrameHandle] = { IF tv = NIL THEN RETURN[NIL]; WITH tv SELECT FROM tr: REF TypedVariableRec => WITH tgfh: tr.head SELECT FROM gfh => {Runtime.ValidateGlobalFrame[tgfh.gfh]; RETURN[tgfh.gfh]}; ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]]; ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]]}; -- MOVE -- raises typeFault GlobalParent: PUBLIC SAFE PROC[tv: TypedVariable--transfer or local frame--] RETURNS[TypedVariable--globalFrame--] = TRUSTED {IF IsRemote[tv] THEN {type: Type = TVType[tv]; gfh: RemoteGlobalFrameHandle _ nilRemoteGlobalFrameHandle; SELECT TypeClass[UnderType[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 = UnwindRemoteIndirectProcDesc[TVToRemoteProc[tv]]; IF pd.pd = PrincOps.NullLink THEN RETURN[NIL]; gfh _ GetRemoteGFHandle[world: pd.world, gfi: LOOPHOLE[pd.pd, PrincOps.ProcDesc].gfi]}; signal, error => {sed: RemoteSED = TVToRemoteSignal[tv]; IF sed.sed = PrincOps.NullLink 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 _ GetRemoteGFHandle[world: sed.world, gfi: LOOPHOLE[sed.sed, PrincOps.ProcDesc].gfi]}; nil => RETURN[NIL]; ENDCASE => ERROR Error[reason: typeFault, type: type]; RETURN[TVForRemoteGFHReferent[gfh]]} ELSE -- local case {type: Type = TVType[tv]; gfh: PrincOps.GlobalFrameHandle; SELECT TypeClass[UnderType[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 _ GFT[sed.gfi].frame}; program, procedure => {pd: PrincOps.ProcDesc = UnwindIndirectProcDesc [LOOPHOLE[TVToCardinal[tv], PrincOps.ControlLink]]; IF pd = PrincOps.NullLink THEN RETURN[NIL]; gfh _ GFT[pd.gfi].frame}; nil => RETURN[NIL]; ENDCASE => ERROR Error[reason: typeFault, type: type]; RETURN[TVForGFHReferent[gfh]]}}; -- end GlobalParent ContextPC: PUBLIC SAFE PROC[tv: TypedVariable--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 => ERROR Error[reason: typeFault, type: TVType[tv]]}; IsStarted: PUBLIC SAFE PROC[tv: TypedVariable--globalFrame--] RETURNS[BOOL] = 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 => ERROR Error[reason: typeFault, type: TVType[tv]]}; IsCopied: PUBLIC SAFE PROC[tv: TypedVariable--globalFrame--] RETURNS[BOOL] = 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 => ERROR Error[reason: typeFault, type: TVType[tv]]}; -- MOVE Procedure: PUBLIC SAFE PROC[tv: TypedVariable--localFrame--] RETURNS [TypedVariable--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] -- last time there were no symbols for this turkey THEN {name: ROPE; fh _ RemoteFHFromTV[tv]; bti _ th.bti _ AcquireBTIFromRemoteFH[fh, th.contextPC]; -- returns BTNull if still no symbols 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 ERROR Error[reason: typeFault, type: TVType[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 ERROR Error[reason: typeFault, type: TVType[tv]]; -- start proc frame 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[[world: fh.world, worldIncarnation: CurrentIncarnation[fh.world], pd: sppd]]]}; ENDLOOP; ReleaseSTB[stb]; RETURN[NIL]} ELSE -- non-remote localFrame TV arg to Procedure {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 ERROR Error[reason: typeFault, type: TVType[tv]] ELSE {bti _ th.bti; -- XXX be careful about access via assign to RC variables that appear to be in a local frame (startproc) -- but really live in the GF. Also remote case IF NullBTI[bti] -- no symbols for this localFrame TV THEN {fh _ FHFromTV[tv]; bti _ th.bti _ AcquireBTIFromFH[fh, th.contextPC ! ANY => CONTINUE].bti; -- returns BTNull if still no symbols IF NOT NullBTI[th.bti] THEN {[th.isCatchFrame, th.bti] _ IsCatchFrame[fh, bti]; bti _ th.bti; IF th.isCatchFrame THEN ERROR Error[reason: typeFault, type: TVType[tv]]; } ELSE ERROR AMTypes.Error [reason: noSymbols, msg: GFHToName[th.fh.accesslink]]; }; }; ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]]; -- here with bti # nullBodyIndex fh _ FHFromTV[tv]; IF fh = NIL THEN RETURN[NIL]; stb _ AcquireSTBFromGFH[fh.accesslink]; -- search up thru enclosing blocks till a callable one 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 ERROR Error[reason: typeFault, type: TVType[tv]]; -- going up from a block or a body inside a startproc. 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]; -- here if the local frame has no enclosing callable body. -- This can't happen. ERROR; -- RETURN[NIL]; }}; -- end Procedure Signal: PUBLIC SAFE PROC[tv: TypedVariable--localFrame--] RETURNS[ans: TypedVariable--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: sed]]} ELSE ans _ TVForSignal[LOOPHOLE[RemoteSignalValues[tv].signal, ERROR ANY RETURNS ANY]]}; Argument: PUBLIC SAFE PROC[tv: TypedVariable--local or catch Frame--, index: Index] RETURNS[TypedVariable] = TRUSTED {RETURN[ArgOrResult[tv, index, Domain]]}; Result: PUBLIC SAFE PROC[tv: TypedVariable--local or catch Frame--, index: Index] RETURNS[TypedVariable] = TRUSTED {RETURN[ArgOrResult[tv, index, Range]]}; -- break up and MOVE ArgOrResult: PROC[tv: TypedVariable--local or catch Frame--, index: Index, domainOrRange: PROC[Type] RETURNS [Type]] RETURNS[TypedVariable] = {type: Type; catch: BOOLEAN; message: UNSPECIFIED; world: World; argsTV: REF TypedVariableRec; tvr: REF TypedVariableRec; offset: INTEGER _ 0; -- returns a signal type if tv is for a catch frame, -- a procedure type if tv is for a local frame, -- raises TypeFault otherwise. GetSignalOrProcType: PROC[tv: TypedVariable] RETURNS [type: Type _ nullType, catch: BOOLEAN _ 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 => ERROR Error[reason: typeFault, type: TVType[tv]]}; IF tv = NIL THEN ERROR Error[reason: typeFault, type: nullType]; tvr _ NARROW[tv]; [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 -- find the specified element in the frame, create a TV for it {BuildEmbeddedTV: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] = {sei: SymbolIndex = ISEType[stb, isei]; csei: SymbolConstructorIndex _ SEUnderType[stb, sei]; bitsForType: 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); -- bit offset of the field within the local frame cType: Type _ AcquireType[stb, sei]; IF ISEConstant[stb, isei] THEN { IF IsRemote[tv] AND IsTypeSEI[ISEType[stb, isei]] THEN argsTV _ tvZone.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 _ tvZone.NEW[TypedVariableRec _ [ referentType: [cType], head: (WITH tv SELECT FROM tr: REF TypedVariableRec => tr.head, ENDCASE => [reference[ref: tv]]), status: const, field: constant[value: GetIdConstantValue[tv, stb, isei]]]]; } ELSE argsTV _ tvZone.NEW[TypedVariableRec _ [ referentType: [cType], head: (WITH tv SELECT FROM tr:REF TypedVariableRec => tr.head, ENDCASE => [reference[ref: tv]]), status: (IF ISEImmutable[stb, isei] THEN readOnly ELSE TVStatus[tv]), field: embedded[fd: BuildRecordFieldDescriptor [tv, fieldBitOffset, fieldBits, bitsForType]]]]; }; -- END BuildEmbeddedTV -- Begin Here RTTypesPrivate.RecordComponentISEI[UnderType[type], index, BuildEmbeddedTV]; RETURN[argsTV]}; -- END ~catch OR domainOrRange = Range -- gotta do something different if this is an arg to a catch phrase [world: world, message: message] _ RemoteSignalValues[tv]; -- message is either a pointer to a long arg record OR a single word value IF Size[type] = 1 THEN {ws: WordSequence = NEW[WordSequenceRecord[1]]; ws[0] _ LOOPHOLE[message, CARDINAL]; argsTV _ tvZone.NEW[TypedVariableRec _ [referentType: [type], head: tvr.head, status: const, field: constant[value: ws]]]} ELSE IF IsRemote[tv] THEN argsTV _ tvZone.NEW [TypedVariableRec _ [referentType: [type], head: [remotePointer [remotePointer: [world: world, worldIncarnation: CurrentIncarnation[world], ptr: Long[world: world, addr: message]]]], status: readOnly, field: entire[]]] ELSE argsTV _ tvZone.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: TypedVariable--localFrame--] RETURNS[TypedVariable--localFrame--] = TRUSTED -- maybe NIL --// NOTE: if tv represents a block within a catch phrase, EnclosingBody --// may return the wrong context; i.e., the one enclosing the catch phrase. --// This won't come up if there is no block in the catch phrase at all; --// TVForFrame will detect it and do the right thing. It's harder to do --// the right thing here. --// The right solution is to put catch phrases in the body table!!! {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; -- static nesting level, associated with a CTX (optimization: blocks, instead of -- counting up, get level of enclosing proc). -- 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. -- catch phrase in main prog would have a level of 2 (tho these are not recorded, -- because there are not symbol table entries for catch phrases. 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]; ERROR Error[reason: typeFault, type: TVType[tv]]}; -- a fh tv will have NullBTI[bti] if there are no symbols for its referent or if it -- represents a frame for a startproc or catch phrase at a point outside the scope -- of locals IF NullBTI[bti] THEN {IF isCatchFrame THEN -- get the bti of the smallest body that encloses the PC -- (if it's rootBodyIndex then RETURN[NIL]). Verify that this body -- is a body contained (not necessarily properly) within a -- frame somewhere up the static link. Return a tv for such a frame. { rfh: RemoteFrameHandle = RemoteFHFromTV[tv]; rgfh: WorldVM.ShortAddress _ LOOPHOLE[GetRemoteFrameHeader[rfh].accesslink]; bti _ SmallestBTIFromRemoteFH[rfh, stb, contextPC ! UNWIND => ReleaseSTB[stb]]; IF IsRootBTI[bti] -- not in the scope of any locals THEN {ReleaseSTB[stb]; RETURN[NIL]}; -- starting with the frame of the most recent instance of the smallest -- enclosing static parent of the catch frame, search up the static chain -- to find the first frame that encloses the catch frame IF GetRemoteFrameHeader[remoteFH].staticlink = NIL THEN Runtime.CallDebugger["Please call Paul Rovner"]; 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] -- look up the static chain to find an encloser of bti 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 Runtime.CallDebugger["Please call Paul Rovner"]; 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 => { -- Easy if we already have the right bti, -- otherwise get the new value of isCatchFrame IF bti = th.bti THEN RETURN[tv]; evalStack _ NIL; -- NOTE isCatchFrame _ th.isCatchFrame; return _ th.return; contextPC _ th.contextPC}; ENDCASE => ERROR; ReleaseSTB[stb]; RETURN[tvZone.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 }; IF CallableBTI[stb, bti] THEN -- No more enclosing blocks: this one is callable and not a catch frame 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 GetRemoteFrameHeader[remoteFH].staticlink = NIL THEN Runtime.CallDebugger["Please call Paul Rovner"]; 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; -- means either that tv represents a frame for a startproc or catch phrase at -- a place outside the scope of locals. IF isCatchFrame AND (NOT NullBTI[bti]) AND level # BodyLevel[stb, bti] THEN {-- When the level changes inside of a catch phrase -- then we have to go through the static link (local 0) -- to get to the frame that corresponds to this bti. -- The static link points at local 0, not the frame base (=> subtract localbase). ReleaseSTB[stb]; -- we no longer need the stb IF GetRemoteFrameHeader[remoteFH].staticlink = NIL THEN Runtime.CallDebugger["Please call Paul Rovner"]; 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 => { -- Easy if we already have the right bti, -- otherwise get the new value of isCatchFrame 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[tvZone.NEW[TypedVariableRec _ [referentType: [fhType], head: [remoteFH[remoteFrameHandle: RemoteFHFromTV[tv], evalStack: evalStack, bti: bti, isCatchFrame: isCatchFrame, return: return, contextPC: contextPC]], status: mutable, field: entire[]]]]; } ELSE -- local case of EnclosingBody { 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; -- static nesting level, associated with a CTX (optimization: blocks, instead of -- counting up, get level of enclosing proc). -- 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. -- catch phrase in main prog would have a level of 2 (tho these are not recorded, -- because there are not symbol table entries for catch phrases. 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]; ERROR Error[reason: typeFault, type: TVType[tv]]}; -- a fh tv will have NullBTI[bti] if there are no symbols for its referent or if it -- represents a frame for a startproc or catch phrase at a point outside the scope -- of locals IF NullBTI[bti] THEN {IF isCatchFrame THEN -- get the bti of the smallest body that encloses the PC -- (if it's rootBodyIndex then RETURN[NIL]). Verify that this body -- is a body contained (not necessarily properly) within a -- frame somewhere up the static link. Return a tv for such a frame. { fh: PrincOps.FrameHandle = FHFromTV[tv]; gfh: PrincOps.GlobalFrameHandle _ fh.accesslink; bti _ SmallestBTIFromFH[fh, stb, contextPC ! UNWIND => ReleaseSTB[stb]]; IF IsRootBTI[bti] -- not in the scope of any locals THEN {ReleaseSTB[stb]; RETURN[NIL]}; -- starting with the frame of the most recent instance of the smallest -- enclosing static parent of the catch frame, search up the static chain -- to find the first frame that encloses the catch frame IF fh.staticlink = NIL THEN Runtime.CallDebugger["Please call Paul Rovner"]; tv _ TVForFrame[LOOPHOLE[fh.staticlink - PrincOps.localbase, PrincOps.FrameHandle]]; UNTIL IsBodyEncloser[er: tv, ee: bti, stb: stb] -- look up the static chain to find an encloser of bti DO IF FHFromTV[tv].accesslink # gfh THEN {ReleaseSTB[stb]; ERROR}; -- (bti # rootBodyIndex) => one better exist IF FHFromTV[tv].staticlink = NIL THEN Runtime.CallDebugger["Please call Paul Rovner"]; tv _ TVForFrame [LOOPHOLE[FHFromTV[tv].staticlink - PrincOps.localbase, PrincOps.FrameHandle]]; ENDLOOP; rtr _ NARROW[tv, REF TypedVariableRec]; WITH th: rtr.head SELECT FROM fh => { -- Easy if we already have the right bti, -- otherwise get the new value of isCatchFrame IF bti = th.bti THEN RETURN[tv]; evalStack _ NIL; -- NOTE isCatchFrame _ th.isCatchFrame; return _ th.return; contextPC _ th.contextPC}; ENDCASE => ERROR; ReleaseSTB[stb]; RETURN[tvZone.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 }; IF CallableBTI[stb, bti] THEN -- No more enclosing blocks: this one is callable and not a catch frame 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 Runtime.CallDebugger["Please call Paul Rovner"]; 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; -- means either that tv represents a frame for a startproc or catch phrase at -- a place outside the scope of locals. IF isCatchFrame AND (NOT NullBTI[bti]) AND level # BodyLevel[stb, bti] THEN {-- When the level changes inside of a catch phrase -- then we have to go through the static link (local 0) -- to get to the frame that corresponds to this bti. -- The static link points at local 0, not the frame base (=> subtract localbase). ReleaseSTB[stb]; -- we no longer need the stb IF FHFromTV[tv].staticlink = NIL THEN Runtime.CallDebugger["Please call Paul Rovner"]; tv _ TVForFrame [LOOPHOLE[FHFromTV[tv].staticlink - PrincOps.localbase, PrincOps.FrameHandle]]; rtr _ NARROW[tv, REF TypedVariableRec]; WITH th: rtr.head SELECT FROM fh => { -- Easy if we already have the right bti, -- otherwise get the new value of isCatchFrame 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[tvZone.NEW[TypedVariableRec _ [referentType: [fhType], head: [fh[fh: FHFromTV[tv], evalStack: evalStack, bti: bti, isCatchFrame: isCatchFrame, return: return, contextPC: contextPC]], status: mutable, field: entire[]]]]; }}; -- end EnclosingBody -- MOVE Locals: PUBLIC SAFE PROC[tv: TypedVariable--localFrame--] RETURNS[TypedVariable--record--] = -- maybe NIL TRUSTED {IF IsRemote[tv] THEN { stb: SymbolTableBase; rtr: REF TypedVariableRec; bti: BodyIndex; fh: RemoteFrameHandle = RemoteFHFromTV[tv]; type: Type; IF fh = nilRemoteFrameHandle THEN RETURN[NIL]; stb _ AcquireSTBFromRemoteGFH [[world: fh.world, worldIncarnation: CurrentIncarnation[fh.world], gfh: LOOPHOLE[GetRemoteFrameHeader[fh].accesslink, WorldVM.ShortAddress]]]; rtr _ NARROW[tv ! UNWIND => ReleaseSTB[stb]]; bti _ (WITH th: rtr.head SELECT FROM remoteFH => th.bti, ENDCASE => nullBodyIndex); IF NullBTI[bti] OR IsRootBTI[bti] THEN {ReleaseSTB[stb]; RETURN[NIL]}; IF NullSEI[BodyType[stb, bti]] THEN {ReleaseSTB[stb]; RETURN[NIL]}; type _ AcquireType[stb, BodyType[stb, bti] ! UNWIND => ReleaseSTB[stb]]; ReleaseSTB[stb]; RETURN[tvZone.NEW[TypedVariableRec _ [referentType: [type], head: rtr.head, status: mutable, field: entire[]]]]} ELSE { stb: SymbolTableBase; rtr: REF TypedVariableRec; bti: BodyIndex; fh: PrincOps.FrameHandle = FHFromTV[tv]; type: Type; IF fh = NIL THEN RETURN[NIL]; stb _ AcquireSTBFromGFH[fh.accesslink]; rtr _ NARROW[tv ! UNWIND => ReleaseSTB[stb]]; bti _ (WITH th: rtr.head SELECT FROM fh => th.bti, ENDCASE => nullBodyIndex); IF NullBTI[bti] OR IsRootBTI[bti] THEN {ReleaseSTB[stb]; RETURN[NIL]}; IF NullSEI[BodyType[stb, bti]] THEN {ReleaseSTB[stb]; RETURN[NIL]}; type _ AcquireType[stb, BodyType[stb, bti] ! UNWIND => ReleaseSTB[stb]]; ReleaseSTB[stb]; RETURN[tvZone.NEW[TypedVariableRec _ [referentType: [type], head: rtr.head, status: mutable, field: entire[]]]]}}; DynamicParent: PUBLIC SAFE PROC[tv: TypedVariable--localFrame--] RETURNS[TypedVariable--localFrame--] = TRUSTED {IF IsRemote[tv] THEN { fh: RemoteFrameHandle = RemoteFHFromTV[tv]; IF fh = nilRemoteFrameHandle THEN RETURN[NIL]; {ValidateRemoteFrame[[world: fh.world, worldIncarnation: CurrentIncarnation[fh.world], fh: LOOPHOLE[AMProcessBasic.ReturnLink [fh.world, LOOPHOLE[fh.fh, PrincOps.FrameHandle]], WorldVM.ShortAddress]] ! ANY => GOTO nope]; EXITS nope => RETURN[NIL]}; RETURN[TVForRemoteFrame [[world: fh.world, worldIncarnation: CurrentIncarnation[fh.world], fh: LOOPHOLE[AMProcessBasic.ReturnLink [fh.world, LOOPHOLE[fh.fh, PrincOps.FrameHandle]], WorldVM.ShortAddress]]]]} ELSE { fh: PrincOps.FrameHandle = FHFromTV[tv]; IF fh = NIL THEN RETURN[NIL]; {Runtime.ValidateFrame [AMProcessBasic.ReturnLink[WorldVM.LocalWorld[], fh ! ANY => GOTO nope] ! ANY => GOTO nope]; EXITS nope => RETURN[NIL]; }; RETURN[TVForFrame [AMProcessBasic.ReturnLink[WorldVM.LocalWorld[], fh].frame]]}}; -- break up and MOVE Globals: PUBLIC SAFE PROC[tv: TypedVariable--globalFrame--] RETURNS[TypedVariable--record--] = TRUSTED {IF IsRemote[tv] THEN { tvr: REF TypedVariableRec; gfh: RemoteGlobalFrameHandle _ nilRemoteGlobalFrameHandle; type: Type; IF tv = NIL THEN RETURN[NIL]; tvr _ NARROW[tv]; gfh _ RemoteGFHFromTV[tv]; IF gfh = nilRemoteGlobalFrameHandle THEN RETURN[NIL]; {stb: SymbolTableBase = AcquireSTBFromRemoteGFH[gfh]; type _ AcquireType[stb, RootBodyType[stb] ! UNWIND => ReleaseSTB[stb]]; ReleaseSTB[stb]}; RETURN[tvZone.NEW[TypedVariableRec _ [referentType: [type], head: tvr.head, status: mutable, field: entire[]]]]} ELSE { tvr: REF TypedVariableRec; gfh: PrincOps.GlobalFrameHandle; type: Type; IF tv = NIL THEN RETURN[NIL]; tvr _ NARROW[tv]; gfh _ GFHFromTV[tv]; IF gfh = NIL THEN RETURN[NIL]; IF (type _ RTLoader.GetGFRCType[gfh.gfi]) = nullType THEN {stb: SymbolTableBase = AcquireSTBFromGFH[gfh]; type _ AcquireType[stb, RootBodyType[stb] ! UNWIND => ReleaseSTB[stb]]; ReleaseSTB[stb]}; RETURN[tvZone.NEW[TypedVariableRec _ [referentType: [type], head: tvr.head, status: mutable, field: entire[]]]]}}; -- NOTE --SignalValues: PROC[tv: TypedVariable] --catch Frame -- RETURNS [message: UNSPECIFIED, signal: PrincOps.SignalDesc] = -- {rtr: REF TypedVariableRec _ NARROW[tv]; -- WITH th: rtr.head SELECT FROM -- fh => -- IF th.isCatchFrame -- THEN {mlf: PrincOps.FrameHandle; -- mlfrl: PrincOps.ControlLink; -- sig: UNSPECIFIED; -- Runtime.ValidateFrame[th.fh]; -- now convince the signaller to give back either a single word arg to the signal -- or a pointer to the long arg record, in such a way that this works in a -- different process than the signal was raised. -- mlf _ MyLocalFrame[]; -- mlfrl _ mlf.returnlink; -- mlf.returnlink _ th.fh.returnlink; -- [message, sig] _ SIGNAL RuntimeInternal.SendMsgSignal; -- mlf.returnlink _ mlfrl; -- signal _ LOOPHOLE[sig, PrincOps.SignalDesc]; -- RETURN} -- ELSE ERROR Error[reason: typeFault, type: TVType[tv]]; -- ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]]}; -- MOVE IsBodyEncloser: PROC[er: TypedVariable, 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; }; -- MOVE GFT: PUBLIC PROC [gftx: PrincOps.GFTIndex] RETURNS [frame: PrincOps.GlobalFrameHandle, epbase: CARDINAL] = -- NOTE assumption about conversion of epbias to epbase -- we assume that it is supposed to be shifted to agree with the Alto world -- to make the entry point (ep) numbers come out right {item: PrincOpsRuntime.GFTItem = PrincOpsRuntime.GFT[gftx]; RETURN [frame: PrincOpsRuntime.GetFrame[item], epbase: item.epbias * PrincOps.EPRange]}; -- Cases: normal, startproc, block in startproc, catch frame, block in catch frame, -- catch frame in startproc. Possibly no symbols. -- all cases below can raise Error[noSymbols] -- normal: returns a vanilla-flavored (maybe callable) bti -- catch frame: returns a non-callable bti or nullBodyIndex (if outside scope of locals) -- startproc: returns a vanilla-flavored bti, maybe rootBodyIndex -- MOVE AcquireBTIFromFH: PROC[fh: PrincOps.FrameHandle, contextPC: BOOL] RETURNS[isCatchFrame: BOOL, bti: BodyIndex] = {stb: SymbolTableBase = AcquireSTBFromGFH[fh.accesslink]; bti _ SmallestBTIFromFH[fh, stb, contextPC ! UNWIND => ReleaseSTB[stb]]; -- if fh is for a catch phrase, bti might be for a proc that contains it. [isCatchFrame, bti] _ IsCatchFrame[fh, bti ! UNWIND => ReleaseSTB[stb]]; ReleaseSTB[stb]; RETURN[isCatchFrame, bti]}; -- MOVE 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]; -- if epn = 0 then this is a frame for the startproc or for a catchframe in the startproc 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]; -- if epn = 0 then this is a frame for the startproc or for a catchframe in the startproc bti _ ConvertCbti[base: stb, pc: framePC, start: start, lastBti: LOOPHOLE[GetCBTI[stb, epn], BodyIndex]]}; -- finds the cbti for the specified entrypoint -- MOVE GetCBTI: PUBLIC PROC[stb: SymbolTableBase, epn: CARDINAL] RETURNS[cbti: CallableBodyIndex] = { IsThisItX: PROC[bti: bx.BodyIndex] RETURNS[stop: BOOLEAN] = { 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: BOOLEAN] = { 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]]}; -- finds the bti for the smallest enclosing block -- MOVE 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}; -- finds the entrypoint index and its start pc for the proc containing the specified pc. -- BEWARE that if the pc is in a catch phrase, this returns the epn for the statically -- enclosing procedure of the catch phrase. -- MOVE 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: BOOLEAN] = {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: BOOLEAN] = {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}; -- body of GetEp begins here diff: CARDINAL _ LAST[CARDINAL]; anyProcedure: BOOLEAN _ FALSE; FOR i: EVRange IN [0..FindMaxEI[]] DO 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; RETURN}; -- finds the start (byte) pc for the specified entrypoint index and GF GetPc: PUBLIC PROC[gf: PrincOps.GlobalFrameHandle, i: EVRange] RETURNS [PrincOps.BytePC] = {codeBase: LONG POINTER TO PrincOps.CSegPrefix = LOOPHOLE[Runtime.GetTableBase[LOOPHOLE[gf, PROGRAM]], LONG POINTER TO PrincOps.CSegPrefix]; wpc: CARDINAL = codeBase.entry[i].initialpc; -- GROAN RETURN[LOOPHOLE[wpc*2, PrincOps.BytePC]]}; -- MOVE ??? IsCatchFrame: PROC[frame: PrincOps.FrameHandle, bti: BodyIndex] RETURNS[isCatchFrame: BOOLEAN _ TRUE, revisedBti: BodyIndex] = {revisedBti _ bti; Runtime.ValidateFrame[frame ! ANY => GOTO notCatch]; -- return FALSE if frame invalid {nextFrame: PrincOps.FrameHandle _ AMProcessBasic.ReturnLink[WorldVM.LocalWorld[], frame].frame; Runtime.ValidateFrame[nextFrame ! ANY => GOTO notCatch]; -- return FALSE if calling frame is invalid IF nextFrame.accesslink # sigGF OR ~nextFrame.mark THEN GOTO notCatch; -- return FALSE if caller not signaller {L0Frame: PrincOps.FrameHandle _ NIL; IF frame.staticlink = NIL THEN Runtime.CallDebugger["Please call Paul Rovner"]; L0Frame _ LOOPHOLE[frame.staticlink - PrincOps.localbase, PrincOps.FrameHandle]; -- L0Frame is the frame that encloses the catch frame Runtime.ValidateFrame[L0Frame ! ANY => GOTO notCatch]; -- return FALSE if enclosing frame not valid IF frame.accesslink # L0Frame.accesslink THEN GOTO notCatch; { -- detect situation where catch frame has no locals, thus no body table entry. tr: REF TypedVariableRec = NARROW[TVForFrame[L0Frame], REF TypedVariableRec]; WITH hd: tr.head SELECT FROM fh => IF bti = hd.bti THEN revisedBti _ IF bti.brand = x THEN [x[bx.nullBodyIndex]] ELSE [y[by.nullBodyIndex]]; -- return nullBodyIndex if isCatchFrame and it has no locals ENDCASE => ERROR } } }; EXITS notCatch => isCatchFrame _ FALSE}; -- end IsCatchFrame Card: PROC[pc: PrincOps.BytePC] RETURNS[CARDINAL] = INLINE {RETURN[LOOPHOLE[pc, CARDINAL]]}; MyLocalFrame: PROCEDURE RETURNS [PrincOps.FrameHandle] = MACHINE CODE BEGIN Mopcodes.zLADRB, 0 END; -- START HERE [qz: tvZone] _ GetTVZones[]; END.