]>
Commit | Line | Data |
---|---|---|
d23b8f57 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3084fecd | 3 | -- GNAT RUN-TIME COMPONENTS -- |
d23b8f57 RK |
4 | -- -- |
5 | -- A D A . S T R E A M S . S T R E A M _ 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 | ||
3d923671 | 32 | with Interfaces.C_Streams; use Interfaces.C_Streams; |
0ae9f22f RD |
33 | |
34 | with System; use System; | |
b7d5e87b | 35 | with System.Communication; use System.Communication; |
d23b8f57 RK |
36 | with System.File_IO; |
37 | with System.Soft_Links; | |
209db2bf | 38 | with System.CRTL; |
0ae9f22f | 39 | |
cecaf88a RD |
40 | with Ada.Unchecked_Conversion; |
41 | with Ada.Unchecked_Deallocation; | |
d23b8f57 RK |
42 | |
43 | package body Ada.Streams.Stream_IO is | |
44 | ||
45 | package FIO renames System.File_IO; | |
46 | package SSL renames System.Soft_Links; | |
47 | ||
48 | subtype AP is FCB.AFCB_Ptr; | |
49 | ||
cecaf88a RD |
50 | function To_FCB is new Ada.Unchecked_Conversion (File_Mode, FCB.File_Mode); |
51 | function To_SIO is new Ada.Unchecked_Conversion (FCB.File_Mode, File_Mode); | |
d23b8f57 RK |
52 | use type FCB.File_Mode; |
53 | use type FCB.Shared_Status_Type; | |
54 | ||
55 | ----------------------- | |
56 | -- Local Subprograms -- | |
57 | ----------------------- | |
58 | ||
0ae9f22f | 59 | procedure Set_Position (File : File_Type); |
d23b8f57 RK |
60 | -- Sets file position pointer according to value of current index |
61 | ||
62 | ------------------- | |
63 | -- AFCB_Allocate -- | |
64 | ------------------- | |
65 | ||
66 | function AFCB_Allocate (Control_Block : Stream_AFCB) return FCB.AFCB_Ptr is | |
07fc65c4 | 67 | pragma Warnings (Off, Control_Block); |
d23b8f57 RK |
68 | begin |
69 | return new Stream_AFCB; | |
70 | end AFCB_Allocate; | |
71 | ||
72 | ---------------- | |
73 | -- AFCB_Close -- | |
74 | ---------------- | |
75 | ||
76 | -- No special processing required for closing Stream_IO file | |
77 | ||
d90e94c7 | 78 | procedure AFCB_Close (File : not null access Stream_AFCB) is |
07fc65c4 | 79 | pragma Warnings (Off, File); |
d23b8f57 RK |
80 | begin |
81 | null; | |
82 | end AFCB_Close; | |
83 | ||
84 | --------------- | |
85 | -- AFCB_Free -- | |
86 | --------------- | |
87 | ||
d90e94c7 | 88 | procedure AFCB_Free (File : not null access Stream_AFCB) is |
d23b8f57 RK |
89 | type FCB_Ptr is access all Stream_AFCB; |
90 | FT : FCB_Ptr := FCB_Ptr (File); | |
91 | ||
cecaf88a | 92 | procedure Free is new Ada.Unchecked_Deallocation (Stream_AFCB, FCB_Ptr); |
d23b8f57 RK |
93 | |
94 | begin | |
95 | Free (FT); | |
96 | end AFCB_Free; | |
97 | ||
98 | ----------- | |
99 | -- Close -- | |
100 | ----------- | |
101 | ||
102 | procedure Close (File : in out File_Type) is | |
103 | begin | |
07736171 | 104 | FIO.Close (AP (File)'Unrestricted_Access); |
d23b8f57 RK |
105 | end Close; |
106 | ||
107 | ------------ | |
108 | -- Create -- | |
109 | ------------ | |
110 | ||
111 | procedure Create | |
112 | (File : in out File_Type; | |
0ae9f22f RD |
113 | Mode : File_Mode := Out_File; |
114 | Name : String := ""; | |
115 | Form : String := "") | |
d23b8f57 | 116 | is |
fbf5a39b AC |
117 | Dummy_File_Control_Block : Stream_AFCB; |
118 | pragma Warnings (Off, Dummy_File_Control_Block); | |
119 | -- Yes, we know this is never assigned a value, only the tag | |
120 | -- is used for dispatching purposes, so that's expected. | |
d23b8f57 RK |
121 | |
122 | begin | |
123 | FIO.Open (File_Ptr => AP (File), | |
fbf5a39b | 124 | Dummy_FCB => Dummy_File_Control_Block, |
d23b8f57 RK |
125 | Mode => To_FCB (Mode), |
126 | Name => Name, | |
127 | Form => Form, | |
128 | Amethod => 'S', | |
129 | Creat => True, | |
130 | Text => False); | |
131 | File.Last_Op := Op_Write; | |
132 | end Create; | |
133 | ||
134 | ------------ | |
135 | -- Delete -- | |
136 | ------------ | |
137 | ||
138 | procedure Delete (File : in out File_Type) is | |
139 | begin | |
07736171 | 140 | FIO.Delete (AP (File)'Unrestricted_Access); |
d23b8f57 RK |
141 | end Delete; |
142 | ||
143 | ----------------- | |
144 | -- End_Of_File -- | |
145 | ----------------- | |
146 | ||
0ae9f22f | 147 | function End_Of_File (File : File_Type) return Boolean is |
d23b8f57 RK |
148 | begin |
149 | FIO.Check_Read_Status (AP (File)); | |
a8930b80 | 150 | return File.Index > Size (File); |
d23b8f57 RK |
151 | end End_Of_File; |
152 | ||
153 | ----------- | |
154 | -- Flush -- | |
155 | ----------- | |
156 | ||
07fc65c4 | 157 | procedure Flush (File : File_Type) is |
d23b8f57 RK |
158 | begin |
159 | FIO.Flush (AP (File)); | |
160 | end Flush; | |
161 | ||
162 | ---------- | |
163 | -- Form -- | |
164 | ---------- | |
165 | ||
0ae9f22f | 166 | function Form (File : File_Type) return String is |
d23b8f57 RK |
167 | begin |
168 | return FIO.Form (AP (File)); | |
169 | end Form; | |
170 | ||
171 | ----------- | |
172 | -- Index -- | |
173 | ----------- | |
174 | ||
0ae9f22f | 175 | function Index (File : File_Type) return Positive_Count is |
d23b8f57 RK |
176 | begin |
177 | FIO.Check_File_Open (AP (File)); | |
a8930b80 | 178 | return File.Index; |
d23b8f57 RK |
179 | end Index; |
180 | ||
181 | ------------- | |
182 | -- Is_Open -- | |
183 | ------------- | |
184 | ||
0ae9f22f | 185 | function Is_Open (File : File_Type) return Boolean is |
d23b8f57 RK |
186 | begin |
187 | return FIO.Is_Open (AP (File)); | |
188 | end Is_Open; | |
189 | ||
190 | ---------- | |
191 | -- Mode -- | |
192 | ---------- | |
193 | ||
0ae9f22f | 194 | function Mode (File : File_Type) return File_Mode is |
d23b8f57 RK |
195 | begin |
196 | return To_SIO (FIO.Mode (AP (File))); | |
197 | end Mode; | |
198 | ||
199 | ---------- | |
200 | -- Name -- | |
201 | ---------- | |
202 | ||
0ae9f22f | 203 | function Name (File : File_Type) return String is |
d23b8f57 RK |
204 | begin |
205 | return FIO.Name (AP (File)); | |
206 | end Name; | |
207 | ||
208 | ---------- | |
209 | -- Open -- | |
210 | ---------- | |
211 | ||
212 | procedure Open | |
213 | (File : in out File_Type; | |
0ae9f22f RD |
214 | Mode : File_Mode; |
215 | Name : String; | |
216 | Form : String := "") | |
d23b8f57 | 217 | is |
fbf5a39b AC |
218 | Dummy_File_Control_Block : Stream_AFCB; |
219 | pragma Warnings (Off, Dummy_File_Control_Block); | |
220 | -- Yes, we know this is never assigned a value, only the tag | |
221 | -- is used for dispatching purposes, so that's expected. | |
d23b8f57 RK |
222 | |
223 | begin | |
224 | FIO.Open (File_Ptr => AP (File), | |
fbf5a39b | 225 | Dummy_FCB => Dummy_File_Control_Block, |
d23b8f57 RK |
226 | Mode => To_FCB (Mode), |
227 | Name => Name, | |
228 | Form => Form, | |
229 | Amethod => 'S', | |
230 | Creat => False, | |
231 | Text => False); | |
232 | ||
233 | -- Ensure that the stream index is set properly (e.g., for Append_File) | |
234 | ||
235 | Reset (File, Mode); | |
236 | ||
fbf5a39b AC |
237 | -- Set last operation. The purpose here is to ensure proper handling |
238 | -- of the initial operation. In general, a write after a read requires | |
239 | -- resetting and doing a seek, so we set the last operation as Read | |
240 | -- for an In_Out file, but for an Out file we set the last operation | |
241 | -- to Op_Write, since in this case it is not necessary to do a seek | |
242 | -- (and furthermore there are situations (such as the case of writing | |
243 | -- a sequential Posix FIFO file) where the lseek would cause problems. | |
244 | ||
5fd3fd79 | 245 | File.Last_Op := (if Mode = Out_File then Op_Write else Op_Read); |
d23b8f57 RK |
246 | end Open; |
247 | ||
248 | ---------- | |
249 | -- Read -- | |
250 | ---------- | |
251 | ||
252 | procedure Read | |
0ae9f22f | 253 | (File : File_Type; |
d23b8f57 RK |
254 | Item : out Stream_Element_Array; |
255 | Last : out Stream_Element_Offset; | |
0ae9f22f | 256 | From : Positive_Count) |
d23b8f57 RK |
257 | is |
258 | begin | |
259 | Set_Index (File, From); | |
260 | Read (File, Item, Last); | |
261 | end Read; | |
262 | ||
263 | procedure Read | |
0ae9f22f | 264 | (File : File_Type; |
d23b8f57 RK |
265 | Item : out Stream_Element_Array; |
266 | Last : out Stream_Element_Offset) | |
267 | is | |
268 | Nread : size_t; | |
269 | ||
270 | begin | |
271 | FIO.Check_Read_Status (AP (File)); | |
272 | ||
273 | -- If last operation was not a read, or if in file sharing mode, | |
274 | -- then reset the physical pointer of the file to match the index | |
275 | -- We lock out task access over the two operations in this case. | |
276 | ||
277 | if File.Last_Op /= Op_Read | |
278 | or else File.Shared_Status = FCB.Yes | |
279 | then | |
d23b8f57 RK |
280 | Locked_Processing : begin |
281 | SSL.Lock_Task.all; | |
282 | Set_Position (File); | |
283 | FIO.Read_Buf (AP (File), Item'Address, Item'Length, Nread); | |
284 | SSL.Unlock_Task.all; | |
285 | ||
286 | exception | |
287 | when others => | |
288 | SSL.Unlock_Task.all; | |
289 | raise; | |
290 | end Locked_Processing; | |
291 | ||
292 | else | |
293 | FIO.Read_Buf (AP (File), Item'Address, Item'Length, Nread); | |
294 | end if; | |
295 | ||
296 | File.Index := File.Index + Count (Nread); | |
d23b8f57 | 297 | File.Last_Op := Op_Read; |
b7d5e87b | 298 | Last := Last_Index (Item'First, Nread); |
d23b8f57 RK |
299 | end Read; |
300 | ||
301 | -- This version of Read is the primitive operation on the underlying | |
302 | -- Stream type, used when a Stream_IO file is treated as a Stream | |
303 | ||
304 | procedure Read | |
305 | (File : in out Stream_AFCB; | |
306 | Item : out Ada.Streams.Stream_Element_Array; | |
307 | Last : out Ada.Streams.Stream_Element_Offset) | |
308 | is | |
309 | begin | |
310 | Read (File'Unchecked_Access, Item, Last); | |
311 | end Read; | |
312 | ||
313 | ----------- | |
314 | -- Reset -- | |
315 | ----------- | |
316 | ||
0ae9f22f | 317 | procedure Reset (File : in out File_Type; Mode : File_Mode) is |
d23b8f57 RK |
318 | begin |
319 | FIO.Check_File_Open (AP (File)); | |
320 | ||
321 | -- Reset file index to start of file for read/write cases. For | |
322 | -- the append case, the Set_Mode call repositions the index. | |
323 | ||
324 | File.Index := 1; | |
325 | Set_Mode (File, Mode); | |
326 | end Reset; | |
327 | ||
328 | procedure Reset (File : in out File_Type) is | |
329 | begin | |
330 | Reset (File, To_SIO (File.Mode)); | |
331 | end Reset; | |
332 | ||
333 | --------------- | |
334 | -- Set_Index -- | |
335 | --------------- | |
336 | ||
0ae9f22f | 337 | procedure Set_Index (File : File_Type; To : Positive_Count) is |
d23b8f57 RK |
338 | begin |
339 | FIO.Check_File_Open (AP (File)); | |
340 | File.Index := Count (To); | |
341 | File.Last_Op := Op_Other; | |
342 | end Set_Index; | |
343 | ||
344 | -------------- | |
345 | -- Set_Mode -- | |
346 | -------------- | |
347 | ||
0ae9f22f | 348 | procedure Set_Mode (File : in out File_Type; Mode : File_Mode) is |
d23b8f57 RK |
349 | begin |
350 | FIO.Check_File_Open (AP (File)); | |
351 | ||
352 | -- If we are switching from read to write, or vice versa, and | |
353 | -- we are not already open in update mode, then reopen in update | |
354 | -- mode now. Note that we can use Inout_File as the mode for the | |
355 | -- call since File_IO handles all modes for all file types. | |
356 | ||
357 | if ((File.Mode = FCB.In_File) /= (Mode = In_File)) | |
358 | and then not File.Update_Mode | |
359 | then | |
07736171 | 360 | FIO.Reset (AP (File)'Unrestricted_Access, FCB.Inout_File); |
d23b8f57 RK |
361 | File.Update_Mode := True; |
362 | end if; | |
363 | ||
364 | -- Set required mode and position to end of file if append mode | |
365 | ||
366 | File.Mode := To_FCB (Mode); | |
367 | FIO.Append_Set (AP (File)); | |
368 | ||
369 | if File.Mode = FCB.Append_File then | |
e9f80612 AC |
370 | if Standard'Address_Size = 64 then |
371 | File.Index := Count (ftell64 (File.Stream)) + 1; | |
372 | else | |
373 | File.Index := Count (ftell (File.Stream)) + 1; | |
374 | end if; | |
d23b8f57 RK |
375 | end if; |
376 | ||
377 | File.Last_Op := Op_Other; | |
378 | end Set_Mode; | |
379 | ||
380 | ------------------ | |
381 | -- Set_Position -- | |
382 | ------------------ | |
383 | ||
0ae9f22f | 384 | procedure Set_Position (File : File_Type) is |
d1e0e148 | 385 | use type System.CRTL.int64; |
e9f80612 | 386 | R : int; |
d23b8f57 | 387 | begin |
d1e0e148 | 388 | R := fseek64 (File.Stream, System.CRTL.int64 (File.Index) - 1, SEEK_SET); |
e9f80612 AC |
389 | |
390 | if R /= 0 then | |
d23b8f57 RK |
391 | raise Use_Error; |
392 | end if; | |
393 | end Set_Position; | |
394 | ||
395 | ---------- | |
396 | -- Size -- | |
397 | ---------- | |
398 | ||
0ae9f22f | 399 | function Size (File : File_Type) return Count is |
d23b8f57 RK |
400 | begin |
401 | FIO.Check_File_Open (AP (File)); | |
402 | ||
403 | if File.File_Size = -1 then | |
404 | File.Last_Op := Op_Other; | |
405 | ||
d1e0e148 | 406 | if fseek64 (File.Stream, 0, SEEK_END) /= 0 then |
d23b8f57 RK |
407 | raise Device_Error; |
408 | end if; | |
409 | ||
d1e0e148 AC |
410 | File.File_Size := Stream_Element_Offset (ftell64 (File.Stream)); |
411 | ||
412 | if File.File_Size = -1 then | |
413 | raise Use_Error; | |
e9f80612 | 414 | end if; |
d23b8f57 RK |
415 | end if; |
416 | ||
417 | return Count (File.File_Size); | |
418 | end Size; | |
419 | ||
420 | ------------ | |
421 | -- Stream -- | |
422 | ------------ | |
423 | ||
0ae9f22f | 424 | function Stream (File : File_Type) return Stream_Access is |
d23b8f57 RK |
425 | begin |
426 | FIO.Check_File_Open (AP (File)); | |
427 | return Stream_Access (File); | |
428 | end Stream; | |
429 | ||
430 | ----------- | |
431 | -- Write -- | |
432 | ----------- | |
433 | ||
434 | procedure Write | |
0ae9f22f RD |
435 | (File : File_Type; |
436 | Item : Stream_Element_Array; | |
437 | To : Positive_Count) | |
d23b8f57 RK |
438 | is |
439 | begin | |
440 | Set_Index (File, To); | |
441 | Write (File, Item); | |
442 | end Write; | |
443 | ||
0ae9f22f RD |
444 | procedure Write |
445 | (File : File_Type; | |
446 | Item : Stream_Element_Array) | |
447 | is | |
d23b8f57 RK |
448 | begin |
449 | FIO.Check_Write_Status (AP (File)); | |
450 | ||
451 | -- If last operation was not a write, or if in file sharing mode, | |
452 | -- then reset the physical pointer of the file to match the index | |
453 | -- We lock out task access over the two operations in this case. | |
454 | ||
455 | if File.Last_Op /= Op_Write | |
456 | or else File.Shared_Status = FCB.Yes | |
457 | then | |
458 | Locked_Processing : begin | |
459 | SSL.Lock_Task.all; | |
460 | Set_Position (File); | |
461 | FIO.Write_Buf (AP (File), Item'Address, Item'Length); | |
462 | SSL.Unlock_Task.all; | |
463 | ||
464 | exception | |
465 | when others => | |
466 | SSL.Unlock_Task.all; | |
467 | raise; | |
468 | end Locked_Processing; | |
469 | ||
470 | else | |
471 | FIO.Write_Buf (AP (File), Item'Address, Item'Length); | |
472 | end if; | |
473 | ||
474 | File.Index := File.Index + Item'Length; | |
475 | File.Last_Op := Op_Write; | |
476 | File.File_Size := -1; | |
477 | end Write; | |
478 | ||
479 | -- This version of Write is the primitive operation on the underlying | |
480 | -- Stream type, used when a Stream_IO file is treated as a Stream | |
481 | ||
482 | procedure Write | |
483 | (File : in out Stream_AFCB; | |
0ae9f22f | 484 | Item : Ada.Streams.Stream_Element_Array) |
d23b8f57 RK |
485 | is |
486 | begin | |
487 | Write (File'Unchecked_Access, Item); | |
488 | end Write; | |
489 | ||
490 | end Ada.Streams.Stream_IO; |