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

⟦6e38d9da9⟧ Ada Source

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

Derivation

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

with Calendar;  
with Io_Exceptions;  
with Transport_Interchange;

package body Rpc is

    package Rkind is new Transport_Interchange.Discrete (Reject_Kind);  
    package Mkind is new Transport_Interchange.Discrete (Message_Kind);  
    package Error is new Transport_Interchange.Discrete (Error_Type);

    use Transport_Interchange;

    procedure Put (Into : Stream_Id; Data : Version_Range) is  
    begin  
        Put (Into, Interchange.Short_Integer (Data.First));  
        Put (Into, Interchange.Short_Integer (Data.Last));  
    end Put;

    procedure Get (From : Stream_Id; Data : out Version_Range) is  
    begin  
        Get (From, Interchange.Short_Integer (Data.First));  
        Get (From, Interchange.Short_Integer (Data.Last));  
    end Get;

    procedure Put_Reject (Into : Stream_Id; Data : Reject_Details) is  
    begin  
        Rkind.Put (Into, Data.Kind);

        case Data.Kind is  
            when Rej_No_Such_Version =>  
                Put (Into, Data.Supported);  
            when others =>  
                null;  
        end case;  
    end Put_Reject;

    function Get_Reject (From : Stream_Id) return Reject_Details is  
        Kind : Reject_Kind;  
    begin  
        Rkind.Get (From, Kind);

        declare  
            Data : Reject_Details (Kind => Kind);  
        begin  
            case Data.Kind is  
                when Rej_No_Such_Program =>  
                    raise No_Such_Program;  
                when Rej_No_Such_Version =>  
                    Get (From, Data.Supported);  
                    raise No_Such_Version;  
                when Rej_No_Such_Procedure =>  
                    raise No_Such_Procedure;  
                when Rej_Invalid_Argument =>  
                    raise Invalid_Argument;  
            end case;

            return Data;  
        end;  
    end Get_Reject;


    procedure Put_Message (Into : Stream_Id; Data : Message_Header) is  
    begin  
        Mkind.Put (Into, Data.Kind);  
        Put (Into, Interchange.Short_Integer (Data.Id));

        case Data.Kind is  
            when Call_Message =>  
                Put (Into, Interchange.Integer (Data.Program));  
                Put (Into, Interchange.Short_Integer (Data.Version));  
                Put (Into, Interchange.Short_Integer (Data.Proc));  
            when Reject_Message =>  
                Put_Reject (Into, Data.Details);  
            when Return_Message =>  
                null;  
            when Abort_Message =>  
                Error.Put (Into, Data.Error);  
        end case;  
    end Put_Message;

    function Get_Message (From : Stream_Id) return Message_Header is  
        Kind : Message_Kind;  
    begin  
        Mkind.Get (From, Kind);  
        declare  
            Data : Message_Header (Kind => Kind);  
        begin  
            Get (From, Interchange.Short_Integer (Data.Id));  
            case Kind is  
                when Call_Message =>  
                    Get (From, Interchange.Integer (Data.Program));  
                    Get (From, Interchange.Short_Integer (Data.Version));  
                    Get (From, Interchange.Short_Integer (Data.Proc));  
                when Reject_Message =>  
                    Data.Details := Get_Reject (From);  
                when Return_Message =>  
                    null;  
                when Abort_Message =>  
                    Error.Get (From, Data.Error);  
            end case;  
            case Kind is  
                when Abort_Message =>  
                    case Data.Error is  
                        when Error_Other =>  
                            raise Other_Error;  
                        when Error_Constraint =>  
                            raise Standard.Constraint_Error;  
                        when Error_Numeric =>  
                            raise Standard.Numeric_Error;  
                        when Error_Program =>  
                            raise Standard.Program_Error;  
                        when Error_Storage =>  
                            raise Standard.Storage_Error;  
                        when Error_Tasking =>  
                            raise Standard.Tasking_Error;  
                        when Status_Error =>  
                            raise Io_Exceptions.Status_Error;  
                        when Mode_Error =>  
                            raise Io_Exceptions.Mode_Error;  
                        when Name_Error =>  
                            raise Io_Exceptions.Name_Error;  
                        when Use_Error =>  
                            raise Io_Exceptions.Use_Error;  
                        when Device_Error =>  
                            raise Io_Exceptions.Device_Error;  
                        when End_Error =>  
                            raise Io_Exceptions.End_Error;  
                        when Data_Error =>  
                            raise Io_Exceptions.Data_Error;  
                        when Layout_Error =>  
                            raise Io_Exceptions.Layout_Error;  
                        when Error_Server_Defined =>  
                            raise Server_Defined_Error;  
                        when Error_Username_Or_Password =>  
                            raise Username_Or_Password_Error;  
                    end case;  
                when others =>  
                    null;  
            end case;  
            return Data;  
        end;  
    end Get_Message;

    procedure Put (Into : Stream_Id; Data : Exception_Number) is  
    begin  
        Transport_Interchange.Put (Into, Interchange.Integer (Data));  
    end Put;

    procedure Get (From : Stream_Id; Data : out Exception_Number) is  
    begin  
        Transport_Interchange.Get (From, Interchange.Integer (Data));  
    end Get;

    function Non_Null (X : Version_Range) return Boolean is  
    begin  
        return X.First <= X.Last;  
    end Non_Null;

    function Overlaps (X, Y : Version_Range) return Boolean is  
    begin  
        return Non_Null (X) and then Non_Null (Y) and then  
                  (X.First <= Y.Last or else X.Last >= Y.First);  
    end Overlaps;

    function Max (X, Y : Version_Range) return Version_Number is  
    begin  
        if X.Last > Y.Last then  
            return Y.Last;  
        else  
            return X.Last;  
        end if;  
    end Max;

end Rpc;  

    nblk1=7
    nid=0
    hdr6=e
        [0x00] rec0=1f rec1=00 rec2=01 rec3=04a
        [0x01] rec0=20 rec1=00 rec2=02 rec3=04c
        [0x02] rec0=1a rec1=00 rec2=03 rec3=054
        [0x03] rec0=15 rec1=00 rec2=04 rec3=02a
        [0x04] rec0=12 rec1=00 rec2=05 rec3=042
        [0x05] rec0=18 rec1=00 rec2=06 rec3=070
        [0x06] rec0=18 rec1=00 rec2=07 rec3=000
    tail 0x201007cde7bac64b24539 0x42a00088462060003