File : a-ststio.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
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 -- --
9 -- Copyright (C) 1992-2014, 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 -- --
19 -- --
20 -- --
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 with Interfaces.C_Streams; use Interfaces.C_Streams;
33
34 with System; use System;
35 with System.Communication; use System.Communication;
36 with System.File_IO;
37 with System.Soft_Links;
38 with System.CRTL;
39
40 with Ada.Unchecked_Conversion;
41 with Ada.Unchecked_Deallocation;
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
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);
52 use type FCB.File_Mode;
53 use type FCB.Shared_Status_Type;
54
55 -----------------------
56 -- Local Subprograms --
57 -----------------------
58
59 procedure Set_Position (File : File_Type);
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
67 pragma Warnings (Off, Control_Block);
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
78 procedure AFCB_Close (File : not null access Stream_AFCB) is
79 pragma Warnings (Off, File);
80 begin
81 null;
82 end AFCB_Close;
83
84 ---------------
85 -- AFCB_Free --
86 ---------------
87
88 procedure AFCB_Free (File : not null access Stream_AFCB) is
89 type FCB_Ptr is access all Stream_AFCB;
90 FT : FCB_Ptr := FCB_Ptr (File);
91
92 procedure Free is new Ada.Unchecked_Deallocation (Stream_AFCB, FCB_Ptr);
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
104 FIO.Close (AP (File)'Unrestricted_Access);
105 end Close;
106
107 ------------
108 -- Create --
109 ------------
110
111 procedure Create
112 (File : in out File_Type;
113 Mode : File_Mode := Out_File;
114 Name : String := "";
115 Form : String := "")
116 is
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.
121
122 begin
123 FIO.Open (File_Ptr => AP (File),
124 Dummy_FCB => Dummy_File_Control_Block,
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
140 FIO.Delete (AP (File)'Unrestricted_Access);
141 end Delete;
142
143 -----------------
144 -- End_Of_File --
145 -----------------
146
147 function End_Of_File (File : File_Type) return Boolean is
148 begin
149 FIO.Check_Read_Status (AP (File));
150 return File.Index > Size (File);
151 end End_Of_File;
152
153 -----------
154 -- Flush --
155 -----------
156
157 procedure Flush (File : File_Type) is
158 begin
159 FIO.Flush (AP (File));
160 end Flush;
161
162 ----------
163 -- Form --
164 ----------
165
166 function Form (File : File_Type) return String is
167 begin
168 return FIO.Form (AP (File));
169 end Form;
170
171 -----------
172 -- Index --
173 -----------
174
175 function Index (File : File_Type) return Positive_Count is
176 begin
177 FIO.Check_File_Open (AP (File));
178 return File.Index;
179 end Index;
180
181 -------------
182 -- Is_Open --
183 -------------
184
185 function Is_Open (File : File_Type) return Boolean is
186 begin
187 return FIO.Is_Open (AP (File));
188 end Is_Open;
189
190 ----------
191 -- Mode --
192 ----------
193
194 function Mode (File : File_Type) return File_Mode is
195 begin
196 return To_SIO (FIO.Mode (AP (File)));
197 end Mode;
198
199 ----------
200 -- Name --
201 ----------
202
203 function Name (File : File_Type) return String is
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;
214 Mode : File_Mode;
215 Name : String;
216 Form : String := "")
217 is
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.
222
223 begin
224 FIO.Open (File_Ptr => AP (File),
225 Dummy_FCB => Dummy_File_Control_Block,
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
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
245 File.Last_Op := (if Mode = Out_File then Op_Write else Op_Read);
246 end Open;
247
248 ----------
249 -- Read --
250 ----------
251
252 procedure Read
253 (File : File_Type;
254 Item : out Stream_Element_Array;
255 Last : out Stream_Element_Offset;
256 From : Positive_Count)
257 is
258 begin
259 Set_Index (File, From);
260 Read (File, Item, Last);
261 end Read;
262
263 procedure Read
264 (File : File_Type;
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
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);
297 File.Last_Op := Op_Read;
298 Last := Last_Index (Item'First, Nread);
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
317 procedure Reset (File : in out File_Type; Mode : File_Mode) is
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
337 procedure Set_Index (File : File_Type; To : Positive_Count) is
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
348 procedure Set_Mode (File : in out File_Type; Mode : File_Mode) is
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
360 FIO.Reset (AP (File)'Unrestricted_Access, FCB.Inout_File);
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
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;
375 end if;
376
377 File.Last_Op := Op_Other;
378 end Set_Mode;
379
380 ------------------
381 -- Set_Position --
382 ------------------
383
384 procedure Set_Position (File : File_Type) is
385 use type System.CRTL.int64;
386 R : int;
387 begin
388 R := fseek64 (File.Stream, System.CRTL.int64 (File.Index) - 1, SEEK_SET);
389
390 if R /= 0 then
391 raise Use_Error;
392 end if;
393 end Set_Position;
394
395 ----------
396 -- Size --
397 ----------
398
399 function Size (File : File_Type) return Count is
400 begin
401 FIO.Check_File_Open (AP (File));
402
403 if File.File_Size = -1 then
404 File.Last_Op := Op_Other;
405
406 if fseek64 (File.Stream, 0, SEEK_END) /= 0 then
407 raise Device_Error;
408 end if;
409
410 File.File_Size := Stream_Element_Offset (ftell64 (File.Stream));
411
412 if File.File_Size = -1 then
413 raise Use_Error;
414 end if;
415 end if;
416
417 return Count (File.File_Size);
418 end Size;
419
420 ------------
421 -- Stream --
422 ------------
423
424 function Stream (File : File_Type) return Stream_Access is
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
435 (File : File_Type;
436 Item : Stream_Element_Array;
437 To : Positive_Count)
438 is
439 begin
440 Set_Index (File, To);
441 Write (File, Item);
442 end Write;
443
444 procedure Write
445 (File : File_Type;
446 Item : Stream_Element_Array)
447 is
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;
484 Item : Ada.Streams.Stream_Element_Array)
485 is
486 begin
487 Write (File'Unchecked_Access, Item);
488 end Write;
489
490 end Ada.Streams.Stream_IO;