|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT RUN-TIME COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- A D A . D I R E C T _ I O --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
|
9 -- Copyright (C) 1992-2017, Free Software Foundation, Inc. --
|
|
|
10 -- --
|
|
|
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. --
|
|
|
17 -- --
|
|
|
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. --
|
|
|
21 -- --
|
|
|
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/>. --
|
|
|
26 -- --
|
|
|
27 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
29 -- --
|
|
|
30 ------------------------------------------------------------------------------
|
|
|
31
|
|
|
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)
|
|
|
36
|
|
|
37 with Interfaces.C_Streams; use Interfaces.C_Streams;
|
|
|
38 with System; use System;
|
|
|
39 with System.CRTL;
|
|
|
40 with System.File_Control_Block;
|
|
|
41 with System.File_IO;
|
|
|
42 with System.Storage_Elements;
|
|
|
43 with Ada.Unchecked_Conversion;
|
|
|
44
|
|
|
45 package body Ada.Direct_IO is
|
|
|
46
|
|
|
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
|
|
|
50
|
|
|
51 package FCB renames System.File_Control_Block;
|
|
|
52 package FIO renames System.File_IO;
|
|
|
53 package DIO renames System.Direct_IO;
|
|
|
54
|
|
|
55 SU : constant := System.Storage_Unit;
|
|
|
56
|
|
|
57 subtype AP is FCB.AFCB_Ptr;
|
|
|
58 subtype FP is DIO.File_Type;
|
|
|
59 subtype DPCount is DIO.Positive_Count;
|
|
|
60
|
|
|
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);
|
|
|
63
|
|
|
64 use type System.CRTL.size_t;
|
|
|
65
|
|
|
66 -----------
|
|
|
67 -- Close --
|
|
|
68 -----------
|
|
|
69
|
|
|
70 procedure Close (File : in out File_Type) is
|
|
|
71 begin
|
|
|
72 FIO.Close (AP (File)'Unrestricted_Access);
|
|
|
73 end Close;
|
|
|
74
|
|
|
75 ------------
|
|
|
76 -- Create --
|
|
|
77 ------------
|
|
|
78
|
|
|
79 procedure Create
|
|
|
80 (File : in out File_Type;
|
|
|
81 Mode : File_Mode := Inout_File;
|
|
|
82 Name : String := "";
|
|
|
83 Form : String := "")
|
|
|
84 is
|
|
|
85 begin
|
|
|
86 DIO.Create (FP (File), To_FCB (Mode), Name, Form);
|
|
|
87 File.Bytes := Bytes;
|
|
|
88 end Create;
|
|
|
89
|
|
|
90 ------------
|
|
|
91 -- Delete --
|
|
|
92 ------------
|
|
|
93
|
|
|
94 procedure Delete (File : in out File_Type) is
|
|
|
95 begin
|
|
|
96 FIO.Delete (AP (File)'Unrestricted_Access);
|
|
|
97 end Delete;
|
|
|
98
|
|
|
99 -----------------
|
|
|
100 -- End_Of_File --
|
|
|
101 -----------------
|
|
|
102
|
|
|
103 function End_Of_File (File : File_Type) return Boolean is
|
|
|
104 begin
|
|
|
105 return DIO.End_Of_File (FP (File));
|
|
|
106 end End_Of_File;
|
|
|
107
|
|
|
108 -----------
|
|
|
109 -- Flush --
|
|
|
110 -----------
|
|
|
111
|
|
|
112 procedure Flush (File : File_Type) is
|
|
|
113 begin
|
|
|
114 FIO.Flush (AP (File));
|
|
|
115 end Flush;
|
|
|
116
|
|
|
117 ----------
|
|
|
118 -- Form --
|
|
|
119 ----------
|
|
|
120
|
|
|
121 function Form (File : File_Type) return String is
|
|
|
122 begin
|
|
|
123 return FIO.Form (AP (File));
|
|
|
124 end Form;
|
|
|
125
|
|
|
126 -----------
|
|
|
127 -- Index --
|
|
|
128 -----------
|
|
|
129
|
|
|
130 function Index (File : File_Type) return Positive_Count is
|
|
|
131 begin
|
|
|
132 return Positive_Count (DIO.Index (FP (File)));
|
|
|
133 end Index;
|
|
|
134
|
|
|
135 -------------
|
|
|
136 -- Is_Open --
|
|
|
137 -------------
|
|
|
138
|
|
|
139 function Is_Open (File : File_Type) return Boolean is
|
|
|
140 begin
|
|
|
141 return FIO.Is_Open (AP (File));
|
|
|
142 end Is_Open;
|
|
|
143
|
|
|
144 ----------
|
|
|
145 -- Mode --
|
|
|
146 ----------
|
|
|
147
|
|
|
148 function Mode (File : File_Type) return File_Mode is
|
|
|
149 begin
|
|
|
150 return To_DIO (FIO.Mode (AP (File)));
|
|
|
151 end Mode;
|
|
|
152
|
|
|
153 ----------
|
|
|
154 -- Name --
|
|
|
155 ----------
|
|
|
156
|
|
|
157 function Name (File : File_Type) return String is
|
|
|
158 begin
|
|
|
159 return FIO.Name (AP (File));
|
|
|
160 end Name;
|
|
|
161
|
|
|
162 ----------
|
|
|
163 -- Open --
|
|
|
164 ----------
|
|
|
165
|
|
|
166 procedure Open
|
|
|
167 (File : in out File_Type;
|
|
|
168 Mode : File_Mode;
|
|
|
169 Name : String;
|
|
|
170 Form : String := "")
|
|
|
171 is
|
|
|
172 begin
|
|
|
173 DIO.Open (FP (File), To_FCB (Mode), Name, Form);
|
|
|
174 File.Bytes := Bytes;
|
|
|
175 end Open;
|
|
|
176
|
|
|
177 ----------
|
|
|
178 -- Read --
|
|
|
179 ----------
|
|
|
180
|
|
|
181 procedure Read
|
|
|
182 (File : File_Type;
|
|
|
183 Item : out Element_Type;
|
|
|
184 From : Positive_Count)
|
|
|
185 is
|
|
|
186 begin
|
|
|
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.
|
|
|
191
|
|
|
192 -- Note: we have to turn warnings on/off because this use of
|
|
|
193 -- the Constrained attribute is an obsolescent feature.
|
|
|
194
|
|
|
195 pragma Warnings (Off);
|
|
|
196 if not Element_Type'Constrained then
|
|
|
197 pragma Warnings (On);
|
|
|
198
|
|
|
199 declare
|
|
|
200 Buf : Element_Type;
|
|
|
201
|
|
|
202 begin
|
|
|
203 DIO.Read (FP (File), Buf'Address, Bytes, DPCount (From));
|
|
|
204 Item := Buf;
|
|
|
205 end;
|
|
|
206
|
|
|
207 -- In the normal case, we can read straight into the buffer
|
|
|
208
|
|
|
209 else
|
|
|
210 DIO.Read (FP (File), Item'Address, Bytes, DPCount (From));
|
|
|
211 end if;
|
|
|
212 end Read;
|
|
|
213
|
|
|
214 procedure Read (File : File_Type; Item : out Element_Type) is
|
|
|
215 begin
|
|
|
216 -- Same processing for unconstrained case as above
|
|
|
217
|
|
|
218 -- Note: we have to turn warnings on/off because this use of
|
|
|
219 -- the Constrained attribute is an obsolescent feature.
|
|
|
220
|
|
|
221 pragma Warnings (Off);
|
|
|
222 if not Element_Type'Constrained then
|
|
|
223 pragma Warnings (On);
|
|
|
224
|
|
|
225 declare
|
|
|
226 Buf : Element_Type;
|
|
|
227
|
|
|
228 begin
|
|
|
229 DIO.Read (FP (File), Buf'Address, Bytes);
|
|
|
230 Item := Buf;
|
|
|
231 end;
|
|
|
232
|
|
|
233 else
|
|
|
234 DIO.Read (FP (File), Item'Address, Bytes);
|
|
|
235 end if;
|
|
|
236 end Read;
|
|
|
237
|
|
|
238 -----------
|
|
|
239 -- Reset --
|
|
|
240 -----------
|
|
|
241
|
|
|
242 procedure Reset (File : in out File_Type; Mode : File_Mode) is
|
|
|
243 begin
|
|
|
244 DIO.Reset (FP (File), To_FCB (Mode));
|
|
|
245 end Reset;
|
|
|
246
|
|
|
247 procedure Reset (File : in out File_Type) is
|
|
|
248 begin
|
|
|
249 DIO.Reset (FP (File));
|
|
|
250 end Reset;
|
|
|
251
|
|
|
252 ---------------
|
|
|
253 -- Set_Index --
|
|
|
254 ---------------
|
|
|
255
|
|
|
256 procedure Set_Index (File : File_Type; To : Positive_Count) is
|
|
|
257 begin
|
|
|
258 DIO.Set_Index (FP (File), DPCount (To));
|
|
|
259 end Set_Index;
|
|
|
260
|
|
|
261 ----------
|
|
|
262 -- Size --
|
|
|
263 ----------
|
|
|
264
|
|
|
265 function Size (File : File_Type) return Count is
|
|
|
266 begin
|
|
|
267 return Count (DIO.Size (FP (File)));
|
|
|
268 end Size;
|
|
|
269
|
|
|
270 -----------
|
|
|
271 -- Write --
|
|
|
272 -----------
|
|
|
273
|
|
|
274 procedure Write
|
|
|
275 (File : File_Type;
|
|
|
276 Item : Element_Type;
|
|
|
277 To : Positive_Count)
|
|
|
278 is
|
|
|
279 begin
|
|
|
280 DIO.Set_Index (FP (File), DPCount (To));
|
|
|
281 DIO.Write (FP (File), Item'Address, Item'Size / SU, Zeroes);
|
|
|
282 end Write;
|
|
|
283
|
|
|
284 procedure Write (File : File_Type; Item : Element_Type) is
|
|
|
285 begin
|
|
|
286 DIO.Write (FP (File), Item'Address, Item'Size / SU, Zeroes);
|
|
|
287 end Write;
|
|
|
288
|
|
|
289 end Ada.Direct_IO;
|
