DataMuseum.dk

top - metrics - download

    Length: 6232 (0x1858)
    Types: TextFile
    Names: »B«

└─⟦afbc8121e⟧ Bits:30000532 8mm tape, Rational 1000, MC68020_OS2000 7_2_2
    └─⟦77aa8350c⟧ »DATA« 
        └─⟦f794ecd1d⟧ 
            └─⟦4c85d69e2⟧ 
                └─⟦this⟧ 

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.
--
--

with Primitive_Io;  -- For debugging only

separate (Common_Text_Io)

package body Standard_Files is

    type Array_Of_Files is array (Kind) of File_Type;
    Std  : Array_Of_Files;
    Curr : Array_Of_Files;

    function "=" (L, R : File_Type) return Boolean renames Dio."=";

    -- procedure Pput (S : in String) renames Primitive_Io.Put_Line;


    procedure Open_Special (File : in out File_Type;
                            Mode :        File_Mode := Out_File;
                            Kind :        Dio.File_Kind) is
        Actual_Buffer_Size : Natural;
    begin

        -- Pput ("Cti.Standard_Files.Open_Special opening " &
        --     Dio.File_Kind'Image (Kind));

        Dio.Open (File, Convert (Mode), Kind, "", "",
                  Default_Buffer_Size, Actual_Buffer_Size);
        begin
            Dio.Acquire (File);
            State_Handling.Allocate_State (File, Mode);
            Dio.Release (File);
            -- Pput ("Cti.Standard_Files.Open_Special " &
            --     Dio.File_Kind'Image (Kind) & " opened ok");
        exception
            when others =>
                Dio.Release (File);
                raise;
        end;
    exception
        when others =>
            -- Pput ("Cti.Standard_Files.Open_Special " &
            --     Dio.File_Kind'Image (Kind) & " NOT opened");
            raise;
    end Open_Special;


    procedure Create_Special (File : in out File_Type;
                              Mode :        File_Mode := Out_File;
                              Kind :        Dio.File_Kind) is
        Actual_Buffer_Size : Natural;
    begin
        -- Pput ("Cti.Standard_Files.Create_Special creating " &
        --     Dio.File_Kind'Image (Kind));
        Dio.Create (File, Convert (Mode), Kind, "", "",
                    Default_Buffer_Size, Actual_Buffer_Size);
        begin
            Dio.Acquire (File);
            State_Handling.Allocate_State (File, Mode);
            Dio.Release (File);
            -- Pput ("Cti.Standard_Files.Create_Special " &
            --     Dio.File_Kind'Image (Kind) & " created ok");
        exception
            when others =>
                Dio.Release (File);
                raise;
        end;
    exception
        when others =>
            -- Pput ("Cti.Standard_Files.Create_Special " &
            --     Dio.File_Kind'Image (Kind) & " NOT created");
            raise;
    end Create_Special;


    -- Does whatever necessary to open Standard_Input, Standard_Output,
    -- and Standard_Error, and set Current_Input, Current_Output,
    -- and Current_Error to their initial values.

    procedure Initialize is
    begin
        Open_Special (Std (Input), In_File, Dio.Standard_Input);
        Create_Special (Std (Output), Out_File, Dio.Standard_Output);
        Create_Special (Std (Error), Out_File, Dio.Standard_Error);
        Curr := Std;
    end Initialize;


    -- Used to set the "current" file.
    procedure Set (K : Kind; F : File_Type) is
        M : File_Mode;
        I : Access_Input_State;
        O : Access_Output_State;
    begin
        State_Handling.Get_File_State (F, M, I, O);
        -- ^ May raise Status_Error if the file is not open.
        case K is
            when Input =>
                if M /= In_File then
                    raise Mode_Error;
                end if;
            when Output | Error =>
                if M /= Out_File then
                    raise Mode_Error;
                end if;
        end case;
        Curr (K) := F;
    end Set;


    -- Gets the value of the "current" file.
    function Egt (K : Kind) return File_Type is
    begin
        return Curr (K);
    end Egt;


    -- Gets the value of the original "standard" file.
    function Std_Get (K : Kind) return File_Type is
    begin
        return Std (K);
    end Std_Get;

    procedure Check_If_Closing_Current (File : in out File_Type) is
    begin
        if File = Curr (Input) then
            File         := Dio.Closed_Input_File;
            Curr (Input) := File;
        elsif File = Curr (Output) then
            File          := Dio.Closed_Output_File;  
            Curr (Output) := File;
        elsif File = Curr (Error) then
            File         := Dio.Closed_Error_File;  
            Curr (Error) := File;
        else
            File := Dio.Null_File;
        end if;
    end Check_If_Closing_Current;

    procedure Check_If_Current_Compatible_Mode
                 (File : File_Type; New_Mode : File_Mode) is
    begin
        case New_Mode is
            when In_File =>
                if File = Curr (Output) or else File = Curr (Error) then
                    raise Iof.Illegal_Operation_On_Outfile;
                end if;

            when Out_File =>
                if File = Curr (Input) then
                    raise Iof.Illegal_Operation_On_Infile;
                end if;
        end case;
    end Check_If_Current_Compatible_Mode;

    procedure Check_If_Reassociating_Current
                 (Old_File : File_Type; New_File : File_Type) is
    begin
        if Old_File = Curr (Input) then
            Curr (Input) := New_File;
        elsif Old_File = Curr (Output) then
            Curr (Output) := New_File;
        elsif Old_File = Curr (Error) then
            Curr (Error) := New_File;
        end if;
    end Check_If_Reassociating_Current;

end Standard_Files;