diff options
Diffstat (limited to 'gcc/ada/a-direio.adb')
-rw-r--r-- | gcc/ada/a-direio.adb | 273 |
1 files changed, 273 insertions, 0 deletions
diff --git a/gcc/ada/a-direio.adb b/gcc/ada/a-direio.adb new file mode 100644 index 0000000..f4a823a --- /dev/null +++ b/gcc/ada/a-direio.adb @@ -0,0 +1,273 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUNTIME COMPONENTS -- +-- -- +-- A D A . D I R E C T _ I O -- +-- -- +-- B o d y -- +-- -- +-- $Revision: 1.22 $ -- +-- -- +-- Copyright (C) 1992-1998 Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is the generic template for Direct_IO, i.e. the code that gets +-- duplicated. We absolutely minimize this code by either calling routines +-- in System.File_IO (for common file functions), or in System.Direct_IO +-- (for specialized Direct_IO functions) + +with Interfaces.C_Streams; use Interfaces.C_Streams; +with System; use System; +with System.File_Control_Block; +with System.File_IO; +with System.Direct_IO; +with System.Storage_Elements; +with Unchecked_Conversion; + +use type System.Direct_IO.Count; + +package body Ada.Direct_IO is + + Zeroes : System.Storage_Elements.Storage_Array := + (1 .. System.Storage_Elements.Storage_Offset (Bytes) => 0); + -- Buffer used to fill out partial records. + + package FCB renames System.File_Control_Block; + package FIO renames System.File_IO; + package DIO renames System.Direct_IO; + + SU : constant := System.Storage_Unit; + + subtype AP is FCB.AFCB_Ptr; + subtype FP is DIO.File_Type; + subtype DCount is DIO.Count; + subtype DPCount is DIO.Positive_Count; + + function To_FCB is new Unchecked_Conversion (File_Mode, FCB.File_Mode); + function To_DIO is new Unchecked_Conversion (FCB.File_Mode, File_Mode); + + ----------- + -- Close -- + ----------- + + procedure Close (File : in out File_Type) is + begin + FIO.Close (AP (File)); + end Close; + + ------------ + -- Create -- + ------------ + + procedure Create + (File : in out File_Type; + Mode : in File_Mode := Inout_File; + Name : in String := ""; + Form : in String := "") + is + begin + DIO.Create (FP (File), To_FCB (Mode), Name, Form); + File.Bytes := Bytes; + end Create; + + ------------ + -- Delete -- + ------------ + + procedure Delete (File : in out File_Type) is + begin + FIO.Delete (AP (File)); + end Delete; + + ----------------- + -- End_Of_File -- + ----------------- + + function End_Of_File (File : in File_Type) return Boolean is + begin + return DIO.End_Of_File (FP (File)); + end End_Of_File; + + ---------- + -- Form -- + ---------- + + function Form (File : in File_Type) return String is + begin + return FIO.Form (AP (File)); + end Form; + + ----------- + -- Index -- + ----------- + + function Index (File : in File_Type) return Positive_Count is + begin + return Positive_Count (DIO.Index (FP (File))); + end Index; + + ------------- + -- Is_Open -- + ------------- + + function Is_Open (File : in File_Type) return Boolean is + begin + return FIO.Is_Open (AP (File)); + end Is_Open; + + ---------- + -- Mode -- + ---------- + + function Mode (File : in File_Type) return File_Mode is + begin + return To_DIO (FIO.Mode (AP (File))); + end Mode; + + ---------- + -- Name -- + ---------- + + function Name (File : in File_Type) return String is + begin + return FIO.Name (AP (File)); + end Name; + + ---------- + -- Open -- + ---------- + + procedure Open + (File : in out File_Type; + Mode : in File_Mode; + Name : in String; + Form : in String := "") + is + begin + DIO.Open (FP (File), To_FCB (Mode), Name, Form); + File.Bytes := Bytes; + end Open; + + ---------- + -- Read -- + ---------- + + procedure Read + (File : in File_Type; + Item : out Element_Type; + From : in Positive_Count) + is + begin + -- For a non-constrained variant record type, we read into an + -- intermediate buffer, since we may have the case of discriminated + -- records where a discriminant check is required, and we may need + -- to assign only part of the record buffer originally written + + if not Element_Type'Constrained then + declare + Buf : Element_Type; + + begin + DIO.Read (FP (File), Buf'Address, Bytes, DPCount (From)); + Item := Buf; + end; + + -- In the normal case, we can read straight into the buffer + + else + DIO.Read (FP (File), Item'Address, Bytes, DPCount (From)); + end if; + end Read; + + procedure Read (File : in File_Type; Item : out Element_Type) is + begin + -- Same processing for unconstrained case as above + + if not Element_Type'Constrained then + declare + Buf : Element_Type; + + begin + DIO.Read (FP (File), Buf'Address, Bytes); + Item := Buf; + end; + + else + DIO.Read (FP (File), Item'Address, Bytes); + end if; + end Read; + + ----------- + -- Reset -- + ----------- + + procedure Reset (File : in out File_Type; Mode : in File_Mode) is + begin + DIO.Reset (FP (File), To_FCB (Mode)); + end Reset; + + procedure Reset (File : in out File_Type) is + begin + DIO.Reset (FP (File)); + end Reset; + + --------------- + -- Set_Index -- + --------------- + + procedure Set_Index (File : in File_Type; To : in Positive_Count) is + begin + DIO.Set_Index (FP (File), DPCount (To)); + end Set_Index; + + ---------- + -- Size -- + ---------- + + function Size (File : in File_Type) return Count is + begin + return Count (DIO.Size (FP (File))); + end Size; + + ----------- + -- Write -- + ----------- + + procedure Write + (File : in File_Type; + Item : in Element_Type; + To : in Positive_Count) + is + begin + DIO.Set_Index (FP (File), DPCount (To)); + DIO.Write (FP (File), Item'Address, Item'Size / SU, Zeroes); + end Write; + + procedure Write (File : in File_Type; Item : in Element_Type) is + begin + DIO.Write (FP (File), Item'Address, Item'Size / SU, Zeroes); + end Write; + +end Ada.Direct_IO; |