<<>>
<<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.>>

    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); -- ????
    <<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,
            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]
            <<N.B. This would need to be an ENTRY proc except that the RefTab package handles concurrent clients.>>
            ~ {
            [] Ź RefTab.Store[x~startInstanceProcTable, key~class,
            val~NEW[StartInstanceProcValueObject Ź [startServerInstanceProc]]];
            };

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

        }.