OSDN Git Service

PR 43839
[pf3gnuchains/gcc-fork.git] / libgfortran / io / file_pos.c
1 /* Copyright (C) 2002-2003, 2005, 2006, 2007, 2009 Free Software Foundation, Inc.
2    Contributed by Andy Vaught and Janne Blomqvist
3
4 This file is part of the GNU Fortran runtime library (libgfortran).
5
6 Libgfortran is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 3, or (at your option)
9 any later version.
10
11 Libgfortran is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14 GNU General Public License for more details.
15
16 Under Section 7 of GPL version 3, you are granted additional
17 permissions described in the GCC Runtime Library Exception, version
18 3.1, as published by the Free Software Foundation.
19
20 You should have received a copy of the GNU General Public License and
21 a copy of the GCC Runtime Library Exception along with this program;
22 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
23 <http://www.gnu.org/licenses/>.  */
24
25 #include "io.h"
26 #include "fbuf.h"
27 #include "unix.h"
28 #include <string.h>
29
30 /* file_pos.c-- Implement the file positioning statements, i.e. BACKSPACE,
31    ENDFILE, and REWIND as well as the FLUSH statement.  */
32
33
34 /* formatted_backspace(fpp, u)-- Move the file back one line.  The
35    current position is after the newline that terminates the previous
36    record, and we have to sift backwards to find the newline before
37    that or the start of the file, whichever comes first.  */
38
39 static const int READ_CHUNK = 4096;
40
41 static void
42 formatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
43 {
44   gfc_offset base;
45   char p[READ_CHUNK];
46   ssize_t n;
47
48   base = stell (u->s) - 1;
49
50   do
51     {
52       n = (base < READ_CHUNK) ? base : READ_CHUNK;
53       base -= n;
54       if (sseek (u->s, base, SEEK_SET) < 0)
55         goto io_error;
56       if (sread (u->s, p, n) != n)
57         goto io_error;
58
59       /* We have moved backwards from the current position, it should
60          not be possible to get a short read.  Because it is not
61          clear what to do about such thing, we ignore the possibility.  */
62
63       /* There is no memrchr() in the C library, so we have to do it
64          ourselves.  */
65
66       while (n > 0)
67         {
68           n--;
69           if (p[n] == '\n')
70             {
71               base += n + 1;
72               goto done;
73             }
74         }
75
76     }
77   while (base != 0);
78
79   /* base is the new pointer.  Seek to it exactly.  */
80  done:
81   if (sseek (u->s, base, SEEK_SET) < 0)
82     goto io_error;
83   u->last_record--;
84   u->endfile = NO_ENDFILE;
85
86   return;
87
88  io_error:
89   generate_error (&fpp->common, LIBERROR_OS, NULL);
90 }
91
92
93 /* unformatted_backspace(fpp) -- Move the file backwards for an unformatted
94    sequential file.  We are guaranteed to be between records on entry and 
95    we have to shift to the previous record.  Loop over subrecords.  */
96
97 static void
98 unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
99 {
100   gfc_offset m, slen;
101   GFC_INTEGER_4 m4;
102   GFC_INTEGER_8 m8;
103   ssize_t length;
104   int continued;
105   char p[sizeof (GFC_INTEGER_8)];
106
107   if (compile_options.record_marker == 0)
108     length = sizeof (GFC_INTEGER_4);
109   else
110     length = compile_options.record_marker;
111
112   do
113     {
114       slen = - (gfc_offset) length;
115       if (sseek (u->s, slen, SEEK_CUR) < 0)
116         goto io_error;
117       if (sread (u->s, p, length) != length)
118         goto io_error;
119
120       /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here.  */
121       if (likely (u->flags.convert == GFC_CONVERT_NATIVE))
122         {
123           switch (length)
124             {
125             case sizeof(GFC_INTEGER_4):
126               memcpy (&m4, p, sizeof (m4));
127               m = m4;
128               break;
129
130             case sizeof(GFC_INTEGER_8):
131               memcpy (&m8, p, sizeof (m8));
132               m = m8;
133               break;
134
135             default:
136               runtime_error ("Illegal value for record marker");
137               break;
138             }
139         }
140       else
141         {
142           switch (length)
143             {
144             case sizeof(GFC_INTEGER_4):
145               reverse_memcpy (&m4, p, sizeof (m4));
146               m = m4;
147               break;
148
149             case sizeof(GFC_INTEGER_8):
150               reverse_memcpy (&m8, p, sizeof (m8));
151               m = m8;
152               break;
153
154             default:
155               runtime_error ("Illegal value for record marker");
156               break;
157             }
158
159         }
160
161       continued = m < 0;
162       if (continued)
163         m = -m;
164
165       if (sseek (u->s, -m -2 * length, SEEK_CUR) < 0)
166         goto io_error;
167     } while (continued);
168
169   u->last_record--;
170   return;
171
172  io_error:
173   generate_error (&fpp->common, LIBERROR_OS, NULL);
174 }
175
176
177 extern void st_backspace (st_parameter_filepos *);
178 export_proto(st_backspace);
179
180 void
181 st_backspace (st_parameter_filepos *fpp)
182 {
183   gfc_unit *u;
184
185   library_start (&fpp->common);
186
187   u = find_unit (fpp->common.unit);
188   if (u == NULL)
189     {
190       generate_error (&fpp->common, LIBERROR_BAD_UNIT, NULL);
191       goto done;
192     }
193
194   /* Direct access is prohibited, and so is unformatted stream access.  */
195
196
197   if (u->flags.access == ACCESS_DIRECT)
198     {
199       generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
200                       "Cannot BACKSPACE a file opened for DIRECT access");
201       goto done;
202     }
203
204   if (u->flags.access == ACCESS_STREAM && u->flags.form == FORM_UNFORMATTED)
205     {
206       generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
207                       "Cannot BACKSPACE an unformatted stream file");
208       goto done;
209     }
210
211   /* Make sure format buffer is flushed and reset.  */
212   if (u->flags.form == FORM_FORMATTED)
213     {
214       int pos = fbuf_reset (u);
215       if (pos != 0)
216         sseek (u->s, pos, SEEK_CUR);
217     }
218
219   
220   /* Check for special cases involving the ENDFILE record first.  */
221
222   if (u->endfile == AFTER_ENDFILE)
223     {
224       u->endfile = AT_ENDFILE;
225       u->flags.position = POSITION_APPEND;
226       sflush (u->s);
227     }
228   else
229     {
230       if (stell (u->s) == 0)
231         {
232           u->flags.position = POSITION_REWIND;
233           goto done;            /* Common special case */
234         }
235
236       if (u->mode == WRITING)
237         {
238           /* If there are previously written bytes from a write with
239              ADVANCE="no", add a record marker before performing the
240              BACKSPACE.  */
241
242           if (u->previous_nonadvancing_write)
243             finish_last_advance_record (u);
244
245           u->previous_nonadvancing_write = 0;
246
247           unit_truncate (u, stell (u->s), &fpp->common);
248           u->mode = READING;
249         }
250
251       if (u->flags.form == FORM_FORMATTED)
252         formatted_backspace (fpp, u);
253       else
254         unformatted_backspace (fpp, u);
255
256       u->flags.position = POSITION_UNSPECIFIED;
257       u->endfile = NO_ENDFILE;
258       u->current_record = 0;
259       u->bytes_left = 0;
260     }
261
262  done:
263   if (u != NULL)
264     unlock_unit (u);
265
266   library_end ();
267 }
268
269
270 extern void st_endfile (st_parameter_filepos *);
271 export_proto(st_endfile);
272
273 void
274 st_endfile (st_parameter_filepos *fpp)
275 {
276   gfc_unit *u;
277
278   library_start (&fpp->common);
279
280   u = find_unit (fpp->common.unit);
281   if (u != NULL)
282     {
283       if (u->flags.access == ACCESS_DIRECT)
284         {
285           generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
286                           "Cannot perform ENDFILE on a file opened"
287                           " for DIRECT access");
288           goto done;
289         }
290
291       /* If there are previously written bytes from a write with ADVANCE="no",
292          add a record marker before performing the ENDFILE.  */
293
294       if (u->previous_nonadvancing_write)
295         finish_last_advance_record (u);
296
297       u->previous_nonadvancing_write = 0;
298
299       if (u->current_record)
300         {
301           st_parameter_dt dtp;
302           dtp.common = fpp->common;
303           memset (&dtp.u.p, 0, sizeof (dtp.u.p));
304           dtp.u.p.current_unit = u;
305           next_record (&dtp, 1);
306         }
307
308       unit_truncate (u, stell (u->s), &fpp->common);
309       u->endfile = AFTER_ENDFILE;
310       if (0 == stell (u->s))
311         u->flags.position = POSITION_REWIND;
312     done:
313       unlock_unit (u);
314     }
315
316   library_end ();
317 }
318
319
320 extern void st_rewind (st_parameter_filepos *);
321 export_proto(st_rewind);
322
323 void
324 st_rewind (st_parameter_filepos *fpp)
325 {
326   gfc_unit *u;
327
328   library_start (&fpp->common);
329
330   u = find_unit (fpp->common.unit);
331   if (u != NULL)
332     {
333       if (u->flags.access == ACCESS_DIRECT)
334         generate_error (&fpp->common, LIBERROR_BAD_OPTION,
335                         "Cannot REWIND a file opened for DIRECT access");
336       else
337         {
338           /* If there are previously written bytes from a write with ADVANCE="no",
339              add a record marker before performing the ENDFILE.  */
340
341           if (u->previous_nonadvancing_write)
342             finish_last_advance_record (u);
343
344           u->previous_nonadvancing_write = 0;
345
346           fbuf_reset (u);
347
348           u->last_record = 0;
349
350           if (sseek (u->s, 0, SEEK_SET) < 0)
351             generate_error (&fpp->common, LIBERROR_OS, NULL);
352
353           /* Handle special files like /dev/null differently.  */
354           if (!is_special (u->s))
355             {
356               /* We are rewinding so we are not at the end.  */
357               u->endfile = NO_ENDFILE;
358             }
359           else
360             {
361               /* Set this for compatibilty with g77 for /dev/null.  */
362               if (file_length (u->s) == 0  && stell (u->s) == 0)
363                 u->endfile = AT_ENDFILE;
364               /* Future refinements on special files can go here.  */
365             }
366
367           u->current_record = 0;
368           u->strm_pos = 1;
369           u->read_bad = 0;
370         }
371       /* Update position for INQUIRE.  */
372       u->flags.position = POSITION_REWIND;
373       unlock_unit (u);
374     }
375
376   library_end ();
377 }
378
379
380 extern void st_flush (st_parameter_filepos *);
381 export_proto(st_flush);
382
383 void
384 st_flush (st_parameter_filepos *fpp)
385 {
386   gfc_unit *u;
387
388   library_start (&fpp->common);
389
390   u = find_unit (fpp->common.unit);
391   if (u != NULL)
392     {
393       /* Make sure format buffer is flushed.  */
394       if (u->flags.form == FORM_FORMATTED)
395         fbuf_flush (u, u->mode);
396
397       sflush (u->s);
398       unlock_unit (u);
399     }
400   else
401     /* FLUSH on unconnected unit is illegal: F95 std., 9.3.5. */ 
402     generate_error (&fpp->common, LIBERROR_BAD_OPTION,
403                         "Specified UNIT in FLUSH is not connected");
404
405   library_end ();
406 }