-- RTTypedFramesImpl.Mesa -- last modified on December 20, 1982 5:37 pm by Paul Rovner DIRECTORY AMBridge USING[TVToCardinal, WordSequence, WordSequenceRecord, IsRemote, RemotePD, RemoteSED, TVToRemoteSignal, TVToRemoteProc, TVForRemoteProc, RemoteGlobalFrameHandle, RemoteFrameHandle, RemoteFHFromTV, TVForRemoteGFHReferent, TVForRemoteSignal, TVForRemoteFrame, RemoteGFHFromTV, nilRemoteFrameHandle, nilRemoteGlobalFrameHandle, GetWorld, nilRemotePD], AMTypes USING[TypeClass, TVType, Range, TypedVariable, Error, Domain, Size, UnderType, IndexToTV, Index, TV, TVStatus], Mopcodes USING[zLADRB], PrincOps USING[EPRange, SignalDesc, BytePC, CSegPrefix, GFTIndex, FrameHandle, ControlLink, localbase, ProcDesc, NullLink, UnboundLink, GlobalFrameHandle, GlobalFrame, StateVector], PrincOpsRuntime USING[GetFrame, GFT, GFTItem], Rope USING[ROPE], RTLoader USING[GetGFRCType], RTSD USING[SD, sGetCanonicalProcType, sGetCanonicalSignalType], RTSymbols USING[AcquireSTBFromGFH, EnumerateRecordIseis, SymbolTableBase, ReleaseSTB, AcquireType, AcquireRope, CallableBodyIndex, BlockContextLevel, BodyIndex, nullBodyIndex, rootBodyIndex, SymbolIndex, SymbolIdIndex, SymbolConstructorIndex, nullSymbolIndex, SymbolRecordIndex, outerContextLevel], RTTypesBasic USING[Type, nullType, fhType, gfhType, GetCanonicalType], RTTypesPrivate USING[TypedVariableRec, GetTVZones, RecordComponentISEI, BuildRecordFieldDescriptor, GetIdConstantValue, FieldDescriptor, GFHToName], RTTypesRemotePrivate USING[UnwindRemoteIndirectProcDesc, AcquireSTBFromRemoteGFH, GetRemoteGFHandle, GetRemoteGFHeader, GetRemoteFrameHeader, AcquireCBTHandleFromRemotePD, ValidateRemoteFrame, RemoteSignalValues, RemoteGFHToName], Runtime USING[ValidateFrame, ValidateGlobalFrame, GetTableBase], RuntimeInternal USING[SendMsgSignal], SDDefs USING[SD, sSignal], WorldVM USING[CurrentIncarnation, Long, ShortAddress, World]; RTTypedFramesImpl: PROGRAM IMPORTS AMTypes, PrincOpsRuntime, RTLoader, RTSymbols, AMBridge, RTTypesBasic, RTTypesPrivate, RTTypesRemotePrivate, Runtime, RuntimeInternal, WorldVM EXPORTS AMTypes, AMBridge, RTTypesPrivate = BEGIN OPEN Rope, AMTypes, RTTypesPrivate, RTSymbols, AMBridge, RTTypesBasic, 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 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]]]]}; 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]]]]}; -- MOVE 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, stb.seb[stb.bb[cbti].id].hash ! UNWIND => ReleaseSTB[stb]]; ReleaseSTB[stb]; RETURN[ans]}; -- MOVE SEDToName: PUBLIC PROC[sed: PrincOps.SignalDesc] RETURNS[ans: ROPE] = { gfh: PrincOps.GlobalFrameHandle; stb: SymbolTableBase; proc: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOLEAN] = { tsei: 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 {ans _ AcquireRope[stb, stb.seb[isei].hash]; 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 _ stb.bb[rootBodyIndex].type; ans _ NIL; IF sei # nullSymbolIndex THEN [] _ EnumerateRecordIseis[stb, sei, proc ! UNWIND => ReleaseSTB[stb]]; ReleaseSTB[stb]}; -- 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]]}; -- 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]]}; -- MOVE 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 StaticParent: PUBLIC SAFE PROC[tv: TypedVariable--procedure--] RETURNS[TypedVariable--procedure--] = TRUSTED {IF IsRemote[tv] THEN { pd: RemotePD _ nilRemotePD; stb: SymbolTableBase; bti: BodyIndex; pd _ UnwindRemoteIndirectProcDesc[TVToRemoteProc[tv]]; IF pd.pd = PrincOps.NullLink THEN RETURN[NIL]; IF TypeClass[UnderType[TVType[tv]]] # procedure THEN ERROR Error[reason: typeFault, type: TVType[tv]]; [stb, bti] _ AcquireCBTHandleFromRemotePD[pd]; FOR bti _ bti, stb.ParentBti[bti] UNTIL bti = nullBodyIndex DO WITH stb.bb[bti] SELECT FROM Callable => { sppd: PrincOps.ProcDesc _ PrincOps.ControlLink[procedure[gfi: 0, ep: 0, tag: TRUE]]; 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]]]}; ENDCASE; ENDLOOP; ReleaseSTB[stb]; RETURN[NIL]} ELSE { pd: PrincOps.ProcDesc; stb: SymbolTableBase; bti: BodyIndex; pd _ UnwindIndirectProcDesc[LOOPHOLE[TVToProc[tv], PrincOps.ControlLink]]; IF pd = PrincOps.NullLink THEN RETURN[NIL]; IF TypeClass[UnderType[TVType[tv]]] # procedure THEN ERROR Error[reason: typeFault, type: TVType[tv]]; [stb, bti] _ AcquireCBTHandleFromPD[pd]; FOR bti _ bti, stb.ParentBti[bti] UNTIL bti = nullBodyIndex DO WITH stb.bb[bti] SELECT FROM Callable => { sppd: PrincOps.ProcDesc _ PrincOps.ControlLink[procedure[gfi: 0, ep: 0, tag: TRUE]]; 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]]]}; ENDCASE; ENDLOOP; ReleaseSTB[stb]; RETURN[NIL]}}; -- end StaticParent -- 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 bti = nullBodyIndex THEN {name: ROPE; fh _ RemoteFHFromTV[tv]; 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 bti = nullBodyIndex 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, stb.ParentBti[bti] UNTIL bti = nullBodyIndex DO WITH stb.bb[bti] SELECT FROM Callable => {sppd: PrincOps.ProcDesc _ LOOPHOLE[PrincOps.UnboundLink, PrincOps.ProcDesc]; 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]]]}; ENDCASE; 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 bti = nullBodyIndex -- no symbols for this localFrame TV THEN 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, stb.ParentBti[bti] UNTIL bti = nullBodyIndex DO WITH stb.bb[bti] SELECT FROM Callable => {sppd: PrincOps.ProcDesc _ LOOPHOLE[PrincOps.UnboundLink, PrincOps.ProcDesc]; -- 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]]]}; ENDCASE; 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[SignalValues[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 = stb.seb[isei].idType; csei: SymbolConstructorIndex _ stb.UnderType[sei]; bitsForType: CARDINAL _ stb.BitsForType[csei]; -- bits for the value in the field fieldBits: CARDINAL _ stb.seb[isei].idInfo; -- bits for the field fieldBitOffset: CARDINAL _ stb.seb[isei].idValue; -- bit offset of the field within the local frame cType: Type _ AcquireType[stb, sei]; IF stb.seb[isei].constant THEN 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 stb.seb[isei].immutable 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 IF IsRemote[tv] THEN [world: world, message: message] _ RemoteSignalValues[tv] ELSE message _ SignalValues[tv].message; -- 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 -- break up and MOVE 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 _ nullBodyIndex; evalStack: WordSequence _ NIL; isCatchFrame: BOOLEAN; remoteFH: RemoteFrameHandle _ nilRemoteFrameHandle; level, nlevel: BlockContextLevel; return, contextPC: BOOL; WITH th: rtr.head SELECT FROM remoteFH => {bti _ th.bti; evalStack _ evalStack; isCatchFrame _ th.isCatchFrame; remoteFH _ th.remoteFrameHandle; return _ th.return; contextPC _ th.contextPC}; ENDCASE => ERROR; IF bti = nullBodyIndex THEN {ReleaseSTB[stb]; ERROR Error[reason: typeFault, type: TVType[tv]]}; level _ stb.bb[bti].level; WITH stb.bb[bti] SELECT FROM Callable => {ReleaseSTB[stb]; RETURN[NIL]}; ENDCASE; bti _ stb.ParentBti[bti]; IF bti = rootBodyIndex THEN bti _ nullBodyIndex; IF bti = nullBodyIndex THEN nlevel _ level ELSE nlevel _ stb.bb[bti].level; ReleaseSTB[stb]; IF isCatchFrame AND nlevel # level THEN {-- when the level changes inside of a catchPhrase -- then we have to go through the static link (local 0) -- to get to the real frame for this bti -- NOTE: the static link points at local 0, not the frame base tv _ TVForRemoteFrame [[world: remoteFH.world, worldIncarnation: CurrentIncarnation[remoteFH.world], fh: LOOPHOLE[GetRemoteFrameHeader[remoteFH].staticlink - PrincOps.localbase, WorldVM.ShortAddress]]]; rtr _ NARROW[tv]; WITH th: rtr.head SELECT FROM remoteFH => {-- quick kill if we are already at the right bti -- otherwise get the new value of isCatchFrame IF bti = th.bti THEN RETURN[tv]; isCatchFrame _ th.isCatchFrame}; ENDCASE => ERROR}; -- The Callable bt entry also describes the outer block locals. If it is the enclosing -- body for the incoming tv, return it. Otherwise the locals are not available. 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 XXX fix above case { 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 bti = nullBodyIndex 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 bti = nullBodyIndex 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 bti = rootBodyIndex -- 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 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 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 }; WITH stb.bb[bti] SELECT FROM Callable => -- No more enclosing blocks: this one is callable and not a catch frame IF stb.bb[bti].level <= outerContextLevel -- TRUE => not a nested procedure THEN {ReleaseSTB[stb]; RETURN[NIL]} ELSE { -- this is a frame for a nested procedure ReleaseSTB[stb]; RETURN[TVForFrame [LOOPHOLE[FHFromTV[tv].staticlink - PrincOps.localbase, PrincOps.FrameHandle]]]; }; ENDCASE; level _ stb.bb[bti].level; bti _ stb.ParentBti[bti]; -- A Callable bt entry also describes the outer block locals IF bti = rootBodyIndex 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 bti # nullBodyIndex AND level # stb.bb[bti].level 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 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 bti = nullBodyIndex OR bti = rootBodyIndex THEN {ReleaseSTB[stb]; RETURN[NIL]}; IF stb.bb[bti].type = nullSymbolIndex THEN {ReleaseSTB[stb]; RETURN[NIL]}; type _ AcquireType[stb, stb.bb[bti].type ! 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 bti = nullBodyIndex OR bti = rootBodyIndex THEN {ReleaseSTB[stb]; RETURN[NIL]}; IF stb.bb[bti].type = nullSymbolIndex THEN {ReleaseSTB[stb]; RETURN[NIL]}; type _ AcquireType[stb, stb.bb[bti].type ! 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[GetRemoteFrameHeader[fh].returnlink, WorldVM.ShortAddress]] ! ANY => GOTO nope]; EXITS nope => RETURN[NIL]}; RETURN[TVForRemoteFrame [[world: fh.world, worldIncarnation: CurrentIncarnation[fh.world], fh: LOOPHOLE[GetRemoteFrameHeader[fh].returnlink, WorldVM.ShortAddress]]]]} ELSE { fh: PrincOps.FrameHandle = FHFromTV[tv]; IF fh = NIL THEN RETURN[NIL]; {Runtime.ValidateFrame[fh.returnlink ! ANY => GOTO nope]; EXITS nope => RETURN[NIL]}; RETURN[TVForFrame[fh.returnlink.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, stb.bb[rootBodyIndex].type ! 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, stb.bb[rootBodyIndex].type ! UNWIND => ReleaseSTB[stb]]; ReleaseSTB[stb]}; RETURN[tvZone.NEW[TypedVariableRec _ [referentType: [type], head: tvr.head, status: mutable, field: entire[]]]]}}; -- 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]]}; -- MOVE GetProcedureType: PROC[pd: PrincOps.ProcDesc] RETURNS[type: Type] = { stb: SymbolTableBase; cbti: CallableBodyIndex; [stb, cbti] _ AcquireCBTHandleFromPD[pd]; type _ AcquireType[stb, stb.bb[cbti].ioType ! UNWIND => ReleaseSTB[stb]]; ReleaseSTB[stb]}; STInfoToEPN: PROC[cl: PrincOps.SignalDesc] RETURNS[CARDINAL] = {RETURN[(cl.gfi - 1) * PrincOps.EPRange + cl.ep]}; -- MOVE GetSignalType: PROC[sed: PrincOps.SignalDesc] RETURNS[type: Type] = { proc: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOLEAN] = { tsei: 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[stb, stb.seb[isei].idType]; RETURN[TRUE]} ELSE RETURN[FALSE]}; stb: SymbolTableBase; -- START 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, stb.bb[rootBodyIndex].type, proc ! UNWIND => ReleaseSTB[stb]]; ReleaseSTB[stb]}; -- 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? FOR bti: BodyIndex _ th.bti, stb.SonBti[bti] UNTIL bti = nullBodyIndex DO IF bti = ee THEN RETURN[TRUE]; ENDLOOP; }; ENDCASE => ERROR; }; -- MOVE 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]}; 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: GetCBTI[stb, epn]]}; -- finds the cbti for the specified entrypoint -- MOVE GetCBTI: PUBLIC PROC[stb: SymbolTableBase, epn: CARDINAL] RETURNS[cbti: CallableBodyIndex] = { IsThisIt: PROC[bti: BodyIndex] RETURNS[stop: BOOLEAN] = { WITH stb.bb[bti] SELECT FROM Callable => RETURN[(NOT inline) AND (epn = entryIndex)]; ENDCASE => RETURN[FALSE]}; RETURN[LOOPHOLE[stb.EnumerateBodies[rootBodyIndex, IsThisIt], CallableBodyIndex]]}; -- finds the bti for the smallest enclosing block -- MOVE ConvertCbti: PUBLIC PROC[lastBti: BodyIndex, pc, start: PrincOps.BytePC, base: SymbolTableBase] RETURNS[bti: BodyIndex] = { bodyStart: PrincOps.BytePC; bti _ lastBti; DO FOR lastBti _ base.SonBti[bti], base.SiblingBti[lastBti] UNTIL lastBti = 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] = { GetMax: PROC [bti: BodyIndex] RETURNS [stop: BOOLEAN] = {WITH stb.bb[bti] SELECT FROM Callable => IF ~inline THEN max _ MAX[max, entryIndex]; ENDCASE; RETURN[FALSE]}; max _ 0; [] _ stb.EnumerateBodies[rootBodyIndex, GetMax]}; -- 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 _ frame.returnlink.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 _ 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 _ 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; GetCanonicalProcType: PROC[proc: UNSPECIFIED] RETURNS[Type] = { pd: PrincOps.ProcDesc = UnwindIndirectProcDesc[proc]; IF pd = PrincOps.NullLink THEN RETURN[nullType]; RETURN[RTTypesBasic.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.