DataMuseum.dk

top - metrics - download

    Length: 5954 (0x1742)
    Types: TextFile
    Names: »B«

└─⟦bad92a95e⟧ Bits:30000535 8mm tape, Rational 1000, RPC 1_0_2
    └─⟦bb34fe6e2⟧ »DATA« 
        └─⟦15d8b76c6⟧ 
            └─⟦this⟧ 

TextFile

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);

                    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 others =>
                            raise Protocol_Error;
                    end case;
            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;