1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . D I R E C T _ I O --
9 -- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 -- This is the generic template for Direct_IO, i.e. the code that gets
33 -- duplicated. We absolutely minimize this code by either calling routines
34 -- in System.File_IO (for common file functions), or in System.Direct_IO
35 -- (for specialized Direct_IO functions)
37 with Interfaces.C_Streams; use Interfaces.C_Streams;
38 with System; use System;
40 with System.File_Control_Block;
42 with System.Direct_IO;
43 with System.Storage_Elements;
44 with Ada.Unchecked_Conversion;
46 use type System.Direct_IO.Count;
48 package body Ada.Direct_IO is
50 Zeroes : constant System.Storage_Elements.Storage_Array :=
51 (1 .. System.Storage_Elements.Storage_Offset (Bytes) => 0);
52 -- Buffer used to fill out partial records
54 package FCB renames System.File_Control_Block;
55 package FIO renames System.File_IO;
56 package DIO renames System.Direct_IO;
58 SU : constant := System.Storage_Unit;
60 subtype AP is FCB.AFCB_Ptr;
61 subtype FP is DIO.File_Type;
62 subtype DPCount is DIO.Positive_Count;
64 function To_FCB is new Ada.Unchecked_Conversion (File_Mode, FCB.File_Mode);
65 function To_DIO is new Ada.Unchecked_Conversion (FCB.File_Mode, File_Mode);
67 use type System.CRTL.size_t;
73 procedure Close (File : in out File_Type) is
75 FIO.Close (AP (File)'Unrestricted_Access);
83 (File : in out File_Type;
84 Mode : File_Mode := Inout_File;
89 DIO.Create (FP (File), To_FCB (Mode), Name, Form);
97 procedure Delete (File : in out File_Type) is
99 FIO.Delete (AP (File)'Unrestricted_Access);
106 function End_Of_File (File : File_Type) return Boolean is
108 return DIO.End_Of_File (FP (File));
115 function Form (File : File_Type) return String is
117 return FIO.Form (AP (File));
124 function Index (File : File_Type) return Positive_Count is
126 return Positive_Count (DIO.Index (FP (File)));
133 function Is_Open (File : File_Type) return Boolean is
135 return FIO.Is_Open (AP (File));
142 function Mode (File : File_Type) return File_Mode is
144 return To_DIO (FIO.Mode (AP (File)));
151 function Name (File : File_Type) return String is
153 return FIO.Name (AP (File));
161 (File : in out File_Type;
167 DIO.Open (FP (File), To_FCB (Mode), Name, Form);
177 Item : out Element_Type;
178 From : Positive_Count)
181 -- For a non-constrained variant record type, we read into an
182 -- intermediate buffer, since we may have the case of discriminated
183 -- records where a discriminant check is required, and we may need
184 -- to assign only part of the record buffer originally written.
186 -- Note: we have to turn warnings on/off because this use of
187 -- the Constrained attribute is an obsolescent feature.
189 pragma Warnings (Off);
190 if not Element_Type'Constrained then
191 pragma Warnings (On);
197 DIO.Read (FP (File), Buf'Address, Bytes, DPCount (From));
201 -- In the normal case, we can read straight into the buffer
204 DIO.Read (FP (File), Item'Address, Bytes, DPCount (From));
208 procedure Read (File : File_Type; Item : out Element_Type) is
210 -- Same processing for unconstrained case as above
212 -- Note: we have to turn warnings on/off because this use of
213 -- the Constrained attribute is an obsolescent feature.
215 pragma Warnings (Off);
216 if not Element_Type'Constrained then
217 pragma Warnings (On);
223 DIO.Read (FP (File), Buf'Address, Bytes);
228 DIO.Read (FP (File), Item'Address, Bytes);
236 procedure Reset (File : in out File_Type; Mode : File_Mode) is
238 DIO.Reset (FP (File), To_FCB (Mode));
241 procedure Reset (File : in out File_Type) is
243 DIO.Reset (FP (File));
250 procedure Set_Index (File : File_Type; To : Positive_Count) is
252 DIO.Set_Index (FP (File), DPCount (To));
259 function Size (File : File_Type) return Count is
261 return Count (DIO.Size (FP (File)));
274 DIO.Set_Index (FP (File), DPCount (To));
275 DIO.Write (FP (File), Item'Address, Item'Size / SU, Zeroes);
278 procedure Write (File : File_Type; Item : Element_Type) is
280 DIO.Write (FP (File), Item'Address, Item'Size / SU, Zeroes);