1*0bfacb9bSmrg /* Copyright (C) 2008-2020 Free Software Foundation, Inc.
2760c2415Smrg    Contributed by Janne Blomqvist
3760c2415Smrg 
4760c2415Smrg This file is part of the GNU Fortran runtime library (libgfortran).
5760c2415Smrg 
6760c2415Smrg Libgfortran is free software; you can redistribute it and/or modify
7760c2415Smrg it under the terms of the GNU General Public License as published by
8760c2415Smrg the Free Software Foundation; either version 3, or (at your option)
9760c2415Smrg any later version.
10760c2415Smrg 
11760c2415Smrg Libgfortran is distributed in the hope that it will be useful,
12760c2415Smrg but WITHOUT ANY WARRANTY; without even the implied warranty of
13760c2415Smrg MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14760c2415Smrg GNU General Public License for more details.
15760c2415Smrg 
16760c2415Smrg Under Section 7 of GPL version 3, you are granted additional
17760c2415Smrg permissions described in the GCC Runtime Library Exception, version
18760c2415Smrg 3.1, as published by the Free Software Foundation.
19760c2415Smrg 
20760c2415Smrg You should have received a copy of the GNU General Public License and
21760c2415Smrg a copy of the GCC Runtime Library Exception along with this program;
22760c2415Smrg see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
23760c2415Smrg <http://www.gnu.org/licenses/>.  */
24760c2415Smrg 
25760c2415Smrg 
26760c2415Smrg #include "io.h"
27760c2415Smrg #include "fbuf.h"
28760c2415Smrg #include "unix.h"
29760c2415Smrg #include <string.h>
30760c2415Smrg 
31760c2415Smrg 
32760c2415Smrg //#define FBUF_DEBUG
33760c2415Smrg 
34760c2415Smrg 
35760c2415Smrg void
fbuf_init(gfc_unit * u,size_t len)36760c2415Smrg fbuf_init (gfc_unit *u, size_t len)
37760c2415Smrg {
38760c2415Smrg   if (len == 0)
39760c2415Smrg     len = 512;			/* Default size.  */
40760c2415Smrg 
41760c2415Smrg   u->fbuf = xmalloc (sizeof (struct fbuf));
42760c2415Smrg   u->fbuf->buf = xmalloc (len);
43760c2415Smrg   u->fbuf->len = len;
44760c2415Smrg   u->fbuf->act = u->fbuf->pos = 0;
45760c2415Smrg }
46760c2415Smrg 
47760c2415Smrg 
48760c2415Smrg void
fbuf_destroy(gfc_unit * u)49760c2415Smrg fbuf_destroy (gfc_unit *u)
50760c2415Smrg {
51760c2415Smrg   if (u->fbuf == NULL)
52760c2415Smrg     return;
53760c2415Smrg   free (u->fbuf->buf);
54760c2415Smrg   free (u->fbuf);
55760c2415Smrg   u->fbuf = NULL;
56760c2415Smrg }
57760c2415Smrg 
58760c2415Smrg 
59760c2415Smrg static void
60760c2415Smrg #ifdef FBUF_DEBUG
fbuf_debug(gfc_unit * u,const char * format,...)61760c2415Smrg fbuf_debug (gfc_unit *u, const char *format, ...)
62760c2415Smrg {
63760c2415Smrg   va_list args;
64760c2415Smrg   va_start(args, format);
65760c2415Smrg   vfprintf(stderr, format, args);
66760c2415Smrg   va_end(args);
67760c2415Smrg   fprintf (stderr, "fbuf_debug pos: %lu, act: %lu, buf: ''",
68760c2415Smrg            (long unsigned) u->fbuf->pos, (long unsigned) u->fbuf->act);
69760c2415Smrg   for (size_t ii = 0; ii < u->fbuf->act; ii++)
70760c2415Smrg     {
71760c2415Smrg       putc (u->fbuf->buf[ii], stderr);
72760c2415Smrg     }
73760c2415Smrg   fprintf (stderr, "''\n");
74760c2415Smrg }
75760c2415Smrg #else
76760c2415Smrg fbuf_debug (gfc_unit *u __attribute__ ((unused)),
77760c2415Smrg             const char *format __attribute__ ((unused)),
78760c2415Smrg             ...) {}
79760c2415Smrg #endif
80760c2415Smrg 
81760c2415Smrg 
82760c2415Smrg 
83760c2415Smrg /* You should probably call this before doing a physical seek on the
84760c2415Smrg    underlying device.  Returns how much the physical position was
85760c2415Smrg    modified.  */
86760c2415Smrg 
87760c2415Smrg ptrdiff_t
fbuf_reset(gfc_unit * u)88760c2415Smrg fbuf_reset (gfc_unit *u)
89760c2415Smrg {
90760c2415Smrg   ptrdiff_t seekval = 0;
91760c2415Smrg 
92760c2415Smrg   if (!u->fbuf)
93760c2415Smrg     return 0;
94760c2415Smrg 
95760c2415Smrg   fbuf_debug (u, "fbuf_reset: ");
96760c2415Smrg   fbuf_flush (u, u->mode);
97760c2415Smrg   /* If we read past the current position, seek the underlying device
98760c2415Smrg      back.  */
99760c2415Smrg   if (u->mode == READING && u->fbuf->act > u->fbuf->pos)
100760c2415Smrg     {
101760c2415Smrg       seekval = - (u->fbuf->act - u->fbuf->pos);
102760c2415Smrg       fbuf_debug (u, "fbuf_reset seekval %ld, ", (long) seekval);
103760c2415Smrg     }
104760c2415Smrg   u->fbuf->act = u->fbuf->pos = 0;
105760c2415Smrg   return seekval;
106760c2415Smrg }
107760c2415Smrg 
108760c2415Smrg 
109760c2415Smrg /* Return a pointer to the current position in the buffer, and increase
110760c2415Smrg    the pointer by len. Makes sure that the buffer is big enough,
111760c2415Smrg    reallocating if necessary.  */
112760c2415Smrg 
113760c2415Smrg char *
fbuf_alloc(gfc_unit * u,size_t len)114760c2415Smrg fbuf_alloc (gfc_unit *u, size_t len)
115760c2415Smrg {
116760c2415Smrg   size_t newlen;
117760c2415Smrg   char *dest;
118760c2415Smrg   fbuf_debug (u, "fbuf_alloc len %lu, ", (long unsigned) len);
119760c2415Smrg   if (u->fbuf->pos + len > u->fbuf->len)
120760c2415Smrg     {
121760c2415Smrg       /* Round up to nearest multiple of the current buffer length.  */
122760c2415Smrg       newlen = ((u->fbuf->pos + len) / u->fbuf->len + 1) *u->fbuf->len;
123760c2415Smrg       u->fbuf->buf = xrealloc (u->fbuf->buf, newlen);
124760c2415Smrg       u->fbuf->len = newlen;
125760c2415Smrg     }
126760c2415Smrg 
127760c2415Smrg   dest = u->fbuf->buf + u->fbuf->pos;
128760c2415Smrg   u->fbuf->pos += len;
129760c2415Smrg   if (u->fbuf->pos > u->fbuf->act)
130760c2415Smrg     u->fbuf->act = u->fbuf->pos;
131760c2415Smrg   return dest;
132760c2415Smrg }
133760c2415Smrg 
134760c2415Smrg 
135760c2415Smrg /* mode argument is WRITING for write mode and READING for read
136760c2415Smrg    mode. Return value is 0 for success, -1 on failure.  */
137760c2415Smrg 
138760c2415Smrg int
fbuf_flush(gfc_unit * u,unit_mode mode)139760c2415Smrg fbuf_flush (gfc_unit *u, unit_mode mode)
140760c2415Smrg {
141760c2415Smrg   if (!u->fbuf)
142760c2415Smrg     return 0;
143760c2415Smrg 
144760c2415Smrg   fbuf_debug (u, "fbuf_flush with mode %d: ", mode);
145760c2415Smrg 
146760c2415Smrg   if (mode == WRITING)
147760c2415Smrg     {
148760c2415Smrg       if (u->fbuf->pos > 0)
149760c2415Smrg 	{
150760c2415Smrg 	  ptrdiff_t nwritten = swrite (u->s, u->fbuf->buf, u->fbuf->pos);
151760c2415Smrg 	  if (nwritten < 0)
152760c2415Smrg 	    return -1;
153760c2415Smrg 	}
154760c2415Smrg     }
155760c2415Smrg   /* Salvage remaining bytes for both reading and writing. This
156760c2415Smrg      happens with the combination of advance='no' and T edit
157760c2415Smrg      descriptors leaving the final position somewhere not at the end
158760c2415Smrg      of the record. For reading, this also happens if we sread() past
159760c2415Smrg      the record boundary.  */
160760c2415Smrg   if (u->fbuf->act > u->fbuf->pos && u->fbuf->pos > 0)
161760c2415Smrg     memmove (u->fbuf->buf, u->fbuf->buf + u->fbuf->pos,
162760c2415Smrg              u->fbuf->act - u->fbuf->pos);
163760c2415Smrg 
164760c2415Smrg   u->fbuf->act -= u->fbuf->pos;
165760c2415Smrg   u->fbuf->pos = 0;
166760c2415Smrg 
167760c2415Smrg   return 0;
168760c2415Smrg }
169760c2415Smrg 
170760c2415Smrg 
171760c2415Smrg /* The mode argument is LIST_WRITING for write mode and LIST_READING for
172760c2415Smrg    read.  This should only be used for list directed  I/O.
173760c2415Smrg    Return value is 0 for success, -1 on failure.  */
174760c2415Smrg 
175760c2415Smrg int
fbuf_flush_list(gfc_unit * u,unit_mode mode)176760c2415Smrg fbuf_flush_list (gfc_unit *u, unit_mode mode)
177760c2415Smrg {
178760c2415Smrg   if (!u->fbuf)
179760c2415Smrg     return 0;
180760c2415Smrg 
181760c2415Smrg   if (u->fbuf->pos < 524288) /* Upper limit for list writing.  */
182760c2415Smrg     return 0;
183760c2415Smrg 
184760c2415Smrg   fbuf_debug (u, "fbuf_flush_list with mode %d: ", mode);
185760c2415Smrg 
186760c2415Smrg   if (mode == LIST_WRITING)
187760c2415Smrg     {
188760c2415Smrg       ptrdiff_t nwritten = swrite (u->s, u->fbuf->buf, u->fbuf->pos);
189760c2415Smrg       if (nwritten < 0)
190760c2415Smrg 	return -1;
191760c2415Smrg     }
192760c2415Smrg 
193760c2415Smrg   /* Salvage remaining bytes for both reading and writing.  */
194760c2415Smrg   if (u->fbuf->act > u->fbuf->pos)
195760c2415Smrg     memmove (u->fbuf->buf, u->fbuf->buf + u->fbuf->pos,
196760c2415Smrg              u->fbuf->act - u->fbuf->pos);
197760c2415Smrg 
198760c2415Smrg   u->fbuf->act -= u->fbuf->pos;
199760c2415Smrg   u->fbuf->pos = 0;
200760c2415Smrg 
201760c2415Smrg   return 0;
202760c2415Smrg }
203760c2415Smrg 
204760c2415Smrg 
205760c2415Smrg ptrdiff_t
fbuf_seek(gfc_unit * u,ptrdiff_t off,int whence)206760c2415Smrg fbuf_seek (gfc_unit *u, ptrdiff_t off, int whence)
207760c2415Smrg {
208760c2415Smrg   if (!u->fbuf)
209760c2415Smrg     return -1;
210760c2415Smrg 
211760c2415Smrg   switch (whence)
212760c2415Smrg     {
213760c2415Smrg     case SEEK_SET:
214760c2415Smrg       break;
215760c2415Smrg     case SEEK_CUR:
216760c2415Smrg       off += u->fbuf->pos;
217760c2415Smrg       break;
218760c2415Smrg     case SEEK_END:
219760c2415Smrg       off += u->fbuf->act;
220760c2415Smrg       break;
221760c2415Smrg     default:
222760c2415Smrg       return -1;
223760c2415Smrg     }
224760c2415Smrg 
225760c2415Smrg   fbuf_debug (u, "fbuf_seek, off %ld ", (long) off);
226760c2415Smrg   /* The start of the buffer is always equal to the left tab
227760c2415Smrg      limit. Moving to the left past the buffer is illegal in C and
228760c2415Smrg      would also imply moving past the left tab limit, which is never
229760c2415Smrg      allowed in Fortran. Similarly, seeking past the end of the buffer
230760c2415Smrg      is not possible, in that case the user must make sure to allocate
231760c2415Smrg      space with fbuf_alloc().  So return error if that is
232760c2415Smrg      attempted.  */
233760c2415Smrg   if (off < 0 || off > (ptrdiff_t) u->fbuf->act)
234760c2415Smrg     return -1;
235760c2415Smrg   u->fbuf->pos = off;
236760c2415Smrg   return off;
237760c2415Smrg }
238760c2415Smrg 
239760c2415Smrg 
240760c2415Smrg /* Fill the buffer with bytes for reading.  Returns a pointer to start
241760c2415Smrg    reading from. If we hit EOF, returns a short read count. If any
242760c2415Smrg    other error occurs, return NULL.  After reading, the caller is
243760c2415Smrg    expected to call fbuf_seek to update the position with the number
244760c2415Smrg    of bytes actually processed. */
245760c2415Smrg 
246760c2415Smrg char *
fbuf_read(gfc_unit * u,size_t * len)247760c2415Smrg fbuf_read (gfc_unit *u, size_t *len)
248760c2415Smrg {
249760c2415Smrg   char *ptr;
250760c2415Smrg   size_t oldact, oldpos;
251760c2415Smrg   ptrdiff_t readlen = 0;
252760c2415Smrg 
253760c2415Smrg   fbuf_debug (u, "fbuf_read, len %lu: ", (unsigned long) *len);
254760c2415Smrg   oldact = u->fbuf->act;
255760c2415Smrg   oldpos = u->fbuf->pos;
256760c2415Smrg   ptr = fbuf_alloc (u, *len);
257760c2415Smrg   u->fbuf->pos = oldpos;
258760c2415Smrg   if (oldpos + *len > oldact)
259760c2415Smrg     {
260760c2415Smrg       fbuf_debug (u, "reading %lu bytes starting at %lu ",
261760c2415Smrg                   (long unsigned) oldpos + *len - oldact,
262760c2415Smrg 		  (long unsigned) oldact);
263760c2415Smrg       readlen = sread (u->s, u->fbuf->buf + oldact, oldpos + *len - oldact);
264760c2415Smrg       if (readlen < 0)
265760c2415Smrg 	return NULL;
266760c2415Smrg       *len = oldact - oldpos + readlen;
267760c2415Smrg     }
268760c2415Smrg   u->fbuf->act = oldact + readlen;
269760c2415Smrg   fbuf_debug (u, "fbuf_read done: ");
270760c2415Smrg   return ptr;
271760c2415Smrg }
272760c2415Smrg 
273760c2415Smrg 
274760c2415Smrg /* When the fbuf_getc() inline function runs out of buffer space, it
275760c2415Smrg    calls this function to fill the buffer with bytes for
276760c2415Smrg    reading. Never call this function directly.  */
277760c2415Smrg 
278760c2415Smrg int
fbuf_getc_refill(gfc_unit * u)279760c2415Smrg fbuf_getc_refill (gfc_unit *u)
280760c2415Smrg {
281760c2415Smrg   char *p;
282760c2415Smrg 
283760c2415Smrg   fbuf_debug (u, "fbuf_getc_refill ");
284760c2415Smrg 
285760c2415Smrg   /* Read 80 bytes (average line length?).  This is a compromise
286760c2415Smrg      between not needing to call the read() syscall all the time and
287760c2415Smrg      not having to memmove unnecessary stuff when switching to the
288760c2415Smrg      next record.  */
289760c2415Smrg   size_t nread = 80;
290760c2415Smrg 
291760c2415Smrg   p = fbuf_read (u, &nread);
292760c2415Smrg 
293760c2415Smrg   if (p && nread > 0)
294760c2415Smrg     return (unsigned char) u->fbuf->buf[u->fbuf->pos++];
295760c2415Smrg   else
296760c2415Smrg     return EOF;
297760c2415Smrg }
298