libgfortran/io/fbuf.c

   1 /* Copyright (C) 2008-2022 Free Software Foundation, Inc.
   2    Contributed by 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 3, 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 Under Section 7 of GPL version 3, you are granted additional
  17 permissions described in the GCC Runtime Library Exception, version
  18 3.1, as published by the Free Software Foundation.
  19
  20 You should have received a copy of the GNU General Public License and
  21 a copy of the GCC Runtime Library Exception along with this program;
  22 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  23 <http://www.gnu.org/licenses/>.  */
  24
  25
  26 #include "io.h"
  27 #include "fbuf.h"
  28 #include "unix.h"
  29 #include <string.h>
  30
  31
  32 //#define FBUF_DEBUG
  33
  34
  35 void
  36 fbuf_init (gfc_unit *u, size_t len)
  37 {
  38   if (len == 0)
  39     len = 512;                  /* Default size.  */
  40
  41   u->fbuf = xmalloc (sizeof (struct fbuf));
  42   u->fbuf->buf = xmalloc (len);
  43   u->fbuf->len = len;
  44   u->fbuf->act = u->fbuf->pos = 0;
  45 }
  46
  47
  48 void
  49 fbuf_destroy (gfc_unit *u)
  50 {
  51   if (u->fbuf == NULL)
  52     return;
  53   free (u->fbuf->buf);
  54   free (u->fbuf);
  55   u->fbuf = NULL;
  56 }
  57
  58
  59 static void
  60 #ifdef FBUF_DEBUG
  61 fbuf_debug (gfc_unit *u, const char *format, ...)
  62 {
  63   va_list args;
  64   va_start(args, format);
  65   vfprintf(stderr, format, args);
  66   va_end(args);
  67   fprintf (stderr, "fbuf_debug pos: %lu, act: %lu, buf: ''",
  68            (long unsigned) u->fbuf->pos, (long unsigned) u->fbuf->act);
  69   for (size_t ii = 0; ii < u->fbuf->act; ii++)
  70     {
  71       putc (u->fbuf->buf[ii], stderr);
  72     }
  73   fprintf (stderr, "''\n");
  74 }
  75 #else
  76 fbuf_debug (gfc_unit *u __attribute__ ((unused)),
  77             const char *format __attribute__ ((unused)),
  78             ...) {}
  79 #endif
  80
  81
  82
  83 /* You should probably call this before doing a physical seek on the
  84    underlying device.  Returns how much the physical position was
  85    modified.  */
  86
  87 ptrdiff_t
  88 fbuf_reset (gfc_unit *u)
  89 {
  90   ptrdiff_t seekval = 0;
  91
  92   if (!u->fbuf)
  93     return 0;
  94
  95   fbuf_debug (u, "fbuf_reset: ");
  96   fbuf_flush (u, u->mode);
  97   /* If we read past the current position, seek the underlying device
  98      back.  */
  99   if (u->mode == READING && u->fbuf->act > u->fbuf->pos)
 100     {
 101       seekval = - (u->fbuf->act - u->fbuf->pos);
 102       fbuf_debug (u, "fbuf_reset seekval %ld, ", (long) seekval);
 103     }
 104   u->fbuf->act = u->fbuf->pos = 0;
 105   return seekval;
 106 }
 107
 108
 109 /* Return a pointer to the current position in the buffer, and increase
 110    the pointer by len. Makes sure that the buffer is big enough,
 111    reallocating if necessary.  */
 112
 113 char *
 114 fbuf_alloc (gfc_unit *u, size_t len)
 115 {
 116   size_t newlen;
 117   char *dest;
 118   fbuf_debug (u, "fbuf_alloc len %lu, ", (long unsigned) len);
 119   if (u->fbuf->pos + len > u->fbuf->len)
 120     {
 121       /* Round up to nearest multiple of the current buffer length.  */
 122       newlen = ((u->fbuf->pos + len) / u->fbuf->len + 1) *u->fbuf->len;
 123       u->fbuf->buf = xrealloc (u->fbuf->buf, newlen);
 124       u->fbuf->len = newlen;
 125     }
 126
 127   dest = u->fbuf->buf + u->fbuf->pos;
 128   u->fbuf->pos += len;
 129   if (u->fbuf->pos > u->fbuf->act)
 130     u->fbuf->act = u->fbuf->pos;
 131   return dest;
 132 }
 133
 134
 135 /* mode argument is WRITING for write mode and READING for read
 136    mode. Return value is 0 for success, -1 on failure.  */
 137
 138 int
 139 fbuf_flush (gfc_unit *u, unit_mode mode)
 140 {
 141   if (!u->fbuf)
 142     return 0;
 143
 144   fbuf_debug (u, "fbuf_flush with mode %d: ", mode);
 145
 146   if (mode == WRITING)
 147     {
 148       if (u->fbuf->pos > 0)
 149         {
 150           ptrdiff_t nwritten = swrite (u->s, u->fbuf->buf, u->fbuf->pos);
 151           if (nwritten < 0)
 152             return -1;
 153         }
 154     }
 155   /* Salvage remaining bytes for both reading and writing. This
 156      happens with the combination of advance='no' and T edit
 157      descriptors leaving the final position somewhere not at the end
 158      of the record. For reading, this also happens if we sread() past
 159      the record boundary.  */
 160   if (u->fbuf->act > u->fbuf->pos && u->fbuf->pos > 0)
 161     memmove (u->fbuf->buf, u->fbuf->buf + u->fbuf->pos,
 162              u->fbuf->act - u->fbuf->pos);
 163
 164   u->fbuf->act -= u->fbuf->pos;
 165   u->fbuf->pos = 0;
 166
 167   return 0;
 168 }
 169
 170
 171 /* The mode argument is LIST_WRITING for write mode and LIST_READING for
 172    read.  This should only be used for list directed  I/O.
 173    Return value is 0 for success, -1 on failure.  */
 174
 175 int
 176 fbuf_flush_list (gfc_unit *u, unit_mode mode)
 177 {
 178   if (!u->fbuf)
 179     return 0;
 180
 181   if (u->fbuf->pos < 524288) /* Upper limit for list writing.  */
 182     return 0;
 183
 184   fbuf_debug (u, "fbuf_flush_list with mode %d: ", mode);
 185
 186   if (mode == LIST_WRITING)
 187     {
 188       ptrdiff_t nwritten = swrite (u->s, u->fbuf->buf, u->fbuf->pos);
 189       if (nwritten < 0)
 190         return -1;
 191     }
 192
 193   /* Salvage remaining bytes for both reading and writing.  */
 194   if (u->fbuf->act > u->fbuf->pos)
 195     memmove (u->fbuf->buf, u->fbuf->buf + u->fbuf->pos,
 196              u->fbuf->act - u->fbuf->pos);
 197
 198   u->fbuf->act -= u->fbuf->pos;
 199   u->fbuf->pos = 0;
 200
 201   return 0;
 202 }
 203
 204
 205 ptrdiff_t
 206 fbuf_seek (gfc_unit *u, ptrdiff_t off, int whence)
 207 {
 208   if (!u->fbuf)
 209     return -1;
 210
 211   switch (whence)
 212     {
 213     case SEEK_SET:
 214       break;
 215     case SEEK_CUR:
 216       off += u->fbuf->pos;
 217       break;
 218     case SEEK_END:
 219       off += u->fbuf->act;
 220       break;
 221     default:
 222       return -1;
 223     }
 224
 225   fbuf_debug (u, "fbuf_seek, off %ld ", (long) off);
 226   /* The start of the buffer is always equal to the left tab
 227      limit. Moving to the left past the buffer is illegal in C and
 228      would also imply moving past the left tab limit, which is never
 229      allowed in Fortran. Similarly, seeking past the end of the buffer
 230      is not possible, in that case the user must make sure to allocate
 231      space with fbuf_alloc().  So return error if that is
 232      attempted.  */
 233   if (off < 0 || off > (ptrdiff_t) u->fbuf->act)
 234     return -1;
 235   u->fbuf->pos = off;
 236   return off;
 237 }
 238
 239
 240 /* Fill the buffer with bytes for reading.  Returns a pointer to start
 241    reading from. If we hit EOF, returns a short read count. If any
 242    other error occurs, return NULL.  After reading, the caller is
 243    expected to call fbuf_seek to update the position with the number
 244    of bytes actually processed. */
 245
 246 char *
 247 fbuf_read (gfc_unit *u, size_t *len)
 248 {
 249   char *ptr;
 250   size_t oldact, oldpos;
 251   ptrdiff_t readlen = 0;
 252
 253   fbuf_debug (u, "fbuf_read, len %lu: ", (unsigned long) *len);
 254   oldact = u->fbuf->act;
 255   oldpos = u->fbuf->pos;
 256   ptr = fbuf_alloc (u, *len);
 257   u->fbuf->pos = oldpos;
 258   if (oldpos + *len > oldact)
 259     {
 260       fbuf_debug (u, "reading %lu bytes starting at %lu ",
 261                   (long unsigned) oldpos + *len - oldact,
 262                   (long unsigned) oldact);
 263       readlen = sread (u->s, u->fbuf->buf + oldact, oldpos + *len - oldact);
 264       if (readlen < 0)
 265         return NULL;
 266       *len = oldact - oldpos + readlen;
 267     }
 268   u->fbuf->act = oldact + readlen;
 269   fbuf_debug (u, "fbuf_read done: ");
 270   return ptr;
 271 }
 272
 273
 274 /* When the fbuf_getc() inline function runs out of buffer space, it
 275    calls this function to fill the buffer with bytes for
 276    reading. Never call this function directly.  */
 277
 278 int
 279 fbuf_getc_refill (gfc_unit *u)
 280 {
 281   char *p;
 282
 283   fbuf_debug (u, "fbuf_getc_refill ");
 284
 285   /* Read 80 bytes (average line length?).  This is a compromise
 286      between not needing to call the read() syscall all the time and
 287      not having to memmove unnecessary stuff when switching to the
 288      next record.  */
 289   size_t nread = 80;
 290
 291   p = fbuf_read (u, &nread);
 292
 293   if (p && nread > 0)
 294     return (unsigned char) u->fbuf->buf[u->fbuf->pos++];
 295   else
 296     return EOF;
 297 }