<> <> <> <> DIRECTORY AMBridge USING [TVToCardinal, WordSequenceRecord, WordSequence, RemoteRef, RemotePointer, RemoteSED, RemotePD, RemoteFrameHandle, RemoteGlobalFrameHandle, nilRemotePD, nilRemoteSED, TVToLC, TVForGFHReferent], AMTypes USING [Error, Class, UnderClass, TVType, TV, Status, Type], AtomPrivate USING [AtomRec], Basics USING [bitsPerWord], Rope USING [RopeRep], RTSymbolDefs USING [BodyIndex], RTSymbolOps USING [NullBTI], SafeStorage USING [nullType, fhType, gfhType, EquivalentTypes], RTTypesPrivate USING [TypedVariableRec, BitsForType, TypedVariableHead], RTTypesRemotePrivate USING [GetRemoteReferentType, GetRemoteProcedureType, GetRemoteSignalType, AcquireBTIFromRemoteFH, IsRemoteCatchFrame], WorldVM USING [CurrentIncarnation, Long, LocalWorld, World, Address]; RTTypesRemoteImpl: PROGRAM IMPORTS AMBridge, AMTypes, RTSymbolOps, SafeStorage, RTTypesPrivate, RTTypesRemotePrivate, WorldVM EXPORTS AMBridge SHARES Rope = BEGIN OPEN AMBridge, AMTypes, Basics, RTSymbolDefs, SafeStorage, RTTypesPrivate, RTTypesRemotePrivate, WorldVM; checkMutable: BOOL _ TRUE; <

