
<<CrRPCImpl.mesa>>
    <<Copyright © 1986 by Xerox Corporation.  All rights reserved.>>
    <<Demers, December 20, 1986 1:47:31 pm PST>>
    <<>>
    <<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],
        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); -- ????
    <<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,
            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]
            <<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 [CrRPCBackdoor.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, local: CrRPC.RefAddress] ~ {
            proc: CrRPCBackdoor.CreateListenerProc ~ LookupCreateListenerProc[class];
            IF proc = NIL THEN ERROR Error[NIL, unknownClass, NIL];
            proc[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] ~ {
            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]] };
    <<Finalization>>
        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;
            };

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

        }.