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

⟦e1de4413b⟧ Ada Source

    Length: 32768 (0x8000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Number_Io, seg_050944

Derivation

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

E3 Source Code



with File_Support;
use File_Support;
with Text_Supprt;
use Text_Supprt;

package body Number_Io is
    pragma Suppress (Access_Check);
    pragma Suppress (Discriminant_Check);
    pragma Suppress (Index_Check);
    pragma Suppress (Length_Check);
    pragma Suppress (Range_Check);
    pragma Suppress (Division_Check);
    pragma Suppress (Elaboration_Check);

    -- for input
    type Signed_Cases is (No_Sign, Plus_Only, Sign_Allowed, Already_Negated);
    No_Point : constant Boolean := False;
    Point_Needed : constant Boolean := True;
    Use_E : constant Boolean := True;
    Not_Using_E : constant Boolean := False;
    Doing_Whole : constant Boolean := False;
    Doing_Fraction : constant Boolean := True;
    To_String : constant Boolean := True;
    To_File : constant Boolean := False;

    -- for output
    Number : constant String := "001234567899";
    Max_Exp : constant Integer := 5;
    Exp_Divisor : constant array (Integer range 1 .. Max_Exp) of Integer :=
       (1, 10, 100, 1000, 10000);


    ----------------------------------------------------------
    --  The following routines are used for input           --
    ----------------------------------------------------------

    function Val_Of (C : in Character) return Integer is
    begin
        case C is
            when 'a' .. 'f' =>
                return Character'Pos (C) - Lc_A + 10;
            when 'A' .. 'F' =>
                return Character'Pos (C) - Uc_A + 10;
            when '0' .. '9' =>
                return Character'Pos (C) - Cnvt_Digit;
            when others =>
                return 16;
        end case;
    end Val_Of;

    function F_Val_Of (C : in Character) return Io_Float is
    begin
        case C is
            when 'a' .. 'f' =>
                return Io_Float (Character'Pos (C) - Lc_A + 10);
            when 'A' .. 'F' =>
                return Io_Float (Character'Pos (C) - Uc_A + 10);
            when '0' .. '9' =>
                return Io_Float (Character'Pos (C) - Cnvt_Digit);
            when others =>
                return 16.0;
        end case;
    end F_Val_Of;

    function Is_Digit
                (C : in Character; Base : in Integer := 16) return Boolean is
        I : Integer := Val_Of (C);
    begin
        case C is
            when 'a' .. 'f' =>
                return (Character'Pos (C) - Lc_A + 10) < Base;
            when 'A' .. 'F' =>
                return (Character'Pos (C) - Uc_A + 10) < Base;
            when '0' .. '9' =>
                return (Character'Pos (C) - Cnvt_Digit) < Base;
            when others =>
                return False;
        end case;
    end Is_Digit;

    function F_Is_Digit
                (C : in Character; Base : in Io_Float := 16.0) return Boolean is
    begin
        case C is
            when 'a' .. 'f' =>
                return (Character'Pos (C) - Lc_A + 10) < Integer (Base);
            when 'A' .. 'F' =>
                return (Character'Pos (C) - Uc_A + 10) < Integer (Base);
            when '0' .. '9' =>
                return (Character'Pos (C) - Cnvt_Digit) < Integer (Base);
            when others =>
                return False;
        end case;
    end F_Is_Digit;

    function Next_Real_Char (Text : String; I : Integer) return Character is
    begin
        if I > Text'Last then
            return ' ';
        else
            return Text (I);
        end if;
    end Next_Real_Char;
    pragma Inline (Next_Real_Char);


    procedure Get_Simple_Num (Text : String;
                              I : in out Integer;
                              Result : out Integer;
                              Base : Integer;
                              Sign_Case : Signed_Cases;
                              Error : out Boolean) is
        Sign : Integer := 1;
        Sum : Integer := 0;
    begin
        Error := False;
        case Sign_Case is
            when Already_Negated =>
                Sign := -1;
            when Plus_Only | Sign_Allowed =>
                if Text (I) = '+' or Text (I) = '-' then
                    if Text (I) = '-' then
                        Sign := -1;
                    end if;
                    I := I + 1;
                end if;
            when No_Sign =>
                null;
        end case;
        if not Is_Digit (Text (I), Base) then
            raise Data_Error;
        end if;

        begin
            loop
                if I > Text'Last then
                    exit;
                end if;
                if Text (I) = '_' then
                    I := I + 1;
                    if not Is_Digit (Text (I), Base) then
                        raise Data_Error;
                    end if;
                elsif not Is_Digit (Text (I), Base) then
                    exit;
                end if;
                Sum := Sum * Base + Sign * Val_Of (Text (I));
                I := I + 1;
            end loop;
        exception
            when Numeric_Error =>
                raise Data_Error;
        end;

        if Sign_Case = Plus_Only and then Sign < 0 then
            raise Data_Error;
        end if;

        Result := Sum;
    exception
        when Constraint_Error | Data_Error =>
            Error := True;
    end Get_Simple_Num;

    procedure Get_Simple_F_Num (Text : String;
                                I : in out Integer;
                                Result : out Io_Float;
                                F_Base : Io_Float;
                                Sign : in out Io_Float;
                                Doing_Fraction : Boolean;
                                Error : out Boolean) is
        Sum : Io_Float := 0.0;
        Base : Integer := Integer (F_Base);
        Fraction_Base : Io_Float := 1.0 / F_Base;
        Sign_Ok : Boolean := (Sign /= 0.0);
    begin
        if Sign_Ok and then (Text (I) = '+' or Text (I) = '-') then
            if Text (I) = '-' then
                Sign := -1.0;
            end if;
            I := I + 1;
        else
            Sign := 1.0;
        end if;

        if not Is_Digit (Text (I), Base) then
            raise Data_Error;
        end if;
        loop
            if Text (I) = '_' then
                I := I + 1;
                if not Is_Digit (Text (I), Base) then
                    raise Data_Error;
                end if;
            elsif not Is_Digit (Text (I), Base) then
                exit;
            end if;
            if Doing_Fraction then
                Sum := Sum + F_Val_Of (Text (I)) * Fraction_Base;
                Fraction_Base := Fraction_Base / F_Base;
            else
                Sum := Sum * F_Base + F_Val_Of (Text (I));
            end if;
            I := I + 1;
            if I > Text'Last then
                exit;
            end if;
        end loop;
        Result := Sum;
        Error := False;
    exception
        when Data_Error | Constraint_Error =>
            Error := True;
    end Get_Simple_F_Num;

    procedure Complete_Based_Lit (Text : String;
                                  I : in out Integer;
                                  Point_Needed : Boolean;
                                  Separator : Character) is
        -----------------------------------------------------------------------
        --| This procedure is used to set file_for_more.in_ptr to the
        --| last character read, in the cases where data_error is known to
        --| be pending due to a digit outside the base.  Ada requires that the
        --| input be parsed as a literal BEFORE being analyzed for base, etc.
        --|
        -----------------------------------------------------------------------
        Point_Expected : Boolean := Point_Needed;       C : Character := '0';  -- not underline;
        Was_Underline : Boolean;
        Exp : Integer;
        Error : Boolean;
    begin
        begin -- for exception region on data_error
            Based_Loop:
                loop
                    Was_Underline := (C = '_');
                    I := I + 1;
                    C := Text (I);
                    case C is
                        when 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' =>
                            null;
                        when '_' =>
                            if Was_Underline then
                                return;
                            end if;
                        when '#' | ':' =>
                            if Point_Expected or C /= Separator then
                                return;
                            end if;
                            exit Based_Loop;
                        when '.' =>
                            if not Point_Expected then
                                return;
                            end if;
                            Point_Expected := False;
                        when others =>
                            return;
                    end case;
                end loop Based_Loop;
        end;
        I := I + 1;
        C := Text (I);
        if C = 'e' or else C = 'E' then
            I := I + 1;
            Get_Simple_Num (Text, I, Exp, 10, Plus_Only, Error);
        end if;
    end Complete_Based_Lit;

    procedure Getnum (Text : String;
                      Item : out Integer;
                      Last : out Integer;
                      Error : in out Boolean) is
        C : Character;
        I : Integer := Text'First;
        Finish : Integer := Text'Last;
        Result : Integer := 0;
        Base : Integer := 10;
        Exp : Integer := 0;
        After_Base : Integer;
        Sign_Case : Signed_Cases;
        Sep : Character;
    begin       Error := False;
        --
        -- skip blanks
        --
        while Text (I) = ' ' or else Text (I) = Ascii.Ht loop
            I := I + 1;
        end loop;
        --
        -- DR0568 let get_simple_num take care of the sign (so that
        -- a get of integer'first does not cause an overflow).
        --
        -- get number (base 10)
        --
        Get_Simple_Num (Text => Text,
                        I => I,
                        Result => Result,
                        Base => 10,
                        Sign_Case => Sign_Allowed,
                        Error => Error);
        if Error then
            Last := I - 1;
            return;
        end if;
        --
        -- is there a '#' or ':'
        --
        if I <= Text'Last and then (Text (I) = '#' or Text (I) = ':') then
            -- yes, number is the base
            if Result < 0 then
                Sign_Case := Already_Negated;
                Result := -Result;
            else
                Sign_Case := No_Sign;
            end if;
            Sep := Text (I);
            Base := Result;
            Result := 0;
            I := I + 1;
            --
            -- get number
            --
            After_Base := I;
            Get_Simple_Num (Text, I, Result, Base, Sign_Case, Error);
            if Error then
                I := After_Base;
                Complete_Based_Lit (Text, I, No_Point, Sep);
                Last := I - 1;
                return;
            end if;
            --
            -- get '#' or ':'
            --
            if Text (I) /= Sep then
                I := I - 1;
                Complete_Based_Lit (Text, I, No_Point, Sep);
                Error := True;
                Last := I - 1;
                return;
            end if;

            I := I + 1;
        end if;

        --
        -- get 'e' or 'E'
        --
        if I > Text'Last or else (Text (I) /= 'e' and Text (I) /= 'E') then
            Exp := 0;
        else
            I := I + 1;
            --
            -- get option exponent (base 10)
            --
            Get_Simple_Num (Text, I, Exp, 10, Plus_Only, Error);
        end if;

        Last := I - 1;
        if Exp < 0 or else Base < 2 or else Base > 16 then
            Error := True;
        else
            if not Error then
                Item := Result * (Base ** Exp);
            end if;
        end if;
    end Getnum;

    -- Upon entry/exit: file is locked
    procedure Getnum (File : in File_Type; Item : out Integer) is
        Fp : File_Ptr := To_Fptr (File);
        Error : Boolean := False;
    begin
        --
        -- skip blanks and lines
        --
        Skip_Blanks_And_Lines (Fp);
        Refill_Buffer (Fp);
        --
        -- get number from buffer
        --
        Getnum (String (Fp.Buffer.Elem (Fp.In_Ptr .. Fp.Last)),
                Item, Fp.In_Ptr, Error);
        if Error then
            raise Data_Error;
        end if;
    end Getnum;

    procedure Getnum (Text : String;
                      Item : out Io_Float;
                      Last : out Integer;
                      Error : in out Boolean) is
        Result : Io_Float := 0.0;
        Scale : Io_Float := 1.0;
        Base : Io_Float := 10.0;
        Fraction : Io_Float;
        I : Integer := Text'First;
        Finish : Integer := Text'Last;
        C : Character;
        Sign : Integer := 1;
        Exp : Integer := 0;
        Based : Boolean := False;
        Sep : Character := '#';
        F_Sign : Io_Float := 1.0;
        No_F_Sign : Io_Float := 0.0;
        No_Frac_Sign : Io_Float := 0.0;
        Bad_Base : Boolean := False;
        pragma Optimize_Code (Off);
    begin
        Error := False;
        --
        -- skip blanks
        --
        while Text (I) = ' ' or else Text (I) = Ascii.Ht loop
            I := I + 1;
            if I > Text'Last then
                Error := True;
                Last := I - 1;
                return;
            end if;
        end loop;
        --
        -- get number (base 10)
        --
        Get_Simple_F_Num (Text, I, Result, 10.0, F_Sign, Doing_Whole, Error);
        if Error then
            Last := I - 1;
            return;
        end if;

        --
        -- is there a '#' or ':'
        --
        if I <= Text'Last and then (Text (I) = '#' or Text (I) = ':') then
            -- yes, number is the base
            Sep := Text (I);
            Based := True;
            Base := Result;
            Bad_Base := Integer (Base) < 2 or Integer (Base) > 16;
            if Bad_Base then
                Base := 16.0;
            end if;
            Result := 0.0;
            I := I + 1;
            Get_Simple_F_Num (Text, I, Result, Base,
                              No_F_Sign, Doing_Whole, Error);
            if Error then
                Complete_Based_Lit (Text, I, Point_Needed, Sep);
                Last := I - 1;
                return;
            end if;
        end if;

        if I > Finish or else Text (I) /= '.' then
            Error := True;
            Last := I - 1;
            return;
        end if;
        I := I + 1;
        --
        -- get fractional part
        --
        Get_Simple_F_Num (Text, I, Fraction, Base,
                          No_Frac_Sign, Doing_Fraction, Error);
        if Error then
            if Based then
                Complete_Based_Lit (Text, I, No_Point, Sep);
            end if;
            Last := I - 1;
            return;
        end if;
        --
        -- At this point, result contains the left-hand-side of
        -- the point and fraction contains the right-hand-side.
        -- Now get the exponent.
        --
        if Based then
            if Text (I) /= Sep then
                I := I - 1;
                Complete_Based_Lit (Text, I, Point_Needed, Sep);
                Error := True;
                Last := I - 1;
                return;
            end if;
            I := I + 1;
        end if;
        if I > Text'Last or else (Text (I) /= 'e' and Text (I) /= 'E') then
            Exp := 0;
        else
            I := I + 1;
            --
            -- get exponent
            --
            Get_Simple_Num (Text, I, Exp, 10, Sign_Allowed, Error);
            if Error then
                Last := I - 1;
                return;
            end if;
        end if;

        if Bad_Base then
            Error := True;
            Last := I - 1;
            return;
        end if;
        --
        -- Build final result from partial result and fraction.
        -- Adjust by exponent.  Note, to preserve accuracy, we
        -- avoid negative exponentiation.
        --
        begin
            if Exp >= 0 then
                Result := Result * (Base ** Exp);
                Fraction := Fraction * (Base ** Exp);
            else
                Result := Result / (Base ** (-Exp));
                Fraction := Fraction / (Base ** (-Exp));
            end if;
        exception
            when Numeric_Error | Constraint_Error =>
                Error := True;
                Last := I - 1;
                return;
        end;
        -- combine both sides of point
        Result := Result + Fraction;
        -- handle negatives
        if F_Sign /= 1.0 then
            Result := -Result;
        end if;
        Item := Result;
        Last := I - 1;
    end Getnum;

    -- Upon entry/exit: file is locked
    procedure Getnum (File : in File_Type; Item : out Io_Float) is
        Fp : File_Ptr := To_Fptr (File);
        Error : Boolean := False;
    begin
        --
        -- skip blanks and lines
        --
        Skip_Blanks_And_Lines (Fp);
        Refill_Buffer (Fp);
        --
        -- get number from buffer
        --
        Getnum (String (Fp.Buffer.Elem (Fp.In_Ptr .. Fp.Last)),
                Item, Fp.In_Ptr, Error);
        if Error then
            raise Data_Error;
        end if;
    end Getnum;

    -- Upon entry/exit: file is locked
    procedure Get_Float (File : in File_Type;
                         Result : out Io_Float;
                         Width : in Field) is
        End_Ptr : Integer;
        Fp : File_Ptr := To_Fptr (File);
        Error : Boolean := False;
    begin
        Must_Be_Input (File);
        if Width /= 0 then
            if Tstfile (Fp) /= At_Char then
                raise Data_Error;
            end if;
            End_Ptr := Fp.In_Ptr + Width;
            if End_Ptr > Fp.Last then
                -- We need to get width characters into the buffer,
                -- but since they may not all fit we'll stick the next
                -- width characters into an array, and getnum on that.
                declare
                    Str : String (1 .. Width);
                    Len : Integer := 0;
                    I : Integer;
                begin
                    while Len < Width loop
                        Len := Len + 1;
                        Str (Len) := Getchar (Fp);
                        exit when Tstfile (Fp) /= At_Char;
                    end loop;
                    I := 1;
                    Getnum (Str (1 .. Len), Result, I, Error);
                    if I /= Len or Error then
                        raise Data_Error;
                    end if;
                end;
            else
                Getnum (String (Fp.Buffer.Elem (Fp.In_Ptr + 1 .. End_Ptr)),
                        Result, Fp.In_Ptr, Error);
                if End_Ptr /= Fp.In_Ptr and then Tstfile (Fp) = At_Char then
                    raise Data_Error;
                elsif Error then
                    raise Data_Error;
                end if;
            end if;
        else
            Getnum (File, Result);
        end if;
    end Get_Float;


    -------------------------------------------------------------------
    --   the following routines are used for output                  --
    -------------------------------------------------------------------
    function Truncate (F : Io_Float; Almost_One : Io_Float) return Integer is
        I_Trunc : Integer;
        F_Trunc : Io_Float;
    begin
        I_Trunc := Integer (F - 0.5);
        F_Trunc := Io_Float (I_Trunc);

        if F - F_Trunc >= Almost_One then
            --  the rounding mode rounded down instead of up
            --\x09or cumulative round_off occurred
            I_Trunc := I_Trunc + 1;
        end if;
        if I_Trunc < 0 then
            I_Trunc := 0;
        end if;

        return I_Trunc;
    end Truncate;

    procedure Decompose_Real (Num : Io_Float;
                              Fore : Integer;
                              Aft : Integer;
                              Using_E : Boolean;
                              Is_Neg : out Boolean;
                              Exponent : out Integer;
                              Digit_Str : out String) is
        R : Io_Float := Num;
        Number : constant String := "0123456789";
        Million : constant Io_Float := Io_Float (1_000_000);
        Rounder : Io_Float;
        Shift_Count : Integer := 0;
        Too_Small : Io_Float;
        Almost_One : Io_Float;
        Exp, M, I : Integer;
    begin
        if R < 0.0 then
            Is_Neg := True;
            R := -R;
        else
            Is_Neg := False;
        end if;

        if R = 0.0 then
            Digit_Str (1 .. Aft + Fore) := (others => '0');
            Exponent := 0;
            return;
        end if;

        Too_Small := (0.1 ** Aft);
        Rounder := 0.5 * Too_Small;
        Almost_One := 1.0 - (Rounder * 0.1);
        if not Using_E then
            R := R + Rounder;
        end if;

        -- make integer part of r within integer range
        Exp := 0;
        while R > Million loop
            R := R / Million;
            Almost_One := (Almost_One * 0.000001) + 0.999999;
            Exp := Exp + 6;
            Shift_Count := Shift_Count + 6;
        end loop;

        I := Truncate (R, Almost_One);
        if I = 0 then
            loop
                R := R * 10.0;
                Exp := Exp - 1;
                I := Truncate (R, Almost_One);
                exit when I > 0;
            end loop;
        else
            while I >= 10 loop
                R := R * 0.1;
                Almost_One := (Almost_One * 0.1) + 0.9;
                Shift_Count := Shift_Count + 1;
                Exp := Exp + 1;
                I := I / 10;
            end loop;
        end if;
        if not Using_E and then Exp + 1 > Fore then
            M := Aft + Exp + 1;  
        else
            M := Aft + Fore;
        end if;

        if Using_E then
            R := R + Rounder;
        end if;
        I := Truncate (R, Almost_One);
        if I = 10 then
            I := 1;
            R := R * 0.1;
            Exp := Exp + 1;
            M := M + 1;
        elsif I = 0 then
            I := 1;
        end if;

        Digit_Str (1) := Character'Val (I + Character'Pos ('0'));
        for K in 2 .. M loop
            R := (R - Io_Float (I)) * 10.0;
            if Shift_Count > 0 then
                Almost_One := (Almost_One * 10.0) - 9.0;
                Shift_Count := Shift_Count - 1;
            end if;
            if R < Float'Safe_Small then
                R := 0.0;
            end if;
            I := Truncate (R, Almost_One);
            Digit_Str (K) := Number (I + 1);
        end loop;
        Exponent := Exp;
    end Decompose_Real;

    procedure Cvt_Num (Str : out String;
                       Len : in out Integer;
                       Num : Io_Float;
                       My_Fore, After : Integer) is
        Max_Len : constant Integer := 250;
        Cvtbuf : String (1 .. Max_Len + 6);
        Fore : Integer := My_Fore;
        Original_Len : Integer;
        Aft : Integer := After;
        P, S : Integer := Str'First;
        Exponent, Fore_Used : Integer;
        Is_Neg : Boolean;
    begin
        while Fore > Max_Len - Aft - 3 loop
            Str (P) := ' ';
            P := P + 1;
            Fore := Fore - 1;
            if Fore <= 1 then
                raise Layout_Error;
            end if;
        end loop;

        Decompose_Real (Num, Fore, Aft, Not_Using_E, Is_Neg, Exponent, Cvtbuf);
        if Exponent > 0 then
            Fore_Used := Exponent + 1;
        else
            Fore_Used := 1;
        end if;
        S := P + Fore - Fore_Used - 1;
        if S < Str'First then
            S := Str'First - 1;
        end if;
        for J in P .. S loop
            Str (J) := ' ';
        end loop;
        if Is_Neg then
            if S < Str'First then
                S := S + 1;
            end if;
            Str (S) := '-';
        end if;
        S := S + 1;
        P := S + Fore_Used;
        if Exponent >= 0 then
            if P > Str'Last then
                raise Layout_Error;
            end if;
            Str (S .. P - 1) := Cvtbuf (1 .. Fore_Used);
            Str (P) := '.';
        else
            -- Zero-fill to first digit.  Decimal point is at s+1.
            -- First digit will go at s+1+(-exponent)
            P := S + (-Exponent);
            if P > Str'Last then
                raise Layout_Error;
            end if;
            Str (S .. S + 1) := "0.";
            Str (S + 2 .. P) := (others => '0');
            Aft := Aft - (P - (S + 1));  -- decrement aft by number of 0's
            Fore_Used := 0;
        end if;
        S := P + Aft;
        P := P + 1;
        if S - Str'First + 1 > Len then
            raise Layout_Error;
        end if;
        if S > Str'Last then
            raise Layout_Error;
        end if;
        Str (P .. S) := Cvtbuf (Fore_Used + 1 .. Fore_Used + Aft);
        Len := S - Str'First + 1;
    exception
        when Constraint_Error =>
            raise Layout_Error;
    end Cvt_Num;

    procedure Cvt_Num_Using_E (Str : out String;
                               Len : in out Integer;
                               Num : Io_Float;
                               My_Fore, My_Aft, My_Exp : Integer;
                               String_Target : Boolean) is
        Max_Len : constant Integer := 250;
        Cvtbuf : String (1 .. Max_Len + 6);
        I, S, M : Integer;
        Fore : Integer := My_Fore;
        Aft : Integer := My_Aft;
        Exp : Integer := My_Exp;
        P : Integer := Str'First;
        Exponent : Integer;
        Leading_0s : Integer := 0;
        Size_Of_E_Field : Integer;
        Is_Neg : Boolean;
    begin
        Decompose_Real (Num, 1, Aft, Use_E, Is_Neg, Exponent, Cvtbuf);
        --
        -- DR 1143 - if negative minimum value for fore is 2
        --
        if Is_Neg and then Fore = 1 then
            Fore := 2;
        end if;

        -- figure space needed for exponent
        Exp := Exp - 1;  -- sign
        while Exp > Max_Exp loop
            Leading_0s := Leading_0s + 1;
            Exp := Exp - 1;
        end loop;
        loop
            M := Exp_Divisor (Exp);
            exit when abs (Exponent / 10) < M;
            Exp := Exp + 1;  -- exponent too large for field size
            if String_Target then
                Fore := Fore - 1;
            end if;
        end loop;

        -- put out leading spaces
        Size_Of_E_Field := Exp + Leading_0s + 2; -- one for E and one for sign
        while Fore > Max_Len - 1 - Aft - Size_Of_E_Field loop
            Str (P) := ' ';
            P := P + 1;
            Fore := Fore - 1;
        end loop;
        S := P + Fore - 2;
        for J in P .. S loop
            Str (J) := ' ';
        end loop;

        if Is_Neg then
            if S < Str'First then
                raise Layout_Error;
            end if;
            Str (S) := '-'; -- was written as ' ' above
        end if;
        S := S + 1;
        if S < Str'First then
            raise Layout_Error;
        end if;
        Str (S) := Cvtbuf (1);
        Str (S + 1) := '.';
        P := S + 2;
        Str (P .. P + Aft - 1) := Cvtbuf (2 .. Aft + 1);
        P := P + Aft + 2;
        Str (P - 2) := 'E';
        if Exponent < 0 then
            Str (P - 1) := '-';
            Exponent := -Exponent;
        else
            Str (P - 1) := '+';
        end if;
        while Leading_0s > 0 loop
            Str (P) := '0';
            P := P + 1;
            Leading_0s := Leading_0s - 1;
        end loop;
        while M > 0 loop -- m was set above
            I := Exponent / M;
            Str (P) := Number (I + 2);
            P := P + 1;
            Exponent := Exponent - I * M;
            M := M / 10;
        end loop;
        P := P - Str'First;
        if P > Len then
            raise Layout_Error;
        end if;
        Len := P;
    exception
        when Constraint_Error =>
            raise Layout_Error;
    end Cvt_Num_Using_E;

    procedure Put_Float (To : out String;
                         Item : in Io_Float;
                         Fore : Integer;
                         Aft : in Field;
                         Exp : in Field;
                         Len : in out Integer) is
        My_Fore : Integer := Fore;
        My_Exp : Integer := Exp;
        My_Aft : Integer := Aft;
    begin
        if My_Exp = 1 then
            My_Exp := 2; -- minimum sign plus one digit
        end if;
        if My_Fore = -1 then
            -- put to string, so there was no fore given.
            My_Fore := Len - Aft - 1;
            if Aft = 0 then
                My_Fore := My_Fore - 1;   -- aft is always >= 1
            end if;
            if My_Exp /= 0 then
                My_Fore := My_Fore - My_Exp - 1;
            end if;
        end if;
        if My_Fore < 1 then
            My_Fore := 1;
        end if;
        if My_Aft < 1 then
            My_Aft := 1;
        end if;
        if My_Exp = 0 then
            Cvt_Num (To, Len, Item, My_Fore, My_Aft);
        else
            Cvt_Num_Using_E (To, Len, Item, My_Fore, My_Aft, My_Exp, Fore = -1);
        end if;
    end Put_Float;

end Number_Io;

E3 Meta Data

    nblk1=1f
    nid=0
    hdr6=3e
        [0x00] rec0=1e rec1=00 rec2=01 rec3=066
        [0x01] rec0=1c rec1=00 rec2=02 rec3=080
        [0x02] rec0=1d rec1=00 rec2=03 rec3=086
        [0x03] rec0=1e rec1=00 rec2=04 rec3=01e
        [0x04] rec0=1f rec1=00 rec2=05 rec3=00a
        [0x05] rec0=1c rec1=00 rec2=06 rec3=020
        [0x06] rec0=1e rec1=00 rec2=07 rec3=03c
        [0x07] rec0=17 rec1=00 rec2=08 rec3=002
        [0x08] rec0=18 rec1=00 rec2=09 rec3=06c
        [0x09] rec0=1f rec1=00 rec2=0a rec3=002
        [0x0a] rec0=1e rec1=00 rec2=0b rec3=024
        [0x0b] rec0=24 rec1=00 rec2=0c rec3=020
        [0x0c] rec0=21 rec1=00 rec2=0d rec3=072
        [0x0d] rec0=20 rec1=00 rec2=0e rec3=04a
        [0x0e] rec0=20 rec1=00 rec2=0f rec3=032
        [0x0f] rec0=20 rec1=00 rec2=10 rec3=00e
        [0x10] rec0=20 rec1=00 rec2=11 rec3=014
        [0x11] rec0=20 rec1=00 rec2=12 rec3=014
        [0x12] rec0=1d rec1=00 rec2=13 rec3=072
        [0x13] rec0=17 rec1=00 rec2=14 rec3=014
        [0x14] rec0=20 rec1=00 rec2=15 rec3=012
        [0x15] rec0=1d rec1=00 rec2=16 rec3=044
        [0x16] rec0=20 rec1=00 rec2=17 rec3=010
        [0x17] rec0=21 rec1=00 rec2=18 rec3=01a
        [0x18] rec0=1f rec1=00 rec2=19 rec3=00e
        [0x19] rec0=1e rec1=00 rec2=1a rec3=036
        [0x1a] rec0=1c rec1=00 rec2=1b rec3=010
        [0x1b] rec0=1f rec1=00 rec2=1c rec3=034
        [0x1c] rec0=21 rec1=00 rec2=1d rec3=006
        [0x1d] rec0=1f rec1=00 rec2=1e rec3=00a
        [0x1e] rec0=1c rec1=00 rec2=1f rec3=001
    tail 0x21757fb4e878e786413ad 0x42a00088462060003