1 /* Copyright (C) 2008-2023 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 }