-- RTTypesRemoteImpl.Mesa
-- last modified on December 21, 1982 9:18 am by Paul Rovner

DIRECTORY
AMBridge USING[TVToCardinal, WordSequenceRecord, WordSequence, RemoteRef,
RemotePointer, RemoteSED, RemotePD, RemoteFrameHandle,
RemoteGlobalFrameHandle, nilRemotePD, nilRemoteSED, TVToLC],
AMTypes USING[Error, Class, TypeClass, UnderType, TVType, TypedVariable, Status, Type,
TV],
AtomsPrivate USING[AtomRec],
Environment USING[bitsPerWord],
Rope USING[RopeRep],
RTCommon USING[ShortenLongCardinal],
RTSymbols USING[BodyIndex, nullBodyIndex],
RTTypesBasic USING[nullType, fhType, gfhType, EquivalentTypes],
RTTypesPrivate USING[TypedVariableRec, GetTVZones, BitsForType],
RTTypesRemotePrivate USING[GetRemoteReferentType, GetRemoteProcedureType,
GetRemoteSignalType, AcquireBTIFromRemoteFH,
IsRemoteCatchFrame],
WorldVM USING[CurrentIncarnation, Long, LocalWorld, World, Address];

RTTypesRemoteImpl: PROGRAM
IMPORTS AMBridge, AMTypes, RTCommon, RTTypesBasic, RTTypesPrivate,
RTTypesRemotePrivate, WorldVM
EXPORTS AMBridge
SHARES Rope

= BEGIN OPEN AMBridge, AMTypes, Environment, RTCommon, RTSymbols, RTTypesBasic,
RTTypesPrivate, RTTypesRemotePrivate, WorldVM;

tvZone: ZONE;
tvPrefixedZone: ZONE;

-- 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[TypedVariable] =
{ type: Type;
bitsForType: LONG CARDINAL;
type ← GetRemoteReferentType[remoteRef];

IF type = nullType THEN RETURN[NIL];

IF RTTypesBasic.EquivalentTypes[type, CODE[AtomsPrivate.AtomRec]]
OR RTTypesBasic.EquivalentTypes[type, CODE[Rope.RopeRep]]
THEN ERROR Error[reason: typeFault, type: type];


bitsForType ← BitsForType[type].bft;

RETURN[
IF bitsForType < bitsPerWord
THEN
tvZone.NEW[TypedVariableRec ←
[referentType: [type],
head: [remoteReference[remoteRef: remoteRef]],
status: status,
field: embedded[fd: [wordOffset: 0,
extent: small[field: [bitFirst: bitsPerWord-bitsForType,
bitCount: ShortenLongCardinal[bitsForType]]]]]]]
ELSE tvZone.NEW[TypedVariableRec ← [referentType: [type],
head: [remoteReference[remoteRef: remoteRef]],
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 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 ← BitsForType[type].bft;
RETURN[
IF bitsForType < bitsPerWord
THEN
tvZone.NEW[TypedVariableRec ←
[referentType: [type],
head: [remotePointer[remotePointer: remotePointer]],
status: status,
field: embedded[fd: [wordOffset: 0,
extent: small[field: [bitFirst: bitsPerWord-bitsForType,
bitCount: ShortenLongCardinal[bitsForType]]]]]]]
ELSE tvZone.NEW[TypedVariableRec ← [referentType: [type],
head: [remotePointer[remotePointer: remotePointer]],
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 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 bti # nullBodyIndex
THEN [isCatchFrame, bti] ← IsRemoteCatchFrame[remoteFrameHandle, bti];
RETURN[tvZone.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];
RETURN[tvZone.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]];
};


-- START HERE
[qz: tvZone, pz: tvPrefixedZone] ← GetTVZones[];

END.