DataMuseum.dk

top - download

    Length: 5776 (0x1690)
    Types: TextFile
    Names: »B«

└─⟦afbc8121e⟧ Bits:30000532 8mm tape, Rational 1000, MC68020_OS2000 7_2_2
    └─ ⟦77aa8350c⟧ »DATA« 
        └─⟦f794ecd1d⟧ 
            └─⟦4c85d69e2⟧ 
                └─⟦this⟧ 

TextFile

--    The use of this system is subject to the software license terms and
--    conditions agreed upon between Rational and the Customer.
--
--                Copyright 1988 by Rational.
--
--                          RESTRICTED RIGHTS LEGEND
--
--    Use, duplication, or disclosure by the Government is subject to
--    restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
--    Technical Data and Computer Software clause at 52.227-7013.
--
--
--                Rational
--                3320 Scott Boulevard
--                Santa Clara, California 95054-3197
--
--   PROPRIETARY AND CONFIDENTIAL INFORMATION OF RATIONAL;
--   USE OR COPYING WITHOUT EXPRESS WRITTEN AUTHORIZATION
--   IS STRICTLY PROHIBITED.  THIS MATERIAL IS PROTECTED AS
--   AN UNPUBLISHED WORK UNDER THE U.S. COPYRIGHT ACT OF
--   1976.  CREATED 1988.  ALL RIGHTS RESERVED.
--
--

separate (M68k_Float_Conversions)

function Based_Value (S : String) return Flt.Extended_Float is
    Si : Natural := S'First;  -- index into literal

    Is_Negative : Boolean := False;

    Base  : Natural := 0;
    Ebase : Flt.Extended_Float;
    Value : Flt.Extended_Float;

    In_Fraction       : Boolean := False;
    Exponent_Shift    : Integer := 0;
    Given_Exponent    : Integer := 0;
    Exponent_Negative : Boolean := False;

    Result : Flt.Packed_Float;
    Temp   : Flt.Packed_Float;

    procedure Accumulate_Digit (Digit : Natural) is
    begin
        if Digit < Base then
            Flt.Accumulate_Digit (Digit, Ebase, Value);
            if In_Fraction then
                Exponent_Shift := Exponent_Shift - 1;
            end if;
            Flt.Extended_To_Packed (Value, Temp);
            -- Debug ("Value is " & Image (Temp));
        else
            -- Debug ("Base_Value digit out of range");
            raise Constraint_Error;
        end if;
    end Accumulate_Digit;

begin
    -- Debug ("Base_Value of " & S);

    Flt.Integer_To_Extended (0, Value);
    Flt.Extended_To_Packed (Value, Temp);
    -- Debug ("Initial value is " & Image (Temp));

    -- Already skipped white space

    if S (Si) = '+' then
        Si := Si + 1;
    elsif S (Si) = '-' then
        Is_Negative := True;
        Si          := Si + 1;  
    end if;

    -- Accumulate the base
    loop
        declare
            C : Character := S (Si);
        begin
            Si := Si + 1;   -- will skip opening '#' or ':'
            case C is
                when '0' .. '9' =>
                    Base := Base * 10 + (Character'Pos (C) -
                                         Character'Pos ('0'));

                when '_' =>
                    null;

                when others =>
                    exit;
            end case;
        end;
    end loop;

    if Base in 2 .. 16 then
        -- Debug ("Base_Value base is " & Integer'Image (Base));
        Flt.Integer_To_Extended (Base, Ebase);
        Flt.Extended_To_Packed (Ebase, Temp);
        -- Debug ("Ebase is " & Image (Temp));
    else
        raise Constraint_Error;
    end if;

    loop
        declare
            C : Character := S (Si);
        begin
            Si := Si + 1;   -- will skip closing '#' or ':'
            -- Debug ("Based_Value has mantissa char " & C);

            case C is
                when '0' .. '9' =>
                    Accumulate_Digit (Character'Pos (C) - Character'Pos ('0'));

                when 'A' .. 'F' =>
                    Accumulate_Digit (10 + Character'Pos (C) -
                                      Character'Pos ('A'));

                when 'a' .. 'f' =>
                    Accumulate_Digit (10 + Character'Pos (C) -
                                      Character'Pos ('a'));

                when '.' =>
                    In_Fraction := True;

                when '_' =>
                    null;

                when others =>
                    exit;
            end case;
        end;
    end loop;

    -- Debug ("Based_Value processed mantissa");

    while Si <= S'Last loop
        declare
            C : Character := S (Si);
        begin
            Si := Si + 1;
            -- Debug ("Based_Value has exponent char " & C);
            case C is
                when '0' .. '9' =>
                    Given_Exponent := Given_Exponent * 10 +
                                         (Character'Pos (C) -
                                          Character'Pos ('0'));

                when '-' =>
                    Exponent_Negative := True;

                when '+' | 'E' | 'e' | '_' =>
                    null;

                when others =>
                    -- should never happen
                    -- Debug ("Based_Value raising CE with " & C);
                    raise Constraint_Error;
            end case;
        end;
    end loop;

    if Exponent_Negative then
        Given_Exponent := -Given_Exponent;
    end if;

    Given_Exponent := Given_Exponent + Exponent_Shift;

    -- Debug ("Based_Value processed exponent = " &
    --        Integer'Image (Given_Exponent));

    if Given_Exponent /= 0 then
        if Base mod 2 = 0 then
            case Base is
                when 4 =>
                    Given_Exponent := Given_Exponent * 2;
                when 8 =>
                    Given_Exponent := Given_Exponent * 3;
                when 16 =>
                    Given_Exponent := Given_Exponent * 4;
                when others =>
                    null;
            end case;
            Flt.Binary_Exponentiate (Given_Exponent, Value);
        else
            Flt.Based_Exponentiate (Given_Exponent, Ebase, Value);
        end if;
    end if;

    Value.Negative := Is_Negative;

    Flt.Extended_To_Packed (Value, Result);
    -- Debug ("Result is " & Image (Result));

    return Value;
end Based_Value;