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

⟦b7e69b1bd⟧ TextFile

    Length: 12766 (0x31de)
    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;