
<<CrRPCImpl.mesa>>
    <<Copyright © 1986 by Xerox Corporation.  All rights reserved.>>
    <<Demers, November 21, 1986 2:59:19 pm PST>>
    <<>>
    <<Courier runtime support.>>

    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;

    <<Errors>>
        Error: PUBLIC ERROR [
            h: Handle,
            errorReason: CrRPC.ErrorReason,
            text: ROPE] ~ CODE;
    <<Create / Set Parameters / Destroy for Client Handles>>
        CreateClientHandleProcValue: TYPE ~ REF CreateClientHandleProcValueObject;
        CreateClientHandleProcValueObject: TYPE ~ RECORD [
            createClientHandleProc: CrRPCFriends.CreateClientHandleProc ];

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

        RegisterCreateClientHandleProc: PUBLIC PROC [
        class: ATOM, proc: CrRPCFriends.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 [CrRPCFriends.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: 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] };

    <<Calling a Remote Procedure>>
        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];
            };

    <<Create / Destroy for Servers>>
        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]
            <<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 [CrRPCFriends.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, 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] ] };
    <<Marshalling Procs>>
        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]] };
            <<IF littleEndian THEN FOR i: CARDINAL IN [0..2*n) DO>>
                <<seqCARDINAL.body[i] _ CfH[LOOPHOLE[seqCARDINAL.body[i]]];>>
                <<ENDLOOP; ????>>
            };

        PutSeqCARDINAL: PUBLIC PROC [h: Handle, seqCARDINAL: CrRPC.SeqCARDINAL] ~ {
            n: CARDINAL ~ seqCARDINAL.length;
            <<IF littleEndian THEN FOR i: CARDINAL IN [0..2*n) DO>>
                <<seqCARDINAL.body[i] _ LOOPHOLE[HfC[seqCARDINAL.body[i]]];>>
                <<ENDLOOP; ????>>
            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]] };
    <<Finalization>>
        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;
            };

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

        }.