1 ------------------------------------------------------------------------------
3 -- GNAT RUNTIME COMPONENTS --
5 -- A D A . D I R E C T _ I O --
9 -- Copyright (C) 1992-2004 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 2, 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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 -- This is the generic template for Direct_IO, i.e. the code that gets
35 -- duplicated. We absolutely minimize this code by either calling routines
36 -- in System.File_IO (for common file functions), or in System.Direct_IO
37 -- (for specialized Direct_IO functions)
39 with Interfaces.C_Streams; use Interfaces.C_Streams;
40 with System; use System;
42 with System.File_Control_Block;
44 with System.Direct_IO;
45 with System.Storage_Elements;
46 with Unchecked_Conversion;
48 use type System.Direct_IO.Count;
50 package body Ada.Direct_IO is
52 Zeroes : constant System.Storage_Elements.Storage_Array :=
53 (1 .. System.Storage_Elements.Storage_Offset (Bytes) => 0);
54 -- Buffer used to fill out partial records.
56 package FCB renames System.File_Control_Block;
57 package FIO renames System.File_IO;
58 package DIO renames System.Direct_IO;
60 SU : constant := System.Storage_Unit;
62 subtype AP is FCB.AFCB_Ptr;
63 subtype FP is DIO.File_Type;
64 subtype DPCount is DIO.Positive_Count;
66 function To_FCB is new Unchecked_Conversion (File_Mode, FCB.File_Mode);
67 function To_DIO is new Unchecked_Conversion (FCB.File_Mode, File_Mode);
69 use type System.CRTL.size_t;
75 procedure Close (File : in out File_Type) is
77 FIO.Close (AP (File));
85 (File : in out File_Type;
86 Mode : in File_Mode := Inout_File;
87 Name : in String := "";
88 Form : in String := "")
91 DIO.Create (FP (File), To_FCB (Mode), Name, Form);
99 procedure Delete (File : in out File_Type) is
101 FIO.Delete (AP (File));
108 function End_Of_File (File : in File_Type) return Boolean is
110 return DIO.End_Of_File (FP (File));
117 function Form (File : in File_Type) return String is
119 return FIO.Form (AP (File));
126 function Index (File : in File_Type) return Positive_Count is
128 return Positive_Count (DIO.Index (FP (File)));
135 function Is_Open (File : in File_Type) return Boolean is
137 return FIO.Is_Open (AP (File));
144 function Mode (File : in File_Type) return File_Mode is
146 return To_DIO (FIO.Mode (AP (File)));
153 function Name (File : in File_Type) return String is
155 return FIO.Name (AP (File));
163 (File : in out File_Type;
166 Form : in String := "")
169 DIO.Open (FP (File), To_FCB (Mode), Name, Form);
178 (File : in File_Type;
179 Item : out Element_Type;
180 From : in Positive_Count)
183 -- For a non-constrained variant record type, we read into an
184 -- intermediate buffer, since we may have the case of discriminated
185 -- records where a discriminant check is required, and we may need
186 -- to assign only part of the record buffer originally written.
188 -- Note: we have to turn warnings on/off because this use of
189 -- the Constrained attribute is an obsolescent feature.
191 pragma Warnings (Off);
192 if not Element_Type'Constrained then
193 pragma Warnings (On);
199 DIO.Read (FP (File), Buf'Address, Bytes, DPCount (From));
203 -- In the normal case, we can read straight into the buffer
206 DIO.Read (FP (File), Item'Address, Bytes, DPCount (From));
210 procedure Read (File : in File_Type; Item : out Element_Type) is
212 -- Same processing for unconstrained case as above
214 -- Note: we have to turn warnings on/off because this use of
215 -- the Constrained attribute is an obsolescent feature.
217 pragma Warnings (Off);
218 if not Element_Type'Constrained then
219 pragma Warnings (On);
225 DIO.Read (FP (File), Buf'Address, Bytes);
230 DIO.Read (FP (File), Item'Address, Bytes);
238 procedure Reset (File : in out File_Type; Mode : in File_Mode) is
240 DIO.Reset (FP (File), To_FCB (Mode));
243 procedure Reset (File : in out File_Type) is
245 DIO.Reset (FP (File));
252 procedure Set_Index (File : in File_Type; To : in Positive_Count) is
254 DIO.Set_Index (FP (File), DPCount (To));
261 function Size (File : in File_Type) return Count is
263 return Count (DIO.Size (FP (File)));
271 (File : in File_Type;
272 Item : in Element_Type;
273 To : in Positive_Count)
276 DIO.Set_Index (FP (File), DPCount (To));
277 DIO.Write (FP (File), Item'Address, Item'Size / SU, Zeroes);
280 procedure Write (File : in File_Type; Item : in Element_Type) is
282 DIO.Write (FP (File), Item'Address, Item'Size / SU, Zeroes);