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 - metrics - download

⟦a61da513a⟧ Ada Source

    Length: 5120 (0x1400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Fixed_Io, seg_05094e, separate Text_Io

Derivation

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

with Number_Io;
use Number_Io;

separate (Text_Io)
package body Fixed_Io is
    pragma Suppress (Access_Check);
    pragma Suppress (Discriminant_Check);
    pragma Suppress (Index_Check);
    pragma Suppress (Length_Check);
    pragma Suppress (Division_Check);
    pragma Suppress (Overflow_Check);
    pragma Suppress (Elaboration_Check);

    Max_Fixed_Length : constant Natural := 64;

    --=========================================================================
    -- ATTENTION:  (Not Yet Implemented.)  Fixed i/o must eventually be
    -- rewritten to handle arbitrary fixed point representations, and
    -- floating point will not be usable as the base representation.
    --=========================================================================

    procedure Get (File : in File_Type;
                   Item : out Num;
                   Width : in Field := 0) is
        Result : Io_Float;
    begin
        Safe_Support.File_Lock (File);       Get_Float (File, Result, Width);
        begin
            Item := Num (Result);
        exception
            when Constraint_Error =>
                raise Data_Error;
        end;
        Safe_Support.File_Unlock (File);
    exception
        when others =>
            Safe_Support.File_Unlock (File);
            raise;
    end Get;

    procedure Get (Item : out Num; Width : in Field := 0) is
    begin
        -- Called get() does file_lock()/file_unlock()
        Get (Current_Input, Item, Width);
    end Get;

    procedure Put (File : in File_Type;
                   Item : in Num;
                   Fore : in Field := Default_Fore;
                   Aft : in Field := Default_Aft;
                   Exp : in Field := Default_Exp) is
        Str : String (1 .. Max_Fixed_Length);
        Len : Integer := Str'Last;
    begin
        Safe_Support.File_Lock (File);
        Put_Float (Str, Io_Float (Item), Fore, Aft, Exp, Len);
        Put_String_On_One_Line (File, Str (1 .. Len));
        Safe_Support.File_Unlock (File);
    exception
        when others =>
            Safe_Support.File_Unlock (File);
            raise;
    end Put;

    procedure Put (Item : in Num;
                   Fore : in Field := Default_Fore;
                   Aft : in Field := Default_Aft;
                   Exp : in Field := Default_Exp) is
    begin
        -- Called put() does file_lock()/file_unlock()
        Put (Current_Output, Item, Fore, Aft, Exp);
    end Put;

    procedure Get (From : in String; Item : out Num; Last : out Positive) is
        Result : Io_Float;
        Error : Boolean := False;
        I : Integer;
    begin
        --
        -- test for end_error
        --
        I := From'First;
        loop
            if I > From'Last then
                raise End_Error;
            end if;
            exit when From (I) /= ' ' and then From (I) /= Ascii.Ht;
            I := I + 1;
        end loop;
        Getnum (From, Result, Last, Error);
        if Error then
            raise Data_Error;
        end if;
        begin
            Item := Num (Result);
        exception
            when Constraint_Error =>
                raise Data_Error;
        end;
    end Get;

    procedure Put (To : out String;
                   Item : in Num;
                   Aft : in Field := Default_Aft;
                   Exp : in Field := Default_Exp) is
        Len : Integer := To'Length;
    begin
        Put_Float (To, Io_Float (Item), -1, Aft, Exp, Len);
        if Len /= To'Length then
            Put_Line ("VADS internal error: cvtnum failed");
            raise Program_Error;
        end if;
    end Put;

end Fixed_Io;

    nblk1=4
    nid=0
    hdr6=8
        [0x00] rec0=1d rec1=00 rec2=01 rec3=002
        [0x01] rec0=1e rec1=00 rec2=02 rec3=00e
        [0x02] rec0=1f rec1=00 rec2=03 rec3=020
        [0x03] rec0=1c rec1=00 rec2=04 rec3=000
    tail 0x21757fc2c878e78831c6e 0x42a00088462060003