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

⟦da80a16c1⟧ Ada Source

    Length: 7168 (0x1c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, seg_00b2e6

Derivation

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

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;

    nblk1=6
    nid=0
    hdr6=c
        [0x00] rec0=21 rec1=00 rec2=01 rec3=002
        [0x01] rec0=23 rec1=00 rec2=02 rec3=03a
        [0x02] rec0=1c rec1=00 rec2=03 rec3=022
        [0x03] rec0=18 rec1=00 rec2=04 rec3=010
        [0x04] rec0=1b rec1=00 rec2=05 rec3=000
        [0x05] rec0=1a rec1=00 rec2=06 rec3=000
    tail 0x21708295481fa63934a06 0x489e0066482863c01