DIRECTORY
CrRPC USING [BulkDataSink, BulkDataSource, CallProc, ClientProcs, ErrorReason, GetCARD, GetCARDINAL, GetCHAR, GetHAlign, GetHWORD, Handle, HandleClass, HandleKind, MarshallProcs, Object, PutCARDINAL, PutCHAR, PutHAlign, SeqCARDINAL, SeqCARDINALObject, SeqHWORD, SeqHWORDObject, ServerProc, ServerProcs, UnsafeGetBlock, UnsafePutBlock],
CrRPCFriends USING [CreateClientHandleProc, CreateListenerProc],
Process USING [Detach, priorityBackground, SetPriority],
RefTab USING [Create, Fetch, Ref, Store],
RefText USING [AppendChar, ObtainScratch, ReleaseScratch],
Rope USING [FromRefText, InlineFetch, Length, ROPE],
SafeStorage USING [CantEstablishFinalization, EnableFinalization, EstablishFinalization, FinalizationQueue, FQNext, NewFQ, ReEstablishFinalization],
XNS USING [Address, Socket];
CrRPCImpl:
CEDAR
MONITOR
IMPORTS CrRPC, Process, RefTab, RefText, Rope, SafeStorage
EXPORTS CrRPC, CrRPCFriends
~ {
CARD: TYPE ~ LONG CARDINAL;
ROPE: TYPE ~ Rope.ROPE;
Handle:
TYPE ~ CrRPC.Handle;
Errors
Error:
PUBLIC
ERROR [
h: Handle,
errorReason: CrRPC.ErrorReason,
text: ROPE] ~ CODE;
Create / Set Parameters / Destroy for Client Handles
CreateClientHandleProcValue: TYPE ~ REF CreateClientHandleProcValueObject;
CreateClientHandleProcValueObject:
TYPE ~
RECORD [
createClientHandleProc: CrRPCFriends.CreateClientHandleProc ];
createClientHandleProcTable: RefTab.Ref ← RefTab.Create[];
RegisterCreateClientHandleProc:
PUBLIC
PROC [
class:
ATOM, proc: CrRPCFriends.CreateClientHandleProc]
N.B. This would need to be an ENTRY proc except that the RefTab package handles concurrent clients.
~ {
[] ← RefTab.Store[x~createClientHandleProcTable, key~class, val~NEW[CreateClientHandleProcValueObject ← [proc]]];
};
LookupCreateClientHandleProc:
PROC [class:
ATOM]
RETURNS [CrRPCFriends.CreateClientHandleProc] ~ {
N.B. This would need to be an ENTRY proc except that the RefTab package handles concurrent clients.
found: BOOL;
val: REF;
[found, val] ← RefTab.Fetch[x~createClientHandleProcTable, key~class];
IF found
THEN RETURN [NARROW[val, CreateClientHandleProcValue].createClientHandleProc]
ELSE RETURN [NIL];
};
CreateClientHandle:
PUBLIC
PROC [
class: ATOM, remote: XNS.Address, timeoutMsec: INT
] RETURNS [CrRPC.Handle] ~ {
proc: CrRPCFriends.CreateClientHandleProc ~ LookupCreateClientHandleProc[class];
IF proc = NIL THEN ERROR Error[NIL, unknownClass, NIL];
RETURN [proc[remote, timeoutMsec]]
};
SetRemote:
PUBLIC
PROC [h: Handle, remote:
XNS.Address]
RETURNS [Handle] ~ {
IF h.kind # client THEN ERROR Error[h, notClientHandle, "not client handle"];
RETURN [ (NARROW[h.procs, REF CrRPC.ClientProcs]).setRemote[h, remote] ] };
SetTimeout:
PUBLIC
PROC [h: Handle, timeoutMsec:
INT]
RETURNS [Handle] ~ {
IF h.kind # client THEN ERROR Error[h, notClientHandle, "not client handle"];
RETURN [ (NARROW[h.procs, REF CrRPC.ClientProcs]).setTimeout[h, timeoutMsec] ] };
SetHops:
PUBLIC
PROC [h: Handle, low, high:
NAT]
RETURNS [Handle] ~ {
clientProcs: REF CrRPC.ClientProcs;
IF h.kind # client THEN ERROR Error[h, notClientHandle, "not client handle"];
clientProcs ← NARROW[h.procs];
IF clientProcs.setHops =
NIL
THEN ERROR Error[h, notBroadcastHandle, "not broadcast handle"];
RETURN [ clientProcs.setHops[h, low, high] ] };
DestroyClientHandle:
PUBLIC
PROC [h: Handle] ~ {
IF h.kind # client THEN ERROR Error[h, notClientHandle, "not client handle"];
(NARROW[h.procs, REF CrRPC.ClientProcs]).destroy[h] };
Calling a Remote Procedure
Call:
PUBLIC CrRPC.CallProc ~ {
clientProcs: REF CrRPC.ClientProcs;
IF h.kind # client THEN ERROR Error[h, notClientHandle, "not client handle"];
clientProcs ← NARROW[h.procs];
clientProcs.call [h, remotePgm, remotePgmVersion, remoteProc,
putArgs, getResults, getError];
};
Create / Destroy for Servers
ServerValue: TYPE ~ REF ServerValueObject;
ServerValueObject:
TYPE ~
RECORD [
next: ServerValue,
pgm: CARD,
pgmVersion: CARDINAL,
serverProc: CrRPC.ServerProc];
serverTableSize: CARDINAL ~ 101; -- a modest prime
ServerTable: TYPE ~ REF ServerTableObject;
ServerTableObject:
TYPE ~
RECORD [
values: ARRAY [0..serverTableSize) OF ServerValue];
serverTable: ServerTable ←
NEW[ServerTableObject ← [
ALL[
NIL]]];
HashServer:
INTERNAL
PROC [pgm:
CARD, pgmVersion:
CARDINAL]
RETURNS[index:
CARD] ~
INLINE {
index ← ((pgm * 8) + CARD[pgmVersion]) MOD CARD[serverTableSize] };
FetchServerValue:
INTERNAL
PROC [pgm:
CARD, pgmVersion:
CARDINAL]
RETURNS [ServerValue] ~ {
index: CARD ~ HashServer[pgm, pgmVersion];
FOR p: ServerValue ← serverTable.values[index], p.next
WHILE p #
NIL
DO
IF (p.pgm = pgm) AND (p.pgmVersion = pgmVersion) THEN RETURN [p];
ENDLOOP;
RETURN [NIL];
};
StoreServerProc:
INTERNAL
PROC [pgm:
CARD, pgmVersion:
CARDINAL, serverProc: CrRPC.ServerProc] ~ {
index: CARD;
p: ServerValue;
IF (p ← FetchServerValue[pgm, pgmVersion]) #
NIL
THEN {
p.serverProc ← serverProc;
RETURN };
index ← HashServer[pgm, pgmVersion];
serverTable.values[index] ← NEW[ServerValueObject ←
[next~serverTable.values[index], pgm~pgm, pgmVersion~pgmVersion, serverProc~serverProc]];
};
DeleteServerValue:
INTERNAL
PROC [pgm:
CARD, pgmVersion:
CARDINAL]
~ {
p, prev: ServerValue;
index: CARD ~ HashServer[pgm, pgmVersion];
p ← serverTable.values[index]; prev ← NIL;
WHILE (p #
NIL)
AND ((p.pgm # pgm)
OR (p.pgmVersion # pgmVersion))
DO
prev ← p; p ← p.next;
ENDLOOP;
IF p = NIL THEN RETURN;
IF prev = NIL THEN serverTable.values[index] ← p.next ELSE prev.next ← p.next;
p.next ← NIL;
};
RegisterServerProc:
PUBLIC ENTRY PROC [pgm:
CARD, pgmVersion:
CARDINAL,
serverProc: CrRPC.ServerProc] ~ {
ENABLE UNWIND => NULL;
IF serverProc #
NIL
THEN StoreServerProc[pgm, pgmVersion, serverProc]
ELSE DeleteServerValue[pgm, pgmVersion];
};
LookUpServerProc:
PUBLIC
ENTRY
PROC [pgm:
CARD, pgmVersion:
CARDINAL]
RETURNS [CrRPC.ServerProc] ~ {
serverValue: ServerValue ~ FetchServerValue[pgm, pgmVersion];
RETURN [ IF serverValue # NIL THEN serverValue.serverProc ELSE NIL ];
};
CreateListenerProcValue: TYPE ~ REF CreateListenerProcValueObject;
CreateListenerProcValueObject:
TYPE ~
RECORD [
createListenerProc: CrRPCFriends.CreateListenerProc];
createListenerProcTable: RefTab.Ref ← RefTab.Create[];
RegisterCreateListenerProc:
PUBLIC
PROC [
class: CrRPC.HandleClass,
createListenerProc: CrRPCFriends.CreateListenerProc]
N.B. This would need to be an ENTRY proc except that the RefTab package handles concurrent clients.
~ {
[] ← RefTab.Store[x~createListenerProcTable, key~class,
val~NEW[CreateListenerProcValueObject ← [createListenerProc]]];
};
LookupCreateListenerProc:
PROC [class:
ATOM]
RETURNS [CrRPCFriends.CreateListenerProc] ~ {
N.B. This would need to be an ENTRY proc except that the RefTab package handles concurrent clients.
found: BOOL;
val: REF;
[found, val] ← RefTab.Fetch[x~createListenerProcTable, key~class];
IF found
THEN RETURN [NARROW[val, CreateListenerProcValue].createListenerProc]
ELSE RETURN [NIL];
};
EnsureListener:
PUBLIC
PROC [class: CrRPC.HandleClass, socket:
XNS.Socket] ~ {
proc: CrRPCFriends.CreateListenerProc ~ LookupCreateListenerProc[class];
IF proc = NIL THEN ERROR Error[NIL, unknownClass, NIL];
proc[socket];
};
GetRemote:
PUBLIC
PROC [h: CrRPC.Handle]
RETURNS [remote:
XNS.Address] ~ {
IF h.kind # server THEN ERROR Error[h, notServerHandle, "not server handle"];
RETURN [ (NARROW[h.procs, REF CrRPC.ServerProcs]).getRemote[h] ] };
Marshalling Procs
GetSeqHWORD:
PUBLIC PROC [h: Handle]
RETURNS [seqHWORD: CrRPC.SeqHWORD] ~ {
n: CARDINAL ~ CrRPC.GetCARD[h];
seqHWORD ← NEW[CrRPC.SeqHWORDObject[n]];
TRUSTED {
[] ← CrRPC.UnsafeGetBlock[h~h, block~[base~LOOPHOLE[seqHWORD], startIndex~2*SIZE[CrRPC.SeqHWORDObject[0]], count~2*n]] };
};
PutSeqHWORD:
PUBLIC PROC [h: Handle, seqHWORD: CrRPC.SeqHWORD] ~ {
n: CARDINAL ~ seqHWORD.length;
TRUSTED {
CrRPC.UnsafePutBlock[h~h, block~[base~LOOPHOLE[seqHWORD], startIndex~2*SIZE[CrRPC.SeqHWORDObject[0]], count~2*n]] };
};
GetSeqCARDINAL:
PUBLIC PROC [h: Handle]
RETURNS [seqCARDINAL: CrRPC.SeqCARDINAL] ~ {
n: CARDINAL ~ CrRPC.GetCARD[h];
seqCARDINAL ← NEW[CrRPC.SeqCARDINALObject[n]];
TRUSTED {
[] ← CrRPC.UnsafeGetBlock[h~h, block~[base~LOOPHOLE[seqCARDINAL], startIndex~2*SIZE[CrRPC.SeqCARDINALObject[0]], count~2*n]] };
IF littleEndian THEN FOR i: CARDINAL IN [0..2*n) DO
seqCARDINAL.body[i] ← CfH[LOOPHOLE[seqCARDINAL.body[i]]];
ENDLOOP; ????
};
PutSeqCARDINAL:
PUBLIC PROC [h: Handle, seqCARDINAL: CrRPC.SeqCARDINAL] ~ {
n: CARDINAL ~ seqCARDINAL.length;
IF littleEndian THEN FOR i: CARDINAL IN [0..2*n) DO
seqCARDINAL.body[i] ← LOOPHOLE[HfC[seqCARDINAL.body[i]]];
ENDLOOP; ????
TRUSTED {
CrRPC.UnsafePutBlock[h~h, block~[base~LOOPHOLE[seqCARDINAL], startIndex~2*SIZE[CrRPC.SeqCARDINALObject[0]], count~2*n]] };
};
SkipSeqHWORD,
SkipSeqCARDINAL:
PUBLIC
PROC [h: Handle] ~ {
n: CARDINAL ~ CrRPC.GetCARDINAL[h];
THROUGH [0 .. n)
DO
[] ← CrRPC.GetHWORD[h];
ENDLOOP;
};
GetROPE:
PUBLIC PROC [h: Handle]
RETURNS [rope:
ROPE] ~ {
text: REF TEXT;
len: CARDINAL;
len ← CrRPC.GetCARDINAL[h];
text ← RefText.ObtainScratch[len];
FOR i:
INT
IN [0 .. len)
DO
text ← RefText.AppendChar[to~text, from~CrRPC.GetCHAR[h]]
ENDLOOP;
CrRPC.GetHAlign[h];
rope ← Rope.FromRefText[text];
RefText.ReleaseScratch[text];
};
PutROPE:
PUBLIC PROC [h: Handle, rope:
ROPE] ~ {
len: CARDINAL ~ Rope.Length[rope];
CrRPC.PutCARDINAL[h, len];
FOR i:
CARDINAL
IN [0..len)
DO
CrRPC.PutCHAR[h, Rope.InlineFetch[rope, i]];
ENDLOOP;
CrRPC.PutHAlign[h];
};
SkipROPE:
PUBLIC PROC [h: Handle] ~ {
len: CARDINAL ~ CrRPC.GetCARDINAL[h];
THROUGH [0 .. len)
DO
[] ← CrRPC.GetCHAR[h];
ENDLOOP;
CrRPC.GetHAlign[h];
};
MarshalledROPEHWords:
PUBLIC PROC [rope:
ROPE]
RETURNS [hWords:
CARDINAL] ~ {
RETURN [ (Rope.Length[rope] + 3) / 2 ] };
GetBulkDataSource:
PUBLIC
PROC [h: Handle]
RETURNS [CrRPC.BulkDataSource] ~ {
RETURN [h.marshallProcs.getBulkDataSource[h]] };
GetBulkDataSink:
PUBLIC
PROC [h: Handle]
RETURNS [CrRPC.BulkDataSink] ~ {
RETURN [h.marshallProcs.getBulkDataSink[h]] };
Finalization
clientHandleFinalizationQueue: SafeStorage.FinalizationQueue ← SafeStorage.NewFQ[];
NewClientObject:
PUBLIC
PROC [class: CrRPC.HandleClass,
marshallProcs:
REF CrRPC.MarshallProcs, procs:
REF CrRPC.ClientProcs,
data:
REF
ANY ←
NIL, clientData:
REF
ANY ←
NIL]
RETURNS [h: Handle] ~ {
h ← NEW[CrRPC.Object ← [class~class, kind~client, marshallProcs~marshallProcs, procs~procs, data~data, clientData~clientData]];
SafeStorage.EnableFinalization[h];
};
ClientHandleFinalizer:
PROC ~ {
Process.SetPriority[Process.priorityBackground];
DO
h: Handle ← NARROW[SafeStorage.FQNext[clientHandleFinalizationQueue]];
WITH h.procs
SELECT
FROM
clientProcs:
REF CrRPC.ClientProcs => {
IF clientProcs #
NIL
AND clientProcs.finalize #
NIL
THEN clientProcs.finalize[h];
};
ENDCASE => NULL;
h ← NIL;
ENDLOOP;
};
Initialization for client handle finalizer
{ established:
BOOL;
established ← TRUE;
SafeStorage.EstablishFinalization[type~
CODE[CrRPC.Object], npr~0, fq~clientHandleFinalizationQueue
! SafeStorage.CantEstablishFinalization => { established ← FALSE; CONTINUE }];
IF
NOT established
THEN {
established ← TRUE;
SafeStorage.ReEstablishFinalization[type~
CODE[CrRPC.Object], npr~0, fq~clientHandleFinalizationQueue
! SafeStorage.CantEstablishFinalization => { established ← FALSE; CONTINUE }];
};
IF NOT established THEN ERROR };
TRUSTED { Process.Detach[FORK ClientHandleFinalizer[]]; };
}.