DataMuseum.dk

top - download

    Length: 6257 (0x1871)
    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 System;
with System_Types;
with Io_Exception_Flavors;
with Unchecked_Conversion;

with Typed_Io_Support;
with Device_Independent_Io;

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

package body Sequential_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;


    Items_Constrained : constant Boolean := Element_Type'Constrained;

    -- if Is_Constrained then
    --     initialized in the body

    Constrained_Size : Natural;

    -- else
    --     restrict the maximum size for a single object to 2**24-1 bytes
    --     for unconstrained element types; write out 3 byte header of
    --     the size of the following object.
    --

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


    procedure Create (File : in out File_Type;
                      Mode :        File_Mode := Out_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.Out_File =>
                return Out_File;
            when Dio.Inout_File | 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;


    procedure Read (File : File_Type; Item : out Element_Type) is
        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);

        Item_Bs : constant Item_Ptr := Convert (Item'Address);
    begin
        if Items_Constrained then
            Tio.Read (Tio_File_Type (File), Item_Bs.all,
                      Tio.Use_Current_Index, Items_Constrained);
        else
            Tio.Read_With_Size (Tio_File_Type (File), Item_Bs.all);
        end if;
    end Read;

    procedure Write (File : File_Type; Item : Element_Type) is
        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);

        Item_Bs : constant Item_Ptr := Convert (Item'Address);
    begin
        if Items_Constrained then
            Tio.Write (Tio_File_Type (File), Item_Bs.all,
                       Tio.Use_Current_Index);
        else
            Tio.Write_With_Size (Tio_File_Type (File), Item_Bs.all);
        end if;
    end Write;

begin
    if Items_Constrained then
        Constrained_Size := (Element_Type'Size + 7) / 8;
    end if;
exception
    when Constraint_Error | Numeric_Error =>
        -- size is too big to create an object of the type
        Constrained_Size := Natural'Last;
end Sequential_Io;