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