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;

Error: PUBLIC ERROR [
h: Handle,
errorReason: CrRPC.ErrorReason,
text: ROPE] ~ CODE;
CreateClientHandleProcValue: TYPE ~ REF CreateClientHandleProcValueObject;
CreateClientHandleProcValueObject: TYPE ~ RECORD [
createClientHandleProc: CrRPCFriends.CreateClientHandleProc ];

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

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

LookupCreateClientHandleProc: PROC [class: ATOM]
RETURNS [CrRPCFriends.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: 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] };

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

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

LookupCreateListenerProc: PROC [class: ATOM]
RETURNS [CrRPCFriends.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, 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] ] };
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]] };
};

PutSeqCARDINAL: PUBLIC PROC [h: Handle, seqCARDINAL: CrRPC.SeqCARDINAL] ~ {
n: CARDINAL ~ seqCARDINAL.length;
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]] };
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;
};

{ 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, November 21, 1986 2:59:19 pm PST

Courier runtime support.
Errors
Create / Set Parameters / 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.
Calling a Remote Procedure
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
IF littleEndian THEN FOR i: CARDINAL IN [0..2*n) DO
seqCARDINAL.body[i] _ CfH[LOOPHOLE[seqCARDINAL.body[i]]];
ENDLOOP; ????
IF littleEndian THEN FOR i: CARDINAL IN [0..2*n) DO
seqCARDINAL.body[i] _ LOOPHOLE[HfC[seqCARDINAL.body[i]]];
ENDLOOP; ????
Finalization
Initialization for client handle finalizer
Κ—˜š
œ™Icodešœ
Οm
œ1™<K™(K™—K™K˜š
Οk	˜	KšœžœΔ˜ΟKš
œ@˜@Kšœžœ+˜8K˜)Kšœžœ-˜:Kšœžœ$žœ˜4Kšœžœƒ
˜”
Kšžœ
žœ˜K˜—šΡbln	œžœ
ž˜Kšžœ3˜:Kšžœ˜Kš
œ˜K˜Kšžœžœžœ
žœ
˜Kšžœžœžœ
˜šœžœ˜K˜—
head™šΟnœžœ
žœ˜Kš
œ
˜
Kš
œ˜Kšœžœžœ
˜——™4Kšœžœžœ#˜Jšœ#žœžœ˜2Kš
œ>˜>K˜—˜:K˜—š œžœ
žœ
žœ,˜eK™cKš
œ˜Kšœ@žœ.˜qK˜K˜—š œžœ	žœžœ*˜bK™cKšœžœ
˜Kšœžœ
˜	Kš
œF˜Fšžœ˜Kšžœ
žœžœ:˜MKšžœ
žœžœ˜—K˜K˜—š œžœ
žœ˜!Kšœžœ
žœž˜2Kšœžœ˜Kš
œP˜PKšžœžœ
žœ
žœžœžœ˜7Kšžœ˜"Kš
œ˜K˜—š
 	œžœ
žœžœ
žœ
˜LKšžœžœ
žœ0˜MKšžœžœ
žœ.˜KK˜—š
 
œžœ
žœžœžœ
˜JKšžœžœ
žœ0˜MKšžœžœ
žœ4˜QK˜—š
 œžœ
žœžœžœ
˜EKšœ
žœ˜#Kšžœžœ
žœ0˜MKšœžœ
˜šžœž˜Kšžœ
žœ6˜@—Kšžœ)˜/K˜—š œžœ
žœ˜0Kšžœžœ
žœ0˜MKšœ
žœ
žœ"˜6K˜——™š œžœ˜Kšœ
žœ˜#Kšžœžœ
žœ0˜MKšœžœ
˜Kš
œ]˜]K˜K˜——™Kšœ
žœžœ˜*šœžœžœ˜"Kš
œ˜Kšœžœ
˜
Kšœžœ
˜Kš
œ˜K˜—KšœžœΟc˜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š
œ5˜5K˜—š
œ6˜6K˜—š œžœ
žœ˜)Kš
œ˜Kš
œ4˜4K™cKš
œ˜Kšœ<žœ8˜wK˜K˜—š œžœ	žœžœ&˜ZK™cKšœžœ
˜Kšœžœ
˜	Kš
œB˜Bšžœ˜Kšžœ
žœžœ2˜EKšžœ
žœžœ˜—K˜K˜—š œžœ
žœ$žœ˜NKš
œH˜HKšžœžœ
žœ
žœžœžœ˜7Kš
œ
˜
K˜K˜—š
 	œžœ
žœžœ
žœ
˜JKšžœžœ
žœ0˜MKšžœžœ
žœ&˜C——™š œžœ
žœ˜KKšœžœ˜Kšœžœ˜(šžœ˜	Kšœ+žœžœ)˜y—K˜K˜—š œžœ*˜BKšœžœ˜šžœ˜	Kšœ&žœžœ)˜t—K˜K˜—š œžœ
žœ%˜TKšœžœ˜Kšœžœ˜.šžœ˜	Kšœ+žœžœ,˜—šžœžœ
žœžœ
žœ
ž™3Kšœžœ™9Kšžœ™
—K˜K˜—š œžœ0˜KKšœžœ˜!šžœžœ
žœžœ
žœ
ž™3Kšœžœ™9Kšžœ™
—šžœ˜	Kšœ&žœžœ,˜z—K˜K˜—š œ œžœ
žœ˜:Kšœžœ˜#šžœ
ž˜K˜Kšžœ
˜—K˜K˜—š œžœ
žœžœ˜9Kšœžœ
žœ
˜Kšœžœ
˜Kš
œ˜K˜"šžœžœ
žœž˜Kš
œ9˜9Kšžœ
˜—Kš
œ˜K˜K˜Kš
œ˜K˜—š œžœžœ˜0Kšœžœ˜"Kš
œ˜šžœžœ
žœ
ž˜Kš
œ,˜,Kšžœ
˜—Kš
œ˜K˜K˜—š œžœ˜%Kšœžœ˜%šžœž˜Kš
œ˜Kšžœ
˜—Kš
œ˜K˜K˜—š
 œžœžœžœ
žœ˜MKšžœ#˜)K˜—š œžœ
žœ
žœ˜MKšžœ*˜0K˜—š œžœ
žœ
žœ˜IKšžœ(˜.——™Kš
œS˜SK˜š œžœ
žœ+žœžœžœ
žœžœžœ
žœžœžœ˜Ε
Kšœžœx˜K˜"K˜K˜—š œžœ˜Kš
œ0˜0š
ž˜Kšœžœ4˜Fšžœ	žœ
ž˜šœ
žœ˜'šžœžœ
žœž˜3Kšžœ˜—K˜—Kšžœžœ
˜—Kšœžœ
˜Kšžœ
˜—K˜K˜——™*šœžœ
˜Kšœžœ
˜šœ'žœ7˜bKšœ;žœžœ˜N—šžœ
žœ
žœ˜Kšœžœ
˜šœ)žœ7˜dKšœ;žœžœ˜N—K˜—Kšžœ
žœ
žœ
žœ˜ —Kšžœžœ˜:K˜—K˜——…—(Β95