libgfortran/io/backspace.c

   1 /* Copyright (C) 2002-2003 Free Software Foundation, Inc.
   2    Contributed by Andy Vaught
   3
   4 This file is part of the GNU Fortran 95 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, 59 Temple Place - Suite 330,
  28 Boston, MA 02111-1307, USA.  */
  29
  30 #include "config.h"
  31 #include <string.h>
  32 #include "libgfortran.h"
  33 #include "io.h"
  34
  35 /* backspace.c -- Implement the BACKSPACE statement */
  36
  37 /* formatted_backspace(void)-- 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 (void)
  46 {
  47   gfc_offset base;
  48   char *p;
  49   int n;
  50
  51   base = file_position (current_unit->s) - 1;
  52
  53   do
  54     {
  55       n = (base < READ_CHUNK) ? base : READ_CHUNK;
  56       base -= n;
  57
  58       p = salloc_r_at (current_unit->s, &n, base);
  59       if (p == NULL)
  60         goto io_error;
  61
  62       /* Because we've moved backwords from the current position, it
  63        * should not be possible to get a short read.  Because it isn't
  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
  78           n--;
  79         }
  80
  81     }
  82   while (base != 0);
  83
  84   /* base is the new pointer.  Seek to it exactly */
  85  done:
  86   if (sseek (current_unit->s, base) == FAILURE)
  87     goto io_error;
  88   current_unit->last_record--;
  89   current_unit->endfile = NO_ENDFILE;
  90
  91   return;
  92
  93  io_error:
  94   generate_error (ERROR_OS, NULL);
  95 }
  96
  97
  98 /* unformatted_backspace()-- Move the file backwards for an
  99  * unformatted sequential file.  We are guaranteed to be between
 100  * records on entry and we have to shift to the previous record.  */
 101
 102 static void
 103 unformatted_backspace (void)
 104 {
 105   gfc_offset m, new;
 106   int length;
 107   char *p;
 108
 109   length = sizeof (gfc_offset);
 110
 111   p = salloc_r_at (current_unit->s, &length,
 112                    file_position (current_unit->s) - length);
 113   if (p == NULL)
 114     goto io_error;
 115
 116   memcpy (&m, p, sizeof (gfc_offset));
 117   new = file_position (current_unit->s) - m - 2*length;
 118   if (sseek (current_unit->s, new) == FAILURE)
 119     goto io_error;
 120
 121   current_unit->last_record--;
 122   return;
 123
 124  io_error:
 125   generate_error (ERROR_OS, NULL);
 126 }
 127
 128
 129 extern void st_backspace (void);
 130 export_proto(st_backspace);
 131
 132 void
 133 st_backspace (void)
 134 {
 135   gfc_unit *u;
 136
 137   library_start ();
 138
 139   u = find_unit (ioparm.unit);
 140   if (u == NULL)
 141     {
 142       generate_error (ERROR_BAD_UNIT, NULL);
 143       goto done;
 144     }
 145
 146   current_unit = u;
 147
 148   /* Ignore direct access.  Non-advancing I/O is only allowed for
 149    * formatted sequential I/O and the next direct access transfer
 150    * repositions the file anyway. */
 151
 152   if (u->flags.access == ACCESS_DIRECT)
 153     goto done;
 154
 155   /* Check for special cases involving the ENDFILE record first */
 156
 157   if (u->endfile == AFTER_ENDFILE)
 158     u->endfile = AT_ENDFILE;
 159   else
 160     {
 161       if (file_position (u->s) == 0)
 162         goto done;              /* Common special case */
 163
 164       if (u->mode == WRITING)
 165       {
 166         flush (u->s);
 167         struncate (u->s);
 168         u->mode = READING;
 169       }
 170
 171       if (u->flags.form == FORM_FORMATTED)
 172         formatted_backspace ();
 173       else
 174         unformatted_backspace ();
 175
 176       u->endfile = NO_ENDFILE;
 177       u->current_record = 0;
 178     }
 179
 180  done:
 181   library_end ();
 182 }