1*4c3eb207Smrg /* Copyright (C) 2008-2020 Free Software Foundation, Inc.
2627f7eb2Smrg Contributed by Janne Blomqvist
3627f7eb2Smrg
4627f7eb2Smrg This file is part of the GNU Fortran runtime library (libgfortran).
5627f7eb2Smrg
6627f7eb2Smrg Libgfortran is free software; you can redistribute it and/or modify
7627f7eb2Smrg it under the terms of the GNU General Public License as published by
8627f7eb2Smrg the Free Software Foundation; either version 3, or (at your option)
9627f7eb2Smrg any later version.
10627f7eb2Smrg
11627f7eb2Smrg Libgfortran is distributed in the hope that it will be useful,
12627f7eb2Smrg but WITHOUT ANY WARRANTY; without even the implied warranty of
13627f7eb2Smrg MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14627f7eb2Smrg GNU General Public License for more details.
15627f7eb2Smrg
16627f7eb2Smrg Under Section 7 of GPL version 3, you are granted additional
17627f7eb2Smrg permissions described in the GCC Runtime Library Exception, version
18627f7eb2Smrg 3.1, as published by the Free Software Foundation.
19627f7eb2Smrg
20627f7eb2Smrg You should have received a copy of the GNU General Public License and
21627f7eb2Smrg a copy of the GCC Runtime Library Exception along with this program;
22627f7eb2Smrg see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
23627f7eb2Smrg <http://www.gnu.org/licenses/>. */
24627f7eb2Smrg
25627f7eb2Smrg
26627f7eb2Smrg #include "io.h"
27627f7eb2Smrg #include "fbuf.h"
28627f7eb2Smrg #include "unix.h"
29627f7eb2Smrg #include <string.h>
30627f7eb2Smrg
31627f7eb2Smrg
32627f7eb2Smrg //#define FBUF_DEBUG
33627f7eb2Smrg
34627f7eb2Smrg
35627f7eb2Smrg void
fbuf_init(gfc_unit * u,size_t len)36627f7eb2Smrg fbuf_init (gfc_unit *u, size_t len)
37627f7eb2Smrg {
38627f7eb2Smrg if (len == 0)
39627f7eb2Smrg len = 512; /* Default size. */
40627f7eb2Smrg
41627f7eb2Smrg u->fbuf = xmalloc (sizeof (struct fbuf));
42627f7eb2Smrg u->fbuf->buf = xmalloc (len);
43627f7eb2Smrg u->fbuf->len = len;
44627f7eb2Smrg u->fbuf->act = u->fbuf->pos = 0;
45627f7eb2Smrg }
46627f7eb2Smrg
47627f7eb2Smrg
48627f7eb2Smrg void
fbuf_destroy(gfc_unit * u)49627f7eb2Smrg fbuf_destroy (gfc_unit *u)
50627f7eb2Smrg {
51627f7eb2Smrg if (u->fbuf == NULL)
52627f7eb2Smrg return;
53627f7eb2Smrg free (u->fbuf->buf);
54627f7eb2Smrg free (u->fbuf);
55627f7eb2Smrg u->fbuf = NULL;
56627f7eb2Smrg }
57627f7eb2Smrg
58627f7eb2Smrg
59627f7eb2Smrg static void
60627f7eb2Smrg #ifdef FBUF_DEBUG
fbuf_debug(gfc_unit * u,const char * format,...)61627f7eb2Smrg fbuf_debug (gfc_unit *u, const char *format, ...)
62627f7eb2Smrg {
63627f7eb2Smrg va_list args;
64627f7eb2Smrg va_start(args, format);
65627f7eb2Smrg vfprintf(stderr, format, args);
66627f7eb2Smrg va_end(args);
67627f7eb2Smrg fprintf (stderr, "fbuf_debug pos: %lu, act: %lu, buf: ''",
68627f7eb2Smrg (long unsigned) u->fbuf->pos, (long unsigned) u->fbuf->act);
69627f7eb2Smrg for (size_t ii = 0; ii < u->fbuf->act; ii++)
70627f7eb2Smrg {
71627f7eb2Smrg putc (u->fbuf->buf[ii], stderr);
72627f7eb2Smrg }
73627f7eb2Smrg fprintf (stderr, "''\n");
74627f7eb2Smrg }
75627f7eb2Smrg #else
76627f7eb2Smrg fbuf_debug (gfc_unit *u __attribute__ ((unused)),
77627f7eb2Smrg const char *format __attribute__ ((unused)),
78627f7eb2Smrg ...) {}
79627f7eb2Smrg #endif
80627f7eb2Smrg
81627f7eb2Smrg
82627f7eb2Smrg
83627f7eb2Smrg /* You should probably call this before doing a physical seek on the
84627f7eb2Smrg underlying device. Returns how much the physical position was
85627f7eb2Smrg modified. */
86627f7eb2Smrg
87627f7eb2Smrg ptrdiff_t
fbuf_reset(gfc_unit * u)88627f7eb2Smrg fbuf_reset (gfc_unit *u)
89627f7eb2Smrg {
90627f7eb2Smrg ptrdiff_t seekval = 0;
91627f7eb2Smrg
92627f7eb2Smrg if (!u->fbuf)
93627f7eb2Smrg return 0;
94627f7eb2Smrg
95627f7eb2Smrg fbuf_debug (u, "fbuf_reset: ");
96627f7eb2Smrg fbuf_flush (u, u->mode);
97627f7eb2Smrg /* If we read past the current position, seek the underlying device
98627f7eb2Smrg back. */
99627f7eb2Smrg if (u->mode == READING && u->fbuf->act > u->fbuf->pos)
100627f7eb2Smrg {
101627f7eb2Smrg seekval = - (u->fbuf->act - u->fbuf->pos);
102627f7eb2Smrg fbuf_debug (u, "fbuf_reset seekval %ld, ", (long) seekval);
103627f7eb2Smrg }
104627f7eb2Smrg u->fbuf->act = u->fbuf->pos = 0;
105627f7eb2Smrg return seekval;
106627f7eb2Smrg }
107627f7eb2Smrg
108627f7eb2Smrg
109627f7eb2Smrg /* Return a pointer to the current position in the buffer, and increase
110627f7eb2Smrg the pointer by len. Makes sure that the buffer is big enough,
111627f7eb2Smrg reallocating if necessary. */
112627f7eb2Smrg
113627f7eb2Smrg char *
fbuf_alloc(gfc_unit * u,size_t len)114627f7eb2Smrg fbuf_alloc (gfc_unit *u, size_t len)
115627f7eb2Smrg {
116627f7eb2Smrg size_t newlen;
117627f7eb2Smrg char *dest;
118627f7eb2Smrg fbuf_debug (u, "fbuf_alloc len %lu, ", (long unsigned) len);
119627f7eb2Smrg if (u->fbuf->pos + len > u->fbuf->len)
120627f7eb2Smrg {
121627f7eb2Smrg /* Round up to nearest multiple of the current buffer length. */
122627f7eb2Smrg newlen = ((u->fbuf->pos + len) / u->fbuf->len + 1) *u->fbuf->len;
123627f7eb2Smrg u->fbuf->buf = xrealloc (u->fbuf->buf, newlen);
124627f7eb2Smrg u->fbuf->len = newlen;
125627f7eb2Smrg }
126627f7eb2Smrg
127627f7eb2Smrg dest = u->fbuf->buf + u->fbuf->pos;
128627f7eb2Smrg u->fbuf->pos += len;
129627f7eb2Smrg if (u->fbuf->pos > u->fbuf->act)
130627f7eb2Smrg u->fbuf->act = u->fbuf->pos;
131627f7eb2Smrg return dest;
132627f7eb2Smrg }
133627f7eb2Smrg
134627f7eb2Smrg
135627f7eb2Smrg /* mode argument is WRITING for write mode and READING for read
136627f7eb2Smrg mode. Return value is 0 for success, -1 on failure. */
137627f7eb2Smrg
138627f7eb2Smrg int
fbuf_flush(gfc_unit * u,unit_mode mode)139627f7eb2Smrg fbuf_flush (gfc_unit *u, unit_mode mode)
140627f7eb2Smrg {
141627f7eb2Smrg if (!u->fbuf)
142627f7eb2Smrg return 0;
143627f7eb2Smrg
144627f7eb2Smrg fbuf_debug (u, "fbuf_flush with mode %d: ", mode);
145627f7eb2Smrg
146627f7eb2Smrg if (mode == WRITING)
147627f7eb2Smrg {
148627f7eb2Smrg if (u->fbuf->pos > 0)
149627f7eb2Smrg {
150627f7eb2Smrg ptrdiff_t nwritten = swrite (u->s, u->fbuf->buf, u->fbuf->pos);
151627f7eb2Smrg if (nwritten < 0)
152627f7eb2Smrg return -1;
153627f7eb2Smrg }
154627f7eb2Smrg }
155627f7eb2Smrg /* Salvage remaining bytes for both reading and writing. This
156627f7eb2Smrg happens with the combination of advance='no' and T edit
157627f7eb2Smrg descriptors leaving the final position somewhere not at the end
158627f7eb2Smrg of the record. For reading, this also happens if we sread() past
159627f7eb2Smrg the record boundary. */
160627f7eb2Smrg if (u->fbuf->act > u->fbuf->pos && u->fbuf->pos > 0)
161627f7eb2Smrg memmove (u->fbuf->buf, u->fbuf->buf + u->fbuf->pos,
162627f7eb2Smrg u->fbuf->act - u->fbuf->pos);
163627f7eb2Smrg
164627f7eb2Smrg u->fbuf->act -= u->fbuf->pos;
165627f7eb2Smrg u->fbuf->pos = 0;
166627f7eb2Smrg
167627f7eb2Smrg return 0;
168627f7eb2Smrg }
169627f7eb2Smrg
170627f7eb2Smrg
171627f7eb2Smrg /* The mode argument is LIST_WRITING for write mode and LIST_READING for
172627f7eb2Smrg read. This should only be used for list directed I/O.
173627f7eb2Smrg Return value is 0 for success, -1 on failure. */
174627f7eb2Smrg
175627f7eb2Smrg int
fbuf_flush_list(gfc_unit * u,unit_mode mode)176627f7eb2Smrg fbuf_flush_list (gfc_unit *u, unit_mode mode)
177627f7eb2Smrg {
178627f7eb2Smrg if (!u->fbuf)
179627f7eb2Smrg return 0;
180627f7eb2Smrg
181627f7eb2Smrg if (u->fbuf->pos < 524288) /* Upper limit for list writing. */
182627f7eb2Smrg return 0;
183627f7eb2Smrg
184627f7eb2Smrg fbuf_debug (u, "fbuf_flush_list with mode %d: ", mode);
185627f7eb2Smrg
186627f7eb2Smrg if (mode == LIST_WRITING)
187627f7eb2Smrg {
188627f7eb2Smrg ptrdiff_t nwritten = swrite (u->s, u->fbuf->buf, u->fbuf->pos);
189627f7eb2Smrg if (nwritten < 0)
190627f7eb2Smrg return -1;
191627f7eb2Smrg }
192627f7eb2Smrg
193627f7eb2Smrg /* Salvage remaining bytes for both reading and writing. */
194627f7eb2Smrg if (u->fbuf->act > u->fbuf->pos)
195627f7eb2Smrg memmove (u->fbuf->buf, u->fbuf->buf + u->fbuf->pos,
196627f7eb2Smrg u->fbuf->act - u->fbuf->pos);
197627f7eb2Smrg
198627f7eb2Smrg u->fbuf->act -= u->fbuf->pos;
199627f7eb2Smrg u->fbuf->pos = 0;
200627f7eb2Smrg
201627f7eb2Smrg return 0;
202627f7eb2Smrg }
203627f7eb2Smrg
204627f7eb2Smrg
205627f7eb2Smrg ptrdiff_t
fbuf_seek(gfc_unit * u,ptrdiff_t off,int whence)206627f7eb2Smrg fbuf_seek (gfc_unit *u, ptrdiff_t off, int whence)
207627f7eb2Smrg {
208627f7eb2Smrg if (!u->fbuf)
209627f7eb2Smrg return -1;
210627f7eb2Smrg
211627f7eb2Smrg switch (whence)
212627f7eb2Smrg {
213627f7eb2Smrg case SEEK_SET:
214627f7eb2Smrg break;
215627f7eb2Smrg case SEEK_CUR:
216627f7eb2Smrg off += u->fbuf->pos;
217627f7eb2Smrg break;
218627f7eb2Smrg case SEEK_END:
219627f7eb2Smrg off += u->fbuf->act;
220627f7eb2Smrg break;
221627f7eb2Smrg default:
222627f7eb2Smrg return -1;
223627f7eb2Smrg }
224627f7eb2Smrg
225627f7eb2Smrg fbuf_debug (u, "fbuf_seek, off %ld ", (long) off);
226627f7eb2Smrg /* The start of the buffer is always equal to the left tab
227627f7eb2Smrg limit. Moving to the left past the buffer is illegal in C and
228627f7eb2Smrg would also imply moving past the left tab limit, which is never
229627f7eb2Smrg allowed in Fortran. Similarly, seeking past the end of the buffer
230627f7eb2Smrg is not possible, in that case the user must make sure to allocate
231627f7eb2Smrg space with fbuf_alloc(). So return error if that is
232627f7eb2Smrg attempted. */
233627f7eb2Smrg if (off < 0 || off > (ptrdiff_t) u->fbuf->act)
234627f7eb2Smrg return -1;
235627f7eb2Smrg u->fbuf->pos = off;
236627f7eb2Smrg return off;
237627f7eb2Smrg }
238627f7eb2Smrg
239627f7eb2Smrg
240627f7eb2Smrg /* Fill the buffer with bytes for reading. Returns a pointer to start
241627f7eb2Smrg reading from. If we hit EOF, returns a short read count. If any
242627f7eb2Smrg other error occurs, return NULL. After reading, the caller is
243627f7eb2Smrg expected to call fbuf_seek to update the position with the number
244627f7eb2Smrg of bytes actually processed. */
245627f7eb2Smrg
246627f7eb2Smrg char *
fbuf_read(gfc_unit * u,size_t * len)247627f7eb2Smrg fbuf_read (gfc_unit *u, size_t *len)
248627f7eb2Smrg {
249627f7eb2Smrg char *ptr;
250627f7eb2Smrg size_t oldact, oldpos;
251627f7eb2Smrg ptrdiff_t readlen = 0;
252627f7eb2Smrg
253627f7eb2Smrg fbuf_debug (u, "fbuf_read, len %lu: ", (unsigned long) *len);
254627f7eb2Smrg oldact = u->fbuf->act;
255627f7eb2Smrg oldpos = u->fbuf->pos;
256627f7eb2Smrg ptr = fbuf_alloc (u, *len);
257627f7eb2Smrg u->fbuf->pos = oldpos;
258627f7eb2Smrg if (oldpos + *len > oldact)
259627f7eb2Smrg {
260627f7eb2Smrg fbuf_debug (u, "reading %lu bytes starting at %lu ",
261627f7eb2Smrg (long unsigned) oldpos + *len - oldact,
262627f7eb2Smrg (long unsigned) oldact);
263627f7eb2Smrg readlen = sread (u->s, u->fbuf->buf + oldact, oldpos + *len - oldact);
264627f7eb2Smrg if (readlen < 0)
265627f7eb2Smrg return NULL;
266627f7eb2Smrg *len = oldact - oldpos + readlen;
267627f7eb2Smrg }
268627f7eb2Smrg u->fbuf->act = oldact + readlen;
269627f7eb2Smrg fbuf_debug (u, "fbuf_read done: ");
270627f7eb2Smrg return ptr;
271627f7eb2Smrg }
272627f7eb2Smrg
273627f7eb2Smrg
274627f7eb2Smrg /* When the fbuf_getc() inline function runs out of buffer space, it
275627f7eb2Smrg calls this function to fill the buffer with bytes for
276627f7eb2Smrg reading. Never call this function directly. */
277627f7eb2Smrg
278627f7eb2Smrg int
fbuf_getc_refill(gfc_unit * u)279627f7eb2Smrg fbuf_getc_refill (gfc_unit *u)
280627f7eb2Smrg {
281627f7eb2Smrg char *p;
282627f7eb2Smrg
283627f7eb2Smrg fbuf_debug (u, "fbuf_getc_refill ");
284627f7eb2Smrg
285627f7eb2Smrg /* Read 80 bytes (average line length?). This is a compromise
286627f7eb2Smrg between not needing to call the read() syscall all the time and
287627f7eb2Smrg not having to memmove unnecessary stuff when switching to the
288627f7eb2Smrg next record. */
289627f7eb2Smrg size_t nread = 80;
290627f7eb2Smrg
291627f7eb2Smrg p = fbuf_read (u, &nread);
292627f7eb2Smrg
293627f7eb2Smrg if (p && nread > 0)
294627f7eb2Smrg return (unsigned char) u->fbuf->buf[u->fbuf->pos++];
295627f7eb2Smrg else
296627f7eb2Smrg return EOF;
297627f7eb2Smrg }
298