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); -- ????
Error: PUBLIC ERROR [
h: Handle,
errorReason: CrRPC.ErrorReason,
text: ROPE] ~ CODE;
CreateClientHandleProcValue: TYPE ~ REF CreateClientHandleProcValueObject;
CreateClientHandleProcValueObject: TYPE ~ RECORD [
createClientHandleProc: CrRPCBackdoor.CreateClientHandleProc ];

createClientHandleProcTable: RefTab.Ref _ RefTab.Create[];

RegisterCreateClientHandleProc: PUBLIC PROC [
class: ATOM, proc: CrRPCBackdoor.CreateClientHandleProc]
~ {
[] _ RefTab.Store[x~createClientHandleProcTable, key~class, val~NEW[CreateClientHandleProcValueObject _ [proc]]];
};

LookupCreateClientHandleProc: PROC [class: ATOM]
RETURNS [CrRPCBackdoor.CreateClientHandleProc] ~ {
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]]
};

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]
~ {
[] _ RefTab.Store[x~createListenerProcTable, key~class,
val~NEW[CreateListenerProcValueObject _ [createListenerProc]]];
};

LookupCreateListenerProc: PROC [class: ATOM]
RETURNS [CrRPCBackdoor.CreateListenerProc] ~ {
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];
};
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]] };
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;
};

{ 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[]]; };

}.
ΈCrRPCImpl.mesa
Copyright c 1986 by Xerox Corporation.  All rights reserved.
Demers, December 20, 1986 1:47:31 pm PST

