⟦440c6bb15⟧

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

with Typed_Io_Support;
with Device_Independent_Io;

pragma Elaborate (Typed_Io_Support);
pragma Elaborate (Device_Independent_Io);

package body Direct_Io is

    package Iof renames Io_Exception_Flavors;
    package Dio renames Device_Independent_Io;
    package Tio renames Typed_Io_Support;

    function Tio_File_Type is new Unchecked_Conversion
                                     (File_Type, Typed_Io_Support.File_Type);
    function External_File_Type is
       new Unchecked_Conversion (Typed_Io_Support.File_Type, File_Type);


    subtype Byte_String is System_Types.Byte_String;


    Item_Size : Natural;
    -- number of bytes for an object of Element_Type
    -- logically constant (Element_Type'Size + 7) / 8;
    -- but may raise numeric error, so initialized in statement list

    Items_Too_Large : Boolean := False;
    -- object of Element_Type too large

    Items_Constrained : constant Boolean := Element_Type'Constrained;

    Xchng : constant array (File_Mode) of Dio.File_Mode :=
       (In_File    => Dio.In_File,
        Inout_File => Dio.Inout_File,
        Out_File   => Dio.Out_File);

\f

    procedure Create (File : in out File_Type;  
                      Mode :        File_Mode := Inout_File;  
                      Name :        String    := "";  
                      Form :        String    := "") is
        F : Tio.File_Type := Tio_File_Type (File);
    begin
        Tio.Create (F, Xchng (Mode), Name, Form);
        File := External_File_Type (F);
    end Create;

    procedure Open (File : in out File_Type;  
                    Mode :        File_Mode;  
                    Name :        String;  
                    Form :        String := "") is
        F : Tio.File_Type := Tio_File_Type (File);
    begin
        Tio.Open (F, Xchng (Mode), Name, Form);
        File := External_File_Type (F);
    end Open;

    procedure Close (File : in out File_Type) is
        F : Tio.File_Type := Tio_File_Type (File);
    begin
        Tio.Close (F);
        File := External_File_Type (F);
    end Close;

    procedure Delete (File : in out File_Type) is
        F : Tio.File_Type := Tio_File_Type (File);
    begin
        Tio.Delete (F);
        File := External_File_Type (F);
    end Delete;

    procedure Reset (File : in out File_Type; Mode : File_Mode) is
        F : Tio.File_Type := Tio_File_Type (File);
    begin
        Tio.Reset (F, Xchng (Mode));
        File := External_File_Type (F);
    end Reset;

    procedure Reset (File : in out File_Type) is
        F : Tio.File_Type := Tio_File_Type (File);
    begin
        Tio.Reset (F);
        File := External_File_Type (F);
    end Reset;

    function Mode (File : File_Type) return File_Mode is
    begin
        case Tio.Mode (Tio_File_Type (File)) is
            when Dio.In_File =>
                return In_File;
            when Dio.Inout_File =>
                return Inout_File;
            when Dio.Out_File =>
                return Out_File;
            when Dio.Closed =>
                raise Status_Error;
        end case;
    end Mode;

    function Name (File : File_Type) return String is
    begin
        return Tio.Name (Tio_File_Type (File));
    end Name;

    function Form (File : File_Type) return String is
    begin
        return Tio.Form (Tio_File_Type (File));
    end Form;

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

    function End_Of_File (File : File_Type) return Boolean is
    begin
        return Tio.End_Of_File (Tio_File_Type (File));
    end End_Of_File;

    function Index (For_Item : Positive_Count) return Tio.Byte_Count is
    begin
        return Tio.Byte_Count (Item_Size * Natural (For_Item - 1));
    end Index;

    procedure Read (File :     File_Type;  
                    Item : out Element_Type;  
                    From :     Positive_Count) is
        This_Item_Size : constant Natural := (Item'Size + 7) / 8;
        subtype Item_As_Byte_String is Byte_String (1 .. Item_Size);
        type    Item_Ptr            is access Item_As_Byte_String;
        for Item_Ptr'Storage_Size use 0;  -- suppress collection
        function Convert is new Unchecked_Conversion (System.Address, Item_Ptr);
    begin
        if Items_Constrained or else This_Item_Size = Item_Size then
            declare
                Item_Bs : constant Item_Ptr := Convert (Item'Address);
            begin
                Tio.Read (Tio_File_Type (File), Item_Bs.all,
                          Index (From), Items_Constrained);
            end;
        elsif not Items_Too_Large then
            declare
                Unconstrained_Item    : Element_Type;
                Unconstrained_Item_Bs : constant Item_Ptr :=
                   Convert (Unconstrained_Item'Address);
            begin
                Tio.Read (Tio_File_Type (File), Unconstrained_Item_Bs.all,
                          Index (From), Items_Constrained);
                Item := Unconstrained_Item;
            end;
        else
            raise Data_Error;
        end if;
    end Read;

    procedure Read (File : File_Type; Item : out Element_Type) is
        This_Item_Size : constant Natural := (Item'Size + 7) / 8;

        subtype Item_As_Byte_String is Byte_String (1 .. Item_Size);
        type    Item_Ptr            is access Item_As_Byte_String;
        for Item_Ptr'Storage_Size use 0;  -- suppress collection
        function Convert is new Unchecked_Conversion (System.Address, Item_Ptr);
    begin
        if Items_Constrained or else This_Item_Size = Item_Size then
            declare
                Item_Bs : constant Item_Ptr := Convert (Item'Address);
            begin
                Tio.Read (Tio_File_Type (File), Item_Bs.all,
                          Tio.Use_Current_Index, Items_Constrained);
            end;
        elsif not Items_Too_Large then
            declare
                Unconstrained_Item    : Element_Type;
                Unconstrained_Item_Bs : constant Item_Ptr :=
                   Convert (Unconstrained_Item'Address);
            begin
                Tio.Read (Tio_File_Type (File), Unconstrained_Item_Bs.all,
                          Tio.Use_Current_Index, Items_Constrained);
                Item := Unconstrained_Item;
            end;
        else
            raise Data_Error;
        end if;
    end Read;

    procedure Write (File : File_Type;  
                     Item : Element_Type;  
                     To   : Positive_Count) is
        This_Item_Size : constant Natural := (Item'Size + 7) / 8;
        subtype Item_As_Byte_String is Byte_String (1 .. Item_Size);
        type    Item_Ptr            is access Item_As_Byte_String;
        for Item_Ptr'Storage_Size use 0;  -- suppress collection
        function Convert is new Unchecked_Conversion (System.Address, Item_Ptr);
    begin
        if Items_Constrained or else This_Item_Size = Item_Size then
            declare
                Item_Bs : constant Item_Ptr := Convert (Item'Address);
            begin
                Tio.Write (Tio_File_Type (File), Item_Bs.all, Index (To));
            end;
        elsif not Items_Too_Large then
            declare
                Unconstrained_Item    : Element_Type      := Item;
                Unconstrained_Item_Bs : constant Item_Ptr :=
                   Convert (Unconstrained_Item'Address);
            begin
                Tio.Write (Tio_File_Type (File),
                           Unconstrained_Item_Bs.all, Index (To));
            end;
        else
            raise Use_Error;
        end if;
    end Write;

    procedure Write (File : File_Type; Item : Element_Type) is
        This_Item_Size : constant Natural := (Item'Size + 7) / 8;
        subtype Item_As_Byte_String is Byte_String (1 .. Item_Size);
        type    Item_Ptr            is access Item_As_Byte_String;
        for Item_Ptr'Storage_Size use 0;  -- suppress collection
        function Convert is new Unchecked_Conversion (System.Address, Item_Ptr);
    begin
        if Items_Constrained or else This_Item_Size = Item_Size then
            declare
                Item_Bs : constant Item_Ptr := Convert (Item'Address);
            begin
                Tio.Write (Tio_File_Type (File), Item_Bs.all,
                           Tio.Use_Current_Index);
            end;
        elsif not Items_Too_Large then
            declare
                Unconstrained_Item    : Element_Type      := Item;
                Unconstrained_Item_Bs : constant Item_Ptr :=
                   Convert (Unconstrained_Item'Address);
            begin
                Tio.Write (Tio_File_Type (File), Unconstrained_Item_Bs.all,
                           Tio.Use_Current_Index);
            end;
        else
            raise Use_Error;
        end if;
    end Write;

    procedure Set_Index (File : File_Type; To : Positive_Count) is
    begin
        Tio.Set_Index (Tio_File_Type (File), Index (To));
    end Set_Index;

    function Index (File : File_Type) return Positive_Count is
    begin
        return Positive_Count
                  (Natural (Tio.Index (Tio_File_Type (File)) / Item_Size) + 1);
    end Index;

    function Size (File : File_Type) return Count is
    begin
        return Count (Natural (Tio.Size (Tio_File_Type (File))) / Item_Size);
    end Size;

begin
    Item_Size := (Element_Type'Size + 7) / 8;
exception
    when Constraint_Error | Numeric_Error =>
        if not Items_Constrained then
            Item_Size       := Natural'Last;
            Items_Too_Large := True;
        end if;
end Direct_Io;
DataMuseum.dk

Rational R1000/400 Tapes

⟦440c6bb15⟧ TextFile

Derivation

TextFile
