]> git.ipfire.org Git - thirdparty/gcc.git/blame - libgfortran/io/fbuf.c
re PR tree-optimization/80374 (ICE in fold_convert_loc, at fold-const.c:2384)
[thirdparty/gcc.git] / libgfortran / io / fbuf.c
CommitLineData
cbe34bb5 1/* Copyright (C) 2008-2017 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
7812c78c 36fbuf_init (gfc_unit * u, int 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
49fbuf_destroy (gfc_unit * u)
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
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: %d, act: %d, buf: ''",
68 u->fbuf->pos, u->fbuf->act);
69 for (int 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
87int
88fbuf_reset (gfc_unit * u)
89{
90 int 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 %d, ", seekval);
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 *
7812c78c 114fbuf_alloc (gfc_unit * u, int len)
7c1b4aba 115{
7812c78c 116 int newlen;
7c1b4aba 117 char *dest;
7812c78c 118 fbuf_debug (u, "fbuf_alloc len %d, ", len);
8947fd62 119 if (u->fbuf->pos + len > u->fbuf->len)
7c1b4aba 120 {
7812c78c
JD
121 /* Round up to nearest multiple of the current buffer length. */
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
7812c78c 139fbuf_flush (gfc_unit * u, unit_mode mode)
7c1b4aba 140{
7812c78c 141 int nwritten;
7c1b4aba
JB
142
143 if (!u->fbuf)
144 return 0;
7812c78c
JD
145
146 fbuf_debug (u, "fbuf_flush with mode %d: ", mode);
147
148 if (mode == WRITING)
7c1b4aba 149 {
7812c78c
JD
150 if (u->fbuf->pos > 0)
151 {
152 nwritten = swrite (u->s, u->fbuf->buf, u->fbuf->pos);
153 if (nwritten < 0)
154 return -1;
155 }
7c1b4aba 156 }
7812c78c
JD
157 /* Salvage remaining bytes for both reading and writing. This
158 happens with the combination of advance='no' and T edit
159 descriptors leaving the final position somewhere not at the end
160 of the record. For reading, this also happens if we sread() past
161 the record boundary. */
162 if (u->fbuf->act > u->fbuf->pos && u->fbuf->pos > 0)
163 memmove (u->fbuf->buf, u->fbuf->buf + u->fbuf->pos,
164 u->fbuf->act - u->fbuf->pos);
165
166 u->fbuf->act -= u->fbuf->pos;
167 u->fbuf->pos = 0;
168
169 return 0;
7c1b4aba
JB
170}
171
172
1060d940
JD
173/* The mode argument is LIST_WRITING for write mode and LIST_READING for
174 read. This should only be used for list directed I/O.
175 Return value is 0 for success, -1 on failure. */
176
177int
178fbuf_flush_list (gfc_unit * u, unit_mode mode)
179{
180 int nwritten;
181
182 if (!u->fbuf)
183 return 0;
184
185 if (u->fbuf->pos < 524288) /* Upper limit for list writing. */
186 return 0;
187
188 fbuf_debug (u, "fbuf_flush_list with mode %d: ", mode);
189
190 if (mode == LIST_WRITING)
191 {
192 nwritten = swrite (u->s, u->fbuf->buf, u->fbuf->pos);
193 if (nwritten < 0)
194 return -1;
195 }
196
197 /* Salvage remaining bytes for both reading and writing. */
198 if (u->fbuf->act > u->fbuf->pos)
199 memmove (u->fbuf->buf, u->fbuf->buf + u->fbuf->pos,
200 u->fbuf->act - u->fbuf->pos);
201
202 u->fbuf->act -= u->fbuf->pos;
203 u->fbuf->pos = 0;
204
205 return 0;
206}
207
208
7c1b4aba 209int
7812c78c 210fbuf_seek (gfc_unit * u, int off, int whence)
7c1b4aba 211{
7812c78c 212 if (!u->fbuf)
7c1b4aba 213 return -1;
7812c78c
JD
214
215 switch (whence)
216 {
217 case SEEK_SET:
218 break;
219 case SEEK_CUR:
220 off += u->fbuf->pos;
221 break;
222 case SEEK_END:
223 off += u->fbuf->act;
224 break;
225 default:
226 return -1;
227 }
228
229 fbuf_debug (u, "fbuf_seek, off %d ", off);
230 /* The start of the buffer is always equal to the left tab
231 limit. Moving to the left past the buffer is illegal in C and
232 would also imply moving past the left tab limit, which is never
233 allowed in Fortran. Similarly, seeking past the end of the buffer
234 is not possible, in that case the user must make sure to allocate
235 space with fbuf_alloc(). So return error if that is
236 attempted. */
237 if (off < 0 || off > u->fbuf->act)
238 return -1;
239 u->fbuf->pos = off;
240 return off;
241}
242
243
244/* Fill the buffer with bytes for reading. Returns a pointer to start
245 reading from. If we hit EOF, returns a short read count. If any
246 other error occurs, return NULL. After reading, the caller is
247 expected to call fbuf_seek to update the position with the number
248 of bytes actually processed. */
249
250char *
251fbuf_read (gfc_unit * u, int * len)
252{
253 char *ptr;
254 int oldact, oldpos;
255 int readlen = 0;
256
257 fbuf_debug (u, "fbuf_read, len %d: ", *len);
258 oldact = u->fbuf->act;
259 oldpos = u->fbuf->pos;
260 ptr = fbuf_alloc (u, *len);
261 u->fbuf->pos = oldpos;
262 if (oldpos + *len > oldact)
263 {
264 fbuf_debug (u, "reading %d bytes starting at %d ",
265 oldpos + *len - oldact, oldact);
266 readlen = sread (u->s, u->fbuf->buf + oldact, oldpos + *len - oldact);
267 if (readlen < 0)
268 return NULL;
269 *len = oldact - oldpos + readlen;
270 }
271 u->fbuf->act = oldact + readlen;
272 fbuf_debug (u, "fbuf_read done: ");
273 return ptr;
274}
275
276
277/* When the fbuf_getc() inline function runs out of buffer space, it
278 calls this function to fill the buffer with bytes for
279 reading. Never call this function directly. */
280
281int
282fbuf_getc_refill (gfc_unit * u)
283{
284 int nread;
285 char *p;
286
287 fbuf_debug (u, "fbuf_getc_refill ");
288
289 /* Read 80 bytes (average line length?). This is a compromise
290 between not needing to call the read() syscall all the time and
291 not having to memmove unnecessary stuff when switching to the
292 next record. */
293 nread = 80;
294
295 p = fbuf_read (u, &nread);
296
297 if (p && nread > 0)
298 return (unsigned char) u->fbuf->buf[u->fbuf->pos++];
299 else
300 return EOF;
7c1b4aba 301}