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-2009, 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
;
36 with System
.Soft_Links
;
39 with Ada
.Unchecked_Conversion
;
40 with Ada
.Unchecked_Deallocation
;
42 package body Ada
.Streams
.Stream_IO
is
44 package FIO
renames System
.File_IO
;
45 package SSL
renames System
.Soft_Links
;
47 subtype AP
is FCB
.AFCB_Ptr
;
49 function To_FCB
is new Ada
.Unchecked_Conversion
(File_Mode
, FCB
.File_Mode
);
50 function To_SIO
is new Ada
.Unchecked_Conversion
(FCB
.File_Mode
, File_Mode
);
51 use type FCB
.File_Mode
;
52 use type FCB
.Shared_Status_Type
;
54 -----------------------
55 -- Local Subprograms --
56 -----------------------
58 procedure Set_Position
(File
: File_Type
);
59 -- Sets file position pointer according to value of current index
65 function AFCB_Allocate
(Control_Block
: Stream_AFCB
) return FCB
.AFCB_Ptr
is
66 pragma Warnings
(Off
, Control_Block
);
68 return new Stream_AFCB
;
75 -- No special processing required for closing Stream_IO file
77 procedure AFCB_Close
(File
: not null access Stream_AFCB
) is
78 pragma Warnings
(Off
, File
);
87 procedure AFCB_Free
(File
: not null access Stream_AFCB
) is
88 type FCB_Ptr
is access all Stream_AFCB
;
89 FT
: FCB_Ptr
:= FCB_Ptr
(File
);
91 procedure Free
is new Ada
.Unchecked_Deallocation
(Stream_AFCB
, FCB_Ptr
);
101 procedure Close
(File
: in out File_Type
) is
103 FIO
.Close
(AP
(File
)'Unrestricted_Access);
111 (File
: in out File_Type
;
112 Mode
: File_Mode
:= Out_File
;
116 Dummy_File_Control_Block
: Stream_AFCB
;
117 pragma Warnings
(Off
, Dummy_File_Control_Block
);
118 -- Yes, we know this is never assigned a value, only the tag
119 -- is used for dispatching purposes, so that's expected.
122 FIO
.Open
(File_Ptr
=> AP
(File
),
123 Dummy_FCB
=> Dummy_File_Control_Block
,
124 Mode
=> To_FCB
(Mode
),
130 File
.Last_Op
:= Op_Write
;
137 procedure Delete
(File
: in out File_Type
) is
139 FIO
.Delete
(AP
(File
)'Unrestricted_Access);
146 function End_Of_File
(File
: File_Type
) return Boolean is
148 FIO
.Check_Read_Status
(AP
(File
));
149 return Count
(File
.Index
) > Size
(File
);
156 procedure Flush
(File
: File_Type
) is
158 FIO
.Flush
(AP
(File
));
165 function Form
(File
: File_Type
) return String is
167 return FIO
.Form
(AP
(File
));
174 function Index
(File
: File_Type
) return Positive_Count
is
176 FIO
.Check_File_Open
(AP
(File
));
177 return Count
(File
.Index
);
184 function Is_Open
(File
: File_Type
) return Boolean is
186 return FIO
.Is_Open
(AP
(File
));
193 function Mode
(File
: File_Type
) return File_Mode
is
195 return To_SIO
(FIO
.Mode
(AP
(File
)));
202 function Name
(File
: File_Type
) return String is
204 return FIO
.Name
(AP
(File
));
212 (File
: in out File_Type
;
217 Dummy_File_Control_Block
: Stream_AFCB
;
218 pragma Warnings
(Off
, Dummy_File_Control_Block
);
219 -- Yes, we know this is never assigned a value, only the tag
220 -- is used for dispatching purposes, so that's expected.
223 FIO
.Open
(File_Ptr
=> AP
(File
),
224 Dummy_FCB
=> Dummy_File_Control_Block
,
225 Mode
=> To_FCB
(Mode
),
232 -- Ensure that the stream index is set properly (e.g., for Append_File)
236 -- Set last operation. The purpose here is to ensure proper handling
237 -- of the initial operation. In general, a write after a read requires
238 -- resetting and doing a seek, so we set the last operation as Read
239 -- for an In_Out file, but for an Out file we set the last operation
240 -- to Op_Write, since in this case it is not necessary to do a seek
241 -- (and furthermore there are situations (such as the case of writing
242 -- a sequential Posix FIFO file) where the lseek would cause problems.
244 if Mode
= Out_File
then
245 File
.Last_Op
:= Op_Write
;
247 File
.Last_Op
:= Op_Read
;
257 Item
: out Stream_Element_Array
;
258 Last
: out Stream_Element_Offset
;
259 From
: Positive_Count
)
262 Set_Index
(File
, From
);
263 Read
(File
, Item
, Last
);
268 Item
: out Stream_Element_Array
;
269 Last
: out Stream_Element_Offset
)
274 FIO
.Check_Read_Status
(AP
(File
));
276 -- If last operation was not a read, or if in file sharing mode,
277 -- then reset the physical pointer of the file to match the index
278 -- We lock out task access over the two operations in this case.
280 if File
.Last_Op
/= Op_Read
281 or else File
.Shared_Status
= FCB
.Yes
283 Locked_Processing
: begin
286 FIO
.Read_Buf
(AP
(File
), Item
'Address, Item
'Length, Nread
);
293 end Locked_Processing
;
296 FIO
.Read_Buf
(AP
(File
), Item
'Address, Item
'Length, Nread
);
299 File
.Index
:= File
.Index
+ Count
(Nread
);
300 Last
:= Item
'First + Stream_Element_Offset
(Nread
) - 1;
301 File
.Last_Op
:= Op_Read
;
304 -- This version of Read is the primitive operation on the underlying
305 -- Stream type, used when a Stream_IO file is treated as a Stream
308 (File
: in out Stream_AFCB
;
309 Item
: out Ada
.Streams
.Stream_Element_Array
;
310 Last
: out Ada
.Streams
.Stream_Element_Offset
)
313 Read
(File
'Unchecked_Access, Item
, Last
);
320 procedure Reset
(File
: in out File_Type
; Mode
: File_Mode
) is
322 FIO
.Check_File_Open
(AP
(File
));
324 -- Reset file index to start of file for read/write cases. For
325 -- the append case, the Set_Mode call repositions the index.
328 Set_Mode
(File
, Mode
);
331 procedure Reset
(File
: in out File_Type
) is
333 Reset
(File
, To_SIO
(File
.Mode
));
340 procedure Set_Index
(File
: File_Type
; To
: Positive_Count
) is
342 FIO
.Check_File_Open
(AP
(File
));
343 File
.Index
:= Count
(To
);
344 File
.Last_Op
:= Op_Other
;
351 procedure Set_Mode
(File
: in out File_Type
; Mode
: File_Mode
) is
353 FIO
.Check_File_Open
(AP
(File
));
355 -- If we are switching from read to write, or vice versa, and
356 -- we are not already open in update mode, then reopen in update
357 -- mode now. Note that we can use Inout_File as the mode for the
358 -- call since File_IO handles all modes for all file types.
360 if ((File
.Mode
= FCB
.In_File
) /= (Mode
= In_File
))
361 and then not File
.Update_Mode
363 FIO
.Reset
(AP
(File
)'Unrestricted_Access, FCB
.Inout_File
);
364 File
.Update_Mode
:= True;
367 -- Set required mode and position to end of file if append mode
369 File
.Mode
:= To_FCB
(Mode
);
370 FIO
.Append_Set
(AP
(File
));
372 if File
.Mode
= FCB
.Append_File
then
373 File
.Index
:= Count
(ftell
(File
.Stream
)) + 1;
376 File
.Last_Op
:= Op_Other
;
383 procedure Set_Position
(File
: File_Type
) is
384 use type System
.CRTL
.long
;
386 if fseek
(File
.Stream
,
387 System
.CRTL
.long
(File
.Index
) - 1, SEEK_SET
) /= 0
397 function Size
(File
: File_Type
) return Count
is
399 FIO
.Check_File_Open
(AP
(File
));
401 if File
.File_Size
= -1 then
402 File
.Last_Op
:= Op_Other
;
404 if fseek
(File
.Stream
, 0, SEEK_END
) /= 0 then
408 File
.File_Size
:= Stream_Element_Offset
(ftell
(File
.Stream
));
411 return Count
(File
.File_Size
);
418 function Stream
(File
: File_Type
) return Stream_Access
is
420 FIO
.Check_File_Open
(AP
(File
));
421 return Stream_Access
(File
);
430 Item
: Stream_Element_Array
;
434 Set_Index
(File
, To
);
440 Item
: Stream_Element_Array
)
443 FIO
.Check_Write_Status
(AP
(File
));
445 -- If last operation was not a write, or if in file sharing mode,
446 -- then reset the physical pointer of the file to match the index
447 -- We lock out task access over the two operations in this case.
449 if File
.Last_Op
/= Op_Write
450 or else File
.Shared_Status
= FCB
.Yes
452 Locked_Processing
: begin
455 FIO
.Write_Buf
(AP
(File
), Item
'Address, Item
'Length);
462 end Locked_Processing
;
465 FIO
.Write_Buf
(AP
(File
), Item
'Address, Item
'Length);
468 File
.Index
:= File
.Index
+ Item
'Length;
469 File
.Last_Op
:= Op_Write
;
470 File
.File_Size
:= -1;
473 -- This version of Write is the primitive operation on the underlying
474 -- Stream type, used when a Stream_IO file is treated as a Stream
477 (File
: in out Stream_AFCB
;
478 Item
: Ada
.Streams
.Stream_Element_Array
)
481 Write
(File
'Unchecked_Access, Item
);
484 end Ada
.Streams
.Stream_IO
;