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

⟦c887b57e6⟧ Ada Source

    Length: 8192 (0x2000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, seg_018514

Derivation

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

WITH Interchange;
WITH Transport_Stream;

PACKAGE Rpc IS

   TYPE Version_Number IS NEW Interchange.Short_Integer;

   TYPE Version_Range IS
      RECORD
         First, Last : Version_Number;
      END RECORD;

   TYPE Transaction_Id IS NEW Interchange.Short_Integer;

   TYPE Program_Number IS NEW Interchange.Integer;

   TYPE Procedure_Number IS NEW Interchange.Short_Integer;


   TYPE Error_Type IS (Error_Other, Error_Constraint, Error_Numeric,
                       Error_Program, Error_Storage, Error_Tasking,
                       Status_Error, Mode_Error, Name_Error, Use_Error,
                       Device_Error, End_Error, Data_Error, Layout_Error,
                       Error_Server_Defined, Error_Username_Or_Password);

   -- for Error_Type use
   --     (0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15);


   TYPE Reject_Kind IS (Rej_No_Such_Program, Rej_No_Such_Version,
                        Rej_No_Such_Procedure, Rej_Invalid_Argument);

   -- for Reject_Kind use (0, 1, 2, 3);


   TYPE Reject_Details (Kind : Reject_Kind := Rej_Invalid_Argument) IS
      RECORD
         CASE Kind IS
            WHEN Rej_No_Such_Version =>
               Supported : Version_Range;
            WHEN OTHERS =>
               NULL;
         END CASE;
      END RECORD;


   TYPE Message_Kind IS (Call_Message, Reject_Message, Return_Message,
                         Abort_Message, Time_Out_Message);

   -- for Message_Kind use (0, 1, 2, 3, 4);


   TYPE Message_Header (Kind : Message_Kind := Return_Message) IS
      RECORD
         Id : Transaction_Id := 0;
         CASE Kind IS
            WHEN Call_Message =>
               Program : Program_Number;
               Version : Version_Number;
               Proc    : Procedure_Number;
               -- argument values follow
            WHEN Reject_Message =>
               Details : Reject_Details;
            WHEN Return_Message =>
               NULL;
               -- result values follow
            WHEN Abort_Message =>
               Error : Error_Type;
            WHEN Time_Out_Message =>
               NULL;
               -- used to return the control to the main loop
         END CASE;
      END RECORD;


   -- Interchange operations on the above types:

   SUBTYPE Stream_Id IS Transport_Stream.Stream_Id;

   PROCEDURE Put (Into : Stream_Id; Data : Version_Range);
   PROCEDURE Get (From : Stream_Id; Data : OUT Version_Range);

   PROCEDURE Put_Message (Into : Stream_Id; Data : Message_Header);
   FUNCTION  Get_Message (From : Stream_Id) RETURN Message_Header;

   -- This last procedure is a little unusual.  If the gotten value
   -- is OK, it returns it, otherwise it raises the corresponding
   -- exception.  In a sense, an exception (or lack thereof) is a
   -- possible return value.

   Protocol_Error       : EXCEPTION;
   No_Such_Program      : EXCEPTION;
   No_Such_Version      : EXCEPTION;
   No_Such_Procedure    : EXCEPTION;
   Other_Error          : EXCEPTION;
   Invalid_Argument     : EXCEPTION;
   Server_Defined_Error : EXCEPTION;


   TYPE Exception_Number IS NEW Interchange.Integer;

   PROCEDURE Put (Into : Stream_Id; Data : Exception_Number);
   PROCEDURE Get (From : Stream_Id; Data : OUT Exception_Number);


   FUNCTION Overlaps (X, Y : Version_Range) RETURN Boolean;
   -- Return true if X and Y have some versions in common.

   FUNCTION Max (X, Y : Version_Range) RETURN Version_Number;
   -- Return the largest version which is common to both X & Y.

   Defined_Versions : CONSTANT Version_Range := (3, 5);
   -- RPC protocol versions which have been defined.

   Exception_Versions : CONSTANT Version_Range := (4, Version_Number'Last);
   -- RPC protocol versions which support server-defined exceptions.

   Username_Versions : CONSTANT Version_Range := (5, Version_Number'Last);
   -- RPC protocol versions which support passing Username & Password
   -- information with each call.

   Username_Or_Password_Error : EXCEPTION;
   -- The Username & Password supplied with a remote procedure call
   -- were rejected by the server machine, either because there is
   -- no such Username or because the Password is incorrect.

END Rpc;

    nblk1=7
    nid=0
    hdr6=e
        [0x00] rec0=20 rec1=00 rec2=01 rec3=06c
        [0x01] rec0=21 rec1=00 rec2=02 rec3=03a
        [0x02] rec0=00 rec1=00 rec2=03 rec3=006
        [0x03] rec0=1d rec1=00 rec2=06 rec3=004
        [0x04] rec0=04 rec1=00 rec2=07 rec3=034
        [0x05] rec0=1a rec1=00 rec2=04 rec3=054
        [0x06] rec0=05 rec1=00 rec2=05 rec3=000
    tail 0x217155310835577dd626d 0x489e0066482863c01