
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, StopServerQueryProc],
CrRPCBackdoor USING [CreateClientHandleProc, StartServerInstanceProc],
FinalizeOps USING [CallQueue, CreateCallQueue, EnableFinalization, FinalizeProc, Handle, ReenableFinalization],
IO USING [EndOfStream, GetChar, GetRope, PutChar, PutRope, STREAM, UnsafeGetBlock, UnsafePutBlock],
RefTab USING [Create, Fetch, Ref, Store],
Rope USING [Length, ROPE];

CrRPCImpl: CEDAR MONITOR
IMPORTS Basics, CrRPC, FinalizeOps, RefTab, Rope
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,
pgmLoVersion: CARD16,
pgmHiVersion: CARD16,
serverProc: CrRPC.ServerProc,
stopServerQueryProc: CrRPC.StopServerQueryProc];

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]
RETURNS[index: CARD] ~ INLINE { index м pgm MOD CARD[serverTableSize] };

FetchServerValue: INTERNAL PROC [pgm: CARD32, pgmVersion: CARD16]
RETURNS [ServerValue] ~ {
index: CARD ~ HashServer[pgm];
FOR p: ServerValue м serverTable.values[index], p.next WHILE p # NIL DO
IF (p.pgm = pgm) AND (p.pgmLoVersion <= pgmVersion) AND (p.pgmHiVersion >= pgmVersion) THEN RETURN [p];
ENDLOOP;
RETURN [NIL];
};

RegisterServerProcs: PUBLIC ENTRY PROC [pgm: CARD32, pgmLoVersion: CARD16, pgmHiVersion: CARD16, serverProc: CrRPC.ServerProc, stopServerQueryProc: CrRPC.StopServerQueryProc] ~ {
ENABLE UNWIND => NULL;
index: CARD;
index м HashServer[pgm];
serverTable.values[index] м NEW[ServerValueObject м
[next~serverTable.values[index], pgm~pgm, pgmLoVersion~pgmLoVersion, pgmHiVersion~pgmHiVersion, serverProc~serverProc, stopServerQueryProc~stopServerQueryProc]];
};

LookUpServerProcs: PUBLIC ENTRY PROC [pgm: CARD32, pgmVersion: CARD16]
RETURNS [serverProc: CrRPC.ServerProc, stopServerQueryProc: CrRPC.StopServerQueryProc] ~ {
serverValue: ServerValue ~ FetchServerValue[pgm, pgmVersion];
IF serverValue # NIL
THEN RETURN [serverValue.serverProc, serverValue.stopServerQueryProc]
ELSE RETURN [NIL, NIL];
};

StartInstanceProcValue: TYPE ~ REF StartInstanceProcValueObject;
StartInstanceProcValueObject: TYPE ~ RECORD [
startInstance: CrRPCBackdoor.StartServerInstanceProc];

startInstanceProcTable: RefTab.Ref м RefTab.Create[];

RegisterStartServerInstanceProc: PUBLIC PROC [
class: CrRPC.HandleClass,
startServerInstanceProc: CrRPCBackdoor.StartServerInstanceProc]
~ {
[] м RefTab.Store[x~startInstanceProcTable, key~class,
val~NEW[StartInstanceProcValueObject м [startServerInstanceProc]]];
};

LookupStartServerInstanceProc: PROC [class: ATOM]
RETURNS [CrRPCBackdoor.StartServerInstanceProc] ~ {
found: BOOL;
val: REF;
[found, val] м RefTab.Fetch[x~startInstanceProcTable, key~class];
IF found
THEN RETURN [NARROW[val, StartInstanceProcValue].startInstance]
ELSE RETURN [NIL];
};

StartServerInstance: PUBLIC PROC [
pgm: CARD32,
pgmVersion: CARD16,
class: CrRPC.HandleClass,
local: CrRPC.RefAddress] ~ {
proc: CrRPCBackdoor.StartServerInstanceProc ~ LookupStartServerInstanceProc[class];
IF proc = NIL THEN ERROR Error[NIL, unknownClass, NIL];
proc[pgm, pgmVersion, 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] ~ {
len: CARDINAL м CrRPC.GetCard16[s];
rope м IO.GetRope[s, len, TRUE];
IF (len MOD 2) # 0 THEN [] м IO.GetChar[s];
};

PutRope: PUBLIC PROC [s: STREAM, rope: ROPE] ~ {
len: INT ~ Rope.Length[rope];
CrRPC.PutCard16[s, len];
IO.PutRope[s, rope];
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]] };
finalizationQueue: FinalizeOps.CallQueue м FinalizeOps.CreateCallQueue[ClientHandleFinalizer];

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]];
[] м FinalizeOps.EnableFinalization[h, finalizationQueue];
};

ClientHandleFinalizer: FinalizeOps.FinalizeProc ~ {
h: Handle м NARROW[object];
IF h.procs.finalize # NIL THEN
IF ( h.procs.finalize[h] ) THEN [] м FinalizeOps.ReenableFinalization[handle];
};

}.
     
CrRPCImpl.mesa
Copyright ╙ 1986, 1990, 1991 by Xerox Corporation.  All rights reserved.
Demers, April 25, 1990 8:11 am PDT
Willie-sue Orr, December 9, 1991 4:46 pm PST
Michael Plass, April 16, 1990 9:43 am PDT
Christian Jacobi, July 24, 1992 7:35 pm PDT

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
FinalizeOps
 Э╩
