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: ┃ B T

⟦50994c2e2⟧ TextFile

    Length: 8136 (0x1fc8)
    Types: TextFile
    Names: »B«

Derivation

└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
    └─ ⟦124ff5788⟧ »DATA« 
        └─⟦this⟧ 
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─ ⟦6f12a12be⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Text_Io;
use Text_Io;

package body Floating_Characteristics is
    --  This package is a floating mantissa definition of a binary FLOAT
    A, B, Y, Z           : Float;
    I, K, Mx, Iz         : Integer;
    Beta, Betam1, Betain : Float;
    One                  : Float := 1.0;
    Zero                 : Float := 0.0;

    procedure Defloat (X : in     Float;
                       N : in out Exponent_Type;
                       F : in out Mantissa_Type) is
        --  This is admittedly a slow method - but portable - for breaking down
        --  a floating point number into its exponent and mantissa
        --  Obviously with knowledge of the machine representation
        --  it could be replaced with a couple of simple extractions
        Exponent_Length : Integer := Iexp;
        M               : Exponent_Type;
        W, Y, Z         : Float;
    begin
        N := 0;
        F := 0.0;
        Y := abs (X);

        if Y = 0.0 then
            return;
        elsif Y < 0.5 then
            for J in reverse 0 .. (Exponent_Length - 2) loop
                --  Dont want to go all the way to 2.0**(EXPONENT_LENGTH - 1)
                --  Since that (or its reciprocal) will overflow if exponent biased
                --  Ought to use talbular values rather than compute each time
                M := Exponent_Type (2 ** J);
                Z := 1.0 / (2.0 ** M);
                W := Y / Z;

                if W < 1.0 then
                    Y := W;
                    N := N - M;
                end if;
            end loop;
        else
            for J in reverse 0 .. (Exponent_Length - 2) loop
                M := Exponent_Type (2 ** J);
                Z := 2.0 ** M;
                W := Y / Z;

                if W >= 0.5 then
                    Y := W;
                    N := N + M;
                end if;
            end loop;
            --  And just to clear up any loose ends from biased exponents
        end if;

        while Y < 0.5 loop
            Y := Y * 2.0;
            N := N - 1;
        end loop;

        while Y >= 1.0 loop
            Y := Y / 2.0;
            N := N + 1;
        end loop;

        F := Mantissa_Type (Y);

        if X < 0.0 then
            F := -F;
        end if;

        return;

    exception
        when others =>
            N := 0;
            F := 0.0;
            return;
    end Defloat;

    procedure Refloat (N : in     Exponent_Type;
                       F : in     Mantissa_Type;
                       X : in out Float) is
        --  Again a brute force method - but portable
        --  Watch out near MAXEXP
        M : Integer;
        Y : Float;
    begin
        if F = 0.0 then
            X := Zero;
            return;
        end if;

        M := Integer (N);
        Y := abs (Float (F));

        while Y < 0.5 loop
            M := M - 1;

            if M < Minexp then
                X := Zero;
            end if;

            Y := Y + Y;
            exit when M <= Minexp;
        end loop;

        if M = Maxexp then
            M := M - 1;
            X := Y * 2.0 ** M;
            X := X * 2.0;
        elsif M <= Minexp + 2 then
            M := M + 3;
            X := Y * 2.0 ** M;
            X := ((X / 2.0) / 2.0) / 2.0;
        else
            X := Y * 2.0 ** M;
        end if;

        if F < 0.0 then
            X := -X;
        end if;

        return;
    end Refloat;

    function Convert_To_Float (K : Integer) return Float is
    begin
        return Float (K);
    end Convert_To_Float;

    -- function CONVERT_TO_FLOAT(N : EXPONENT_TYPE) RETURN FLOAT is
    -- begin
    --    RETURN FLOAT(N);
    -- end CONVERT_TO_FLOAT;

    function Convert_To_Float (F : Mantissa_Type) return Float is
    begin
        return Float (F);
    end Convert_To_Float;
    --
