⟦eef3694a0⟧

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 System_Types;
with Io_Exceptions;
with Io_Exception_Flavors;
with Os_Dependent_Io;

package body Typed_Io_Support is

    package Iof   renames Io_Exception_Flavors;
    package Os_Io renames Os_Dependent_Io;

    subtype Byte is System_Types.Byte;

    -- Unconstrained objects may be written and read
    -- with a 3 byte header containing their size.  This
    -- restricts the maximum size of a single object to
    -- 2 ** 24 - 1 bytes

    subtype Item_Length is Natural range 0 .. 2 ** 24 - 1;
    subtype Size_String is Byte_String (1 .. 3);


    procedure Create (File : in out File_Type;
                      Mode :        File_Mode;
                      Name :        String;
                      Form :        String) is
        Kind  : Dio.File_Kind;
        Dummy : Natural;
    begin
        if Name'Length /= 0 then
            Kind := Dio.Normal;
        else
            Kind := Dio.Temporary;
        end if;

        Dio.Create (File, Mode, Kind, Name, Form,
                    Recommended_Buffer_Size => 0,
                    Actual_Buffer_Size      => Dummy);
    end Create;

    procedure Open (File : in out File_Type;
                    Mode :        File_Mode;
                    Name :        String;
                    Form :        String) is
        Kind  : Dio.File_Kind;
        Dummy : Natural;
    begin
        if Name'Length /= 0 then
            Kind := Dio.Normal;
        else
            Kind := Dio.Temporary;
        end if;

        Dio.Open (File, Mode, Kind, Name, Form,
                  Recommended_Buffer_Size => 0,
                  Actual_Buffer_Size      => Dummy);
    end Open;

    procedure Acquire (File : Dio.File_Type) is
    begin
        Dio.Acquire (File);

        if not Dio.Is_Open (File) then
            raise Iof.Not_Open_Error;
        end if;
    end Acquire;

    procedure Close (File : in out File_Type) is
    begin
        Acquire (File);
        Dio.Close (File);
        -- A successful close releases the file's lock
    exception
        when others =>
            Dio.Release (File);
            raise;
    end Close;

    procedure Delete (File : in out File_Type) is
    begin
        Acquire (File);
        Dio.Delete (File);
        -- Release is not necessary
    exception
        when others =>
            Dio.Release (File);
            raise;
    end Delete;

    procedure Reset (File : in out File_Type; Mode : File_Mode) is
    begin
        Acquire (File);
        Dio.Reset (File, Mode);
        Dio.Release (File);
    exception
        when others =>
            Dio.Release (File);
            raise;
    end Reset;

    procedure Reset (File : in out File_Type) is
    begin
        Acquire (File);
        Dio.Reset (File);
        Dio.Release (File);
    exception
        when others =>
            Dio.Release (File);
            raise;
    end Reset;

    function Mode (File : File_Type) return File_Mode is
        Mode : Dio.File_Mode;
    begin
        Acquire (File);
        Mode := Dio.Mode (File);
        Dio.Release (File);

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

    function Name (File : File_Type) return String is
    begin
        Acquire (File);

        declare
            Name : constant String := Dio.Name (File);
        begin
            Dio.Release (File);

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

    function Form (File : File_Type) return String is
    begin
        Acquire (File);

        declare
            Form : constant String := Dio.Form (File);
        begin
            Dio.Release (File);

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

    function Is_Open (File : File_Type) return Boolean is
    begin
        return Dio.Is_Open (File);
    end Is_Open;

    function End_Of_File (File : File_Type) return Boolean is
        Eof : Boolean;
    begin  
        Acquire (File);

        case Dio.Mode (File) is
            when Dio.In_File | Dio.Inout_File =>
                null;
            when Dio.Out_File =>
                raise Iof.Illegal_Operation_On_Outfile;
            when Dio.Closed =>
                raise Io_Exceptions.Status_Error;
        end case;

        Eof := Dio.End_Of_File (File);
        Dio.Release (File);

        return Eof;
    exception
        when others =>
            Dio.Release (File);
            raise;
    end End_Of_File;

    function Get_Control_Block (From_File : File_Type)
                               return Os_Io.Os_Control_Block is
    begin
        return Os_Io.Control_From_Address
                  (Dio.Get_Os_Dependent_Control (From_File));
    end Get_Control_Block;

    procedure Read (File              :        File_Type;
                    Item              : in out Byte_String;
                    From              :        Byte_Count := Use_Current_Index;
                    Items_Constrained :        Boolean) is
        Os_File    : Os_Io.Os_Control_Block;
        Item_Size  : constant Natural := Item'Length;
        Bytes_Read : Natural;
    begin
        Acquire (File);

        case Dio.Mode (File) is
            when Dio.In_File | Dio.Inout_File =>
                null;
            when Dio.Out_File =>
                raise Iof.Illegal_Operation_On_Outfile;
            when Dio.Closed =>
                raise Io_Exceptions.Status_Error;
        end case;

        Os_File := Get_Control_Block (File);

        if From >= 0 then  
            Os_Io.Set_Index (Ctrl => Os_File, To => Os_Io.Byte_Index (From));
        end if;

        Os_Io.Read_Bytes (Ctrl       => Os_File,
                          Bytes_Addr => Item'Address,
                          Byte_Count => Item_Size,
                          Bytes_Read => Bytes_Read);

        if Items_Constrained then
            if Bytes_Read /= Item_Size then
                raise Io_Exceptions.Data_Error;
            end if;
        else
            for I in Bytes_Read + 1 .. Item'Last loop
                Item (I) := 0;
            end loop;
        end if;

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

    procedure Write (File : File_Type;
                     Item : Byte_String;
                     To   : Byte_Count := Use_Current_Index) is
        Os_File : Os_Io.Os_Control_Block;
    begin
        Acquire (File);

        case Dio.Mode (File) is
            when Dio.In_File =>
                raise Iof.Illegal_Operation_On_Infile;
            when Dio.Inout_File | Dio.Out_File =>
                null;
            when Dio.Closed =>
                raise Io_Exceptions.Status_Error;
        end case;

        Os_File := Get_Control_Block (From_File => File);

        if To >= 0 then
            Os_Io.Set_Index (Ctrl => Os_File, To => Os_Io.Byte_Index (To));
        end if;

        Os_Io.Write_Bytes (Ctrl       => Os_File,
                           Bytes_Addr => Item'Address,
                           Byte_Count => Item'Length);

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

    function Convert (Size : Size_String) return Item_Length is
        Result : Item_Length := 0;
    begin
        for I in Size_String'Range loop
            Result := (Result * 256) + Natural (Size (I));  
        end loop;
        return Result;
    end Convert;

    function Convert (Size : Item_Length) return Size_String is
        Result : Size_String;
        Temp   : Natural := Size;
    begin
        for I in reverse Size_String'Range loop
            Result (I) := Byte (Temp mod 256);
            Temp       := Temp / 256;
        end loop;
        return Result;
    end Convert;

    function Read_Size (From_File : Os_Io.Os_Control_Block)
                       return Item_Length is
        Size_Bytes : Size_String;
        Bytes_Read : Natural;
    begin
        Os_Io.Read_Bytes (Ctrl       => From_File,
                          Bytes_Addr => Size_Bytes'Address,
                          Byte_Count => Size_String'Size / 8,
                          Bytes_Read => Bytes_Read);
        if Bytes_Read /= Size_String'Length then
            raise Io_Exceptions.Data_Error;
        end if;
        return Convert (Size_Bytes);
    end Read_Size;


    procedure Read_With_Size (File : File_Type; Item : in out Byte_String) is
        Os_File    : Os_Io.Os_Control_Block;
        Item_Size  : constant Natural := Item'Length;
        Size_Read  : Item_Length;
        Bytes_Read : Natural;
    begin
        Acquire (File);

        case Dio.Mode (File) is
            when Dio.In_File =>
                null;
            when Dio.Out_File =>
                raise Iof.Illegal_Operation_On_Outfile;
            when Dio.Inout_File | Dio.Closed =>
                raise Io_Exceptions.Status_Error;
        end case;

        Os_File := Get_Control_Block (File);

        Size_Read := Read_Size (From_File => Os_File);

        if Size_Read > Item_Size then
            -- Not enough room in Item for the next value;
            -- discard this value from the file and raise Data_Error.
            declare
                Dummy : Byte_String (1 .. Size_Read);
            begin
                Os_Io.Read_Bytes (Ctrl       => Os_File,
                                  Bytes_Addr => Dummy'Address,
                                  Byte_Count => Size_Read,
                                  Bytes_Read => Bytes_Read);
            end;
            raise Io_Exceptions.Data_Error;
        end if;

        Os_Io.Read_Bytes (Ctrl       => Os_File,
                          Bytes_Addr => Item'Address,
                          Byte_Count => Size_Read,
                          Bytes_Read => Bytes_Read);

        if Bytes_Read /= Size_Read then
            raise Io_Exceptions.Data_Error;
        end if;

        if Size_Read < Item_Size then
            for I in Size_Read + 1 .. Item'Last loop
                Item (I) := 0;
            end loop;
        end if;

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

    procedure Write_Size (Size    : Item_Length;
                          To_File : Os_Io.Os_Control_Block) is
        Size_Bytes : Size_String := Convert (Size);
        Bytes_Read : Natural;
    begin
        Os_Io.Write_Bytes (Ctrl       => To_File,
                           Bytes_Addr => Size_Bytes'Address,
                           Byte_Count => Size_String'Size / 8);
    end Write_Size;

    procedure Write_With_Size (File : File_Type; Item : Byte_String) is
        Os_File : Os_Io.Os_Control_Block;
    begin
        Acquire (File);

        case Dio.Mode (File) is
            when Dio.In_File =>
                raise Iof.Illegal_Operation_On_Infile;
            when Dio.Out_File =>
                null;
            when Dio.Inout_File | Dio.Closed =>
                raise Io_Exceptions.Status_Error;
        end case;

        Os_File := Get_Control_Block (From_File => File);

        if Item'Length <= Item_Length'Last then
            Write_Size (Size => Item'Length, To_File => Os_File);
        else
            raise Io_Exceptions.Data_Error;
        end if;

        Os_Io.Write_Bytes (Ctrl       => Os_File,
                           Bytes_Addr => Item'Address,
                           Byte_Count => Item'Length);

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

    procedure Set_Index (File : File_Type; To : Byte_Count) is
    begin
        Acquire (File);

        case Dio.Mode (Dio.File_Type (File)) is
            when Dio.In_File | Dio.Inout_File | Dio.Out_File =>
                null;
            when Dio.Closed =>
                raise Io_Exceptions.Status_Error;
        end case;

        Os_Io.Set_Index (Ctrl => Get_Control_Block (From_File => File),
                         To   => Os_Io.Byte_Index (To));

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

    function Index (File : File_Type) return Byte_Count is
        Count : Byte_Count;
    begin
        Acquire (File);
        Count := Byte_Count (Natural (Os_Io.Index (Get_Control_Block
                                                      (From_File => File))));
        Dio.Release (File);

        return Count;
    exception
        when others =>
            Dio.Release (File);
            raise;
    end Index;

    function Size (File : File_Type) return Byte_Count is
        Size : Byte_Count;
    begin
        Acquire (File);
        Size := Byte_Count (Os_Io.Size (Get_Control_Block (From_File => File)));
        Dio.Release (File);

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

end Typed_Io_Support;
DataMuseum.dk

Rational R1000/400 Tapes

⟦eef3694a0⟧ TextFile

Derivation

TextFile
