libgfortran/io/file_pos.c

   1 /* Copyright (C) 2002-2003, 2005 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 "config.h"
  31 #include <string.h>
  32 #include "libgfortran.h"
  33 #include "io.h"
  34
  35 /* file_pos.c-- Implement the file positioning statements, i.e. BACKSPACE,
  36    ENDFILE, and REWIND as well as the FLUSH statement.  */
  37
  38
  39 /* formatted_backspace(void)-- Move the file back one line.  The
  40    current position is after the newline that terminates the previous
  41    record, and we have to sift backwards to find the newline before
  42    that or the start of the file, whichever comes first.  */
  43
  44 #define READ_CHUNK 4096
  45
  46 static void
  47 formatted_backspace (void)
  48 {
  49   gfc_offset base;
  50   char *p;
  51   int n;
  52
  53   base = file_position (current_unit->s) - 1;
  54
  55   do
  56     {
  57       n = (base < READ_CHUNK) ? base : READ_CHUNK;
  58       base -= n;
  59
  60       p = salloc_r_at (current_unit->s, &n, base);
  61       if (p == NULL)
  62         goto io_error;
  63
  64       /* We have moved backwards from the current position, it should
  65          not be possible to get a short read.  Because it is not
  66          clear what to do about such thing, we ignore the possibility.  */
  67
  68       /* There is no memrchr() in the C library, so we have to do it
  69          ourselves.  */
  70
  71       n--;
  72       while (n >= 0)
  73         {
  74           if (p[n] == '\n')
  75             {
  76               base += n + 1;
  77               goto done;
  78             }
  79           n--;
  80         }
  81
  82     }
  83   while (base != 0);
  84
  85   /* base is the new pointer.  Seek to it exactly.  */
  86  done:
  87   if (sseek (current_unit->s, base) == FAILURE)
  88     goto io_error;
  89   current_unit->last_record--;
  90   current_unit->endfile = NO_ENDFILE;
  91
  92   return;
  93
  94  io_error:
  95   generate_error (ERROR_OS, NULL);
  96 }
  97
  98
  99 /* unformatted_backspace() -- Move the file backwards for an unformatted
 100    sequential file.  We are guaranteed to be between records on entry and
 101    we have to shift to the previous record.  */
 102
 103 static void
 104 unformatted_backspace (void)
 105 {
 106   gfc_offset m, new;
 107   int length;
 108   char *p;
 109
 110   length = sizeof (gfc_offset);
 111
 112   p = salloc_r_at (current_unit->s, &length,
 113                    file_position (current_unit->s) - length);
 114   if (p == NULL)
 115     goto io_error;
 116
 117   memcpy (&m, p, sizeof (gfc_offset));
 118   new = file_position (current_unit->s) - m - 2*length;
 119   if (sseek (current_unit->s, new) == FAILURE)
 120     goto io_error;
 121
 122   current_unit->last_record--;
 123   return;
 124
 125  io_error:
 126   generate_error (ERROR_OS, NULL);
 127 }
 128
 129
 130 extern void st_backspace (void);
 131 export_proto(st_backspace);
 132
 133 void
 134 st_backspace (void)
 135 {
 136   gfc_unit *u;
 137
 138   library_start ();
 139
 140   u = find_unit (ioparm.unit);
 141   if (u == NULL)
 142     {
 143       generate_error (ERROR_BAD_UNIT, NULL);
 144       goto done;
 145     }
 146
 147   current_unit = u;
 148
 149   /* Ignore direct access.  Non-advancing I/O is only allowed for formatted
 150      sequential I/O and the next direct access transfer repositions the file
 151      anyway.  */
 152
 153   if (u->flags.access == ACCESS_DIRECT)
 154     goto done;
 155
 156   /* Check for special cases involving the ENDFILE record first.  */
 157
 158   if (u->endfile == AFTER_ENDFILE)
 159     u->endfile = AT_ENDFILE;
 160   else
 161     {
 162       if (file_position (u->s) == 0)
 163         goto done;              /* Common special case */
 164
 165       if (u->mode == WRITING)
 166         {
 167           flush (u->s);
 168           struncate (u->s);
 169           u->mode = READING;
 170         }
 171
 172       if (u->flags.form == FORM_FORMATTED)
 173         formatted_backspace ();
 174       else
 175         unformatted_backspace ();
 176
 177       u->endfile = NO_ENDFILE;
 178       u->current_record = 0;
 179     }
 180
 181  done:
 182   library_end ();
 183 }
 184
 185
 186 extern void st_endfile (void);
 187 export_proto(st_endfile);
 188
 189 void
 190 st_endfile (void)
 191 {
 192   gfc_unit *u;
 193
 194   library_start ();
 195
 196   u = get_unit (0);
 197   if (u != NULL)
 198     {
 199       current_unit = u;         /* next_record() needs this set.  */
 200       if (u->current_record)
 201         next_record (1);
 202
 203       flush(u->s);
 204       struncate (u->s);
 205       u->endfile = AFTER_ENDFILE;
 206     }
 207
 208   library_end ();
 209 }
 210
 211
 212 extern void st_rewind (void);
 213 export_proto(st_rewind);
 214
 215 void
 216 st_rewind (void)
 217 {
 218   gfc_unit *u;
 219
 220   library_start ();
 221
 222   u = find_unit (ioparm.unit);
 223   if (u != NULL)
 224     {
 225       if (u->flags.access != ACCESS_SEQUENTIAL)
 226         generate_error (ERROR_BAD_OPTION,
 227                         "Cannot REWIND a file opened for DIRECT access");
 228       else
 229         {
 230           /* If we have been writing to the file, the last written record
 231              is the last record in the file, so truncate the file now.
 232              Reset to read mode so two consecutive rewind statements do not
 233              delete the file contents.  Flush buffer when switching mode.  */
 234           if (u->mode == WRITING)
 235             {
 236               flush (u->s);
 237               struncate (u->s);
 238             }
 239           u->mode = READING;
 240           u->last_record = 0;
 241           if (sseek (u->s, 0) == FAILURE)
 242             generate_error (ERROR_OS, NULL);
 243
 244           u->endfile = NO_ENDFILE;
 245           u->current_record = 0;
 246           test_endfile (u);
 247         }
 248       /* Update position for INQUIRE.  */
 249       u->flags.position = POSITION_REWIND;
 250     }
 251
 252   library_end ();
 253 }
 254
 255
 256 extern void st_flush (void);
 257 export_proto(st_flush);
 258
 259 void
 260 st_flush (void)
 261 {
 262   gfc_unit *u;
 263
 264   library_start ();
 265
 266   u = get_unit (0);
 267   if (u != NULL)
 268     {
 269       current_unit = u;  /* Just to be sure.  */
 270       flush(u->s);
 271     }
 272
 273   library_end ();
 274 }