RTTypesRemoteImpl.Mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Rovner, August 10, 1983 12:30 pm
Russ Atkinson (RRA) February 11, 1985 5:22:25 pm PST
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;
P R O C E D U R E S
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] = {
raises notMutable, internalTV, typeFault
If possible, this returns the REF which points to the value represented by the specified TV. Raises InternalTV if tv is embedded, NotVar if TVStatus[tv] # mutable.
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] = {
If possible, RemotePointerFromTV returns the LONG POINTER which points to the value represented by the specified TV. Raises Error[reason: internalTV] if tv is embedded and not word aligned. Raises NotVar if TVStatus[tv] # mutable.
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] = {
raises typeFault
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] = {
raises typeFault
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] =
{
raises typeFault
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] = {
raises typeFault
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] = {
all such tvs have the same (distinguished) type: gfhType
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]];
};