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 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 You should have received a copy of the GNU General Public License
  17 along with Libgfortran; see the file COPYING.  If not, write to
  18 the Free Software Foundation, 59 Temple Place - Suite 330,
  19 Boston, MA 02111-1307, USA.  */
  20
  21 #include "config.h"
  22 #include "libgfortran.h"
  23 #include "io.h"
  24
  25 /* backspace.c -- Implement the BACKSPACE statement */
  26
  27 /* formatted_backspace(void)-- Move the file back one line.  The
  28  * current position is after the newline that terminates the previous
  29  * record, and we have to sift backwards to find the newline before
  30  * that or the start of the file, whichever comes first. */
  31
  32 #define READ_CHUNK 4096
  33
  34 static void
  35 formatted_backspace (void)
  36 {
  37   gfc_offset base;
  38   char *p;
  39   int n;
  40
  41   base = file_position (current_unit->s) - 1;
  42
  43   do
  44     {
  45       n = (base < READ_CHUNK) ? base : READ_CHUNK;
  46       base -= n;
  47
  48       p = salloc_r_at (current_unit->s, &n, base);
  49       if (p == NULL)
  50         goto io_error;
  51
  52       /* Because we've moved backwords from the current position, it
  53        * should not be possible to get a short read.  Because it isn't
  54        * clear what to do about such thing, we ignore the possibility. */
  55
  56       /* There is no memrchr() in the C library, so we have to do it
  57        * ourselves. */
  58
  59       n--;
  60       while (n >= 0)
  61         {
  62           if (p[n] == '\n')
  63             {
  64               base += n + 1;
  65               goto done;
  66             }
  67
  68           n--;
  69         }
  70
  71     }
  72   while (base != 0);
  73
  74   /* base is the new pointer.  Seek to it exactly */
  75  done:
  76   if (sseek (current_unit->s, base) == FAILURE)
  77     goto io_error;
  78   current_unit->last_record--;
  79   current_unit->endfile = NO_ENDFILE;
  80
  81   return;
  82
  83  io_error:
  84   generate_error (ERROR_OS, NULL);
  85 }
  86
  87
  88 /* unformatted_backspace()-- Move the file backwards for an
  89  * unformatted sequential file.  We are guaranteed to be between
  90  * records on entry and we have to shift to the previous record.  */
  91
  92 static void
  93 unformatted_backspace (void)
  94 {
  95   gfc_offset *p, new;
  96   int length;
  97
  98   length = sizeof (gfc_offset);
  99
 100   p = (gfc_offset *) salloc_r_at (current_unit->s, &length,
 101                                 file_position (current_unit->s) - length);
 102   if (p == NULL)
 103     goto io_error;
 104
 105   new = file_position (current_unit->s) - *p - length;
 106   if (sseek (current_unit->s, new) == FAILURE)
 107     goto io_error;
 108
 109   current_unit->last_record--;
 110   return;
 111
 112  io_error:
 113   generate_error (ERROR_OS, NULL);
 114 }
 115
 116
 117 extern void st_backspace (void);
 118 export_proto(st_backspace);
 119
 120 void
 121 st_backspace (void)
 122 {
 123   gfc_unit *u;
 124
 125   library_start ();
 126
 127   u = find_unit (ioparm.unit);
 128   if (u == NULL)
 129     {
 130       generate_error (ERROR_BAD_UNIT, NULL);
 131       goto done;
 132     }
 133
 134   current_unit = u;
 135
 136   /* Ignore direct access.  Non-advancing I/O is only allowed for
 137    * formatted sequential I/O and the next direct access transfer
 138    * repositions the file anyway. */
 139
 140   if (u->flags.access == ACCESS_DIRECT)
 141     goto done;
 142
 143   /* Check for special cases involving the ENDFILE record first */
 144
 145   if (u->endfile == AFTER_ENDFILE)
 146     u->endfile = AT_ENDFILE;
 147   else
 148     {
 149       if (u->current_record)
 150         next_record (1);
 151
 152       if (file_position (u->s) == 0)
 153         goto done;              /* Common special case */
 154
 155       if (u->flags.form == FORM_FORMATTED)
 156         formatted_backspace ();
 157       else
 158         unformatted_backspace ();
 159     }
 160
 161  done:
 162   library_end ();
 163 }