⟦921846d85⟧

E3 Source Code



WITH Io_Exceptions;
WITH Text_Io;
WITH Transport_Interchange;
WITH X_Defs;
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
      Incompatible_Message_Header_Error : EXCEPTION;
   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);  
         WHEN Time_Out_Message =>
            RAISE Incompatible_Message_Header_Error;
      END CASE;
   END Put_Message;

   FUNCTION Get_Message (From : Stream_Id) RETURN Message_Header IS
      Kind : Message_Kind;
   BEGIN
      DECLARE
      BEGIN
         Mkind.Get (From, Kind);
      EXCEPTION
         WHEN X_Defs.No_Data_To_Read =>
            Kind := Rpc.Time_Out_Message;
            Text_Io.Put_Line ("rpc.Get_message: caught No_Data_To_Read");
      END;

      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 Time_Out_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;
DataMuseum.dk

Rational R1000/400

⟦921846d85⟧ Ada Source

Derivation

E3 Source Code

E3 Meta Data
