]>
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 | -- -- | |
748086b7 | 9 | -- Copyright (C) 1992-2009, 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 | ||
0ae9f22f RD |
32 | with Interfaces.C_Streams; use Interfaces.C_Streams; |
33 | ||
34 | with System; use System; | |
d23b8f57 RK |
35 | with System.File_IO; |
36 | with System.Soft_Links; | |
209db2bf | 37 | with System.CRTL; |
0ae9f22f | 38 | |
cecaf88a RD |
39 | with Ada.Unchecked_Conversion; |
40 | with Ada.Unchecked_Deallocation; | |
d23b8f57 RK |
41 | |
42 | package body Ada.Streams.Stream_IO is | |
43 | ||
44 | package FIO renames System.File_IO; | |
45 | package SSL renames System.Soft_Links; | |
46 | ||
47 | subtype AP is FCB.AFCB_Ptr; | |
48 | ||
cecaf88a RD |
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); | |
d23b8f57 RK |
51 | use type FCB.File_Mode; |
52 | use type FCB.Shared_Status_Type; | |
53 | ||
54 | ----------------------- | |
55 | -- Local Subprograms -- | |
56 | ----------------------- | |
57 | ||
0ae9f22f | 58 | procedure Set_Position (File : File_Type); |
d23b8f57 RK |
59 | -- Sets file position pointer according to value of current index |
60 | ||
61 | ------------------- | |
62 | -- AFCB_Allocate -- | |
63 | ------------------- | |
64 | ||
65 | function AFCB_Allocate (Control_Block : Stream_AFCB) return FCB.AFCB_Ptr is | |
07fc65c4 | 66 | pragma Warnings (Off, Control_Block); |
d23b8f57 RK |
67 | begin |
68 | return new Stream_AFCB; | |
69 | end AFCB_Allocate; | |
70 | ||
71 | ---------------- | |
72 | -- AFCB_Close -- | |
73 | ---------------- | |
74 | ||
75 | -- No special processing required for closing Stream_IO file | |
76 | ||
d90e94c7 | 77 | procedure AFCB_Close (File : not null access Stream_AFCB) is |
07fc65c4 | 78 | pragma Warnings (Off, File); |
d23b8f57 RK |
79 | begin |
80 | null; | |
81 | end AFCB_Close; | |
82 | ||
83 | --------------- | |
84 | -- AFCB_Free -- | |
85 | --------------- | |
86 | ||
d90e94c7 | 87 | procedure AFCB_Free (File : not null access Stream_AFCB) is |
d23b8f57 RK |
88 | type FCB_Ptr is access all Stream_AFCB; |
89 | FT : FCB_Ptr := FCB_Ptr (File); | |
90 | ||
cecaf88a | 91 | procedure Free is new Ada.Unchecked_Deallocation (Stream_AFCB, FCB_Ptr); |
d23b8f57 RK |
92 | |
93 | begin | |
94 | Free (FT); | |
95 | end AFCB_Free; | |
96 | ||
97 | ----------- | |
98 | -- Close -- | |
99 | ----------- | |
100 | ||
101 | procedure Close (File : in out File_Type) is | |
102 | begin | |
07736171 | 103 | FIO.Close (AP (File)'Unrestricted_Access); |
d23b8f57 RK |
104 | end Close; |
105 | ||
106 | ------------ | |
107 | -- Create -- | |
108 | ------------ | |
109 | ||
110 | procedure Create | |
111 | (File : in out File_Type; | |
0ae9f22f RD |
112 | Mode : File_Mode := Out_File; |
113 | Name : String := ""; | |
114 | Form : String := "") | |
d23b8f57 | 115 | is |
fbf5a39b AC |
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. | |
d23b8f57 RK |
120 | |
121 | begin | |
122 | FIO.Open (File_Ptr => AP (File), | |
fbf5a39b | 123 | Dummy_FCB => Dummy_File_Control_Block, |
d23b8f57 RK |
124 | Mode => To_FCB (Mode), |
125 | Name => Name, | |
126 | Form => Form, | |
127 | Amethod => 'S', | |
128 | Creat => True, | |
129 | Text => False); | |
130 | File.Last_Op := Op_Write; | |
131 | end Create; | |
132 | ||
133 | ------------ | |
134 | -- Delete -- | |
135 | ------------ | |
136 | ||
137 | procedure Delete (File : in out File_Type) is | |
138 | begin | |
07736171 | 139 | FIO.Delete (AP (File)'Unrestricted_Access); |
d23b8f57 RK |
140 | end Delete; |
141 | ||
142 | ----------------- | |
143 | -- End_Of_File -- | |
144 | ----------------- | |
145 | ||
0ae9f22f | 146 | function End_Of_File (File : File_Type) return Boolean is |
d23b8f57 RK |
147 | begin |
148 | FIO.Check_Read_Status (AP (File)); | |
149 | return Count (File.Index) > Size (File); | |
150 | end End_Of_File; | |
151 | ||
152 | ----------- | |
153 | -- Flush -- | |
154 | ----------- | |
155 | ||
07fc65c4 | 156 | procedure Flush (File : File_Type) is |
d23b8f57 RK |
157 | begin |
158 | FIO.Flush (AP (File)); | |
159 | end Flush; | |
160 | ||
161 | ---------- | |
162 | -- Form -- | |
163 | ---------- | |
164 | ||
0ae9f22f | 165 | function Form (File : File_Type) return String is |
d23b8f57 RK |
166 | begin |
167 | return FIO.Form (AP (File)); | |
168 | end Form; | |
169 | ||
170 | ----------- | |
171 | -- Index -- | |
172 | ----------- | |
173 | ||
0ae9f22f | 174 | function Index (File : File_Type) return Positive_Count is |
d23b8f57 RK |
175 | begin |
176 | FIO.Check_File_Open (AP (File)); | |
177 | return Count (File.Index); | |
178 | end Index; | |
179 | ||
180 | ------------- | |
181 | -- Is_Open -- | |
182 | ------------- | |
183 | ||
0ae9f22f | 184 | function Is_Open (File : File_Type) return Boolean is |
d23b8f57 RK |
185 | begin |
186 | return FIO.Is_Open (AP (File)); | |
187 | end Is_Open; | |
188 | ||
189 | ---------- | |
190 | -- Mode -- | |
191 | ---------- | |
192 | ||
0ae9f22f | 193 | function Mode (File : File_Type) return File_Mode is |
d23b8f57 RK |
194 | begin |
195 | return To_SIO (FIO.Mode (AP (File))); | |
196 | end Mode; | |
197 | ||
198 | ---------- | |
199 | -- Name -- | |
200 | ---------- | |
201 | ||
0ae9f22f | 202 | function Name (File : File_Type) return String is |
d23b8f57 RK |
203 | begin |
204 | return FIO.Name (AP (File)); | |
205 | end Name; | |
206 | ||
207 | ---------- | |
208 | -- Open -- | |
209 | ---------- | |
210 | ||
211 | procedure Open | |
212 | (File : in out File_Type; | |
0ae9f22f RD |
213 | Mode : File_Mode; |
214 | Name : String; | |
215 | Form : String := "") | |
d23b8f57 | 216 | is |
fbf5a39b AC |
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. | |
d23b8f57 RK |
221 | |
222 | begin | |
223 | FIO.Open (File_Ptr => AP (File), | |
fbf5a39b | 224 | Dummy_FCB => Dummy_File_Control_Block, |
d23b8f57 RK |
225 | Mode => To_FCB (Mode), |
226 | Name => Name, | |
227 | Form => Form, | |
228 | Amethod => 'S', | |
229 | Creat => False, | |
230 | Text => False); | |
231 | ||
232 | -- Ensure that the stream index is set properly (e.g., for Append_File) | |
233 | ||
234 | Reset (File, Mode); | |
235 | ||
fbf5a39b AC |
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. | |
243 | ||
244 | if Mode = Out_File then | |
245 | File.Last_Op := Op_Write; | |
246 | else | |
247 | File.Last_Op := Op_Read; | |
248 | end if; | |
d23b8f57 RK |
249 | end Open; |
250 | ||
251 | ---------- | |
252 | -- Read -- | |
253 | ---------- | |
254 | ||
255 | procedure Read | |
0ae9f22f | 256 | (File : File_Type; |
d23b8f57 RK |
257 | Item : out Stream_Element_Array; |
258 | Last : out Stream_Element_Offset; | |
0ae9f22f | 259 | From : Positive_Count) |
d23b8f57 RK |
260 | is |
261 | begin | |
262 | Set_Index (File, From); | |
263 | Read (File, Item, Last); | |
264 | end Read; | |
265 | ||
266 | procedure Read | |
0ae9f22f | 267 | (File : File_Type; |
d23b8f57 RK |
268 | Item : out Stream_Element_Array; |
269 | Last : out Stream_Element_Offset) | |
270 | is | |
271 | Nread : size_t; | |
272 | ||
273 | begin | |
274 | FIO.Check_Read_Status (AP (File)); | |
275 | ||
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. | |
279 | ||
280 | if File.Last_Op /= Op_Read | |
281 | or else File.Shared_Status = FCB.Yes | |
282 | then | |
d23b8f57 RK |
283 | Locked_Processing : begin |
284 | SSL.Lock_Task.all; | |
285 | Set_Position (File); | |
286 | FIO.Read_Buf (AP (File), Item'Address, Item'Length, Nread); | |
287 | SSL.Unlock_Task.all; | |
288 | ||
289 | exception | |
290 | when others => | |
291 | SSL.Unlock_Task.all; | |
292 | raise; | |
293 | end Locked_Processing; | |
294 | ||
295 | else | |
296 | FIO.Read_Buf (AP (File), Item'Address, Item'Length, Nread); | |
297 | end if; | |
298 | ||
299 | File.Index := File.Index + Count (Nread); | |
300 | Last := Item'First + Stream_Element_Offset (Nread) - 1; | |
301 | File.Last_Op := Op_Read; | |
302 | end Read; | |
303 | ||
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 | |
306 | ||
307 | procedure Read | |
308 | (File : in out Stream_AFCB; | |
309 | Item : out Ada.Streams.Stream_Element_Array; | |
310 | Last : out Ada.Streams.Stream_Element_Offset) | |
311 | is | |
312 | begin | |
313 | Read (File'Unchecked_Access, Item, Last); | |
314 | end Read; | |
315 | ||
316 | ----------- | |
317 | -- Reset -- | |
318 | ----------- | |
319 | ||
0ae9f22f | 320 | procedure Reset (File : in out File_Type; Mode : File_Mode) is |
d23b8f57 RK |
321 | begin |
322 | FIO.Check_File_Open (AP (File)); | |
323 | ||
324 | -- Reset file index to start of file for read/write cases. For | |
325 | -- the append case, the Set_Mode call repositions the index. | |
326 | ||
327 | File.Index := 1; | |
328 | Set_Mode (File, Mode); | |
329 | end Reset; | |
330 | ||
331 | procedure Reset (File : in out File_Type) is | |
332 | begin | |
333 | Reset (File, To_SIO (File.Mode)); | |
334 | end Reset; | |
335 | ||
336 | --------------- | |
337 | -- Set_Index -- | |
338 | --------------- | |
339 | ||
0ae9f22f | 340 | procedure Set_Index (File : File_Type; To : Positive_Count) is |
d23b8f57 RK |
341 | begin |
342 | FIO.Check_File_Open (AP (File)); | |
343 | File.Index := Count (To); | |
344 | File.Last_Op := Op_Other; | |
345 | end Set_Index; | |
346 | ||
347 | -------------- | |
348 | -- Set_Mode -- | |
349 | -------------- | |
350 | ||
0ae9f22f | 351 | procedure Set_Mode (File : in out File_Type; Mode : File_Mode) is |
d23b8f57 RK |
352 | begin |
353 | FIO.Check_File_Open (AP (File)); | |
354 | ||
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. | |
359 | ||
360 | if ((File.Mode = FCB.In_File) /= (Mode = In_File)) | |
361 | and then not File.Update_Mode | |
362 | then | |
07736171 | 363 | FIO.Reset (AP (File)'Unrestricted_Access, FCB.Inout_File); |
d23b8f57 RK |
364 | File.Update_Mode := True; |
365 | end if; | |
366 | ||
367 | -- Set required mode and position to end of file if append mode | |
368 | ||
369 | File.Mode := To_FCB (Mode); | |
370 | FIO.Append_Set (AP (File)); | |
371 | ||
372 | if File.Mode = FCB.Append_File then | |
373 | File.Index := Count (ftell (File.Stream)) + 1; | |
374 | end if; | |
375 | ||
376 | File.Last_Op := Op_Other; | |
377 | end Set_Mode; | |
378 | ||
379 | ------------------ | |
380 | -- Set_Position -- | |
381 | ------------------ | |
382 | ||
0ae9f22f | 383 | procedure Set_Position (File : File_Type) is |
209db2bf | 384 | use type System.CRTL.long; |
d23b8f57 | 385 | begin |
209db2bf AC |
386 | if fseek (File.Stream, |
387 | System.CRTL.long (File.Index) - 1, SEEK_SET) /= 0 | |
388 | then | |
d23b8f57 RK |
389 | raise Use_Error; |
390 | end if; | |
391 | end Set_Position; | |
392 | ||
393 | ---------- | |
394 | -- Size -- | |
395 | ---------- | |
396 | ||
0ae9f22f | 397 | function Size (File : File_Type) return Count is |
d23b8f57 RK |
398 | begin |
399 | FIO.Check_File_Open (AP (File)); | |
400 | ||
401 | if File.File_Size = -1 then | |
402 | File.Last_Op := Op_Other; | |
403 | ||
404 | if fseek (File.Stream, 0, SEEK_END) /= 0 then | |
405 | raise Device_Error; | |
406 | end if; | |
407 | ||
408 | File.File_Size := Stream_Element_Offset (ftell (File.Stream)); | |
409 | end if; | |
410 | ||
411 | return Count (File.File_Size); | |
412 | end Size; | |
413 | ||
414 | ------------ | |
415 | -- Stream -- | |
416 | ------------ | |
417 | ||
0ae9f22f | 418 | function Stream (File : File_Type) return Stream_Access is |
d23b8f57 RK |
419 | begin |
420 | FIO.Check_File_Open (AP (File)); | |
421 | return Stream_Access (File); | |
422 | end Stream; | |
423 | ||
424 | ----------- | |
425 | -- Write -- | |
426 | ----------- | |
427 | ||
428 | procedure Write | |
0ae9f22f RD |
429 | (File : File_Type; |
430 | Item : Stream_Element_Array; | |
431 | To : Positive_Count) | |
d23b8f57 RK |
432 | is |
433 | begin | |
434 | Set_Index (File, To); | |
435 | Write (File, Item); | |
436 | end Write; | |
437 | ||
0ae9f22f RD |
438 | procedure Write |
439 | (File : File_Type; | |
440 | Item : Stream_Element_Array) | |
441 | is | |
d23b8f57 RK |
442 | begin |
443 | FIO.Check_Write_Status (AP (File)); | |
444 | ||
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. | |
448 | ||
449 | if File.Last_Op /= Op_Write | |
450 | or else File.Shared_Status = FCB.Yes | |
451 | then | |
452 | Locked_Processing : begin | |
453 | SSL.Lock_Task.all; | |
454 | Set_Position (File); | |
455 | FIO.Write_Buf (AP (File), Item'Address, Item'Length); | |
456 | SSL.Unlock_Task.all; | |
457 | ||
458 | exception | |
459 | when others => | |
460 | SSL.Unlock_Task.all; | |
461 | raise; | |
462 | end Locked_Processing; | |
463 | ||
464 | else | |
465 | FIO.Write_Buf (AP (File), Item'Address, Item'Length); | |
466 | end if; | |
467 | ||
468 | File.Index := File.Index + Item'Length; | |
469 | File.Last_Op := Op_Write; | |
470 | File.File_Size := -1; | |
471 | end Write; | |
472 | ||
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 | |
475 | ||
476 | procedure Write | |
477 | (File : in out Stream_AFCB; | |
0ae9f22f | 478 | Item : Ada.Streams.Stream_Element_Array) |
d23b8f57 RK |
479 | is |
480 | begin | |
481 | Write (File'Unchecked_Access, Item); | |
482 | end Write; | |
483 | ||
484 | end Ada.Streams.Stream_IO; |