DataMuseum.dk Presents historical artifacts from the history of: Rational R1000/400

This is an automatic "excavation" of a thematic subset of artifacts from Datamuseum.dk's BitArchive. See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software.

top - download

⟦a79203dcd⟧ Ada Source

    Length: 8192 (0x2000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Rpc_Client, seg_0009d2

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦this⟧ 

with Transport_Interchange;  
with Transport_Stream;

package body Rpc_Client is

    Supported_Versions : constant Rpc.Version_Range := (3, 5);

    procedure Exchange_Versions (Stream : Transport_Stream.Stream_Id) is  
        Server_Versions : Rpc.Version_Range;  
    begin  
        Rpc.Put (Stream, Supported_Versions);  
        Transport_Stream.Flush_Transmit_Buffer (Stream);  
        Rpc.Get (Stream, Server_Versions);

        if Rpc.Overlaps (Server_Versions, Supported_Versions) then  
            Transport_Stream.Set_User_Id  
               (Stream, Integer (Rpc.Max (Server_Versions,  
                                          Supported_Versions)));  
        else  
            Transport_Stream.Disconnect (Stream);  
            raise Rpc.No_Such_Version;  
        end if;  
    end Exchange_Versions;

    procedure Start_Request (The_Stream : Transport_Stream.Stream_Id;  
                             Is_New : Boolean;  
                             Proc : Rpc.Procedure_Number;  
                             Program : Rpc.Program_Number;  
                             Version : Rpc.Version_Number;  
                             Username : String;  
                             Password : String) is  
    begin  
        if Is_New then  
            Exchange_Versions (The_Stream);  
        end if;  
        Rpc.Put_Message (The_Stream,  
                         (Rpc.Call_Message, 0, Program, Version, Proc));  
        if Rpc.Version_Number (Transport_Stream.Get_User_Id (The_Stream)) in  
           Rpc.Username_Versions.First .. Rpc.Username_Versions.Last then  
            Transport_Interchange.Put_String (The_Stream, Username);  
            Transport_Interchange.Put_String (The_Stream, Password);  
        end if;  
    end Start_Request;

    procedure Start_Request (Stream : out Transport_Stream.Stream_Id;  
                             Proc : Rpc.Procedure_Number;  
                             Network : Transport_Defs.Network_Name;  
                             Host : Transport_Defs.Host_Id;  
                             Socket : Transport_Defs.Socket_Id;  
                             Program : Rpc.Program_Number;  
                             Version : Rpc.Version_Number;  
                             Username : String;  
                             Password : String) is  
        The_Stream : Transport_Stream.Stream_Id;  
        Is_New : Boolean;  
    begin  
        Transport_Stream.Allocate (The_Stream, Is_New, Network, Host, Socket);  
        Start_Request (The_Stream, Is_New, Proc, Program, Version,  
                       Username, Password);  
        Stream := The_Stream;  
    end Start_Request;

    procedure Start_Request_With_Username  
                 (Stream : out Transport_Stream.Stream_Id;  
                  Proc : Rpc.Procedure_Number;  
                  Network : Transport_Defs.Network_Name := Default_Network;                   Host : Transport_Defs.Host_Id := Default_Host;  
                  Socket : Transport_Defs.Socket_Id := Default_Socket;  
                  Program : Rpc.Program_Number := Default_Program;  
                  Version : Rpc.Version_Number := Default_Version;  
                  Username : String := Default_Username;  
                  Password : String := Default_Password) is  
    begin  
        Start_Request  
           (Stream, Proc, Network, Host, Socket, Program, Version,  
            Username, Password);  
    end Start_Request_With_Username;

    procedure Start_Request_Generic  
                 (Stream : out Transport_Stream.Stream_Id;  
                  Proc : Rpc.Procedure_Number;  
                  Network : Transport_Defs.Network_Name := Default_Network;  
                  Host : Transport_Defs.Host_Id := Default_Host;  
                  Socket : Transport_Defs.Socket_Id := Default_Socket;  
                  Program : Rpc.Program_Number := Default_Program;  
                  Version : Rpc.Version_Number := Default_Version) is  
    begin  
        Start_Request  
           (Stream, Proc, Network, Host, Socket, Program, Version,  
            Username => "",  
            Password => "");  
    end Start_Request_Generic;

    procedure Begin_Request_Generic (Stream : out Transport_Stream.Stream_Id;  
                                     Proc : Rpc.Procedure_Number) is  
        The_Stream : Transport_Stream.Stream_Id;  
        Is_New : Boolean;  
    begin  
        Transport_Stream.Allocate (The_Stream, Pool, Is_New);  
        Start_Request  
           (The_Stream, Is_New, Proc, Program, Version,  
            Username => "",  
            Password => "");  
        Stream := The_Stream;  
    end Begin_Request_Generic;

    procedure End_Request_With_Exception  
                 (Stream : Transport_Stream.Stream_Id) is  
        Response : Rpc.Message_Header;  
        Excep : Rpc.Exception_Number;  
    begin  
        Transport_Stream.Flush_Transmit_Buffer (Stream);  
        Response := Rpc.Get_Message (Stream);

        if Rpc."/=" (Response.Kind, Rpc.Return_Message) then  
            Transport_Stream.Disconnect (Stream);  
            raise Rpc.Protocol_Error;  
        end if;  
    exception  
        when Rpc.Server_Defined_Error =>  
            Rpc.Get (Stream, Excep);  
            End_Response (Stream);  
            Raise_Exception (Excep);  
            raise; -- in case Raise_Exception didn't.
        when others =>  
            End_Response (Stream);  
            raise;  
    end End_Request_With_Exception;

    procedure Raise_Unknown_Exception (Excep : Rpc.Exception_Number) is  
    begin  
        raise Rpc.Server_Defined_Error; -- JMK 10/24/86 redundant, but why not.
    end Raise_Unknown_Exception;

    procedure End_Request_Guts is  
       new End_Request_With_Exception  
              (Raise_Exception => Raise_Unknown_Exception);

    procedure End_Request (Stream : Transport_Stream.Stream_Id) is  
    begin  
        End_Request_Guts (Stream);  
    end End_Request;

    procedure End_Response (Stream : Transport_Stream.Stream_Id) is  
    begin  
        Transport_Stream.Deallocate (Stream);  
    end End_Response;

end Rpc_Client;  

    nblk1=7
    nid=0
    hdr6=e
        [0x00] rec0=1c rec1=00 rec2=01 rec3=020
        [0x01] rec0=14 rec1=00 rec2=02 rec3=02c
        [0x02] rec0=14 rec1=00 rec2=03 rec3=002
        [0x03] rec0=12 rec1=00 rec2=04 rec3=04e
        [0x04] rec0=19 rec1=00 rec2=05 rec3=014
        [0x05] rec0=1b rec1=00 rec2=06 rec3=024
        [0x06] rec0=0d rec1=00 rec2=07 rec3=000
    tail 0x2050016847bac64b7210e 0x42a00088462060003