Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/libgnat/a-direio.adb @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
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;