DIRECTORY
Basics USING [Card16FromH, FWORD, HFromCard16, HWORD],
CrRPC USING [BulkDataSink, BulkDataSource, ErrorReason, GetCard16, GetHWord, Handle, HandleClass, HandleKind, Object, ProcsObject, PutCard16, RefAddress, SeqCard16, SeqCard16Object, SeqHWord, SeqHWordObject, ServerProc],
CrRPCBackdoor USING [CreateClientHandleProc, CreateListenerProc],
IO USING [EndOfStream, GetChar, PutChar, STREAM, UnsafeGetBlock, UnsafePutBlock],
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];
CrRPCImpl:
CEDAR
MONITOR
IMPORTS Basics, CrRPC, Process, RefTab, RefText, Rope, SafeStorage
EXPORTS CrRPC, CrRPCBackdoor
~ {
FWORD: TYPE ~ Basics.FWORD;
HWORD: TYPE ~ Basics.HWORD;
ROPE: TYPE ~ Rope.ROPE;
Handle: TYPE ~ CrRPC.Handle;
STREAM: TYPE ~ IO.STREAM;
bigEndianHWords: BOOL ~ (LOOPHOLE[Basics.HFromCard16[1], CARD16] = 1); -- ????
Errors
Error:
PUBLIC
ERROR [
h: Handle,
errorReason: CrRPC.ErrorReason,
text: ROPE] ~ CODE;
Create / Destroy for Client Handles
CreateClientHandleProcValue: TYPE ~ REF CreateClientHandleProcValueObject;
CreateClientHandleProcValueObject:
TYPE ~
RECORD [
createClientHandleProc: CrRPCBackdoor.CreateClientHandleProc ];
createClientHandleProcTable: RefTab.Ref ← RefTab.Create[];
RegisterCreateClientHandleProc:
PUBLIC
PROC [
class:
ATOM, proc: CrRPCBackdoor.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 [CrRPCBackdoor.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: CrRPC.RefAddress]
RETURNS [CrRPC.Handle] ~ {
proc: CrRPCBackdoor.CreateClientHandleProc ~ LookupCreateClientHandleProc[class];
IF proc = NIL THEN ERROR Error[NIL, unknownClass, NIL];
RETURN [proc[remote]]
};
Create / Destroy for Servers
ServerValue: TYPE ~ REF ServerValueObject;
ServerValueObject:
TYPE ~
RECORD [
next: ServerValue,
pgm: CARD32,
pgmVersion: CARD16,
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:
CARD32, pgmVersion:
CARD16]
RETURNS[index:
CARD] ~
INLINE {
index ← ((pgm * 7) + CARD[pgmVersion]) MOD CARD[serverTableSize] };
FetchServerValue:
INTERNAL
PROC [pgm:
CARD32, pgmVersion:
CARD16]
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:
CARD32, pgmVersion:
CARD16,
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:
CARD32, pgmVersion:
CARD16]
~ {
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:
CARD32, pgmVersion:
CARD16,
serverProc: CrRPC.ServerProc] ~ {
ENABLE UNWIND => NULL;
IF serverProc #
NIL
THEN StoreServerProc[pgm, pgmVersion, serverProc]
ELSE DeleteServerValue[pgm, pgmVersion];
};
LookUpServerProc:
PUBLIC
ENTRY
PROC [pgm:
CARD32, pgmVersion:
CARD16]
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: CrRPCBackdoor.CreateListenerProc];
createListenerProcTable: RefTab.Ref ← RefTab.Create[];
RegisterCreateListenerProc:
PUBLIC
PROC [
class: CrRPC.HandleClass,
createListenerProc: CrRPCBackdoor.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 [CrRPCBackdoor.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, local: CrRPC.RefAddress] ~ {
proc: CrRPCBackdoor.CreateListenerProc ~ LookupCreateListenerProc[class];
IF proc = NIL THEN ERROR Error[NIL, unknownClass, NIL];
proc[local];
};
Marshalling Procs
GetSeqHWord:
PUBLIC
PROC [s:
STREAM]
RETURNS [seqHWord: CrRPC.SeqHWord] ~ {
n: CARD16;
nBytes, nBytesRead: INT;
n ← CrRPC.GetCard16[s];
seqHWord ← NEW[CrRPC.SeqHWordObject[n]];
nBytes ← (n*BITS[HWORD])/BITS[BYTE];
TRUSTED {
nBytesRead ← IO.UnsafeGetBlock[self~s, block~[base~LOOPHOLE[seqHWord], startIndex~BITS[CrRPC.SeqHWordObject[0]]/BITS[BYTE], count~nBytes]] };
IF nBytesRead # nBytes THEN ERROR IO.EndOfStream[s] };
PutSeqHWORD:
PUBLIC
PROC [s:
STREAM, seqHWord: CrRPC.SeqHWord] ~ {
n: CARD16;
nBytes: INT;
n ← seqHWord.length;
nBytes ← (n*BITS[HWORD])/BITS[BYTE];
CrRPC.PutCard16[s, n];
TRUSTED {
IO.UnsafePutBlock[self~s, block~[base~LOOPHOLE[seqHWord], startIndex~BITS[CrRPC.SeqHWordObject[0]]/BITS[BYTE], count~nBytes]] };
};
GetSeqCard16:
PUBLIC
PROC [s:
STREAM]
RETURNS [seqCard16: CrRPC.SeqCard16] ~ {
n: CARD16;
nBytes, nBytesRead: INT;
n ← CrRPC.GetCard16[s];
seqCard16 ← NEW[CrRPC.SeqCard16Object[n]];
nBytes ← (n*BITS[HWORD])/BITS[BYTE];
TRUSTED {
nBytesRead ← IO.UnsafeGetBlock[self~s, block~[base~LOOPHOLE[seqCard16], startIndex~BITS[CrRPC.SeqCard16Object[0]]/BITS[BYTE], count~nBytes]] };
IF nBytesRead # nBytes THEN ERROR IO.EndOfStream[s];
IF
NOT bigEndianHWords
THEN
FOR i:
CARDINAL
IN [0..n)
DO
seqCard16.body[i] ← Basics.Card16FromH[LOOPHOLE[seqCard16.body[i]]];
ENDLOOP;
};
PutSeqCard16:
PUBLIC
PROC [s:
STREAM, seqCard16: CrRPC.SeqCard16] ~ {
n: CARD16;
nBytes: INT;
n ← seqCard16.length;
nBytes ← (n*BITS[HWORD])/BITS[BYTE];
CrRPC.PutCard16[s, n];
IF
NOT bigEndianHWords
THEN
FOR i:
CARDINAL
IN [0..n)
DO
seqCard16.body[i] ← LOOPHOLE[Basics.HFromCard16[seqCard16.body[i]]];
ENDLOOP;
TRUSTED {
IO.UnsafePutBlock[self~s, block~[base~LOOPHOLE[seqCard16], startIndex~BITS[CrRPC.SeqCard16Object[0]]/BITS[BYTE], count~nBytes]] };
};
SkipSeqHWord,
SkipSeqCard16:
PUBLIC
PROC [s:
STREAM] ~ {
n: CARDINAL ~ CrRPC.GetCard16[s];
THROUGH [0 .. n)
DO
[] ← CrRPC.GetHWord[s];
ENDLOOP;
};
GetRope:
PUBLIC PROC [s:
STREAM]
RETURNS [rope:
ROPE] ~ {
text: REF TEXT;
len: CARDINAL;
len ← CrRPC.GetCard16[s];
text ← RefText.ObtainScratch[len];
FOR i:
CARDINAL
IN [0 .. len)
DO
text ← RefText.AppendChar[to~text, from~IO.GetChar[s]]
ENDLOOP;
IF (len MOD 2) # 0 THEN [] ← IO.GetChar[s];
rope ← Rope.FromRefText[text];
RefText.ReleaseScratch[text];
};
PutRope:
PUBLIC PROC [s:
STREAM, rope:
ROPE] ~ {
len: INT ~ Rope.Length[rope];
CrRPC.PutCard16[s, len];
FOR i:
INT
IN [0..len)
DO
IO.PutChar[s, Rope.InlineFetch[rope, i]];
ENDLOOP;
IF (len MOD 2) # 0 THEN IO.PutChar[s, VAL[0]];
};
SkipROPE:
PUBLIC PROC [h: Handle, s:
STREAM] ~ {
len: CARDINAL ← CrRPC.GetCard16[s];
IF (len MOD 2) # 0 THEN len ← len + 1;
THROUGH [0 .. len)
DO
[] ← IO.GetChar[s];
ENDLOOP;
};
MarshalledRopeHWords:
PUBLIC PROC [rope:
ROPE]
RETURNS [hWords:
CARDINAL] ~ {
hWords ← (Rope.Length[rope] + 2*(BITS[HWORD]/BITS[BYTE]) - 1) / (BITS[HWORD]/BITS[BYTE]) };
GetBulkDataSource:
PUBLIC
PROC [h: Handle, s:
STREAM]
RETURNS [CrRPC.BulkDataSource] ~ {
RETURN [h.procs.getBulkDataSource[h, s]] };
GetBulkDataSink:
PUBLIC
PROC [h: Handle, s:
STREAM]
RETURNS [CrRPC.BulkDataSink] ~ {
RETURN [h.procs.getBulkDataSink[h, s]] };
Finalization
clientHandleFinalizationQueue: SafeStorage.FinalizationQueue ← SafeStorage.NewFQ[];
NewClientObject:
PUBLIC
PROC [class: CrRPC.HandleClass,
procs:
REF CrRPC.ProcsObject, data:
REF ←
NIL, clientData:
REF ←
NIL]
RETURNS [h: Handle] ~ {
h ← NEW[CrRPC.Object ← [class~class, kind~client, procs~procs, data~data, clientData~clientData]];
SafeStorage.EnableFinalization[h];
};
RenewClientObject:
PUBLIC PROC [handle: Handle] ~ {
SafeStorage.EnableFinalization[handle];
};
ClientHandleFinalizer:
PROC ~ {
Process.SetPriority[Process.priorityBackground];
DO
h: Handle ← NARROW[SafeStorage.FQNext[clientHandleFinalizationQueue]];
IF h.procs.finalize # NIL THEN h.procs.finalize[h];
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[]]; };
}.