1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . D I R E C T _ I O --
9 -- Copyright (C) 1992-2019, 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.Storage_Elements;
43 with Ada.Unchecked_Conversion;
45 package body Ada.Direct_IO is
47 Zeroes : constant System.Storage_Elements.Storage_Array :=
48 (1 .. System.Storage_Elements.Storage_Offset (Bytes) => 0);
49 -- Buffer used to fill out partial records
51 package FCB renames System.File_Control_Block;
52 package FIO renames System.File_IO;
53 package DIO renames System.Direct_IO;
55 SU : constant := System.Storage_Unit;
57 subtype AP is FCB.AFCB_Ptr;
58 subtype FP is DIO.File_Type;
59 subtype DPCount is DIO.Positive_Count;
61 function To_FCB is new Ada.Unchecked_Conversion (File_Mode, FCB.File_Mode);
62 function To_DIO is new Ada.Unchecked_Conversion (FCB.File_Mode, File_Mode);
64 use type System.CRTL.size_t;
70 procedure Close (File : in out File_Type) is
72 FIO.Close (AP (File)'Unrestricted_Access);
80 (File : in out File_Type;
81 Mode : File_Mode := Inout_File;
86 DIO.Create (FP (File), To_FCB (Mode), Name, Form);
94 procedure Delete (File : in out File_Type) is
96 FIO.Delete (AP (File)'Unrestricted_Access);
103 function End_Of_File (File : File_Type) return Boolean is
105 return DIO.End_Of_File (FP (File));
112 procedure Flush (File : File_Type) is
114 FIO.Flush (AP (File));
121 function Form (File : File_Type) return String is
123 return FIO.Form (AP (File));
130 function Index (File : File_Type) return Positive_Count is
132 return Positive_Count (DIO.Index (FP (File)));
139 function Is_Open (File : File_Type) return Boolean is
141 return FIO.Is_Open (AP (File));
148 function Mode (File : File_Type) return File_Mode is
150 return To_DIO (FIO.Mode (AP (File)));
157 function Name (File : File_Type) return String is
159 return FIO.Name (AP (File));
167 (File : in out File_Type;
173 DIO.Open (FP (File), To_FCB (Mode), Name, Form);
183 Item : out Element_Type;
184 From : Positive_Count)
187 -- For a non-constrained variant record type, we read into an
188 -- intermediate buffer, since we may have the case of discriminated
189 -- records where a discriminant check is required, and we may need
190 -- to assign only part of the record buffer originally written.
192 -- Note: we have to turn warnings on/off because this use of
193 -- the Constrained attribute is an obsolescent feature.
195 pragma Warnings (Off);
196 if not Element_Type'Constrained then
197 pragma Warnings (On);
203 DIO.Read (FP (File), Buf'Address, Bytes, DPCount (From));
207 -- In the normal case, we can read straight into the buffer
210 DIO.Read (FP (File), Item'Address, Bytes, DPCount (From));
214 procedure Read (File : File_Type; Item : out Element_Type) is
216 -- Same processing for unconstrained case as above
218 -- Note: we have to turn warnings on/off because this use of
219 -- the Constrained attribute is an obsolescent feature.
221 pragma Warnings (Off);
222 if not Element_Type'Constrained then
223 pragma Warnings (On);
229 DIO.Read (FP (File), Buf'Address, Bytes);
234 DIO.Read (FP (File), Item'Address, Bytes);
242 procedure Reset (File : in out File_Type; Mode : File_Mode) is
244 DIO.Reset (FP (File), To_FCB (Mode));
247 procedure Reset (File : in out File_Type) is
249 DIO.Reset (FP (File));
256 procedure Set_Index (File : File_Type; To : Positive_Count) is
258 DIO.Set_Index (FP (File), DPCount (To));
265 function Size (File : File_Type) return Count is
267 return Count (DIO.Size (FP (File)));
280 DIO.Set_Index (FP (File), DPCount (To));
281 DIO.Write (FP (File), Item'Address, Item'Size / SU, Zeroes);
284 procedure Write (File : File_Type; Item : Element_Type) is
286 DIO.Write (FP (File), Item'Address, Item'Size / SU, Zeroes);