Courier runtime support.
Errors
Create / Destroy for Client Handles
N.B. This would need to be an ENTRY proc except that the RefTab package handles concurrent clients.
N.B. This would need to be an ENTRY proc except that the RefTab package handles concurrent clients.
Create / Destroy for Servers
N.B. This would need to be an ENTRY proc except that the RefTab package handles concurrent clients.
N.B. This would need to be an ENTRY proc except that the RefTab package handles concurrent clients.
Marshalling Procs
Finalization
Initialization for client handle finalizer
Κ€˜š
œ™Icodešœ
Οm
œ1™<K™(K™—K™K˜š
Οk	˜	Kšœžœ
žœ
žœ˜6KšœžœΡ
˜ά
Kšœžœ.˜AKšžœ
žœ!žœ"˜QKšœžœ+˜8K˜)Kšœžœ-˜:Kšœžœ$žœ˜4Kšœžœƒ
˜”
K˜—šΡbln	œžœ
ž˜Kšžœ;˜BKšžœ˜Kš
œ˜K˜Kšžœžœ
žœ
˜Kšžœžœ
žœ
˜Kšžœžœžœ
˜Kšœžœ˜Kšžœžœžœ
žœ
˜K˜KšœžœžœžœΟc˜N
head™šΟnœžœ
žœ˜Kš
œ
˜
Kš
œ˜Kšœžœžœ
˜——™#Kšœžœžœ#˜Jšœ#žœžœ˜2Kš
œ?˜?K˜—˜:K˜—š‘œžœ
žœ
žœ-˜fK™cKš
œ˜Kšœ@žœ.˜qK˜K˜—š‘œžœ	žœžœ+˜cK™cKšœžœ
˜Kšœžœ
˜	Kš
œF˜Fšžœ˜Kšžœ
žœžœ:˜MKšžœ
žœžœ˜—K˜K˜—š
‘œžœ
žœ	žœžœ˜bKš
œQ˜QKšžœžœ
žœ
žœžœžœ˜7Kšžœ˜Kš
œ˜K˜——™Kšœ
žœžœ˜*šœžœžœ˜"Kš
œ˜Kšœžœ
˜Kšœžœ
˜Kš
œ˜K˜—Kšœžœ ˜2Kšœ
žœžœ˜*šœžœžœ˜"Kšœžœžœ˜3—šœžœžœ
žœ˜?K˜—š‘
œžœ
žœžœžœžœžœžœ˜[Kšœžœžœ
žœ˜CK˜—š‘œžœ
žœžœžœžœ˜[Kšœžœ˜*šžœ4žœžœ
ž˜GKšžœžœžœ
žœ˜AKšžœ
˜—Kšžœžœ˜
K˜K˜—š
‘œžœ
žœžœžœ#˜bKšœžœ
˜K˜šžœ+žœ
žœ˜7Kš
œ˜Kšžœ˜	—Kšœžœ˜$Kšœžœn˜
K˜K˜—š
‘œžœ
žœžœžœ
˜BK˜Kš
œ˜Kšœžœ˜*Kšœ'žœ
˜+š	žœžœžœžœž˜EKš
œ˜Kšžœ
˜—Kšžœžœ
žœ
žœ
˜Kšžœžœ
žœ$žœ˜NKšœ	žœ
˜
K˜K˜—š‘œžœžœžœ#˜iKšžœ
žœžœ
˜šžœž˜Kšžœ,˜1Kšžœ$˜(—K˜K˜—š‘œžœ
žœ
žœžœžœžœ˜dKš
œ=˜=Kšžœžœžœ
žœžœ
žœ˜EK˜K˜—Kšœžœžœ˜Bšœžœžœ˜.Kš
œ6˜6K˜—š
œ6˜6K˜—š‘œžœ
žœ˜)Kš
œ˜Kš
œ5˜5K™cKš
œ˜Kšœ<žœ8˜wK˜K˜—š‘œžœ	žœžœ'˜[K™cKšœžœ
˜Kšœžœ
˜	Kš
œB˜Bšžœ˜Kšžœ
žœžœ2˜EKšžœ
žœžœ˜—K˜K˜—š‘œžœ
žœ8˜SKš
œI˜IKšžœžœ
žœ
žœžœžœ˜7Kš
œ˜K˜——™š
‘œžœ
žœžœžœ˜KKšœžœ
˜
Kšœžœ
˜Kš
œ˜Kšœžœ˜(Kš	œžœ
žœžœ
žœ˜$šžœ˜	Kšœ
žœ$žœžœžœ
žœ˜
—Kšžœžœ
žœ
žœ˜6K˜—š‘œžœ
žœžœ˜BKšœžœ
˜
Kšœžœ
˜Kš
œ˜Kš	œžœ
žœžœ
žœ˜$K˜šžœ˜	Kš
žœ$žœžœžœ
žœ˜€
—K˜K˜—š
‘œžœ
žœžœžœ!˜NKšœžœ
˜
Kšœžœ
˜Kš
œ˜Kšœžœ˜*Kš	œžœ
žœžœ
žœ˜$šžœ˜	Kšœ
žœ$žœžœžœ
žœ˜
—Kšžœžœ
žœ
žœ˜4š
žœ
žœžœ
žœžœ
žœž˜8Kšœ'žœ˜DKšžœ
˜—K˜K˜—š‘œžœ
žœžœ!˜EKšœžœ
˜
Kšœžœ
˜Kš
œ˜Kš	œžœ
žœžœ
žœ˜$K˜š
žœ
žœžœ
žœžœ
žœž˜8Kšœžœ(˜DKšžœ
˜—šžœ˜	Kš
žœ$žœžœžœ
žœ˜‚
—K˜K˜—š
‘œ‘
œžœ
žœžœ˜8Kšœžœ˜!šžœ
ž˜Kš
œ˜Kšžœ
˜—K˜K˜—š
‘œžœžœžœžœ˜9Kšœžœ
žœ
˜Kšœžœ
˜Kš
œ˜K˜"šžœžœ
žœž˜ Kšœ(žœ˜6Kšžœ
˜—Kšžœžœžœžœ˜+K˜K˜Kš
œ˜K˜—š‘œžœžœžœ˜0Kšœžœ˜Kš
œ˜šžœžœ
žœ
ž˜Kšžœ'˜)Kšžœ
˜—Kš
žœžœžœ
žœžœ˜.K˜K˜—š‘œžœžœ˜0Kšœžœ˜#Kšžœžœžœ˜&šžœž˜Kšœžœ˜Kšžœ
˜—K˜K˜—š
‘œžœžœžœ
žœ˜MKšœ!žœ
žœžœ
žœžœ
žœžœ
žœ˜[K˜—š
‘œžœ
žœžœžœ˜XKšžœ%˜+K˜—š
‘œžœ
žœžœžœ˜TKšžœ#˜)——™Kš
œS˜SK˜š‘œžœ
žœ#žœžœžœžœžœžœ˜•
Kšœžœ[˜bK˜"K˜K˜—š‘œžœ˜3Kš
œ'˜'K˜—K˜š‘œžœ˜Kš
œ0˜0š
ž˜Kšœžœ4˜FKšžœžœ
žœ˜3Kšœžœ
˜Kšžœ
˜—K˜K˜——™*šœžœ
˜Kšœžœ
˜šœ'žœ7˜bKšœ;žœžœ˜N—šžœ
žœ
žœ˜Kšœžœ
˜šœ)žœ7˜dKšœ;žœžœ˜N—K˜—Kšžœ
žœ
žœ
žœ˜ —Kšžœžœ˜:K˜—K˜——…—&"5~