libgfortran/io/file_pos.c

   1 /* Copyright (C) 2002-2003, 2005, 2006, 2007 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 2, or (at your option)
   9 any later version.
  10
  11 In addition to the permissions in the GNU General Public License, the
  12 Free Software Foundation gives you unlimited permission to link the
  13 compiled version of this file into combinations with other programs,
  14 and to distribute those combinations without any restriction coming
  15 from the use of this file.  (The General Public License restrictions
  16 do apply in other respects; for example, they cover modification of
  17 the file, and distribution when not linked into a combine
  18 executable.)
  19
  20 Libgfortran is distributed in the hope that it will be useful,
  21 but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 GNU General Public License for more details.
  24
  25 You should have received a copy of the GNU General Public License
  26 along with Libgfortran; see the file COPYING.  If not, write to
  27 the Free Software Foundation, 51 Franklin Street, Fifth Floor,
  28 Boston, MA 02110-1301, USA.  */
  29
  30 #include "io.h"
  31 #include <string.h>
  32
  33 /* file_pos.c-- Implement the file positioning statements, i.e. BACKSPACE,
  34    ENDFILE, and REWIND as well as the FLUSH statement.  */
  35
  36
  37 /* formatted_backspace(fpp, u)-- Move the file back one line.  The
  38    current position is after the newline that terminates the previous
  39    record, and we have to sift backwards to find the newline before
  40    that or the start of the file, whichever comes first.  */
  41
  42 #define READ_CHUNK 4096
  43
  44 static void
  45 formatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
  46 {
  47   gfc_offset base;
  48   char *p;
  49   int n;
  50
  51   base = file_position (u->s) - 1;
  52
  53   do
  54     {
  55       n = (base < READ_CHUNK) ? base : READ_CHUNK;
  56       base -= n;
  57
  58       p = salloc_r_at (u->s, &n, base);
  59       if (p == NULL)
  60         goto io_error;
  61
  62       /* We have moved backwards from the current position, it should
  63          not be possible to get a short read.  Because it is not
  64          clear what to do about such thing, we ignore the possibility.  */
  65
  66       /* There is no memrchr() in the C library, so we have to do it
  67          ourselves.  */
  68
  69       n--;
  70       while (n >= 0)
  71         {
  72           if (p[n] == '\n')
  73             {
  74               base += n + 1;
  75               goto done;
  76             }
  77           n--;
  78         }
  79
  80     }
  81   while (base != 0);
  82
  83   /* base is the new pointer.  Seek to it exactly.  */
  84  done:
  85   if (sseek (u->s, base) == FAILURE)
  86     goto io_error;
  87   u->last_record--;
  88   u->endfile = NO_ENDFILE;
  89
  90   return;
  91
  92  io_error:
  93   generate_error (&fpp->common, LIBERROR_OS, NULL);
  94 }
  95
  96
  97 /* unformatted_backspace(fpp) -- Move the file backwards for an unformatted
  98    sequential file.  We are guaranteed to be between records on entry and
  99    we have to shift to the previous record.  Loop over subrecords.  */
 100
 101 static void
 102 unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
 103 {
 104   gfc_offset m, new;
 105   GFC_INTEGER_4 m4;
 106   GFC_INTEGER_8 m8;
 107   int length, length_read;
 108   int continued;
 109   char *p;
 110
 111   if (compile_options.record_marker == 0)
 112     length = sizeof (GFC_INTEGER_4);
 113   else
 114     length = compile_options.record_marker;
 115
 116   do
 117     {
 118       length_read = length;
 119
 120       p = salloc_r_at (u->s, &length_read,
 121                        file_position (u->s) - length);
 122       if (p == NULL || length_read != length)
 123         goto io_error;
 124
 125       /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here.  */
 126       if (u->flags.convert == GFC_CONVERT_NATIVE)
 127         {
 128           switch (length)
 129             {
 130             case sizeof(GFC_INTEGER_4):
 131               memcpy (&m4, p, sizeof (m4));
 132               m = m4;
 133               break;
 134
 135             case sizeof(GFC_INTEGER_8):
 136               memcpy (&m8, p, sizeof (m8));
 137               m = m8;
 138               break;
 139
 140             default:
 141               runtime_error ("Illegal value for record marker");
 142               break;
 143             }
 144         }
 145       else
 146         {
 147           switch (length)
 148             {
 149             case sizeof(GFC_INTEGER_4):
 150               reverse_memcpy (&m4, p, sizeof (m4));
 151               m = m4;
 152               break;
 153
 154             case sizeof(GFC_INTEGER_8):
 155               reverse_memcpy (&m8, p, sizeof (m8));
 156               m = m8;
 157               break;
 158
 159             default:
 160               runtime_error ("Illegal value for record marker");
 161               break;
 162             }
 163
 164         }
 165
 166       continued = m < 0;
 167       if (continued)
 168         m = -m;
 169
 170       if ((new = file_position (u->s) - m - 2*length) < 0)
 171         new = 0;
 172
 173       if (sseek (u->s, new) == FAILURE)
 174         goto io_error;
 175     } while (continued);
 176
 177   u->last_record--;
 178   return;
 179
 180  io_error:
 181   generate_error (&fpp->common, LIBERROR_OS, NULL);
 182 }
 183
 184
 185 extern void st_backspace (st_parameter_filepos *);
 186 export_proto(st_backspace);
 187
 188 void
 189 st_backspace (st_parameter_filepos *fpp)
 190 {
 191   gfc_unit *u;
 192
 193   library_start (&fpp->common);
 194
 195   u = find_unit (fpp->common.unit);
 196   if (u == NULL)
 197     {
 198       generate_error (&fpp->common, LIBERROR_BAD_UNIT, NULL);
 199       goto done;
 200     }
 201
 202   /* Ignore direct access.  Non-advancing I/O is only allowed for formatted
 203      sequential I/O and the next direct access transfer repositions the file
 204      anyway.  */
 205
 206   if (u->flags.access == ACCESS_DIRECT || u->flags.access == ACCESS_STREAM)
 207     goto done;
 208
 209   /* Check for special cases involving the ENDFILE record first.  */
 210
 211   if (u->endfile == AFTER_ENDFILE)
 212     {
 213       u->endfile = AT_ENDFILE;
 214       u->flags.position = POSITION_APPEND;
 215       flush (u->s);
 216       struncate (u->s);
 217     }
 218   else
 219     {
 220       if (file_position (u->s) == 0)
 221         {
 222           u->flags.position = POSITION_REWIND;
 223           goto done;            /* Common special case */
 224         }
 225
 226       if (u->mode == WRITING)
 227         {
 228           flush (u->s);
 229           struncate (u->s);
 230           u->mode = READING;
 231         }
 232
 233       if (u->flags.form == FORM_FORMATTED)
 234         formatted_backspace (fpp, u);
 235       else
 236         unformatted_backspace (fpp, u);
 237
 238       update_position (u);
 239       u->endfile = NO_ENDFILE;
 240       u->current_record = 0;
 241       u->bytes_left = 0;
 242     }
 243
 244  done:
 245   if (u != NULL)
 246     unlock_unit (u);
 247
 248   library_end ();
 249 }
 250
 251
 252 extern void st_endfile (st_parameter_filepos *);
 253 export_proto(st_endfile);
 254
 255 void
 256 st_endfile (st_parameter_filepos *fpp)
 257 {
 258   gfc_unit *u;
 259
 260   library_start (&fpp->common);
 261
 262   u = find_unit (fpp->common.unit);
 263   if (u != NULL)
 264     {
 265       if (u->current_record)
 266         {
 267           st_parameter_dt dtp;
 268           dtp.common = fpp->common;
 269           memset (&dtp.u.p, 0, sizeof (dtp.u.p));
 270           dtp.u.p.current_unit = u;
 271           next_record (&dtp, 1);
 272         }
 273
 274       flush (u->s);
 275       struncate (u->s);
 276       u->endfile = AFTER_ENDFILE;
 277       update_position (u);
 278       unlock_unit (u);
 279     }
 280
 281   library_end ();
 282 }
 283
 284
 285 extern void st_rewind (st_parameter_filepos *);
 286 export_proto(st_rewind);
 287
 288 void
 289 st_rewind (st_parameter_filepos *fpp)
 290 {
 291   gfc_unit *u;
 292
 293   library_start (&fpp->common);
 294
 295   u = find_unit (fpp->common.unit);
 296   if (u != NULL)
 297     {
 298       if (u->flags.access == ACCESS_DIRECT)
 299         generate_error (&fpp->common, LIBERROR_BAD_OPTION,
 300                         "Cannot REWIND a file opened for DIRECT access");
 301       else
 302         {
 303           /* Flush the buffers.  If we have been writing to the file, the last
 304                written record is the last record in the file, so truncate the
 305                file now.  Reset to read mode so two consecutive rewind
 306                statements do not delete the file contents.  */
 307           flush (u->s);
 308           if (u->mode == WRITING && u->flags.access != ACCESS_STREAM)
 309             struncate (u->s);
 310
 311           u->mode = READING;
 312           u->last_record = 0;
 313
 314           if (file_position (u->s) != 0 && sseek (u->s, 0) == FAILURE)
 315             generate_error (&fpp->common, LIBERROR_OS, NULL);
 316
 317           /* Handle special files like /dev/null differently.  */
 318           if (!is_special (u->s))
 319             {
 320               /* We are rewinding so we are not at the end.  */
 321               u->endfile = NO_ENDFILE;
 322             }
 323           else
 324             {
 325               /* Set this for compatibilty with g77 for /dev/null.  */
 326               if (file_length (u->s) == 0  && file_position (u->s) == 0)
 327                 u->endfile = AT_ENDFILE;
 328               /* Future refinements on special files can go here.  */
 329             }
 330
 331           u->current_record = 0;
 332           u->strm_pos = 1;
 333           u->read_bad = 0;
 334         }
 335       /* Update position for INQUIRE.  */
 336       u->flags.position = POSITION_REWIND;
 337       unlock_unit (u);
 338     }
 339
 340   library_end ();
 341 }
 342
 343
 344 extern void st_flush (st_parameter_filepos *);
 345 export_proto(st_flush);
 346
 347 void
 348 st_flush (st_parameter_filepos *fpp)
 349 {
 350   gfc_unit *u;
 351
 352   library_start (&fpp->common);
 353
 354   u = find_unit (fpp->common.unit);
 355   if (u != NULL)
 356     {
 357       flush (u->s);
 358       unlock_unit (u);
 359     }
 360   else
 361     /* FLUSH on unconnected unit is illegal: F95 std., 9.3.5. */
 362     generate_error (&fpp->common, LIBERROR_BAD_OPTION,
 363                         "Specified UNIT in FLUSH is not connected");
 364
 365   library_end ();
 366 }