> <<>> IsRemote: PUBLIC PROC [tv: TV] RETURNS [BOOLEAN] = { WITH tv SELECT FROM tvr: REF TypedVariableRec => WITH tvh: tvr.head SELECT FROM remoteReference, remotePointer, remoteGFH, remoteFH, copiedRemoteObject, remoteConstant => RETURN[TRUE]; ENDCASE; ENDCASE; RETURN[FALSE]; }; TVForRemoteReferent: PUBLIC PROC [remoteRef: RemoteRef, status: Status _ mutable] RETURNS [tv: TV] = { bitsForType: LONG CARDINAL; head: RTTypesPrivate.TypedVariableHead = [remoteReference[remoteRef: remoteRef]]; type: Type _ GetRemoteReferentType[remoteRef]; IF type = nullType THEN RETURN[NIL]; IF EquivalentTypes[type, CODE[AtomPrivate.AtomRec]] OR EquivalentTypes[type, CODE[Rope.RopeRep]] THEN ERROR Error[reason: typeFault, type: type]; bitsForType _ BitsForType[type].bft; IF bitsForType < bitsPerWord THEN tv _ NEW[TypedVariableRec _ [ referentType: [type], head: head, status: status, field: embedded[fd: [wordOffset: 0, extent: small[field: [bitFirst: bitsPerWord-bitsForType, bitCount: bitsForType]] ]] ]] ELSE tv _ NEW[TypedVariableRec _ [ referentType: [type], head: head, status: status, field: entire[]]]; }; RemoteRefFromTV: PUBLIC PROC [tv: TV] RETURNS [RemoteRef] = { <> <> WITH tv SELECT FROM tr: REF TypedVariableRec => { IF tr.tag # entire THEN GO TO internal; IF checkMutable AND tr.status # mutable THEN ERROR Error[reason: notMutable]; WITH head: tr.head SELECT FROM remoteReference => RETURN[head.remoteRef]; ENDCASE => GO TO internal}; ENDCASE => ERROR Error[reason: typeFault, type: nullType]; EXITS internal => ERROR Error[reason: internalTV]; }; TVForRemotePointerReferent: PUBLIC PROC [remotePointer: RemotePointer, type: Type, status: Status _ mutable] RETURNS [TV] = { bitsForType: LONG CARDINAL = BitsForType[type].bft; head: RTTypesPrivate.TypedVariableHead = [remotePointer[remotePointer: remotePointer]]; RETURN[ IF bitsForType < bitsPerWord THEN NEW[TypedVariableRec _ [ referentType: [type], head: head, status: status, field: embedded[fd: [wordOffset: 0, extent: small[field: [bitFirst: bitsPerWord - bitsForType, bitCount: bitsForType]]]]]] ELSE NEW[TypedVariableRec _ [referentType: [type], head: head, status: status, field: entire[]]]]; }; RemotePointerFromTV: PUBLIC PROC [tv: TV] RETURNS [RemotePointer] = { <> WITH tv SELECT FROM tr: REF TypedVariableRec => { IF checkMutable AND tr.status # mutable THEN ERROR Error[reason: notMutable]; WITH etr: tr SELECT FROM embedded => WITH fd: etr.fd SELECT FROM large => {rp: RemotePointer _ GetRemoteHeadPointer[tr]; rp.ptr _ rp.ptr + fd.wordOffset; RETURN[rp]}; small => IF fd.field.bitFirst = 0 THEN {rp: RemotePointer _ GetRemoteHeadPointer[tr]; rp.ptr _ rp.ptr + fd.wordOffset; RETURN[rp]} ELSE ERROR Error[reason: internalTV]; ENDCASE => ERROR; entire => RETURN[GetRemoteHeadPointer[tr]]; --may have been narrowed-- ENDCASE => ERROR} ENDCASE => ERROR Error[reason: typeFault, type: nullType]; }; GetRemoteHeadPointer: PROC [tr: REF TypedVariableRec] RETURNS [RemotePointer] = { <> WITH head: tr.head SELECT FROM remotePointer => RETURN[head.remotePointer]; remoteGFH => RETURN[ [ world: head.remoteGlobalFrameHandle.world, worldIncarnation: CurrentIncarnation[head.remoteGlobalFrameHandle.world], ptr: Long[world: head.remoteGlobalFrameHandle.world, addr: head.remoteGlobalFrameHandle.gfh]] ]; remoteFH => RETURN[ [ world: head.remoteFrameHandle.world, worldIncarnation: CurrentIncarnation[head.remoteFrameHandle.world], ptr: Long[world: head.remoteFrameHandle.world, addr: head.remoteFrameHandle.fh]] ]; ENDCASE => ERROR Error[reason: typeFault, type: nullType]; }; TVForRemoteProc: PUBLIC PROC [remotePD: RemotePD] RETURNS [TV] = { RETURN[TVForRemotePD[remotePD]]; }; TVForRemotePD: PUBLIC PROC [remotePD: RemotePD] RETURNS [TV] = { ws: WordSequence _ NEW[WordSequenceRecord[1]]; ws[0] _ LOOPHOLE[remotePD.pd, CARDINAL]; RETURN[NEW[TypedVariableRec _ [referentType: [GetRemoteProcedureType[remotePD]], head: [remoteConstant [world: remotePD.world, worldIncarnation: CurrentIncarnation[remotePD.world]]], status: const, field: constant[value: ws]]]]; }; TVForRemoteSignal: PUBLIC PROC [remoteSED: RemoteSED] RETURNS [TV] = { RETURN[TVForRemoteSED[remoteSED]]; }; TVForRemoteSED: PUBLIC PROC [remoteSED: RemoteSED] RETURNS [TV--signal, error--] = { ws: WordSequence _ NEW[WordSequenceRecord[1]]; ws[0] _ LOOPHOLE[remoteSED.sed, CARDINAL]; RETURN[NEW[TypedVariableRec _ [referentType: [GetRemoteSignalType[remoteSED]], head: [remoteConstant [world: remoteSED.world, worldIncarnation: CurrentIncarnation[remoteSED.world]]], status: const, field: constant[value: ws]]]]; }; TVToRemoteProc: PUBLIC PROC [tv: TV--procedure, program--] RETURNS [RemotePD] = { <> RETURN[TVToRemotePD[tv]]; }; TVToRemotePD: PUBLIC PROC [tv: TV--procedure, program--] RETURNS [RemotePD] = { SELECT UnderClass[TVType[tv]] FROM nil => RETURN[nilRemotePD]; program, procedure => NULL; ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]]; RETURN[[world: GetWorld[tv], worldIncarnation: CurrentIncarnation[GetWorld[tv]], pd: TVToCardinal[tv]]]; }; TVToRemoteSignal: PUBLIC PROC [tv: TV] RETURNS [RemoteSED] = { <> RETURN[TVToRemoteSED[tv]]; }; TVToRemoteSED: PUBLIC PROC [tv: TV] RETURNS [RemoteSED] = { SELECT UnderClass[TVType[tv]] FROM signal, error => NULL; nil => RETURN[nilRemoteSED]; ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]]; RETURN[[world: GetWorld[tv], worldIncarnation: CurrentIncarnation[GetWorld[tv]], sed: TVToCardinal[tv]]]; }; TVForRemoteFrame: PUBLIC PROC [remoteFrameHandle: RemoteFrameHandle, evalStack: WordSequence _ NIL, return: BOOL _ FALSE, contextPC: BOOL _ FALSE] RETURNS [ans: TV _ NIL] = { bti: BodyIndex; isCatchFrame: BOOLEAN _ FALSE; IF remoteFrameHandle.fh = 0 THEN RETURN[NIL]; bti _ AcquireBTIFromRemoteFH[remoteFrameHandle, contextPC];-- returns BTNull if no symbols IF NOT RTSymbolOps.NullBTI[bti] THEN [isCatchFrame, bti] _ IsRemoteCatchFrame[remoteFrameHandle, bti]; RETURN[NEW[TypedVariableRec _ [referentType: [fhType], head: [remoteFH[remoteFrameHandle: remoteFrameHandle, evalStack: evalStack, bti: bti, isCatchFrame: isCatchFrame, return: return, contextPC: contextPC]], status: mutable, field: entire[]]]]}; RemoteFHFromTV: PUBLIC PROC [tv: TV] RETURNS [RemoteFrameHandle] = { <> WITH tv SELECT FROM tvr: REF TypedVariableRec => WITH tvh: tvr.head SELECT FROM remoteFH => RETURN[tvh.remoteFrameHandle]; ENDCASE => ERROR Error[reason: typeFault, type: fhType]; ENDCASE => ERROR Error[reason: typeFault, type: fhType]; }; TVForRemoteGFHReferent: PUBLIC PROC [remoteGlobalFrameHandle: RemoteGlobalFrameHandle] RETURNS [TV] = { <> IF remoteGlobalFrameHandle.gfh = 0 THEN RETURN[NIL]; IF remoteGlobalFrameHandle.world = WorldVM.LocalWorld[] THEN RETURN[TVForGFHReferent[LOOPHOLE[remoteGlobalFrameHandle.gfh]]]; RETURN[NEW[TypedVariableRec _ [referentType: [gfhType], head: [remoteGFH[remoteGlobalFrameHandle: remoteGlobalFrameHandle]], status: mutable, field: entire[]]]]}; RemoteGFHFromTV: PUBLIC PROC [tv: TV] RETURNS [RemoteGlobalFrameHandle] = { WITH tv SELECT FROM tvr: REF TypedVariableRec => WITH tvh: tvr.head SELECT FROM remoteGFH => RETURN[tvh.remoteGlobalFrameHandle]; ENDCASE => GO TO oops; ENDCASE => GO TO oops; EXITS oops => ERROR Error[reason: typeFault, type: gfhType] }; GetWorld: PUBLIC PROC [tv: TV] RETURNS [World] = { WITH tv SELECT FROM tvr: REF TypedVariableRec => WITH tvh: tvr.head SELECT FROM remoteReference => RETURN[tvh.remoteRef.world]; remotePointer => RETURN[tvh.remotePointer.world]; remoteFH => RETURN[tvh.remoteFrameHandle.world]; remoteGFH => RETURN[tvh.remoteGlobalFrameHandle.world]; copiedRemoteObject => RETURN[tvh.world]; remoteConstant => RETURN[tvh.world]; ENDCASE => GO TO local; ENDCASE => GO TO local; EXITS local => RETURN [LocalWorld[]]; }; GetWorldIncarnation: PUBLIC PROC [tv: TV] RETURNS [LONG CARDINAL] = { IF IsRemote[tv] THEN WITH tv SELECT FROM tvr: REF TypedVariableRec => WITH tvh: tvr.head SELECT FROM remoteReference => RETURN[tvh.remoteRef.worldIncarnation]; remotePointer => RETURN[tvh.remotePointer.worldIncarnation]; remoteFH => RETURN[tvh.remoteFrameHandle.worldIncarnation]; remoteGFH => RETURN[tvh.remoteGlobalFrameHandle.worldIncarnation]; copiedRemoteObject => RETURN[tvh.worldIncarnation]; remoteConstant => RETURN[tvh.worldIncarnation]; ENDCASE => ERROR; ENDCASE => ERROR ELSE RETURN[CurrentIncarnation[LocalWorld[]]]; }; TVToRemoteRef: PUBLIC PROC [tv: TV] RETURNS [RemoteRef] = { IF GetWorld[tv] = LocalWorld[] THEN ERROR Error[reason: typeFault, msg: "Can't get a remote REF for a local object"]; SELECT UnderClass[TVType[tv]] FROM atom, rope, list, ref => RETURN[[world: GetWorld[tv], worldIncarnation: GetWorldIncarnation[tv], ref: LOOPHOLE[TVToLC[tv], WorldVM.Address]]]; ENDCASE => ERROR Error[reason: typeFault, type: TVType[tv]]; }; END.