Я  Ц(cedarcode) styleХNewlineDelimiter
Щ ЪЬЩIcodeЪЬ
╧eЬ=ЩHKЩ"KЩ,KЩ)KЩ+KЩ KЩЧKШ Ъ╧k	Ш	KЪЬЮЬЮЬЮЬШ6KЪЬЮЬцШёKЪЬЮЬ3ШFKЪЬЮЬ^ШoKЪЮЬЮЬ3ЮЬ"ШcKШ)KЪЬЮЬ
ЮЬШKШ ЧЪ╤bln	ЬЮЬЮШKЪЮЬ)Ш0KЪЮЬШKЪЬШKШ KЪЮЬЮЬ
ЮЬШKЪЮЬЮЬ
ЮЬШKЪЮЬЮЬЮЬШKЪЬЮЬШKЪЮЬЮЬЮЬЮЬШKШ KЪЬЮЬЮЬЮЬ╧cШNheadЩЪ╧nЬЮЬЮЬШKЪЬ
Ш
KЪЬШKЪЬЮЬЮЬШЧЧЩ#KЪЬЮЬЮЬ#ШJЪЬ#ЮЬЮЬШ2KЪЬ?Ш?KШ ЧШ:KШ ЧЪбЬЮЬЮЬ
ЮЬ-ШfKЩcKЪЬШKЪЬ@ЮЬ.ШqKШKШ ЧЪбЬЮЬ	ЮЬЮЬ+ШcKЩcKЪЬЮЬШKЪЬЮЬШ	KШFЪЮЬШKЪЮЬЮЬЮЬ:ШMKЪЮЬЮЬЮЬШЧKШKШ ЧЪ
бЬЮЬЮЬ	ЮЬЮЬШbKЪЬQШQKЪЮЬЮЬЮЬЮЬЮЬЮЬШ7KЪЮЬШKЪЬШKШ ЧЧЩKЪЬЮЬЮЬШ*ЪЬЮЬЮЬШ"KЪЬШKЪЬЮЬШKЪЬЮЬШKЪЬЮЬШKЪЬШKШ0KШ ЧKЪЬЮЬаШ2KЪЬЮЬЮЬШ*ЪЬЮЬЮЬШ"KЪЬЮЬЮЬШ3ЧЪЬЮЬЮЬЮЬШ?KШ ЧЪб
ЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬШpKШ ЧЪбЬЮЬЮЬЮЬЮЬЮЬШ[KЪЬЮЬШЪЮЬ4ЮЬЮЬЮШGKЪ
ЮЬЮЬ ЮЬ ЮЬЮЬШgKЪЮЬШЧKЪЮЬЮЬШKШKШ ЧЪбЬЮЬЮЬЮЬЮЬЮЬSШ▓KЪЮЬЮЬЮЬШKЪЬЮЬШKЪЬЮЬШKЪЬЮЬ╢Ш╒KШKШ ЧЪбЬЮЬЮЬЮЬЮЬЮЬЮЬSШбKЪЬ=Ш=ЪЮЬЮШKЪЮЬЮЬ:ШEKЪЮЬЮЬЮЬЮЬШЧKШKШ ЧKЪЬЮЬЮЬШ@ЪЬЮЬЮЬШ-KЪЬ6Ш6KШ ЧШ5KШ ЧЪбЬЮЬЮЬШ.KЪЬШKЪЬ?Ш?KЩcKЪЬШKЪЬ;ЮЬ<ШzKШKШ ЧЪбЬЮЬ	ЮЬЮЬ,ШeKЩcKЪЬЮЬШKЪЬЮЬШ	KШAЪЮЬШKЪЮЬЮЬЮЬ,Ш?KЪЮЬЮЬЮЬШЧKШKШ ЧЪ
бЬЮЬЮЬЮЬЮЬ8ШzKЪЬSШSKЪЮЬЮЬЮЬЮЬЮЬЮЬШ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Ш ЧЪбЬЮЬЮЬЮЬШ0KЪЬЮЬШKЪЬШKЪЮЬШKЪ
ЮЬЮЬЮЬЮЬЮЬШ.KШKШ ЧЪбЬЮЬЮЬШ0KЪЬЮЬШ#KЪЮЬЮЬЮЬШ&ЪЮЬЮШKЪЬЮЬШKЪЮЬШЧKШKШ ЧЪ
бЬЮЬЮЬЮЬ
ЮЬШMKЪЬ!ЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬШ[KШ ЧЪ
бЬЮЬЮЬЮЬЮЬШXKЪЮЬ%Ш+KШ ЧЪ
бЬЮЬЮЬЮЬЮЬШTKЪЮЬ#Ш)ЧЧЩKШ^KШ ЪбЬЮЬЮЬ#ЮЬЮЬЮЬЮЬЮЬЮЬШХKЪЬЮЬ[ШbKШ:KШЧKШ ЪбЬШ3KЪЬЮЬ	ШЪЮЬЮЬЮШKЪЮЬЮЬ/ШNЧKШKШ ЧЧKШЧЧ ЕЧ     ╝  .q  