1/* Copyright (C) 2008-2020 Free Software Foundation, Inc. 2 Contributed by Janne Blomqvist 3 4This file is part of the GNU Fortran runtime library (libgfortran). 5 6Libgfortran is free software; you can redistribute it and/or modify 7it under the terms of the GNU General Public License as published by 8the Free Software Foundation; either version 3, or (at your option) 9any later version. 10 11Libgfortran is distributed in the hope that it will be useful, 12but WITHOUT ANY WARRANTY; without even the implied warranty of 13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14GNU General Public License for more details. 15 16Under Section 7 of GPL version 3, you are granted additional 17permissions described in the GCC Runtime Library Exception, version 183.1, as published by the Free Software Foundation. 19 20You should have received a copy of the GNU General Public License and 21a copy of the GCC Runtime Library Exception along with this program; 22see 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 35void 36fbuf_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 48void 49fbuf_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 59static void 60#ifdef FBUF_DEBUG 61fbuf_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 76fbuf_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 87ptrdiff_t 88fbuf_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 113char * 114fbuf_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 138int 139fbuf_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 175int 176fbuf_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 205ptrdiff_t 206fbuf_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 246char * 247fbuf_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 278int 279fbuf_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} 298