]> git.ipfire.org Git - thirdparty/gcc.git/blame - libgfortran/io/fbuf.c
Update copyright years.
[thirdparty/gcc.git] / libgfortran / io / fbuf.c
CommitLineData
7adcbafe 1/* Copyright (C) 2008-2022 Free Software Foundation, Inc.
7c1b4aba
JB
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
748086b7 8the Free Software Foundation; either version 3, or (at your option)
7c1b4aba
JB
9any later version.
10
7c1b4aba
JB
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
748086b7
JJ
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/>. */
7c1b4aba
JB
24
25
26#include "io.h"
92cbdb68
JB
27#include "fbuf.h"
28#include "unix.h"
7c1b4aba 29#include <string.h>
7c1b4aba
JB
30
31
7812c78c
JD
32//#define FBUF_DEBUG
33
34
7c1b4aba 35void
ea99ec5b 36fbuf_init (gfc_unit *u, size_t len)
7c1b4aba
JB
37{
38 if (len == 0)
8947fd62 39 len = 512; /* Default size. */
7c1b4aba 40
1a0fd3d3
JB
41 u->fbuf = xmalloc (sizeof (struct fbuf));
42 u->fbuf->buf = xmalloc (len);
7c1b4aba 43 u->fbuf->len = len;
7812c78c 44 u->fbuf->act = u->fbuf->pos = 0;
7c1b4aba
JB
45}
46
47
48void
f29876bb 49fbuf_destroy (gfc_unit *u)
7c1b4aba
JB
50{
51 if (u->fbuf == NULL)
52 return;
04695783 53 free (u->fbuf->buf);
bb408e87 54 free (u->fbuf);
7812c78c
JD
55 u->fbuf = NULL;
56}
57
58
59static void
60#ifdef FBUF_DEBUG
f29876bb 61fbuf_debug (gfc_unit *u, const char *format, ...)
7812c78c
JD
62{
63 va_list args;
64 va_start(args, format);
65 vfprintf(stderr, format, args);
66 va_end(args);
ea99ec5b
JB
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++)
7812c78c
JD
70 {
71 putc (u->fbuf->buf[ii], stderr);
72 }
73 fprintf (stderr, "''\n");
74}
75#else
f29876bb
JD
76fbuf_debug (gfc_unit *u __attribute__ ((unused)),
77 const char *format __attribute__ ((unused)),
7812c78c
JD
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
ea99ec5b 87ptrdiff_t
f29876bb 88fbuf_reset (gfc_unit *u)
7812c78c 89{
ea99ec5b 90 ptrdiff_t seekval = 0;
7812c78c
JD
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);
ea99ec5b 102 fbuf_debug (u, "fbuf_reset seekval %ld, ", (long) seekval);
7812c78c
JD
103 }
104 u->fbuf->act = u->fbuf->pos = 0;
105 return seekval;
7c1b4aba
JB
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,
7812c78c 111 reallocating if necessary. */
7c1b4aba
JB
112
113char *
ea99ec5b 114fbuf_alloc (gfc_unit *u, size_t len)
7c1b4aba 115{
ea99ec5b 116 size_t newlen;
7c1b4aba 117 char *dest;
ea99ec5b 118 fbuf_debug (u, "fbuf_alloc len %lu, ", (long unsigned) len);
8947fd62 119 if (u->fbuf->pos + len > u->fbuf->len)
7c1b4aba 120 {
7812c78c 121 /* Round up to nearest multiple of the current buffer length. */
f29876bb 122 newlen = ((u->fbuf->pos + len) / u->fbuf->len + 1) *u->fbuf->len;
d74fd3c7 123 u->fbuf->buf = xrealloc (u->fbuf->buf, newlen);
7812c78c 124 u->fbuf->len = newlen;
7c1b4aba 125 }
8947fd62
JB
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;
7c1b4aba
JB
131 return dest;
132}
133
134
7812c78c
JD
135/* mode argument is WRITING for write mode and READING for read
136 mode. Return value is 0 for success, -1 on failure. */
8947fd62 137
7c1b4aba 138int
f29876bb 139fbuf_flush (gfc_unit *u, unit_mode mode)
7c1b4aba 140{
7c1b4aba
JB
141 if (!u->fbuf)
142 return 0;
7812c78c
JD
143
144 fbuf_debug (u, "fbuf_flush with mode %d: ", mode);
145
146 if (mode == WRITING)
7c1b4aba 147 {
7812c78c
JD
148 if (u->fbuf->pos > 0)
149 {
ea99ec5b 150 ptrdiff_t nwritten = swrite (u->s, u->fbuf->buf, u->fbuf->pos);
7812c78c
JD
151 if (nwritten < 0)
152 return -1;
153 }
7c1b4aba 154 }
7812c78c
JD
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;
7c1b4aba
JB
168}
169
170
1060d940
JD
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
f29876bb 176fbuf_flush_list (gfc_unit *u, unit_mode mode)
1060d940 177{
1060d940
JD
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 {
ea99ec5b 188 ptrdiff_t nwritten = swrite (u->s, u->fbuf->buf, u->fbuf->pos);
1060d940
JD
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
ea99ec5b
JB
205ptrdiff_t
206fbuf_seek (gfc_unit *u, ptrdiff_t off, int whence)
7c1b4aba 207{
7812c78c 208 if (!u->fbuf)
7c1b4aba 209 return -1;
7812c78c
JD
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
ea99ec5b 225 fbuf_debug (u, "fbuf_seek, off %ld ", (long) off);
7812c78c
JD
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. */
ea99ec5b 233 if (off < 0 || off > (ptrdiff_t) u->fbuf->act)
7812c78c
JD
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 *
ea99ec5b 247fbuf_read (gfc_unit *u, size_t *len)
7812c78c
JD
248{
249 char *ptr;
ea99ec5b
JB
250 size_t oldact, oldpos;
251 ptrdiff_t readlen = 0;
7812c78c 252
ea99ec5b 253 fbuf_debug (u, "fbuf_read, len %lu: ", (unsigned long) *len);
7812c78c
JD
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 {
ea99ec5b
JB
260 fbuf_debug (u, "reading %lu bytes starting at %lu ",
261 (long unsigned) oldpos + *len - oldact,
262 (long unsigned) oldact);
7812c78c
JD
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
f29876bb 279fbuf_getc_refill (gfc_unit *u)
7812c78c 280{
7812c78c
JD
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. */
ea99ec5b 289 size_t nread = 80;
7812c78c
JD
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;
7c1b4aba 297}