1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . D I R E C T _ I O --
9 -- Copyright (C) 1992-2008, 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, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, 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 Ada.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 Ada.Unchecked_Conversion (File_Mode, FCB.File_Mode);
67 function To_DIO is new Ada.Unchecked_Conversion (FCB.File_Mode, File_Mode);
69 use type System.CRTL.size_t;
75 procedure Close (File : in out File_Type) is
77 for AFCB'Address use File'Address;
78 pragma Import (Ada, AFCB);
80 FIO.Close (AFCB'Access);
88 (File : in out File_Type;
89 Mode : File_Mode := Inout_File;
94 DIO.Create (FP (File), To_FCB (Mode), Name, Form);
102 procedure Delete (File : in out File_Type) is
104 for AFCB'Address use File'Address;
105 pragma Import (Ada, AFCB);
107 FIO.Delete (AFCB'Access);
114 function End_Of_File (File : File_Type) return Boolean is
116 return DIO.End_Of_File (FP (File));
123 function Form (File : File_Type) return String is
125 return FIO.Form (AP (File));
132 function Index (File : File_Type) return Positive_Count is
134 return Positive_Count (DIO.Index (FP (File)));
141 function Is_Open (File : File_Type) return Boolean is
143 return FIO.Is_Open (AP (File));
150 function Mode (File : File_Type) return File_Mode is
152 return To_DIO (FIO.Mode (AP (File)));
159 function Name (File : File_Type) return String is
161 return FIO.Name (AP (File));
169 (File : in out File_Type;
175 DIO.Open (FP (File), To_FCB (Mode), Name, Form);
185 Item : out Element_Type;
186 From : Positive_Count)
189 -- For a non-constrained variant record type, we read into an
190 -- intermediate buffer, since we may have the case of discriminated
191 -- records where a discriminant check is required, and we may need
192 -- to assign only part of the record buffer originally written.
194 -- Note: we have to turn warnings on/off because this use of
195 -- the Constrained attribute is an obsolescent feature.
197 pragma Warnings (Off);
198 if not Element_Type'Constrained then
199 pragma Warnings (On);
205 DIO.Read (FP (File), Buf'Address, Bytes, DPCount (From));
209 -- In the normal case, we can read straight into the buffer
212 DIO.Read (FP (File), Item'Address, Bytes, DPCount (From));
216 procedure Read (File : File_Type; Item : out Element_Type) is
218 -- Same processing for unconstrained case as above
220 -- Note: we have to turn warnings on/off because this use of
221 -- the Constrained attribute is an obsolescent feature.
223 pragma Warnings (Off);
224 if not Element_Type'Constrained then
225 pragma Warnings (On);
231 DIO.Read (FP (File), Buf'Address, Bytes);
236 DIO.Read (FP (File), Item'Address, Bytes);
244 procedure Reset (File : in out File_Type; Mode : File_Mode) is
246 DIO.Reset (FP (File), To_FCB (Mode));
249 procedure Reset (File : in out File_Type) is
251 DIO.Reset (FP (File));
258 procedure Set_Index (File : File_Type; To : Positive_Count) is
260 DIO.Set_Index (FP (File), DPCount (To));
267 function Size (File : File_Type) return Count is
269 return Count (DIO.Size (FP (File)));
282 DIO.Set_Index (FP (File), DPCount (To));
283 DIO.Write (FP (File), Item'Address, Item'Size / SU, Zeroes);
286 procedure Write (File : File_Type; Item : Element_Type) is
288 DIO.Write (FP (File), Item'Address, Item'Size / SU, Zeroes);