DataMuseum.dk

top - metrics - download

    Length: 5553 (0x15b1)
    Types: TextFile
    Names: »B«

└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
    └─⟦5cb1d1d7f⟧ »DATA« 
        └─⟦3b1ee7bd8⟧ 
            └─⟦this⟧ 

TextFile

package body Io_Package is

    package Choice_Io is new Enumeration_Io (Choice_Type);
    package Size_Io is new Integer_Io (Size_Type);
    package Time_Io is new Fixed_Io (Duration);
    use Time_Io, Choice_Io, Size_Io;

    Fore_Size : constant Field := 6;
    Aft_Size : constant Field := 2;
    Width_Size : constant Field := 6;
    -- Internal (Hidden) Functions

    function Min (First, Last : Natural) return Natural is
    begin
        if First <= Last then
            return First;
        else
            return Last;
        end if;
    end Min;

    -- File I/O Functions

    procedure Get_File_Name (File : in out File_Record_Type) is
        Last : Integer;
    begin
        Put ("File name?: ");
        File.File_Name := Blank_File_Name;
        Get_Line (File.File_Name, Last);
    exception
        when Constraint_Error =>
            Put ("*** Name too long, enter ");
            Put (Max_File_Length);
            Put_Line (" characters.");
            Get_File_Name (File);
    end Get_File_Name;

    procedure Open_File (File : in out File_Record_Type;
                         Mode : in Text_Io.File_Mode := In_File) is
    begin
        Put (File.File_Name);
        Text_Io.Open (File.Internal_Name, Mode, File.File_Name);
        Put (" ... open.");
        -- mark the file as open
        File.File_Exists := True;
    exception
        when Name_Error =>
            if Mode = In_File then
                Put_Line ("*** File not found.");
            else
                Text_Io.Create (File.Internal_Name, Mode, File.File_Name);
                Put (" ... created.");
                File.File_Exists := True;
            end if;
    end Open_File;

    procedure Close_File (File : in out File_Record_Type) is
    begin
        if File.File_Exists then
            Put (File.File_Name);
            Text_Io.Close (File.Internal_Name);
            Put (" ... closed.");
            -- and mark as closed
            File.File_Exists := False;
        end if;
    exception
        when Status_Error =>
            File.File_Exists := False;
    end Close_File;

    procedure File_Status (File : in File_Record_Type) is
    begin
        if File.File_Exists then
            Put (File.File_Name);
        else
            Put ("not defined.");
        end if;
    end File_Status;

    -- Compilation I/O

    procedure Get (File : in File_Type; Value : out Compilation_Record_Type) is
        Last : Natural := 0;
        E_Time, C_Time : Duration := 0.0;
        Size : Size_Type := 0;
        Name : Name_Type := Blank_Unit_Name;
        Comments : String (1 .. Columns);
    begin
        Get (File, Name);
        Get (File, E_Time);
        Get (File, C_Time);
        Get (File, Size);
        Get_Line (File, Comments, Last);
        Last := Min (Columns, Last);
        Value := (Last, Name, E_Time, C_Time, Size, Comments (1 .. Last));
    end Get;

    procedure Put (File : in File_Type := Current_Output;
                   Value : in Compilation_Record_Type) is
    begin
        Put (File, Value.Test_Name & "           ");
        Put (File, Value.Total_Elapsed_Time, Fore_Size, Aft_Size);
        Put (File, Value.Total_Cpu_Time, Fore_Size, Aft_Size);
        Put (File, Value.Object_Code_Size, Width_Size);
        Put_Line (File, "       " & Value.Comments);
    end Put;

    -- Run Time I/O

    procedure Get (File : in File_Type; Value : out Run_Time_Record_Type) is
        Last : Natural := 0;
        E_Time, C_Time : Duration := 0.0;
        C_Size, D_Size : Size_Type := 0;
        Name : Name_Type := Blank_Unit_Name;
        Comments : String (1 .. Columns);
    begin
        Get (File, Name);
        Get (File, E_Time);
        Get (File, C_Time);
        Get (File, C_Size);
        Get (File, D_Size);
        Get_Line (File, Comments, Last);
        Last := Min (Columns, Last);
        Value := (Last, Name, E_Time, C_Time, C_Size,
                  D_Size, Comments (1 .. Last));
    end Get;

    procedure Put (File : in File_Type := Current_Output;
                   Value : in Run_Time_Record_Type) is
    begin
        Put (File, Value.Test_Name & "           ");
        Put (File, Value.Total_Elapsed_Time, Fore_Size, Aft_Size);
        Put (File, Value.Total_Cpu_Time, Fore_Size, Aft_Size);
        Put (File, Value.Memory_Code_Size, Width_Size);
        Put (File, Value.Memory_Data_Size, Width_Size);
        Put_Line (File, " " & Value.Comments);
    end Put;

    -- Instrumentation I/O

    procedure Get (File : in File_Type;
                   Value : out Instrumentation_Record_Type) is
        Last : Natural := 0;
        Ident : Choice_Type := Start_Rec;
        E_Time, C_Time : Duration := 0.0;
        Name : Name_Type := Blank_Unit_Name;
        Comments : String (1 .. Columns);
    begin
        Get (File, Name);
        Get (File, Ident);
        Get (File, E_Time);
        Get (File, C_Time);
        Get_Line (File, Comments, Last);
        Last := Min (Columns, Last);
        Value := (Last, Name, Ident, E_Time, C_Time, Comments (1 .. Last));
    end Get;

    procedure Put (File : in File_Type := Current_Output;
                   Value : in Instrumentation_Record_Type) is
        E_Width : constant Field := 9;
    begin
        Put (File, Value.Test_Name & " ");
        Put (File, Value.Ident, E_Width);
        Put (" ");
        Put (File, Value.Elapsed_Time, Fore_Size, Aft_Size);
        Put (File, Value.Elapsed_Cpu_Time, Fore_Size, Aft_Size);
        Put_Line (File, "       " & Value.Comments);
    end Put;

end Io_Package;