]>
Commit | Line | Data |
---|---|---|
d23b8f57 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3084fecd | 3 | -- GNAT RUN-TIME COMPONENTS -- |
d23b8f57 RK |
4 | -- -- |
5 | -- A D A . S E Q U E N T I A L _ I O -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
4b490c1e | 9 | -- Copyright (C) 1992-2020, Free Software Foundation, Inc. -- |
d23b8f57 RK |
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- -- | |
748086b7 | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
d23b8f57 RK |
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 -- | |
748086b7 JJ |
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/>. -- | |
d23b8f57 RK |
26 | -- -- |
27 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 28 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
d23b8f57 RK |
29 | -- -- |
30 | ------------------------------------------------------------------------------ | |
31 | ||
32 | -- This is the generic template for Sequential_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.Sequential_IO | |
35 | -- (for specialized Sequential_IO functions) | |
36 | ||
83553466 | 37 | with Ada.Unchecked_Conversion; |
15918371 | 38 | |
d23b8f57 | 39 | with System; |
15918371 | 40 | with System.Byte_Swapping; |
209db2bf | 41 | with System.CRTL; |
d23b8f57 RK |
42 | with System.File_Control_Block; |
43 | with System.File_IO; | |
44 | with System.Storage_Elements; | |
15918371 | 45 | |
83553466 | 46 | with Interfaces.C_Streams; use Interfaces.C_Streams; |
d23b8f57 RK |
47 | |
48 | package body Ada.Sequential_IO is | |
49 | ||
50 | package FIO renames System.File_IO; | |
51 | package FCB renames System.File_Control_Block; | |
52 | package SIO renames System.Sequential_IO; | |
53 | package SSE renames System.Storage_Elements; | |
54 | ||
55 | SU : constant := System.Storage_Unit; | |
56 | ||
57 | subtype AP is FCB.AFCB_Ptr; | |
58 | subtype FP is SIO.File_Type; | |
59 | ||
cecaf88a RD |
60 | function To_FCB is new Ada.Unchecked_Conversion (File_Mode, FCB.File_Mode); |
61 | function To_SIO is new Ada.Unchecked_Conversion (FCB.File_Mode, File_Mode); | |
d23b8f57 | 62 | |
83553466 | 63 | use type System.Bit_Order; |
209db2bf AC |
64 | use type System.CRTL.size_t; |
65 | ||
83553466 AC |
66 | procedure Byte_Swap (Siz : in out size_t); |
67 | -- Byte swap Siz | |
68 | ||
69 | --------------- | |
70 | -- Byte_Swap -- | |
71 | --------------- | |
72 | ||
73 | procedure Byte_Swap (Siz : in out size_t) is | |
15918371 | 74 | use System.Byte_Swapping; |
83553466 | 75 | begin |
445514c0 | 76 | case size_t'Size is |
15918371 AC |
77 | when 32 => Siz := size_t (Bswap_32 (U32 (Siz))); |
78 | when 64 => Siz := size_t (Bswap_64 (U64 (Siz))); | |
83553466 AC |
79 | when others => raise Program_Error; |
80 | end case; | |
81 | end Byte_Swap; | |
82 | ||
d23b8f57 RK |
83 | ----------- |
84 | -- Close -- | |
85 | ----------- | |
86 | ||
87 | procedure Close (File : in out File_Type) is | |
88 | begin | |
3aa62371 | 89 | FIO.Close (AP (File)'Unrestricted_Access); |
d23b8f57 RK |
90 | end Close; |
91 | ||
92 | ------------ | |
93 | -- Create -- | |
94 | ------------ | |
95 | ||
96 | procedure Create | |
97 | (File : in out File_Type; | |
0ae9f22f RD |
98 | Mode : File_Mode := Out_File; |
99 | Name : String := ""; | |
100 | Form : String := "") | |
d23b8f57 RK |
101 | is |
102 | begin | |
103 | SIO.Create (FP (File), To_FCB (Mode), Name, Form); | |
104 | end Create; | |
105 | ||
106 | ------------ | |
107 | -- Delete -- | |
108 | ------------ | |
109 | ||
110 | procedure Delete (File : in out File_Type) is | |
111 | begin | |
3aa62371 | 112 | FIO.Delete (AP (File)'Unrestricted_Access); |
d23b8f57 RK |
113 | end Delete; |
114 | ||
115 | ----------------- | |
116 | -- End_Of_File -- | |
117 | ----------------- | |
118 | ||
0ae9f22f | 119 | function End_Of_File (File : File_Type) return Boolean is |
d23b8f57 RK |
120 | begin |
121 | return FIO.End_Of_File (AP (File)); | |
122 | end End_Of_File; | |
123 | ||
f6c5454e PO |
124 | ----------- |
125 | -- Flush -- | |
126 | ----------- | |
127 | ||
128 | procedure Flush (File : File_Type) is | |
129 | begin | |
130 | FIO.Flush (AP (File)); | |
131 | end Flush; | |
132 | ||
d23b8f57 RK |
133 | ---------- |
134 | -- Form -- | |
135 | ---------- | |
136 | ||
0ae9f22f | 137 | function Form (File : File_Type) return String is |
d23b8f57 RK |
138 | begin |
139 | return FIO.Form (AP (File)); | |
140 | end Form; | |
141 | ||
142 | ------------- | |
143 | -- Is_Open -- | |
144 | ------------- | |
145 | ||
0ae9f22f | 146 | function Is_Open (File : File_Type) return Boolean is |
d23b8f57 RK |
147 | begin |
148 | return FIO.Is_Open (AP (File)); | |
149 | end Is_Open; | |
150 | ||
151 | ---------- | |
152 | -- Mode -- | |
153 | ---------- | |
154 | ||
0ae9f22f | 155 | function Mode (File : File_Type) return File_Mode is |
d23b8f57 RK |
156 | begin |
157 | return To_SIO (FIO.Mode (AP (File))); | |
158 | end Mode; | |
159 | ||
160 | ---------- | |
161 | -- Name -- | |
162 | ---------- | |
163 | ||
0ae9f22f | 164 | function Name (File : File_Type) return String is |
d23b8f57 RK |
165 | begin |
166 | return FIO.Name (AP (File)); | |
167 | end Name; | |
168 | ||
169 | ---------- | |
170 | -- Open -- | |
171 | ---------- | |
172 | ||
173 | procedure Open | |
174 | (File : in out File_Type; | |
0ae9f22f RD |
175 | Mode : File_Mode; |
176 | Name : String; | |
177 | Form : String := "") | |
d23b8f57 RK |
178 | is |
179 | begin | |
180 | SIO.Open (FP (File), To_FCB (Mode), Name, Form); | |
181 | end Open; | |
182 | ||
183 | ---------- | |
184 | -- Read -- | |
185 | ---------- | |
186 | ||
0ae9f22f | 187 | procedure Read (File : File_Type; Item : out Element_Type) is |
d23b8f57 RK |
188 | Siz : constant size_t := (Item'Size + SU - 1) / SU; |
189 | Rsiz : size_t; | |
190 | ||
191 | begin | |
192 | FIO.Check_Read_Status (AP (File)); | |
193 | ||
194 | -- For non-definite type or type with discriminants, read size and | |
195 | -- raise Program_Error if it is larger than the size of the item. | |
196 | ||
197 | if not Element_Type'Definite | |
198 | or else Element_Type'Has_Discriminants | |
199 | then | |
200 | FIO.Read_Buf | |
201 | (AP (File), Rsiz'Address, size_t'Size / System.Storage_Unit); | |
202 | ||
15918371 AC |
203 | -- If item read has non-default scalar storage order, then the size |
204 | -- will have been written with that same order, so byte swap it. | |
205 | ||
83553466 AC |
206 | if Element_Type'Scalar_Storage_Order /= System.Default_Bit_Order then |
207 | Byte_Swap (Rsiz); | |
208 | end if; | |
209 | ||
d23b8f57 RK |
210 | -- For a type with discriminants, we have to read into a temporary |
211 | -- buffer if Item is constrained, to check that the discriminants | |
212 | -- are correct. | |
213 | ||
edbd98c4 | 214 | if Element_Type'Has_Discriminants and then Item'Constrained then |
d23b8f57 RK |
215 | declare |
216 | RsizS : constant SSE.Storage_Offset := | |
edbd98c4 | 217 | SSE.Storage_Offset (Rsiz - 1); |
d23b8f57 | 218 | |
fbf5a39b AC |
219 | type SA is new SSE.Storage_Array (0 .. RsizS); |
220 | ||
221 | for SA'Alignment use Standard'Maximum_Alignment; | |
222 | -- We will perform an unchecked conversion of a pointer-to-SA | |
223 | -- into pointer-to-Element_Type. We need to ensure that the | |
224 | -- source is always at least as strictly aligned as the target. | |
225 | ||
d23b8f57 RK |
226 | type SAP is access all SA; |
227 | type ItemP is access all Element_Type; | |
228 | ||
229 | pragma Warnings (Off); | |
fbf5a39b AC |
230 | -- We have to turn warnings off for function To_ItemP, |
231 | -- because it gets analyzed for all types, including ones | |
232 | -- which can't possibly come this way, and for which the | |
233 | -- size of the access types differs. | |
d23b8f57 | 234 | |
cecaf88a | 235 | function To_ItemP is new Ada.Unchecked_Conversion (SAP, ItemP); |
d23b8f57 RK |
236 | |
237 | pragma Warnings (On); | |
238 | ||
239 | Buffer : aliased SA; | |
240 | ||
241 | pragma Unsuppress (Discriminant_Check); | |
242 | ||
243 | begin | |
244 | FIO.Read_Buf (AP (File), Buffer'Address, Rsiz); | |
245 | Item := To_ItemP (Buffer'Access).all; | |
246 | return; | |
247 | end; | |
248 | end if; | |
249 | ||
250 | -- In the case of a non-definite type, make sure the length is OK. | |
251 | -- We can't do this in the variant record case, because the size is | |
252 | -- based on the current discriminant, so may be apparently wrong. | |
253 | ||
254 | if not Element_Type'Has_Discriminants and then Rsiz > Siz then | |
255 | raise Program_Error; | |
256 | end if; | |
257 | ||
258 | FIO.Read_Buf (AP (File), Item'Address, Rsiz); | |
259 | ||
260 | -- For definite type without discriminants, use actual size of item | |
261 | ||
262 | else | |
263 | FIO.Read_Buf (AP (File), Item'Address, Siz); | |
264 | end if; | |
265 | end Read; | |
266 | ||
267 | ----------- | |
268 | -- Reset -- | |
269 | ----------- | |
270 | ||
0ae9f22f | 271 | procedure Reset (File : in out File_Type; Mode : File_Mode) is |
d23b8f57 | 272 | begin |
3aa62371 | 273 | FIO.Reset (AP (File)'Unrestricted_Access, To_FCB (Mode)); |
d23b8f57 RK |
274 | end Reset; |
275 | ||
276 | procedure Reset (File : in out File_Type) is | |
277 | begin | |
3aa62371 | 278 | FIO.Reset (AP (File)'Unrestricted_Access); |
d23b8f57 RK |
279 | end Reset; |
280 | ||
281 | ----------- | |
282 | -- Write -- | |
283 | ----------- | |
284 | ||
0ae9f22f | 285 | procedure Write (File : File_Type; Item : Element_Type) is |
d23b8f57 | 286 | Siz : constant size_t := (Item'Size + SU - 1) / SU; |
83553466 AC |
287 | -- Size to be written, in native representation |
288 | ||
289 | Swapped_Siz : size_t := Siz; | |
290 | -- Same, possibly byte swapped to account for Element_Type endianness | |
d23b8f57 RK |
291 | |
292 | begin | |
293 | FIO.Check_Write_Status (AP (File)); | |
294 | ||
295 | -- For non-definite types or types with discriminants, write the size | |
296 | ||
297 | if not Element_Type'Definite | |
298 | or else Element_Type'Has_Discriminants | |
299 | then | |
15918371 AC |
300 | -- If item written has non-default scalar storage order, then the |
301 | -- size is written with that same order, so byte swap it. | |
302 | ||
83553466 AC |
303 | if Element_Type'Scalar_Storage_Order /= System.Default_Bit_Order then |
304 | Byte_Swap (Swapped_Siz); | |
305 | end if; | |
306 | ||
d23b8f57 | 307 | FIO.Write_Buf |
83553466 | 308 | (AP (File), Swapped_Siz'Address, size_t'Size / System.Storage_Unit); |
d23b8f57 RK |
309 | end if; |
310 | ||
311 | FIO.Write_Buf (AP (File), Item'Address, Siz); | |
312 | end Write; | |
313 | ||
314 | end Ada.Sequential_IO; |