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

⟦d97300975⟧ Ada Source

    Length: 26624 (0x6800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, seg_0217be

Derivation

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

WITH Interchange_Float;
WITH Pragma_Assert;

PACKAGE BODY Interchange IS

   SUBTYPE Padding_Type IS Byte_String (1 .. 1);  
   Padding : CONSTANT Padding_Type := (OTHERS => 0);

   Radix : CONSTANT Long_Integer := Long_Integer (Byte'Last) + 1;
   SUBTYPE Signed_Byte_Range IS Long_Integer
                                   RANGE -(Radix / 2) .. (Radix / 2) - 1;

   Scale_A : CONSTANT Standard.Natural  
       := Interchange_Defs.Duration_Magnitude;  
   Scale_B : CONSTANT Standard.Natural := (10 ** 9) / Scale_A;

--   PRAGMA Assert (Scale_A * Scale_B = 10 ** 9);
   Junk : Boolean := Pragma_Assert.Check (Scale_A * Scale_B = 10 ** 9);

   Half_Scale_B : CONSTANT Standard.Natural  := Scale_B / 2;
   Half_Scale_A : CONSTANT Standard.Duration :=
      (Standard.Duration'Delta * Scale_A) / 2;

   FUNCTION Convert (X : Standard.Duration) RETURN Interchange.Duration IS  
      Seconds     : Interchange.Integer;  
      Fraction    : Standard.Duration;  
      Nanoseconds : Standard.Natural;
   BEGIN  
      Seconds  := Interchange.Integer (X);
      Fraction := X - Standard.Duration (Seconds);
      IF Fraction < 0.0 THEN  
         Seconds  := Seconds - 1;  
         Fraction := X - Standard.Duration (Seconds);
      END IF;
--      PRAGMA Assert (Fraction >= 0.0);
      Pragma_Assert.Check (Fraction >= 0.0);
--      PRAGMA Assert (Fraction < 1.0);
      Pragma_Assert.Check (Fraction < 1.0);
      Nanoseconds := Standard.Natural (Fraction * Scale_A) * Scale_B;  
      IF Nanoseconds > Standard.Natural
                          (Interchange.Nanosecond_Count'Last) THEN
         -- duration'delta < 10 ** -9
         Seconds     := Seconds + 1;  
         Nanoseconds := 0;  
      END IF;
      RETURN Interchange.Duration'(Seconds,
                                   Interchange.Nanosecond_Count (Nanoseconds));
   EXCEPTION  
      WHEN Standard.Constraint_Error | Standard.Numeric_Error =>  
         RAISE Interchange.Constraint_Error;  
   END Convert;

   FUNCTION Convert (X : Interchange.Duration) RETURN Standard.Duration IS
      Fraction : Standard.Duration;
   BEGIN  
      Fraction :=
         Standard.Duration
            ((Standard.Natural (X.Nanoseconds) + Half_Scale_B) / Scale_B);
      -- Adding Half_Scale_B before dividing by Scale_B has the effect of
      -- rounding to the NEAREST Integer, rather than the next smallest.
      Fraction := (Fraction + Half_Scale_A) / Scale_A;
      -- The Ada LRM does not specify how rounding is done when dividing
      -- a Duration (fixed-point) by an Integer.  The R1000 rounds DOWN.
      -- Adding Half_Scale_A before dividing by Scale_A has the effect of
      -- rounding to the NEAREST Duration, rather than the next smallest.
      RETURN Standard.Duration (X.Seconds) + Fraction;
   EXCEPTION  
      WHEN Standard.Constraint_Error | Standard.Numeric_Error =>  
         RAISE Interchange.Constraint_Error;  
   END Convert;

   FUNCTION Convert (X : Calendar.Time) RETURN Interchange.Time IS
      Seconds : Calendar.Day_Duration;
      Y       : Time;
   BEGIN
      Calendar.Split (X, Calendar.Year_Number (Y.Year),
                      Calendar.Month_Number (Y.Month),
                      Calendar.Day_Number (Y.Day), Seconds);
      Y.Seconds := Convert (Seconds);
      RETURN Y;
   EXCEPTION
      WHEN Standard.Constraint_Error | Standard.Numeric_Error =>
         RAISE Interchange.Constraint_Error;
   END Convert;

   FUNCTION Convert (X : Interchange.Time) RETURN Calendar.Time IS
   BEGIN
      RETURN Calendar.Time_Of
                (Calendar.Year_Number (X.Year),
                 Calendar.Month_Number (X.Month),
                 Calendar.Day_Number (X.Day), Convert (X.Seconds));
   EXCEPTION
      WHEN Standard.Constraint_Error | Standard.Numeric_Error =>
         RAISE Interchange.Constraint_Error;
   END Convert;

   PACKAGE BODY Operations IS

      PROCEDURE Put (Into  : Stream_Id;
                     Data  : Long_Integer;
                     Bytes : Interchange.Natural) IS
         Data_Copy : Long_Integer := Data;
         Data_Byte : Byte_String (1 .. Standard.Natural (Bytes));
         Temp      : Long_Integer;
      BEGIN
         IF Bytes <= 0 THEN
            IF Data /= 0 THEN
               RAISE Interchange.Constraint_Error;
            END IF;
         ELSE
            FOR I IN REVERSE 2 .. Data_Byte'Last LOOP
               Temp          := Data_Copy MOD Radix;
               Data_Byte (I) := Byte (Temp);
               Data_Copy     := (Data_Copy - Temp) / Radix;
            END LOOP;

            Data_Byte (1) := Byte (Signed_Byte_Range (Data_Copy) MOD Radix);
            Put (Into, Data_Byte);
         END IF;
      EXCEPTION
         WHEN Standard.Constraint_Error | Standard.Numeric_Error =>
            RAISE Interchange.Constraint_Error;
      END Put;

      PROCEDURE Get (From  :     Stream_Id;
                     Data  : OUT Long_Integer;
                     Bytes :     Interchange.Natural) IS
         Data_Byte : Byte_String (1 .. Standard.Natural (Bytes));
         Data_Copy : Long_Integer;
      BEGIN
         IF Bytes <= 0 THEN
            Data := 0;
         ELSE
            Get (From, Data_Byte);
            Data_Copy := Long_Integer (Data_Byte (1));

            IF Data_Copy > Signed_Byte_Range'Last THEN
               Data_Copy := Data_Copy - Radix;
            END IF;

            FOR I IN 2 .. Data_Byte'Last LOOP
               Data_Copy := (Data_Copy * Radix) + Long_Integer (Data_Byte (I));
            END LOOP;

            Data := Data_Copy;
         END IF;
      EXCEPTION
         WHEN Standard.Constraint_Error | Standard.Numeric_Error =>
            RAISE Interchange.Constraint_Error;
      END Get;

      PROCEDURE Put (Into : Stream_Id; Data : Interchange.Short_Integer) IS
      BEGIN
         Put (Into, Long_Integer (Data), 2);
      END Put;

      PROCEDURE Get (From : Stream_Id; Data : OUT Interchange.Short_Integer) IS
      BEGIN
         Get (From, Long_Integer (Data), 2);
      END Get;

      PROCEDURE Put (Into : Stream_Id; Data : Interchange.Integer) IS
      BEGIN
         Put (Into, Long_Integer (Data), 4);
      END Put;

      PROCEDURE Get (From : Stream_Id; Data : OUT Interchange.Integer) IS
      BEGIN
         Get (From, Long_Integer (Data), 4);
      END Get;

      PROCEDURE Put (Into : Stream_Id; Data : Long_Integer) IS
         Data_Copy : Long_Integer := Data;
         Bytes     : Interchange.Natural;
      BEGIN
         IF Data_Copy = 0 THEN
            Bytes := 0;
         ELSE
            Bytes := 1;

            WHILE NOT (Data_Copy IN Signed_Byte_Range) LOOP
               Bytes     := Bytes + 1;
               Data_Copy := Data_Copy / Radix;
            END LOOP;
         END IF;

         Put (Into, Bytes);
         Put (Into, Data, Bytes);

         IF Bytes MOD 2 /= 0 THEN
            Put (Into, Padding);
         END IF;
      EXCEPTION
         WHEN Standard.Constraint_Error | Standard.Numeric_Error =>
            RAISE Interchange.Constraint_Error;
      END Put;

      PROCEDURE Get (From : Stream_Id; Data : OUT Interchange.Long_Integer) IS
         Bytes   : Interchange.Natural; -- JMK 7/14/86
         Padding : Padding_Type;
      BEGIN
         Get (From, Bytes);
         Get (From, Data, Bytes);

         IF Bytes MOD 2 /= 0 THEN
            Get (From, Padding);
         END IF;
      EXCEPTION
         WHEN Standard.Constraint_Error | Standard.Numeric_Error =>
            RAISE Interchange.Constraint_Error;
      END Get;

      PROCEDURE Put (Into : Stream_Id; Data : Interchange.Float) IS
      BEGIN
         Put (Into, Byte_String (Interchange_Float.Convert
                                    (Interchange_Defs.Float (Data))));
      EXCEPTION
         WHEN Standard.Constraint_Error | Standard.Numeric_Error =>
            RAISE Interchange.Constraint_Error;
      END Put;

      PROCEDURE Put (Into : Stream_Id; Data : Interchange.Long_Float) IS
      BEGIN
         Put (Into, Byte_String (Interchange_Float.Convert
                                    (Interchange_Defs.Long_Float (Data))));
      EXCEPTION
         WHEN Standard.Constraint_Error | Standard.Numeric_Error =>
            RAISE Interchange.Constraint_Error;
      END Put;

      PROCEDURE Get (From : Stream_Id; Data : OUT Interchange.Float) IS
         Bytes : Byte_String (1 .. Interchange_Float.Float'Length);
      BEGIN
         Get (From, Bytes);
         Data := Interchange.Float (Interchange_Float.Convert
                                       (Interchange_Float.Float (Bytes)));
      EXCEPTION
         WHEN Standard.Constraint_Error | Standard.Numeric_Error =>
            RAISE Interchange.Constraint_Error;
      END Get;

      PROCEDURE Get (From : Stream_Id; Data : OUT Interchange.Long_Float) IS
         Bytes : Byte_String (1 .. Interchange_Float.Long_Float'Length);
      BEGIN
         Get (From, Bytes);
         Data := Interchange.Long_Float
                    (Interchange_Float.Convert
                        (Interchange_Float.Long_Float (Bytes)));
      EXCEPTION
         WHEN Standard.Constraint_Error | Standard.Numeric_Error =>
            RAISE Interchange.Constraint_Error;
      END Get;

      PROCEDURE Put (Into : Stream_Id; Data : Interchange.Duration) IS
      BEGIN
         Put (Into, Data.Seconds);
         Put (Into, Data.Nanoseconds);
      END Put;

      PROCEDURE Get (From : Stream_Id; Data : OUT Interchange.Duration) IS
      BEGIN
         Get (From, Data.Seconds);
         Get (From, Data.Nanoseconds);
      END Get;

      PROCEDURE Put (Into : Stream_Id; Data : Interchange.Time) IS
      BEGIN
         Put (Into, Data.Year);
         Put (Into, Data.Month);
         Put (Into, Data.Day);
         Put (Into, Data.Seconds);
      END Put;

      PROCEDURE Get (From : Stream_Id; Data : OUT Interchange.Time) IS
      BEGIN
         Get (From, Data.Year);
         Get (From, Data.Month);
         Get (From, Data.Day);
         Get (From, Data.Seconds);
      END Get;

      PROCEDURE Put (Into : Stream_Id; Data : Standard.Boolean) IS
      BEGIN
         IF Data THEN
            Put (Into, Interchange.Short_Natural (1));
         ELSE
            Put (Into, Interchange.Short_Natural (0));
         END IF;
      END Put;

      PROCEDURE Get (From : Stream_Id; Data : OUT Standard.Boolean) IS
         Temp : Interchange.Short_Natural;
      BEGIN
         Get (From, Temp);
         Data := (Temp /= 0);
      END Get;

      PROCEDURE Put (Into : Stream_Id; Data : Standard.Character) IS
      BEGIN
         Put (Into, Interchange.Short_Natural (Standard.Character'Pos (Data)));
      EXCEPTION
         WHEN Standard.Constraint_Error | Standard.Numeric_Error =>
            RAISE Interchange.Constraint_Error;
      END Put;

      PROCEDURE Get (From : Stream_Id; Data : OUT Standard.Character) IS
         Temp : Interchange.Short_Natural;
      BEGIN
         Get (From, Temp);
         Data := Standard.Character'Val (Temp);
      EXCEPTION
         WHEN Standard.Constraint_Error | Standard.Numeric_Error =>
            RAISE Interchange.Constraint_Error;
      END Get;

      PROCEDURE Put_Byte_String (Into : Stream_Id;
                                 Data : Interchange.Byte_String) IS
      BEGIN
         Put (Into, Interchange.Natural (Data'Length));
         Put (Into, Data);

         IF Data'Length MOD 2 /= 0 THEN
            Put (Into, Padding);
         END IF;
      EXCEPTION
         WHEN Standard.Constraint_Error | Standard.Numeric_Error =>
            RAISE Interchange.Constraint_Error;
      END Put_Byte_String;

      FUNCTION Get_Byte_String (From : Stream_Id)
                               RETURN Interchange.Byte_String IS
         Length  : Interchange.Natural;
         Padding : Padding_Type;
      BEGIN
         Get (From, Length);

         DECLARE
            Answer : Interchange.Byte_String (1 .. Standard.Natural (Length));
         BEGIN
            Get (From, Answer);

            IF Answer'Length MOD 2 /= 0 THEN
               Get (From, Padding);
            END IF;

            RETURN Answer;
         END;
      EXCEPTION
         WHEN Standard.Constraint_Error | Standard.Numeric_Error =>
            RAISE Interchange.Constraint_Error;
      END Get_Byte_String;

      PROCEDURE Put_String (Into : Stream_Id; Data : Standard.String) IS
         Bytes : Interchange.Byte_String (Data'First .. Data'Last);
      BEGIN
         FOR I IN Data'Range LOOP
            Bytes (I) := Interchange.Byte (Character'Pos (Data (I)));
         END LOOP;

         Put_Byte_String (Into, ytes);
      EXCEPTION
         WHEN Standard.Constraint_Error | Standard.Numeric_Error =>
            RAISE Interchange.Constraint_Error;
      END Put_String;

      FUNCTION Get_String (From : Stream_Id) RETURN Standard.String IS
         Bytes  : CONSTANT Interchange.Byte_String := Get_Byte_String (From);
         Answer : Standard.String (Bytes'First .. Bytes'Last);
      BEGIN
         FOR I IN Answer'Range LOOP
            Answer (I) := Standard.Character'Val (Bytes (I));
         END LOOP;

         RETURN Answer;
      EXCEPTION
         WHEN Standard.Constraint_Error | Standard.Numeric_Error =>
            RAISE Interchange.Constraint_Error;
      END Get_String;

      PROCEDURE Put (Into : Stream_Id; Data : Interchange.Byte) IS
      BEGIN
         Put (Into, Interchange.Short_Natural (Data));
      END Put;

      PROCEDURE Get (From : Stream_Id; Data : OUT Interchange.Byte) IS
      BEGIN
         Get (From, Interchange.Short_Integer (ata));
      EXCEPTION
         WHEN Standard.Constraint_Error | Standard.Numeric_Error =>
            RAISE Interchange.Constraint_Error;
      END Get;

      PACKAGE BODY Discrete IS

         PROCEDURE Put (Into : Stream_Id; Data : Discrete_Type) IS
         BEGIN
            Put (Into, Interchange.Short_Natural (Discrete_Type'Pos (Data)));
         EXCEPTION
            WHEN Standard.Constraint_Error | Standard.Numeric_Error =>
               RAISE Interchange.Constraint_Error;
         END Put;

         PROCEDURE Get (From : Stream_Id; Data : OUT Discrete_Type) IS
            Pos : Interchange.Short_Natural;
         BEGIN
            Get (From, Pos);
            Data := Discrete_Type'Val (Pos);
         EXCEPTION
            WHEN Standard.Constraint_Error | Standard.Numeric_Error =>
               RAISE Interchange.Constraint_Error;
         END Get;

      END Discrete;

      PACKAGE BODY Vector IS

         PROCEDURE Put (Into : Stream_Id; Data : Vector_Type) IS
         BEGIN
            Put (Into, Interchange.Natural (Data'Length));

            FOR I IN Data'Range LOOP
               Put (Into, Data (I));
            END LOOP;
         EXCEPTION
            WHEN Standard.Constraint_Error | Standard.Numeric_Error =>
               RAISE Interchange.Constraint_Error;
         END Put;

         FUNCTION Get (From : Stream_Id) RETURN Vector_Type IS
            Length : Interchange.Natural;
         BEGIN
            Get (From, Length);

            DECLARE
               Data : Vector_Type (Index_Type'First ..
                                      Index_Type'Val
                                         (Index_Type'Pos (Index_Type'First) +
                                          Length - 1));
            BEGIN
               FOR I IN Data'Range LOOP
                  Get (From, Data (I));
               END LOOP;

               RETURN Data;
            END;
         EXCEPTION
            WHEN Standard.Constraint_Error | Standard.Numeric_Error =>
               RAISE Interchange.Constraint_Error;
         END Get;
      END Vector;

   END Operations;

END Interchange;

    nblk1=19
    nid=0
    hdr6=32
        [0x00] rec0=1c rec1=00 rec2=01 rec3=004
        [0x01] rec0=00 rec1=00 rec2=19 rec3=010
        [0x02] rec0=17 rec1=00 rec2=02 rec3=038
        [0x03] rec0=00 rec1=00 rec2=18 rec3=00c
        [0x04] rec0=16 rec1=00 rec2=03 rec3=008
        [0x05] rec0=1b rec1=00 rec2=04 rec3=02a
        [0x06] rec0=00 rec1=00 rec2=17 rec3=00c
        [0x07] rec0=1a rec1=00 rec2=05 rec3=056
        [0x08] rec0=01 rec1=00 rec2=16 rec3=022
        [0x09] rec0=1d rec1=00 rec2=06 rec3=004
        [0x0a] rec0=21 rec1=00 rec2=07 rec3=034
        [0x0b] rec0=00 rec1=00 rec2=15 rec3=00e
        [0x0c] rec0=1e rec1=00 rec2=08 rec3=034
        [0x0d] rec0=00 rec1=00 rec2=14 rec3=004
        [0x0e] rec0=18 rec1=00 rec2=09 rec3=040
        [0x0f] rec0=1c rec1=00 rec2=0a rec3=012
        [0x10] rec0=20 rec1=00 rec2=0b rec3=020
        [0x11] rec0=1c rec1=00 rec2=0c rec3=03a
        [0x12] rec0=1e rec1=00 rec2=0d rec3=040
        [0x13] rec0=00 rec1=00 rec2=13 rec3=002
        [0x14] rec0=1b rec1=00 rec2=0e rec3=05e
        [0x15] rec0=00 rec1=00 rec2=12 rec3=002
        [0x16] rec0=1e rec1=00 rec2=0f rec3=044
        [0x17] rec0=1d rec1=00 rec2=10 rec3=01a
        [0x18] rec0=09 rec1=00 rec2=11 rec3=001
    tail 0x2151ce0fc838e77d9b0d3 0x489e0066482863c01