1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . S T R E A M S . S T R E A M _ I O --
9 -- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Interfaces.C_Streams; use Interfaces.C_Streams;
34 with System; use System;
35 with System.Communication; use System.Communication;
37 with System.Soft_Links;
40 with Ada.Unchecked_Conversion;
41 with Ada.Unchecked_Deallocation;
43 package body Ada.Streams.Stream_IO is
45 package FIO renames System.File_IO;
46 package SSL renames System.Soft_Links;
48 subtype AP is FCB.AFCB_Ptr;
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;
55 -----------------------
56 -- Local Subprograms --
57 -----------------------
59 procedure Set_Position (File : File_Type);
60 -- Sets file position pointer according to value of current index
66 function AFCB_Allocate (Control_Block : Stream_AFCB) return FCB.AFCB_Ptr is
67 pragma Warnings (Off, Control_Block);
69 return new Stream_AFCB;
76 -- No special processing required for closing Stream_IO file
78 procedure AFCB_Close (File : not null access Stream_AFCB) is
79 pragma Warnings (Off, File);
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);
92 procedure Free is new Ada.Unchecked_Deallocation (Stream_AFCB, FCB_Ptr);
102 procedure Close (File : in out File_Type) is
104 FIO.Close (AP (File)'Unrestricted_Access);
112 (File : in out File_Type;
113 Mode : File_Mode := Out_File;
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.
123 FIO.Open (File_Ptr => AP (File),
124 Dummy_FCB => Dummy_File_Control_Block,
125 Mode => To_FCB (Mode),
131 File.Last_Op := Op_Write;
138 procedure Delete (File : in out File_Type) is
140 FIO.Delete (AP (File)'Unrestricted_Access);
147 function End_Of_File (File : File_Type) return Boolean is
149 FIO.Check_Read_Status (AP (File));
150 return File.Index > Size (File);
157 procedure Flush (File : File_Type) is
159 FIO.Flush (AP (File));
166 function Form (File : File_Type) return String is
168 return FIO.Form (AP (File));
175 function Index (File : File_Type) return Positive_Count is
177 FIO.Check_File_Open (AP (File));
185 function Is_Open (File : File_Type) return Boolean is
187 return FIO.Is_Open (AP (File));
194 function Mode (File : File_Type) return File_Mode is
196 return To_SIO (FIO.Mode (AP (File)));
203 function Name (File : File_Type) return String is
205 return FIO.Name (AP (File));
213 (File : in out File_Type;
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.
224 FIO.Open (File_Ptr => AP (File),
225 Dummy_FCB => Dummy_File_Control_Block,
226 Mode => To_FCB (Mode),
233 -- Ensure that the stream index is set properly (e.g., for Append_File)
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.
245 File.Last_Op := (if Mode = Out_File then Op_Write else Op_Read);
254 Item : out Stream_Element_Array;
255 Last : out Stream_Element_Offset;
256 From : Positive_Count)
259 Set_Index (File, From);
260 Read (File, Item, Last);
265 Item : out Stream_Element_Array;
266 Last : out Stream_Element_Offset)
271 FIO.Check_Read_Status (AP (File));
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.
277 if File.Last_Op /= Op_Read
278 or else File.Shared_Status = FCB.Yes
280 Locked_Processing : begin
283 FIO.Read_Buf (AP (File), Item'Address, Item'Length, Nread);
290 end Locked_Processing;
293 FIO.Read_Buf (AP (File), Item'Address, Item'Length, Nread);
296 File.Index := File.Index + Count (Nread);
297 File.Last_Op := Op_Read;
298 Last := Last_Index (Item'First, Nread);
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
305 (File : in out Stream_AFCB;
306 Item : out Ada.Streams.Stream_Element_Array;
307 Last : out Ada.Streams.Stream_Element_Offset)
310 Read (File'Unchecked_Access, Item, Last);
317 procedure Reset (File : in out File_Type; Mode : File_Mode) is
319 FIO.Check_File_Open (AP (File));
321 -- Reset file index to start of file for read/write cases. For
322 -- the append case, the Set_Mode call repositions the index.
325 Set_Mode (File, Mode);
328 procedure Reset (File : in out File_Type) is
330 Reset (File, To_SIO (File.Mode));
337 procedure Set_Index (File : File_Type; To : Positive_Count) is
339 FIO.Check_File_Open (AP (File));
340 File.Index := Count (To);
341 File.Last_Op := Op_Other;
348 procedure Set_Mode (File : in out File_Type; Mode : File_Mode) is
350 FIO.Check_File_Open (AP (File));
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.
357 if ((File.Mode = FCB.In_File) /= (Mode = In_File))
358 and then not File.Update_Mode
360 FIO.Reset (AP (File)'Unrestricted_Access, FCB.Inout_File);
361 File.Update_Mode := True;
364 -- Set required mode and position to end of file if append mode
366 File.Mode := To_FCB (Mode);
367 FIO.Append_Set (AP (File));
369 if File.Mode = FCB.Append_File then
370 pragma Warnings (Off, "*condition is always*");
371 if Standard'Address_Size = 64 then
372 File.Index := Count (ftell64 (File.Stream)) + 1;
374 File.Index := Count (ftell (File.Stream)) + 1;
376 pragma Warnings (On, "*condition is always*");
379 File.Last_Op := Op_Other;
386 procedure Set_Position (File : File_Type) is
387 use type System.CRTL.long;
388 use type System.CRTL.ssize_t;
391 pragma Warnings (Off, "*condition is always*");
392 if Standard'Address_Size = 64 then
393 R := fseek64 (File.Stream,
394 System.CRTL.ssize_t (File.Index) - 1, SEEK_SET);
396 R := fseek (File.Stream,
397 System.CRTL.long (File.Index) - 1, SEEK_SET);
399 pragma Warnings (On, "*condition is always*");
410 function Size (File : File_Type) return Count is
412 FIO.Check_File_Open (AP (File));
414 if File.File_Size = -1 then
415 File.Last_Op := Op_Other;
417 if fseek (File.Stream, 0, SEEK_END) /= 0 then
421 pragma Warnings (Off, "*condition is always*");
422 if Standard'Address_Size = 64 then
423 File.File_Size := Stream_Element_Offset (ftell64 (File.Stream));
425 File.File_Size := Stream_Element_Offset (ftell (File.Stream));
427 pragma Warnings (On, "*condition is always*");
430 return Count (File.File_Size);
437 function Stream (File : File_Type) return Stream_Access is
439 FIO.Check_File_Open (AP (File));
440 return Stream_Access (File);
449 Item : Stream_Element_Array;
453 Set_Index (File, To);
459 Item : Stream_Element_Array)
462 FIO.Check_Write_Status (AP (File));
464 -- If last operation was not a write, or if in file sharing mode,
465 -- then reset the physical pointer of the file to match the index
466 -- We lock out task access over the two operations in this case.
468 if File.Last_Op /= Op_Write
469 or else File.Shared_Status = FCB.Yes
471 Locked_Processing : begin
474 FIO.Write_Buf (AP (File), Item'Address, Item'Length);
481 end Locked_Processing;
484 FIO.Write_Buf (AP (File), Item'Address, Item'Length);
487 File.Index := File.Index + Item'Length;
488 File.Last_Op := Op_Write;
489 File.File_Size := -1;
492 -- This version of Write is the primitive operation on the underlying
493 -- Stream type, used when a Stream_IO file is treated as a Stream
496 (File : in out Stream_AFCB;
497 Item : Ada.Streams.Stream_Element_Array)
500 Write (File'Unchecked_Access, Item);
503 end Ada.Streams.Stream_IO;