1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . D I R E C T _ I O --
9 -- Copyright (C) 1992-2016, 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 procedure Flush
(File
: File_Type
) is
117 FIO
.Flush
(AP
(File
));
124 function Form
(File
: File_Type
) return String is
126 return FIO
.Form
(AP
(File
));
133 function Index
(File
: File_Type
) return Positive_Count
is
135 return Positive_Count
(DIO
.Index
(FP
(File
)));
142 function Is_Open
(File
: File_Type
) return Boolean is
144 return FIO
.Is_Open
(AP
(File
));
151 function Mode
(File
: File_Type
) return File_Mode
is
153 return To_DIO
(FIO
.Mode
(AP
(File
)));
160 function Name
(File
: File_Type
) return String is
162 return FIO
.Name
(AP
(File
));
170 (File
: in out File_Type
;
176 DIO
.Open
(FP
(File
), To_FCB
(Mode
), Name
, Form
);
186 Item
: out Element_Type
;
187 From
: Positive_Count
)
190 -- For a non-constrained variant record type, we read into an
191 -- intermediate buffer, since we may have the case of discriminated
192 -- records where a discriminant check is required, and we may need
193 -- to assign only part of the record buffer originally written.
195 -- Note: we have to turn warnings on/off because this use of
196 -- the Constrained attribute is an obsolescent feature.
198 pragma Warnings
(Off
);
199 if not Element_Type
'Constrained then
200 pragma Warnings
(On
);
206 DIO
.Read
(FP
(File
), Buf
'Address, Bytes
, DPCount
(From
));
210 -- In the normal case, we can read straight into the buffer
213 DIO
.Read
(FP
(File
), Item
'Address, Bytes
, DPCount
(From
));
217 procedure Read
(File
: File_Type
; Item
: out Element_Type
) is
219 -- Same processing for unconstrained case as above
221 -- Note: we have to turn warnings on/off because this use of
222 -- the Constrained attribute is an obsolescent feature.
224 pragma Warnings
(Off
);
225 if not Element_Type
'Constrained then
226 pragma Warnings
(On
);
232 DIO
.Read
(FP
(File
), Buf
'Address, Bytes
);
237 DIO
.Read
(FP
(File
), Item
'Address, Bytes
);
245 procedure Reset
(File
: in out File_Type
; Mode
: File_Mode
) is
247 DIO
.Reset
(FP
(File
), To_FCB
(Mode
));
250 procedure Reset
(File
: in out File_Type
) is
252 DIO
.Reset
(FP
(File
));
259 procedure Set_Index
(File
: File_Type
; To
: Positive_Count
) is
261 DIO
.Set_Index
(FP
(File
), DPCount
(To
));
268 function Size
(File
: File_Type
) return Count
is
270 return Count
(DIO
.Size
(FP
(File
)));
283 DIO
.Set_Index
(FP
(File
), DPCount
(To
));
284 DIO
.Write
(FP
(File
), Item
'Address, Item
'Size / SU
, Zeroes
);
287 procedure Write
(File
: File_Type
; Item
: Element_Type
) is
289 DIO
.Write
(FP
(File
), Item
'Address, Item
'Size / SU
, Zeroes
);