begin
    --  Initialization for the VAX with values derived by MACHAR
    --  In place of running MACHAR as the actual initialization
    Ibeta  := 2;
    It     := 24;
    Irnd   := 1;
    Negep  := -24;
    Epsneg := 5.9604644E-008;
    Machep := -24;
    Eps    := 5.9604644E-008;
    Ngrd   := 0;
    Xmin   := 5.9E-39;
    Minexp := -126;
    Iexp   := 8;
    Maxexp := 127;
    Xmax   := 8.5E37 * 2.0;


    ----  This initialization is the MACHAR routine of Cody and Waite Appendix B.
    --PUT("INITIALIZATING WITH MACHAR     -     ");
    --    A := ONE;
    --    while (((A + ONE) - A) - ONE) = ZERO  loop
    --      A := A + A;
    --    end loop;
    --    B := ONE;
    --    while ((A + B) - A) = ZERO  loop
    --      B := B + B;
    --    end loop;
    --    IBETA := INTEGER((A + B) - A);
    --    BETA := CONVERT_TO_FLOAT(IBETA);
    --
    --
    --    IT := 0;
    --    B := ONE;
    --    while (((B + ONE) - B) - ONE) = ZERO  loop
    --      IT := IT + 1;
    --      B := B * BETA;
    --    end loop;
    --
    --
    --    IRND := 0;
    --    BETAM1 := BETA - ONE;
    --    if ((A + BETAM1) - A) /= ZERO  then
    --      IRND := 1;
    --    end if;
    --
    --
    --    NEGEP := IT + 3;
    --    BETAIN := ONE / BETA;
    --    A := ONE;
    --  --  for I in 1..NEGEP  loop
    --  for I in 1..50  loop
    --  exit when I > NEGEP;
    --      A := A * BETAIN;
    --    end loop;
    --    B := A;
    --    while ((ONE - A) - ONE) = ZERO  loop
    --      A := A * BETA;
    --      NEGEP := NEGEP - 1;
    --    end loop;
    --    NEGEP := -NEGEP;
    --
    --
    --    EPSNEG := A;
    --    if (IBETA /= 2) and (IRND /= 0)  then
    --      A := (A * (ONE + A)) / (ONE + ONE);
    --      if ((ONE - A) - ONE) /= ZERO  then
    --        EPSNEG := A;
    --      end if;
    --    end if;
    --
    --
    --    MACHEP := -IT - 3;
    --    A := B;
    --    while ((ONE + A) - ONE) = ZERO  loop
    --      A := A * BETA;
    --      MACHEP := MACHEP + 1;
    --    end loop;
    --
    --
    --    EPS := A;
    --    if (IBETA /= 2) and (IRND /= 0)  then
    --      A := (A * (ONE + A)) / (ONE + ONE);
    --      if ((ONE + A) - ONE) /= ZERO  then
    --        EPS := A;
    --      end if;
    --    end if;
    --
    --
    --    NGRD := 0;
    --    if ((IRND = 0) and ((ONE + EPS) * ONE - ONE) /= ZERO)  then
    --      NGRD := 1;
    --    end if;
    --
    --
    --    I := 0;
    --    K := 1;
    --    Z := BETAIN;
    --    loop
    --      Y := Z;
    --      Z := Y * Y;
    --      A := Z * ONE;
    --      exit when ((A + A) = ZERO) or (ABS(Z) >= Y);
    --      I := I + 1;
    --      K := K + K;
    --    end loop;
    --    if (IBETA /= 10)  then
    --      IEXP := I + 1;
    --      MX := K + K;
    --    else
    --      IEXP := 2;
    --      IZ := IBETA;
    --      while (K >= IZ)  loop
    --        IZ := IZ * IBETA;
    --        IEXP := IEXP + 1;
    --      end loop;
    --      MX := IZ + IZ - 1;
    --    end if;
    --
    --    loop
    --      XMIN := Y;
    --      Y := Y * BETAIN;
    --      A := Y * ONE;
    --      exit when ((A + A) = ZERO) or (ABS(Y) >= XMIN);
    --      K := K + 1;
    --    end loop;
    --
    --
    --    MINEXP := -K;
    --
    --
    --    if ((MX <= (K + K - 3)) and (IBETA /= 10))  then
    --      MX := MX + MX;
    --      IEXP := IEXP + 1;
    --    end if;
    --
    --
    --    MAXEXP := MX + MINEXP;
    --    I := MAXEXP + MINEXP;
    --    if ((IBETA = 2) and (I = 0))  then
    --      MAXEXP := MAXEXP - 1;
    --    end if;
    --    if (I > 20)  then
    --      MAXEXP := MAXEXP - 1;
    --    end if;
    --    if (A /= Y)  then
    --      MAXEXP := MAXEXP - 2;
    --    end if;
    --
    --
    --    XMAX := ONE - EPSNEG;
    --    if ((XMAX * ONE) /= XMAX)  then
    --      XMAX := ONE - BETA * EPSNEG;
    --    end if;
    --    XMAX := XMAX / (BETA * BETA * BETA * XMIN);
    --    I := MAXEXP + MINEXP + 3;
    --    if I > 0  then
    --      for J in 1..50  loop
    --  exit when J > I;
    --        if IBETA = 2  then
    --          XMAX := XMAX + XMAX;
    --        else
    --          XMAX := XMAX * BETA;
    --        end if;
    --      end loop;
    --    end if;
    --
    --PUT("INITIALIZED"); NEW_LINE;
end Floating_Characteristics;