RTTypesRemoteImpl.Mesa
last modified on August 10, 1983 12:30 pm by Paul Rovner
DIRECTORY
AMBridge
USING[TVToCardinal, WordSequenceRecord, WordSequence, RemoteRef,
RemotePointer, RemoteSED, RemotePD, RemoteFrameHandle,
RemoteGlobalFrameHandle, nilRemotePD, nilRemoteSED, TVToLC,
TVForGFHReferent],
AMTypes
USING[Error, Class, TypeClass, UnderType, TVType, TypedVariable, Status, Type,
TV],
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;
P R O C E D U R E S
IsRemote:
PUBLIC
PROC[tv: TypedVariable]
RETURNS[
BOOLEAN] =
{
WITH tv
SELECT
FROM
tvr:
REF TypedVariableRec =>
WITH tvh: tvr.head
SELECT
FROM
remoteReference, remotePointer, remoteGFH,
remoteFH, copiedRemoteObject, remoteConstant
=>
IF GetRemoteWorld[tv] = WorldVM.LocalWorld[]
THEN ERROR
ELSE RETURN[TRUE];
ENDCASE => RETURN[FALSE];
ENDCASE => RETURN[FALSE]};
TVForRemoteReferent:
PUBLIC
PROC[remoteRef: RemoteRef, status: Status ← mutable]
RETURNS[tv: TypedVariable] =
{ 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[]]];
};
raises notMutable, internalTV, typeFault
RemoteRefFromTV:
PUBLIC
PROC[tv: TypedVariable]
RETURNS[RemoteRef] =
{
WITH tv
SELECT
FROM
tr:
REF TypedVariableRec =>
{
IF tr.tag # entire
THEN ERROR Error[reason: internalTV]
ELSE
IF checkMutable
AND tr.status # mutable
THEN ERROR Error[reason: notMutable]
ELSE
WITH head: tr.head
SELECT
FROM
remoteReference => RETURN[head.remoteRef];
ENDCASE => ERROR Error[reason: internalTV]};
ENDCASE => ERROR Error[reason: typeFault, type: nullType]};
If possible, this returns the REF which points to the value represented by the specified
TypedVariable. Raises InternalTV if tv is embedded, NotVar if TVStatus[tv] # mutable.
TVForRemotePointerReferent:
PUBLIC
PROC[remotePointer: RemotePointer,
type: Type,
status: Status ← mutable]
RETURNS[TypedVariable] =
{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[]]]]};
If possible, RemotePointerFromTV returns the LONG POINTER which points
to the value represented by the specified TypedVariable.
Raises Error[reason: internalTV] if tv is embedded and not word aligned
Raises NotVar if TVStatus[tv] # mutable.
raises notMutable, internalTV, typeFault
RemotePointerFromTV:
PUBLIC
PROC[tv: TypedVariable]
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]};
raises typeFault
GetRemoteHeadPointer:
PROC[tr:
REF TypedVariableRec]
RETURNS[RemotePointer] =
{
RETURN[(
WITH head: tr.head
SELECT
FROM
remotePointer => head.remotePointer,
remoteGFH => [world: head.remoteGlobalFrameHandle.world,
worldIncarnation:
CurrentIncarnation[head.remoteGlobalFrameHandle.world],
ptr: Long[world: head.remoteGlobalFrameHandle.world,
addr: head.remoteGlobalFrameHandle.gfh]],
remoteFH => [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[TypedVariable
--procedure--] =
{RETURN[TVForRemotePD[remotePD]]};
TVForRemotePD:
PUBLIC
PROC[remotePD: RemotePD]
RETURNS[TypedVariable
--procedure--] =
{ws: WordSequence;
ws ← 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[TypedVariable--signal, error--] = {RETURN[TVForRemoteSED[remoteSED]]};
TVForRemoteSED:
PUBLIC
PROC[remoteSED: RemoteSED]
RETURNS[TypedVariable--signal, error--] =
{ws: WordSequence;
ws ← 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]]]]};
raises typeFault
TVToRemoteProc:
PUBLIC
PROC[tv: TypedVariable
--procedure, program--]
RETURNS[RemotePD] = {RETURN[TVToRemotePD[tv]]};
TVToRemotePD:
PUBLIC
PROC[tv: TypedVariable
--procedure, program--]
RETURNS[RemotePD] =
{
SELECT TypeClass[UnderType[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]]]};
raises typeFault
TVToRemoteSignal:
PUBLIC
PROC[tv: TypedVariable]
RETURNS[RemoteSED] =
{RETURN[TVToRemoteSED[tv]]};
TVToRemoteSED:
PUBLIC
PROC[tv: TypedVariable]
RETURNS[RemoteSED] =
{
SELECT TypeClass[UnderType[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]]]};
MOVE
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[]]]]};
raises typeFault
RemoteFHFromTV:
PUBLIC
PROC[tv: TypedVariable]
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]};
all such tvs have the same (distinguished) type: gfhType
TVForRemoteGFHReferent:
PUBLIC
PROC[remoteGlobalFrameHandle: RemoteGlobalFrameHandle]
RETURNS[TypedVariable] =
{
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[]]]]};
raises typeFault
RemoteGFHFromTV:
PUBLIC
PROC[tv: TypedVariable]
RETURNS[RemoteGlobalFrameHandle] =
{
WITH tv
SELECT
FROM
tvr:
REF TypedVariableRec =>
WITH tvh: tvr.head
SELECT
FROM
remoteGFH => RETURN[tvh.remoteGlobalFrameHandle];
ENDCASE => ERROR Error[reason: typeFault, type: gfhType];
ENDCASE => ERROR Error[reason: typeFault, type: gfhType]};
GetRemoteWorld:
PROC[tv: TypedVariable]
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 => ERROR;
ENDCASE => ERROR;
};
GetWorld:
PUBLIC
PROC[tv: TypedVariable]
RETURNS[World] =
{
IF IsRemote[tv]
THEN RETURN[GetRemoteWorld[tv]]
ELSE RETURN[LocalWorld[]];
};
GetWorldIncarnation:
PUBLIC
PROC[tv: TypedVariable]
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: TypedVariable]
RETURNS[RemoteRef] =
{
IF GetWorld[tv] = LocalWorld[]
THEN ERROR Error[reason: typeFault, msg: "Can't get a remote REF for a local object"];
SELECT TypeClass[UnderType[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.