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

⟦7b802e07a⟧ Ada Source

    Length: 33792 (0x8400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Enumeration_Io, package body Fixed_Io, package body Float_Io, package body Integer_Io, package body Text_Io, seg_05094c

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 System, File_Support, Os_Files;
with Text_Supprt;
use Text_Supprt;
with A_Strings;
use A_Strings;
with Safe_Support;
use File_Support;
use System;

pragma Elaborate (File_Support);
pragma Elaborate (Os_Files);

package body Text_Io is

    Standard_Input_Open : Boolean := False;
    Standard_Output_Open : Boolean := False;
    Standard_Error_Open : Boolean := False;
    Current_Input_Open : Boolean := False;
    Current_Output_Open : Boolean := False;

    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 (Overflow_Check);
    pragma Suppress (Elaboration_Check);

    -- NOTE: NO NESTED FILE LOCKS

    ------------------------------------------------------------------------
    -- Beginning of text_io support routines (file is already lock)
    ------------------------------------------------------------------------

    -- Upon entry/exit: file is locked
    procedure Set_Line_And_Page (File : File_Type) is
        Void : File_Pos;
    begin
        Reject_Null_File (File);
        if File.Mode = Input then
            Void := Tstfile (File);
        end if;
    end Set_Line_And_Page;

    -- Upon entry/exit: file is locked
    function Get_Col (File : in File_Type) return Positive_Count is
    begin
        Reject_Null_File (File);
        if File.Mode = Output then
            return Count (File.Out_Ptr - File.Last_Lf + 1);
        else
            return Count (File.In_Ptr - File.Last_Lf + 1);
        end if;
    end Get_Col;

    -- Upon entry/exit: file is locked
    function Get_Line_Number (File : in File_Type) return Positive_Count is
    begin
        Set_Line_And_Page (File);
        return Count (File.Line);
    end Get_Line_Number;

    -- Upon entry/exit: file is locked
    procedure Put_New_Line (File : in File_Type;
                            Spacing : in Positive_Count := 1) is
    begin
        Must_Be_Output (File);
        for I in 1 .. Spacing loop
            Putchar (File_Ptr (File), Ascii.Lf);
        end loop;
        if File.Always_Flush then
            Flush (File);
        end if;
    end Put_New_Line;

    -- Upon entry/exit: file is locked
    procedure Put_New_Page (File : in File_Type) is
    begin
        Must_Be_Output (File);
        if Get_Col (File) /= 1 or else Get_Line_Number (File) = 1 then
            Putchar (File_Ptr (File), Ascii.Lf);
        end if;
        Putchar (File_Ptr (File), Ascii.Ff);
        if File.Always_Flush then
            Flush (File);
        end if;
    end Put_New_Page;

    ------------------------------------------------------------------------
    -- End of text_io support routines
    ------------------------------------------------------------------------

    -- No file locking. file can't be referenced until create() returns.
    procedure Create (File : in out File_Type;
                      Mode : in File_Mode := Out_File;
                      Name : in String := "";
                      Form : in String := "") is
        Fmode : File_Support.File_Mode;
    begin
        case Mode is
            when In_File =>
                Fmode := Input;
            when Out_File =>
                Fmode := Output;
        end case;

        -- Upon entry/exit: file is unlocked for the following two calls
        File_Open (Name, File_Ptr (File), Fmode, True, Form, Text);
        Setup_Buffer (File_Ptr (File), Os_Files.Default_Buffer_Size);
    end Create;

    -- No file locking. file can't be referenced until open() returns.
    procedure Open (File : in out File_Type;
                    Mode : in File_Mode;
                    Name : in String;
                    Form : in String := "") is
        Fmode : File_Support.File_Mode;
    begin
        case Mode is
            when In_File =>
                Fmode := Input;
            when Out_File =>
                Fmode := Output;
        end case;

        -- Upon entry/exit: file is unlocked for the following two calls
        File_Open (Name, File_Ptr (File), Fmode, False, Form, Text);
        Setup_Buffer (File_Ptr (File), Os_Files.Default_Buffer_Size);
    end Open;

    procedure Close (File : in out File_Type) is
    begin
        Reject_Null_File (File);
        begin
            Safe_Support.File_Lock (File);
            if File.Mode = Output and then Get_Col (File) /= 1 then
                Putchar (File_Ptr (File), Ascii.Lf);
            end if;
            if File_Ptr (File) = Cur_Input then
                Cur_Input := null;
            end if;
            if File_Ptr (File) = Cur_Output then
                Cur_Output := null;
            end if;
        exception
            when others =>
                Safe_Support.File_Unlock (File);
                raise;
        end;

        File_Close (File_Ptr (File)); -- upon return, file is unlocked
        File := null;
    end Close;

    procedure Delete (File : in out File_Type) is
    begin
        Reject_Null_File (File);
        Safe_Support.File_Lock (File);
        File_Delete (File_Ptr (File)); -- upon return, file is unlocked
        File := null;
    end Delete;

    procedure Reset (File : in out File_Type; Mode : in File_Mode) is
        Fmode : File_Support.File_Mode;
        Fp : File_Ptr := File_Ptr (File);
    begin
        Safe_Support.File_Lock (File);
        Reject_Null_File (File);
        case Mode is
            when In_File =>
                Fmode := Input;
            when Out_File =>
                Fmode := Output;
        end case;
        if (Fp = Cur_Input or Fp = Cur_Output) and Fmode /= File.Mode then
            raise Mode_Error; -- raise mode_error before stomping file
        end if;
        if File.Mode = Output and then Get_Col (File) /= 1 then
            Putchar (File_Ptr (File), Ascii.Lf);
        end if;
        File_Reset (File_Ptr (File), Fmode);
        File.Linelength := 0;
        File.Pagelength := 0;
        Safe_Support.File_Unlock (File);
    exception
        when others =>
            Safe_Support.File_Unlock (File);
            raise;
    end Reset;

    procedure Reset (File : in out File_Type) is
    begin
        Safe_Support.File_Lock (File);
        Reject_Null_File (File);
        if File.Mode = Output then
            if Get_Col (File) /= 1 or else
               (File.Line = 1 and File.Page = 1) then
                Putchar (File_Ptr (File), Ascii.Lf);
            end if;
            if File.Line /= 1 or else File.Page = 1 then
                Putchar (File_Ptr (File), Ascii.Ff);
            end if;
        end if;
        File_Reset (File_Ptr (File), File.Mode);
        File.Linelength := 0;
        File.Pagelength := 0;
        Safe_Support.File_Unlock (File);
    exception
        when others =>
            Safe_Support.File_Unlock (File);
            raise;
    end Reset;

    function Mode (File : in File_Type) return File_Mode is
    begin
        Reject_Null_File (File);
        case File.Mode is
            when Input =>
                return In_File;
            when Output =>
                return Out_File;
            when In_Out =>
                raise Program_Error;
        end case;
    end Mode;

    function Name (File : in File_Type) return String is
    begin
        Reject_Null_File (File);
        if File.Name = null then
            return "";
        else
            return File.Name.S;
        end if;
    end Name;

    function Form (File : in File_Type) return String is
    begin
        Reject_Null_File (File);
        if File.Form = null then
            return "";
        end if;
        return File.Form.S;
    end Form;

    function Is_Open (File : in File_Type) return Boolean is
        Fp : File_Ptr := File_Ptr (File);
    begin
        return File /= null and then Fp.File_Id /= Os_Files.Invalid;
    end Is_Open;

    -- control of default input and output files

    -- Upon entry/exit: text_io is locked
    procedure Open_Standard_Input is
    begin
        File_Open (Os_Files.Std_Input_Name, Std_Input,
                   Input, False, "", Os_Files.Special);
        Stdin_Fd := Std_Input.Fd;
        Setup_Buffer (Std_Input, Os_Files.Default_Buffer_Size);
        Standard_Input_Open := True;
        if not Current_Input_Open then
            Cur_Input := Std_Input;
            Cur_Input_Id := Std_Input.File_Id;
            Current_Input_Open := True;
        end if;
    end Open_Standard_Input;

    -- Upon entry/exit: text_io is locked
    procedure Open_Standard_Output is
    begin
        File_Open (Os_Files.Std_Output_Name, Std_Output,
                   Output, False, "", Os_Files.Special);
        Stdout_Fd := Std_Output.Fd;
        if Standard_Input_Open then
            Std_Output.Always_Flush := Std_Output.Always_Flush or
                                          (Is_Interactive (Stdout_Fd) and then
                                           Is_Interactive (Stdin_Fd));
        else
            Std_Output.Always_Flush := Std_Output.Always_Flush or
                                          Is_Interactive (Stdout_Fd);
        end if;
        Setup_Buffer (Std_Output, Os_Files.Default_Buffer_Size);
        Standard_Output_Open := True;
        if not Current_Output_Open then
            Cur_Output := Std_Output;
            Cur_Output_Id := Std_Output.File_Id;
            Current_Output_Open := True;
        end if;
    end Open_Standard_Output;

    -- Upon entry/exit: text_io is locked
    function Standard_Output_Locked return File_Type is
    begin
        begin
            if not Standard_Output_Open then
                Open_Standard_Output;
            end if;
        exception
            when others =>
                raise;
        end;
        return File_Type (Std_Output);
    end Standard_Output_Locked;

    -- Upon entry/exit: text_io is locked
    procedure Open_Standard_Error is
    begin
        File_Open (Os_Files.Std_Error_Name, Std_Error,
                   Output, False, "", Os_Files.Special);
        Stderr_Fd := Std_Error.Fd;
        Std_Error.Always_Flush := Standard_Output_Locked.Always_Flush;
        Setup_Buffer (Std_Error, Os_Files.Default_Buffer_Size);
        Standard_Error_Open := True;
    end Open_Standard_Error;

    procedure Set_Input (File : in File_Type) is
    begin
        Must_Be_Input (File);

        Safe_Support.Text_Io_Lock;
        Cur_Input := File_Ptr (File);
        Cur_Input_Id := Cur_Input.File_Id;
        Current_Input_Open := True;
        Safe_Support.Text_Io_Unlock;
    end Set_Input;

    procedure Set_Output (File : in File_Type) is
    begin
        Must_Be_Output (File);

        Safe_Support.Text_Io_Lock;
        Cur_Output := File_Ptr (File);
        Cur_Output_Id := Cur_Output.File_Id;
        Current_Output_Open := True;
        Safe_Support.Text_Io_Unlock;
    end Set_Output;

    function Standard_Input return File_Type is
    begin
        begin
            Safe_Support.Text_Io_Lock;
            if not Standard_Input_Open then
                Open_Standard_Input;
            end if;
            Safe_Support.Text_Io_Unlock;
        exception
            when others =>
                Safe_Support.Text_Io_Unlock;
                raise;
        end;
        return File_Type (Std_Input);
    end Standard_Input;

    function Standard_Output return File_Type is
    begin
        begin
            Safe_Support.Text_Io_Lock;
            if not Standard_Output_Open then
                Open_Standard_Output;
            end if;
            Safe_Support.Text_Io_Unlock;
        exception
            when others =>
                Safe_Support.Text_Io_Unlock;
                raise;
        end;
        return File_Type (Std_Output);
    end Standard_Output;

    function Standard_Error return File_Type is
    begin
        begin
            Safe_Support.Text_Io_Lock;
            if not Standard_Error_Open then
                Open_Standard_Error;
            end if;
            Safe_Support.Text_Io_Unlock;
        exception
            when others =>
                Safe_Support.Text_Io_Unlock;
                raise;
        end;
        return File_Type (Std_Error);
    end Standard_Error;

    function Current_Input return File_Type is
    begin
        --
        -- If current_input is not open it must be the same as standard_input
        --
        begin
            Safe_Support.Text_Io_Lock;
            if not Current_Input_Open then
                Open_Standard_Input;
            end if;
            Safe_Support.Text_Io_Unlock;
        exception
            when others =>
                Safe_Support.Text_Io_Unlock;
                raise;
        end;
        return File_Type (Cur_Input);
    end Current_Input;

    function Current_Output return File_Type is
    begin
        --
        -- If current_output is not open it must be the same as standard_output
        --
        begin
            Safe_Support.Text_Io_Lock;
            if not Current_Output_Open then
                Open_Standard_Output;
            end if;
            Safe_Support.Text_Io_Unlock;
        exception
            when others =>
                Safe_Support.Text_Io_Unlock;
                raise;
        end;
        return File_Type (Cur_Output);
    end Current_Output;

    -- specification of line and page lengths

    procedure Set_Line_Length (File : in File_Type; To : in Count) is
    begin
        Safe_Support.File_Lock (File);
        Must_Be_Output (File);
        File.Linelength := Natural (To);
        Safe_Support.File_Unlock (File);
    exception
        when others =>
            Safe_Support.File_Unlock (File);
            raise;
    end Set_Line_Length;

    procedure Set_Line_Length (To : in Count) is
    begin
        -- Called set_line_length() does file_lock()/file_unlock()
        Set_Line_Length (Current_Output, To);
    end Set_Line_Length;

    procedure Set_Page_Length (File : in File_Type; To : in Count) is
    begin
        Safe_Support.File_Lock (File);
        Must_Be_Output (File);
        File.Pagelength := Natural (To);
        Safe_Support.File_Unlock (File);
    exception
        when others =>
            Safe_Support.File_Unlock (File);
            raise;
    end Set_Page_Length;

    procedure Set_Page_Length (To : in Count) is
    begin
        -- Called set_page_length() does file_lock()/file_unlock()
        Set_Page_Length (Current_Output, To);
    end Set_Page_Length;

    function Line_Length (File : in File_Type) return Count is
    begin
        Must_Be_Output (File);
        return Count (File.Linelength);
    end Line_Length;

    function Line_Length return Count is
    begin
        return Line_Length (Current_Output);
    end Line_Length;

    function Page_Length (File : in File_Type) return Count is
    begin
        Must_Be_Output (File);
        return Count (File.Pagelength);
    end Page_Length;

    function Page_Length return Count is
    begin
        return Page_Length (Current_Output);
    end Page_Length;

    -- column, line, and page control

    procedure New_Line (File : in File_Type;
                        Spacing : in Positive_Count := 1) is
    begin
        Safe_Support.File_Lock (File);
        Put_New_Line (File, Spacing);
        Safe_Support.File_Unlock (File);
    exception
        when others =>
            Safe_Support.File_Unlock (File);
            raise;
    end New_Line;

    procedure New_Line (Spacing : in Positive_Count := 1) is
    begin
        -- Called new_line() does file_lock()/file_unlock()
        New_Line (Current_Output, Spacing);
    end New_Line;

    procedure Skip_Line (File : in File_Type;
                         Spacing : in Positive_Count := 1) is
    begin
        Safe_Support.File_Lock (File);
        Must_Be_Input (File);
        for I in 1 .. Spacing loop
            File_Support.Skip_Past_Eol (File_Ptr (File));
        end loop;
        Safe_Support.File_Unlock (File);
    exception
        when others =>
            Safe_Support.File_Unlock (File);
            raise;
    end Skip_Line;

    procedure Skip_Line (Spacing : in Positive_Count := 1) is
    begin
        -- Called skip_line() does file_lock()/file_unlock()
        Skip_Line (Current_Input, Spacing);
    end Skip_Line;

    function End_Of_Line (File : in File_Type) return Boolean is
        Result : Boolean;
    begin
        Safe_Support.File_Lock (File);
        Must_Be_Input (File);
        Result := Tstfile (File_Ptr (File)) /= At_Char;
        Safe_Support.File_Unlock (File);
        return Result;
    exception
        when others =>
            Safe_Support.File_Unlock (File);
            raise;
    end End_Of_Line;

    function End_Of_Line return Boolean is
    begin
        -- Called end_of_line() does file_lock()/file_unlock()
        return End_Of_Line (Current_Input);
    end End_Of_Line;

    procedure New_Page (File : in File_Type) is
    begin
        Safe_Support.File_Lock (File);
        Put_New_Page (File);
        Safe_Support.File_Unlock (File);
    exception
        when others =>
            Safe_Support.File_Unlock (File);
            raise;
    end New_Page;

    procedure New_Page is
    begin
        -- Called new_page() does file_lock()/file_unlock()
        New_Page (Current_Output);
    end New_Page;

    procedure Skip_Page (File : in File_Type) is
        Void : File_Pos;
    begin
        Safe_Support.File_Lock (File);
        Must_Be_Input (File);
        loop
            Skip_Past_Eol (File);
            Void := Tstfile_Beyond_Eol (File); --read past ff, if present
            exit when File.Pos = At_Eop or File.Pos = At_Eof;
        end loop;
        Safe_Support.File_Unlock (File);
    exception
        when others =>
            Safe_Support.File_Unlock (File);
            raise;
    end Skip_Page;

    procedure Skip_Page is
    begin
        -- Called skip_page() does file_lock()/file_unlock()
        Skip_Page (Current_Input);
    end Skip_Page;

    function End_Of_Page (File : in File_Type) return Boolean is
        Pos : File_Pos;
    begin
        Safe_Support.File_Lock (File);
        Must_Be_Input (File);
        Pos := Tstfile_Beyond_Eol (File);
        Safe_Support.File_Unlock (File);
        return Pos = At_Eop or else Pos = At_Eof;
    exception
        when others =>
            Safe_Support.File_Unlock (File);
            raise;
    end End_Of_Page;

    function End_Of_Page return Boolean is
    begin
        -- Called end_of_page() does file_lock()/file_unlock()
        return End_Of_Page (Current_Input);
    end End_Of_Page;

    function End_Of_File (File : in File_Type) return Boolean is
        Result : Boolean;
    begin
        Safe_Support.File_Lock (File);
        Must_Be_Input (File);
        Result := Tstfile_Beyond_Eol (File) = At_Eof;
        Safe_Support.File_Unlock (File);
        return Result;
    exception
        when others =>
            Safe_Support.File_Unlock (File);
            raise;
    end End_Of_File;

    function End_Of_File return Boolean is
    begin
        -- Called end_of_file() does file_lock()/file_unlock()
        return End_Of_File (Current_Input);
    end End_Of_File;

    procedure Set_Col (File : in File_Type; To : in Positive_Count) is
        Void : Character;
    begin
        Safe_Support.File_Lock (File);
        Reject_Null_File (File);
        case File.Mode is
            when Input =>
                while Tstfile (File_Ptr (File)) /= At_Char or else
                         Get_Col (File) /= To loop
                    Void := Getchar (File_Ptr (File));
                end loop;
            when Output =>
                if File.Linelength /= 0 and then
                   To > Count (File.Linelength) then
                    raise Layout_Error;
                end if;
                if Get_Col (File) > To then
                    Putchar (File_Ptr (File), Ascii.Lf);
                end if;
                while Get_Col (File) < To loop
                    Putchar (File_Ptr (File), ' ');
                end loop;
                if File.Always_Flush then
                    Flush (File);
                end if;
            when others =>
                null;
        end case;
        Safe_Support.File_Unlock (File);
    exception
        when others =>
            Safe_Support.File_Unlock (File);
            raise;
    end Set_Col;

    procedure Set_Col (To : in Positive_Count) is
    begin
        -- Called set_col() does file_lock()/file_unlock()
        Set_Col (Current_Output, To);
    end Set_Col;

    procedure Set_Line (File : in File_Type; To : in Positive_Count) is
        Void_Pos : File_Pos;
    begin
        Safe_Support.File_Lock (File);
        Reject_Null_File (File);
        case File.Mode is
            when Input =>
                while File.Line /= Natural (To) loop
                    Skip_Past_Eol (File);
                    Void_Pos := Tstfile_Beyond_Eol (File);
                end loop;
            when Output =>
                if File.Pagelength /= 0 and then
                   Natural (To) > File.Pagelength then
                    raise Layout_Error;
                end if;
                if Natural (To) < File.Line then
                    Put_New_Page (File);
                    Put_New_Line (File, To - 1);
                elsif Natural (To) > File.Line then
                    while File.Line /= Natural (To) loop
                        Put_New_Line (File);
                    end loop;
                end if;
                if File.Always_Flush then
                    Flush (File);
                end if;
            when others =>
                null;
        end case;
        Safe_Support.File_Unlock (File);
    exception
        when others =>
            Safe_Support.File_Unlock (File);
            raise;
    end Set_Line;

    procedure Set_Line (To : in Positive_Count) is
    begin
        -- Called set_line() does file_lock()/file_unlock()
        Set_Line (Current_Output, To);
    end Set_Line;

    function Col (File : in File_Type) return Positive_Count is
        Cnt : Count;
    begin
        Safe_Support.File_Lock (File);
        Cnt := Get_Col (File);
        Safe_Support.File_Unlock (File);
        return Cnt;
    exception
        when others =>
            Safe_Support.File_Unlock (File);
            raise;
    end Col;

    function Col return Positive_Count is
    begin
        -- Called col() does file_lock()/file_unlock()
        return Col (Current_Output);
    end Col;

    function Line (File : in File_Type) return Positive_Count is
        Cnt : Positive_Count;
    begin
        Safe_Support.File_Lock (File);
        Cnt := Get_Line_Number (File);
        Safe_Support.File_Unlock (File);
        return Cnt;
    exception
        when others =>
            Safe_Support.File_Unlock (File);
            raise;
    end Line;

    function Line return Positive_Count is
    begin
        -- Called line() does file_lock()/file_unlock()
        return Line (Current_Output);
    end Line;

    function Page (File : in File_Type) return Positive_Count is
    begin
        Safe_Support.File_Lock (File);
        Set_Line_And_Page (File);
        Safe_Support.File_Unlock (File);
        return Count (File.Page);
    exception
        when others =>
            Safe_Support.File_Unlock (File);
            raise;
    end Page;

    function Page return Positive_Count is
    begin
        -- Called page() does file_lock()/file_unlock()
        return Page (Current_Output);
    end Page;

    -- character input-output

    procedure Get (File : in File_Type; Item : out Character) is
        C : Character;
        Fp : File_Ptr := File_Ptr (File);
    begin
        Safe_Support.File_Lock (File);
        if File = null then
            raise Status_Error;
        end if;
        loop
            if File.Pos /= At_Char or else File.In_Ptr >= File.Last then
                C := Getchar (File);
            else
                File.In_Ptr := File.In_Ptr + 1;
                C := File.Buffer.Elem (File.In_Ptr);
                if C = Ascii.Lf then
                    File.In_Ptr := File.In_Ptr - 1;
                    C := Getchar (File);
                else
                    exit;
                end if;
            end if;
            exit when File.Pos = At_Char;
        end loop;
        Item := C;
        Safe_Support.File_Unlock (File);
    exception
        when others =>
            Safe_Support.File_Unlock (File);
            raise;
    end Get;

    procedure Get (Item : out Character) is
    begin
        -- Called get() does file_lock()/file_unlock()
        Get (Current_Input, Item);
    end Get;

    procedure Put (File : in File_Type; Item : in Character) is
    begin
        Safe_Support.File_Lock (File);
        if File = null then
            raise Status_Error;
        end if;
        if File.Mode /= Output then
            raise Mode_Error;
        end if;
        Putchar (File_Ptr (File), Item);
        if File.Always_Flush then
            Flush (File);
        end if;
        Safe_Support.File_Unlock (File);
    exception
        when others =>
            Safe_Support.File_Unlock (File);
            raise;
    end Put;

    procedure Put (Item : in Character) is
    begin
        -- Called put() does file_lock()/file_unlock()
        Put (Current_Output, Item);
    end Put;

    -- string input-output

    procedure Get (File : in File_Type; Item : out String) is
        C : Character;
        Fp : File_Ptr := File_Ptr (File);
        Void : File_Pos;
    begin
        Safe_Support.File_Lock (File);
        Reject_Null_File (File);
        for I in Item'Range loop
            loop
                if Fp.In_Ptr < Fp.Last and then File.Pos = At_Char then
                    Fp.In_Ptr := Fp.In_Ptr + 1;
                    C := File.Buffer.Elem (Fp.In_Ptr);
                    if C = Ascii.Lf then
                        Fp.Pos := At_Delayed_Eol;
                        C := Getchar (Fp);
                    else
                        File.Pos := At_Char;
                        exit;
                    end if;
                else
                    C := Getchar (Fp);
                end if;
                exit when Fp.Pos = At_Char;
            end loop;
            Item (I) := C;
        end loop;
        Safe_Support.File_Unlock (File);
    exception
        when others =>
            Safe_Support.File_Unlock (File);
            raise;
    end Get;

    procedure Get (Item : out String) is
    begin
        Get (Current_Input, Item);
    end Get;

    -- Upon entry/exit: file is locked
    --
    -- Called from float_io.put() and fixed_io.put().
    procedure Put_String_On_One_Line (File : File_Type; Item : String) is
        Len : Integer := Item'Length;
    begin
        Must_Be_Output (File);
        if File.Linelength /= 0 then
            if Integer (Get_Col (File)) + Len - 1 > File.Linelength then
                if Len > File.Linelength then
                    raise Layout_Error;
                end if;
                Put_New_Line (File);
            end if;
        end if;
        for I in Item'Range loop
            Putchar (File, Item (I));
        end loop;
        if File.Always_Flush then
            Flush (File);
        end if;
    end Put_String_On_One_Line;

    procedure Put (File : in File_Type; Item : in String) is
    begin
        Safe_Support.File_Lock (File);
        Must_Be_Output (File);
        for I in Item'Range loop
            Putchar (File, Item (I));
        end loop;
        if File.Always_Flush and then Item'Last >= Item'First then
            Flush (File);
        end if;
        Safe_Support.File_Unlock (File);
    exception
        when others =>
            Safe_Support.File_Unlock (File);
            raise;
    end Put;

    procedure Put (Item : in String) is
    begin
        -- Called put() does file_lock()/file_unlock()
        Put (Current_Output, Item);
    end Put;

    procedure Get_Line
                 (File : in File_Type; Item : out String; Last : out Natural) is
        Fp : File_Ptr := File_Ptr (File);
        C : Character;
    begin
        Safe_Support.File_Lock (File);
        Must_Be_Input (File);
        if Item'Last < Item'First then
            Last := Item'First - 1;
            Safe_Support.File_Unlock (File);
            return;
        end if;
        for I in Item'Range loop
            C := File.Buffer.Elem (Fp.In_Ptr + 1);
            if Fp.In_Ptr >= Fp.Last or else
               C = Ascii.Ff or else C = Ascii.Lf then
                if Tstfile (Fp) /= At_Char then
                    Last := I - 1;
                    Skip_Past_Eol (File);
                    Safe_Support.File_Unlock (File);
                    return;
                end if;
                Item (I) := Getchar (Fp);
            else
                Fp.In_Ptr := Fp.In_Ptr + 1;
                Item (I) := C;
            end if;
        end loop;
        Last := Item'Last;
        Safe_Support.File_Unlock (File);
    exception
        when others =>
            Safe_Support.File_Unlock (File);
            raise;
    end Get_Line;

    procedure Get_Line (Item : out String; Last : out Natural) is
    begin
        -- Called get_line() does file_lock()/file_unlock()
        Get_Line (Current_Input, Item, Last);
    end Get_Line;

    procedure Put_Line (File : in File_Type; Item : in String) is
    begin
        Safe_Support.File_Lock (File);
        Must_Be_Output (File);
        for I in Item'Range loop
            Putchar (File_Ptr (File), Item (I));
        end loop;
        Putchar (File_Ptr (File), Ascii.Lf);
        if File.Always_Flush then
            Flush (File);
        end if;
        Safe_Support.File_Unlock (File);
    exception
        when others =>
            Safe_Support.File_Unlock (File);
            raise;
    end Put_Line;

    procedure Put_Line (Item : in String) is
    begin
        -- Called put_line() does file_lock()/file_unlock()
        Put_Line (Current_Output, Item);
    end Put_Line;

    package body Integer_Io is separate;

    package body Float_Io is separate;

    package body Fixed_Io is separate;

    package body Enumeration_Io is separate;

end Text_Io;

E3 Meta Data

    nblk1=20
    nid=0
    hdr6=40
        [0x00] rec0=23 rec1=00 rec2=01 rec3=008
        [0x01] rec0=1e rec1=00 rec2=02 rec3=04c
        [0x02] rec0=1d rec1=00 rec2=03 rec3=000
        [0x03] rec0=1a rec1=00 rec2=04 rec3=01c
        [0x04] rec0=1d rec1=00 rec2=05 rec3=024
        [0x05] rec0=1e rec1=00 rec2=06 rec3=050
        [0x06] rec0=1c rec1=00 rec2=07 rec3=050
        [0x07] rec0=25 rec1=00 rec2=08 rec3=00e
        [0x08] rec0=1e rec1=00 rec2=09 rec3=012
        [0x09] rec0=16 rec1=00 rec2=0a rec3=060
        [0x0a] rec0=1f rec1=00 rec2=0b rec3=02e
        [0x0b] rec0=23 rec1=00 rec2=0c rec3=022
        [0x0c] rec0=22 rec1=00 rec2=0d rec3=024
        [0x0d] rec0=22 rec1=00 rec2=0e rec3=00c
        [0x0e] rec0=1e rec1=00 rec2=0f rec3=05e
        [0x0f] rec0=22 rec1=00 rec2=10 rec3=048
        [0x10] rec0=20 rec1=00 rec2=11 rec3=006
        [0x11] rec0=22 rec1=00 rec2=12 rec3=00c
        [0x12] rec0=20 rec1=00 rec2=13 rec3=04c
        [0x13] rec0=21 rec1=00 rec2=14 rec3=02a
        [0x14] rec0=19 rec1=00 rec2=15 rec3=018
        [0x15] rec0=1f rec1=00 rec2=16 rec3=030
        [0x16] rec0=1c rec1=00 rec2=17 rec3=06c
        [0x17] rec0=24 rec1=00 rec2=18 rec3=02c
        [0x18] rec0=23 rec1=00 rec2=19 rec3=00e
        [0x19] rec0=1f rec1=00 rec2=1a rec3=00e
        [0x1a] rec0=22 rec1=00 rec2=1b rec3=06e
        [0x1b] rec0=20 rec1=00 rec2=1c rec3=028
        [0x1c] rec0=1d rec1=00 rec2=1d rec3=018
        [0x1d] rec0=1f rec1=00 rec2=1e rec3=00c
        [0x1e] rec0=1e rec1=00 rec2=1f rec3=052
        [0x1f] rec0=1c rec1=00 rec2=20 rec3=000
    tail 0x21757fc0a878e787d54f5 0x42a00088462060003