DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

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 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ I T

⟦8ead325a9⟧ TextFile

    Length: 12525 (0x30ed)
    Types: TextFile
    Names: »INTERCHANGE_FLOAT_B«

Derivation

└─⟦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 System;
with Unchecked_Conversion;

package body Interchange_Float is

    -- This implementation is specific to VAX/VMS.

    use Byte_Defs;
    use Interchange_Defs;

    Radix : constant := 256;

    subtype Long_Integer is Interchange_Defs.Longest_Integer;
    subtype Long_Natural is Long_Integer range 0..Long_Integer'Last;

    subtype Exponent_Type is Long_Integer range - 127..128;
    subtype Fraction_Type is Long_Integer range 0..(2 ** 23) - 1;

    subtype Long_Exponent_Type is Long_Integer range - 1023..1024;


    -- The following is Vax-specific.
    -- Turns out that Vax Ada runtime does not have an integer
    -- long enough to contain the fractional part of a long float.

    subtype Long_Fraction_Type is Byte_Defs.Byte_String (2..8);

    Zero : constant Long_Fraction_Type := (others => 0);

    function "=" (X, Y : Long_Fraction_Type) return Boolean
                  renames Byte_Defs."=";

    type Long_Float_Bits is
        record
            Word_0 : System.Unsigned_Word;
            Word_1 : System.Unsigned_Word;
            Word_2 : System.Unsigned_Word;
            Word_3 : System.Unsigned_Word;
            Word_4 : System.Unsigned_Word;
            Word_5 : System.Unsigned_Word;
            Word_6 : System.Unsigned_Word;
            Word_7 : System.Unsigned_Word;
        end record;

    function Force is new Unchecked_Conversion
                  (Source => Interchange_Defs.Long_Float, 
                   Target => Long_Float_Bits);

    function Force is new Unchecked_Conversion
                  (Source => Long_Float_Bits, 
                   Target => Interchange_Defs.Long_Float);

    function To_Fraction (X : Interchange_Defs.Long_Float) return Long_Fraction_Type is
        -- Extract the most significant 52 bits of X.fraction.
        -- Return them in the fraction bits of an IEEE float.
        Answer : Long_Fraction_Type;
        X_Copy : Long_Float_Bits;

        function "+" (X, Y : System.Unsigned_Word)
                      return System.Unsigned_Word renames System."+";
        function "/" (X, Y : System.Unsigned_Word)
                      return System.Unsigned_Word renames System."/";
        function "*" (X, Y : System.Unsigned_Word)
                      return System.Unsigned_Word renames System."*";
        function "mod" (X, Y : System.Unsigned_Word)
                      return System.Unsigned_Word renames System."mod";

    begin
        X_Copy     := Force (X);
        Answer (2) := Byte_Defs.Byte (X_Copy.Word_1 / 4096);
        Answer (3) := Byte_Defs.Byte ((X_Copy.Word_1 / 16) mod Radix);
        Answer (4) := Byte_Defs.Byte (((X_Copy.Word_1 mod 16) * 16) + 
            (X_Copy.Word_2 / 4096));
        Answer (5) := Byte_Defs.Byte ((X_Copy.Word_2 / 16) mod Radix);
        Answer (6) := Byte_Defs.Byte (((X_Copy.Word_2 mod 16) * 16) + 
            (X_Copy.Word_3 / 4096));
        Answer (7) := Byte_Defs.Byte ((X_Copy.Word_3 / 16) mod Radix);
        Answer (8) := Byte_Defs.Byte (((X_Copy.Word_3 mod 16) * 16) + 
            (X_Copy.Word_4 / 4096));
        return Answer;
    end To_Fraction;

    function To_Float (X : Long_Fraction_Type) return Interchange_Defs.Long_Float is
        -- Store the fraction part of an IEEE float
        -- into the fraction bits of a Long_Float.
        Answer     : Long_Float_Bits;

        -- We have to do arithmetic in unsigned_words,
        -- because byte arithmetic does sign-extension.
        T1, T2, T3 : System.Unsigned_Word;
        function "+" (X, Y : System.Unsigned_Word)
                      return System.Unsigned_Word renames System."+";
        function "/" (X, Y : System.Unsigned_Word)
                      return System.Unsigned_Word renames System."/";
        function "*" (X, Y : System.Unsigned_Word)
                      return System.Unsigned_Word renames System."*";
        function "mod" (X, Y : System.Unsigned_Word)
                      return System.Unsigned_Word renames System."mod";
    begin
        Answer.Word_0 := System.Unsigned_Word ((2 ** 14) + 1); -- exponent
        T1            := System.Unsigned_Word (X (2));
        T2            := System.Unsigned_Word (X (3));
        T3            := System.Unsigned_Word (X (4));
        Answer.Word_1 := ((T1 mod 16) * 4096) + (T2 * 16) + (T3 / 16);
        T1            := T3;
        T2            := System.Unsigned_Word (X (5));
        T3            := System.Unsigned_Word (X (6));
        Answer.Word_2 := ((T1 mod 16) * 4096) + (T2 * 16) + (T3 / 16);
        T1            := T3;
        T2            := System.Unsigned_Word (X (7));
        T3            := System.Unsigned_Word (X (8));
        Answer.Word_3 := ((T1 mod 16) * 4096) + (T2 * 16) + (T3 / 16);
        T1            := T3;
        Answer.Word_4 := ((T1 mod 16) * 4096);
        Answer.Word_5 := 0;
        Answer.Word_6 := 0;
        Answer.Word_7 := 0;
        return Force (Answer);
    end To_Float;

    function Find_Exponent
                  (Data : Interchange_Defs.Long_Float) return Long_Exponent_Type is

        -- Return the (unbiased) exponent part of an IEEE float.
        -- The DATA must be > 0.0.
        -- The exponent must be > exponent'first.

        Temp   : Long_Float_Bits;
        Answer : Long_Exponent_Type;

        function "-" (X, Y : Long_Integer)
                      return Long_Integer renames Interchange_Defs."-";

        function "**" (X : Interchange_Defs.Long_Float; 
                         Y : Long_Integer)
                      return Interchange_Defs.Long_Float is
        begin
            return Interchange_Defs."**" (X, Standard.Integer (Y));
        end "**";

        pragma Inline ("**");

    begin
        Temp   := Force (Data);
        Answer := Long_Integer (Temp.Word_0) - 16_384;

        if Data < (2.0 ** Answer) then
            Answer := Answer - 1;

            if Data < (2.0 ** Answer) then
                Answer := Answer - 1;
            end if;
        end if;

        return Answer;
    end Find_Exponent;

    function Convert (X : Interchange_Float.Float) return Interchange_Defs.Float is
        X_Copy          : Interchange_Float.Float := X;
        Negative        : Boolean := False;
        Exponent        : Exponent_Type := 0;
        Fraction        : Fraction_Type := 0;
        Biased_Exponent : Natural;
        Answer          : Interchange_Defs.Float;
    begin
        if "/=" ((X_Copy (1) / 128), 0) then
            Negative   := True;
            X_Copy (1) := X_Copy (1) mod 128;
        end if;

        Biased_Exponent := (Natural (X_Copy (1)) * 2)
             + (Natural (X_Copy (2)) / 128);
        X_Copy (2)      := X_Copy (2) mod 128;

        for I in 2..4 loop
            Fraction := (Fraction * Fraction_Type (Radix))
                 + Fraction_Type (X_Copy (I));
        end loop;

        Exponent := Exponent_Type (Biased_Exponent - 127);

        if Exponent = 128 then
            Answer := Interchange_Defs.Float'Last;
        elsif Exponent > - 127 then
            Answer := (1.0 + (Interchange_Defs.Float (Fraction) * 
                (2.0 ** (- 23))))
                 * (2.0 ** Standard.Integer (Exponent));
        elsif Fraction /= 0 then
            Answer := (Interchange_Defs.Float (Fraction) * (2.0 ** (- 23)))
                 * (2.0 ** (- 126));
        else
            Answer := 0.0;
        end if;

        if Negative then
            Answer := - Answer;
        end if;

        return Answer;
    end Convert;

    function Convert (X : Interchange_Defs.Float) return Interchange_Float.Float is
        X_Copy          : Interchange_Defs.Float := X;
        Negative        : Boolean := False;
        Exponent        : Exponent_Type;
        Fraction        : Fraction_Type;
        Biased_Exponent : Long_Natural;
        Answer          : Interchange_Float.Float;
    begin
        if X_Copy < 0.0 then
            Negative := True;
            X_Copy   := - X_Copy;
        end if;

        if X_Copy = 0.0 then
            Exponent := Exponent_Type'First;
            Fraction := 0;
        elsif X_Copy < (2.0 ** (- 126)) then
            Exponent := Exponent_Type'First;
            X_Copy   := X_Copy * (2.0 ** 126);
            Fraction := Fraction_Type (X_Copy * (2.0 ** 23));
        elsif X_Copy > (2.0 - (2.0 ** (- 23))) * (2.0 ** 127) then
            Exponent := Exponent_Type'Last;
            Fraction := 0;
        else
            Exponent := Exponent_Type (Find_Exponent
                                            (Interchange_Defs.Long_Float (X_Copy)));
            X_Copy   := X_Copy * (2.0 ** Standard.Integer (- Exponent));
            Fraction := Fraction_Type ((X_Copy - 1.0) * (2.0 ** 23));
        end if;

        Biased_Exponent := Exponent + 127;

        for I in reverse 2..4 loop
            Answer (I) := Byte (Fraction mod Fraction_Type (Radix));
            Fraction   := Fraction / Fraction_Type (Radix);
        end loop;

        if Biased_Exponent mod 2 /= 0 then
            Answer (2) := Byte_Defs."+" (Answer (2), 128);
        end if;

        Answer (1) := Byte (Biased_Exponent / 2);

        if Negative then
            Answer (1) := Byte_Defs."+" (Answer (1), 128);
        end if;

        return Answer;
    end Convert;

    function Convert (X : Interchange_Float.Long_Float) return Interchange_Defs.Long_Float is
        X_Copy          : Interchange_Float.Long_Float := X;
        Negative        : Boolean := False;
        Exponent        : Long_Exponent_Type := 0;
        Fraction        : Long_Fraction_Type := Zero;
        Biased_Exponent : Natural;
        Answer          : Interchange_Defs.Long_Float;
    begin
        -- get sign bit:
        if "/=" ((X_Copy (1) / 128), 0) then
            Negative   := True;
            X_Copy (1) := X_Copy (1) - 128;
        end if;

        -- get biased exponent:
        Biased_Exponent := (Natural (X_Copy (1)) * 16)
             + (Natural (X_Copy (2)) / 16);

        -- get fraction:          
        Fraction (2)    := X_Copy (2) mod 16;
        Fraction (3..8) := Byte_Defs.Byte_String (X_Copy (3..8));

        Exponent        := Long_Exponent_Type (Biased_Exponent - 1023);

        if Exponent = 1024 then
            Answer := Interchange_Defs.Long_Float'Last;
        elsif Exponent > - 1023 then
            Answer := To_Float (Fraction) * 
                (2.0 ** Standard.Integer (Exponent));
        elsif "/=" (Fraction, Zero) then
            Answer := (To_Float (Fraction) - 1.0) * 
                (2.0 ** (- 1022));
        else
            Answer := 0.0;
        end if;

        if Negative then
            Answer := - Answer;
        end if;

        return Answer;
    end Convert;

    function Convert (X : Interchange_Defs.Long_Float) return Interchange_Float.Long_Float is
        X_Copy          : Interchange_Defs.Long_Float := X;
        Negative        : Boolean := False;
        Exponent        : Long_Exponent_Type;
        Fraction        : Long_Fraction_Type;
        Biased_Exponent : Long_Natural;
        Answer          : 
            Byte_Defs.Byte_String (Interchange_Float.Long_Float'Range);
    begin
        if X_Copy < 0.0 then
            Negative := True;
            X_Copy   := - X_Copy;
        end if;

        if X_Copy = 0.0 then
            Exponent := Long_Exponent_Type'First;
            Fraction := Zero;
        elsif X_Copy > (2.0 - (2.0 ** (- 52))) * (2.0 ** 1023) then
            Exponent := Long_Exponent_Type'Last;
            Fraction := Zero;
        elsif X_Copy < (2.0 ** (- 1022)) then
            Exponent := Long_Exponent_Type'First;
            X_Copy   := X_Copy * (2.0 ** 1022);
            Fraction := To_Fraction (X_Copy + 1.0);
        else
            Exponent := Long_Exponent_Type (Find_Exponent (X_Copy));
            X_Copy   := X_Copy * (2.0 ** Standard.Integer (- Exponent));
            Fraction := To_Fraction (X_Copy);
        end if;

        Biased_Exponent := Exponent + 1023;

        -- put fraction:
        Answer (2..8)   := Fraction;

        -- put biased exponent:
        Answer (2)      := Byte_Defs."+"
                                (Answer (2), Byte_Defs.Byte
                                  ((Biased_Exponent mod 16) * 
                                 16));
        Answer (1)      := Byte_Defs.Byte (Biased_Exponent / 16);

        -- put sign bit:
        if Negative then
            Answer (1) := Byte_Defs."+" (Answer (1), 128);
        end if;

        return Interchange_Float.Long_Float (Answer);
    end Convert;

end Interchange_Float;