DataMuseum.dk

top - download

    Length: 6410 (0x190a)
    Types: TextFile
    Names: »B«

└─⟦5f3412b64⟧ Bits:30000745 8mm tape, Rational 1000, ENVIRONMENT 12_6_5 TOOLS 
    └─ ⟦91c658230⟧ »DATA« 
        └─⟦458657fb6⟧ 
            └─⟦a5bbbb819⟧ 
                └─⟦this⟧ 
└─⟦d10a02448⟧ Bits:30000409 8mm tape, Rational 1000, ENVIRONMENT, D_12_7_3
    └─ ⟦fc9b38f02⟧ »DATA« 
        └─⟦9b46a407a⟧ 
            └─⟦eec0a994f⟧ 
                └─⟦this⟧ 

TextFile

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;