⟦56f3b311d⟧

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 (Common_Text_Io)

package body State_Handling is


    Nil : File_Type;
    -- ^ We cheat because we happen to know that Nil has a
    -- default initialization (to null).

    Initial_Input_State : Input_State := (File            => Nil,
                                          Line_Start      => 1,
                                          Eob_Is_Eol      => False,
                                          Line_Number     => 1,
                                          Page_Number     => 1,
                                          Eof_Encountered => False);

    Initial_Output_State : Output_State := (File            => Nil,
                                            Column_Number   => 1,
                                            Line_Number     => 1,
                                            Page_Number     => 1,
                                            Line_Length     => Unbounded_Repr,
                                            Page_Length     => Unbounded_Repr,
                                            Line_Terminated => False);

    -- A replacement for an instantiation of List_Generic
    type Input_State_List_Element;

    type Access_Input_State_List_Element is access Input_State_List_Element;

    type Input_State_List_Element is
        record
            Link : Access_Input_State_List_Element;
            Data : Access_Input_State;
        end record;

    Freed_Input_States              : Access_Input_State_List_Element := null;
    Freed_Input_State_List_Elements : Access_Input_State_List_Element;

    type Output_State_List_Element;

    type Access_Output_State_List_Element is access Output_State_List_Element;

    type Output_State_List_Element is
        record
            Link : Access_Output_State_List_Element;
            Data : Access_Output_State;
        end record;

    Freed_Output_States              : Access_Output_State_List_Element := null;
    Freed_Output_State_List_Elements : Access_Output_State_List_Element;

    --\f

    -- Functions for dealing with the lists of "free" states:

    function  Is_Empty (Head : Access_Input_State_List_Element) return Boolean;
    function  First    (Head : Access_Input_State_List_Element)
                   return Access_Input_State;
    procedure Rest     (Head : in out Access_Input_State_List_Element);
    function  Make     (New_Element : Access_Input_State;
                        Head        : Access_Input_State_List_Element)
                  return Access_Input_State_List_Element;

    function  Is_Empty (Head : Access_Output_State_List_Element) return Boolean;
    function  First    (Head : Access_Output_State_List_Element)
                   return Access_Output_State;
    procedure Rest     (Head : in out Access_Output_State_List_Element);
    function  Make     (New_Element : Access_Output_State;
                        Head        : Access_Output_State_List_Element)
                  return Access_Output_State_List_Element;


    pragma Suppress (Elaboration_Check, On => Is_Empty);
    pragma Suppress (Elaboration_Check, On => First);
    pragma Suppress (Elaboration_Check, On => Rest);
    pragma Suppress (Elaboration_Check, On => Make);


    procedure Initialize (File : File_Type; S : out Input_State) is
        Data : Buffering.Data_Buffer;
    begin
        -- Initialize the input state to correspond to the beginning of the
        -- file, and clear the buffer.

        S      := Initial_Input_State;
        S.File := File;

        Data := Dio.Get (File);
        if Data /= null then
            Buffering.Clear (Data);
        end if;

    end Initialize;


    procedure Initialize (File : File_Type; S : out Output_State) is
        Data : Buffering.Data_Buffer;
    begin
        -- Initialize the output state to correspond to the beginning
        -- of the file, and clear the buffer.

        S      := Initial_Output_State;
        S.File := File;

        Data := Dio.Get (File);
        if Data /= null then
            Buffering.Clear (Data);
        end if;

    end Initialize;

    --\f

    -- The routines Get_Input_State and Get_Output_State are called by every
    -- user-visible entry to Text_IO that requires a file argument to be open
    -- for a specific mode.  These routines check that the file has this state,
    -- returning a pointer to the state if it is there, and raising the
    -- appropriate exception if not.  Both of these routines acquire the
    -- file's lock.
    --

    function Get_Output_State (File : File_Type) return Access_Output_State is
        Mode   : Dio.File_Mode;
        Result : Access_Output_State;
    begin

        Dio.Acquire (File);
        -- Will wait until available, or return immediately if the file
        -- is closed.

        -- Dio.Mode can raise Status_Error if the file is not open
        Mode := Dio.Mode (File);

        if Mode = Dio.Closed then
            raise Iof.Not_Open_Error;
        end if;

        Result := Oget (File);
        if Result = null then
            -- The file was opened by DIO but not by Text_IO.
            -- (You see how this assumes that only Text_Io puts something
            -- in the protocol state!)
            raise Iof.Not_Open_Error;
        end if;

        if Mode /= Dio.Out_File then
            raise Iof.Illegal_Operation_On_Infile;
        end if;

        return Result;
        -- ... leaving file locked

    exception
        when others =>
            Dio.Release (File);
            raise;
    end Get_Output_State;

    --\f

    function Get_Input_State (File : File_Type) return Access_Input_State is
        Mode   : Dio.File_Mode;
        Result : Access_Input_State;
    begin

        Dio.Acquire (File);
        -- Will wait until available, or return immediately if the file
        -- is closed.

        -- Dio.Mode can raise Status_Error if the file is not open
        Mode := Dio.Mode (File);

        if Mode = Dio.Closed then
            raise Iof.Not_Open_Error;
        end if;

        Result := Iget (File);
        if Result = null then
            -- The file was opened by DIO but not by Text_IO.
            -- (You see how this assumes that only Text_Io puts something
            -- in the protocol state!)
            raise Iof.Not_Open_Error;
        end if;

        if Mode /= Dio.In_File then
            raise Iof.Illegal_Operation_On_Outfile;
        end if;

        return Result;
        -- ... leaving file locked

    exception
        when others =>
            Dio.Release (File);
            raise;
    end Get_Input_State;

    --\f

    -- The routine Get_File_State is called by routines that work with files
    -- that are open for input or output.  If the file is not open,
    -- Status_Error is raised.  Otherwise the mode of the file, along with the
    -- corresponding Input_State or Output_State is returned.  Status_Error is
    -- raised if there is no file state in the descriptor.
    --
    -- The nature of operations that are either input or output makes it
    -- unnecessary (or not productive) to lock the handle, so no semaphore
    -- operations are performed.

    procedure Get_File_State (File      :     File_Type;
                              Mode      : out File_Mode;
                              In_State  : out Access_Input_State;
                              Out_State : out Access_Output_State) is

        Dio_Mode        : Dio.File_Mode;
        Local_In_State  : Access_Input_State;
        Local_Out_State : Access_Output_State;

    begin

        Dio_Mode := Dio.Mode (File);
        -- ^ Can raise Status_Error

        case Dio_Mode is
            when Dio.Closed =>
                raise Iof.Not_Open_Error;
            when Dio.In_File =>
                Local_In_State := Iget (File);
                if Local_In_State = null then
                    raise Iof.Not_Open_Error;
                end if;
                Mode := In_File;
            when Dio.Out_File =>
                Local_Out_State := Oget (File);
                if Local_Out_State = null then
                    raise Iof.Not_Open_Error;
                end if;
                Mode := Out_File;
            when Dio.Inout_File =>
                -- Can't be here if opened by Text_Io, therefore consider
                -- file closed
                raise Iof.Not_Open_Error;
        end case;

        -- We assign here to make sure both get a value (though only
        -- one should ever be read by caller)
        In_State  := Local_In_State;
        Out_State := Local_Out_State;
    end Get_File_State;

    --\f

    procedure Allocate_State (File : File_Type; Mode : File_Mode) is
        In_State  : Access_Input_State;
        Out_State : Access_Output_State;
    begin
        -- This routine is called with a file that is open as far as DIO is
        -- concerned, but has no Text_IO state.  The file is given the
        -- appropriate state.

        case Mode is
            when In_File =>
                -- Allocate an Input_State from the list of freed Input_States,
                -- if possible.
                if not Is_Empty (Freed_Input_States) then
                    In_State := First (Freed_Input_States);
                    Rest (Freed_Input_States);
                else
                    In_State := new Input_State;
                end if;

                Initialize (File, In_State.all);
                Iset (File, In_State);

            when Out_File =>
                -- Allocate an Output_State from the list of freed Output_States,
                -- if possible.
                if not Is_Empty (Freed_Output_States) then
                    Out_State := First (Freed_Output_States);
                    Rest (Freed_Output_States);
                else
                    Out_State := new Output_State;
                end if;

                Initialize (File, Out_State.all);
                Oset (File, Out_State);
        end case;
    end Allocate_State;


    procedure Free_State (File : File_Type; Mode : File_Mode) is
        In_State  : Access_Input_State;
        Out_State : Access_Output_State;
    begin
        case Mode is
            when In_File =>
                In_State := Iget (File);
                -- Add In_State to the list of freed Input_States.
                Freed_Input_States := Make (In_State, Freed_Input_States);
                Iset (File, null);
            when Out_File =>
                Out_State := Oget (File);
                -- Add Out_State to the list of freed Output_States.
                Freed_Output_States := Make (Out_State, Freed_Output_States);
                Oset (File, null);
        end case;
    end Free_State;

    procedure Free_State (File : File_Type) is
        In_State  : Access_Input_State;
        Out_State : Access_Output_State;
    begin
        case Dio.Mode (File) is
            when Dio.In_File =>
                Free_State (File, In_File);

            when Dio.Out_File =>
                Free_State (File, Out_File);

            when Dio.Closed | Dio.Inout_File =>
                -- Can't be here if opened by Text_Io, therefore consider
                -- file closed
                null;
        end case;
    end Free_State;

    --\f

    -----------------------------------------------------------------
    -- Replacements for List_Generic:
    -----------------------------------------------------------------

    function Is_Empty (Head : Access_Input_State_List_Element) return Boolean is
    begin
        return Head = null;
    end Is_Empty;

    function First (Head : Access_Input_State_List_Element)
                   return Access_Input_State is
    begin
        return Head.Data;
    end First;

    procedure Rest (Head : in out Access_Input_State_List_Element) is
        H : Access_Input_State_List_Element := Head;
    begin
        Head := Head.Link;
        H.Link := Freed_Input_State_List_Elements;
        Freed_Input_State_List_Elements := H;
    end Rest;

    function Make (New_Element : Access_Input_State;
                   Head        : Access_Input_State_List_Element)
                  return Access_Input_State_List_Element is
    begin
        if Freed_Input_State_List_Elements /= null then
            declare
                N : Access_Input_State_List_Element :=
                   Freed_Input_State_List_Elements;
            begin
                Freed_Input_State_List_Elements := N.Link;
                N.all := (Link => Head, Data => New_Element);
                return N;
            end;
        else
            return new Input_State_List_Element'
                          (Link => Head, Data => New_Element);
        end if;
    end Make;

    function Is_Empty
                (Head : Access_Output_State_List_Element) return Boolean is
    begin
        return Head = null;
    end Is_Empty;

    function First (Head : Access_Output_State_List_Element)
                   return Access_Output_State is
    begin
        return Head.Data;
    end First;

    procedure Rest (Head : in out Access_Output_State_List_Element) is
        H : Access_Output_State_List_Element := Head;
    begin
        Head := Head.Link;
        H.Link := Freed_Output_State_List_Elements;
        Freed_Output_State_List_Elements := H;
    end Rest;

    function Make (New_Element : Access_Output_State;
                   Head        : Access_Output_State_List_Element)
                  return Access_Output_State_List_Element is
    begin
        if Freed_Output_State_List_Elements /= null then
            declare
                N : Access_Output_State_List_Element :=
                   Freed_Output_State_List_Elements;
            begin
                Freed_Output_State_List_Elements := N.Link;
                N.all := (Link => Head, Data => New_Element);
                return N;
            end;
        else
            return new Output_State_List_Element'
                          (Link => Head, Data => New_Element);
        end if;
    end Make;

    --\f

    -----------------------------------------------------------------
    -- Routines to store and retrieve the address of the control
    -- block in the Device_Independent_Io file descriptor.
    -----------------------------------------------------------------

    function As_Address is new Unchecked_Conversion
                                  (Access_Input_State, System.Address);
    function As_Access_Input_State is
       new Unchecked_Conversion (System.Address, Access_Input_State);


    procedure Iset (File : File_Type; Ais : Access_Input_State) is
    begin
        if Ais /= null then
            Dio.Set (File, As_Address (Ais));
        else
            Dio.Set (File, System_Types.Null_Address);
        end if;
    end Iset;

    function Iget (File : File_Type) return Access_Input_State is
        A : System.Address;
    begin
        A := Dio.Get (File);
        if A /= System_Types.Null_Address then
            return As_Access_Input_State (A);
        else
            return null;
        end if;
    end Iget;


    function As_Address is new Unchecked_Conversion
                                  (Access_Output_State, System.Address);
    function As_Access_Output_State is
       new Unchecked_Conversion (System.Address, Access_Output_State);

    procedure Oset (File : File_Type; Aos : Access_Output_State) is
    begin
        if Aos /= null then
            Dio.Set (File, As_Address (Aos));
        else
            Dio.Set (File, System_Types.Null_Address);
        end if;
    end Oset;

    function Oget (File : File_Type) return Access_Output_State is
        A : System.Address;
    begin
        A := Dio.Get (File);
        if A /= System_Types.Null_Address then
            return As_Access_Output_State (A);
        else
            return null;
        end if;
    end Oget;

end State_Handling;
DataMuseum.dk

Rational R1000/400 Tapes

⟦56f3b311d⟧ TextFile

Derivation

TextFile
