1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . D I R E C T _ I O --
9 -- Copyright (C) 1992-2017, 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
);