* gcc-interface/trans.c (process_freeze_entity): Be prepared for a
[official-gcc.git] / libgfortran / io / fbuf.c
blob944469d8cecf4d3e82a46c1d3113c60509edfc09
1 /* Copyright (C) 2008-2017 Free Software Foundation, Inc.
2 Contributed by Janne Blomqvist
4 This file is part of the GNU Fortran runtime library (libgfortran).
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.
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.
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.
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/>. */
26 #include "io.h"
27 #include "fbuf.h"
28 #include "unix.h"
29 #include <string.h>
32 //#define FBUF_DEBUG
35 void
36 fbuf_init (gfc_unit *u, int len)
38 if (len == 0)
39 len = 512; /* Default size. */
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;
48 void
49 fbuf_destroy (gfc_unit *u)
51 if (u->fbuf == NULL)
52 return;
53 free (u->fbuf->buf);
54 free (u->fbuf);
55 u->fbuf = NULL;
59 static void
60 #ifdef FBUF_DEBUG
61 fbuf_debug (gfc_unit *u, const char *format, ...)
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++)
71 putc (u->fbuf->buf[ii], stderr);
73 fprintf (stderr, "''\n");
75 #else
76 fbuf_debug (gfc_unit *u __attribute__ ((unused)),
77 const char *format __attribute__ ((unused)),
78 ...) {}
79 #endif
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. */
87 int
88 fbuf_reset (gfc_unit *u)
90 int seekval = 0;
92 if (!u->fbuf)
93 return 0;
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)
101 seekval = - (u->fbuf->act - u->fbuf->pos);
102 fbuf_debug (u, "fbuf_reset seekval %d, ", seekval);
104 u->fbuf->act = u->fbuf->pos = 0;
105 return seekval;
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. */
113 char *
114 fbuf_alloc (gfc_unit *u, int len)
116 int newlen;
117 char *dest;
118 fbuf_debug (u, "fbuf_alloc len %d, ", len);
119 if (u->fbuf->pos + len > u->fbuf->len)
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;
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;
135 /* mode argument is WRITING for write mode and READING for read
136 mode. Return value is 0 for success, -1 on failure. */
139 fbuf_flush (gfc_unit *u, unit_mode mode)
141 int nwritten;
143 if (!u->fbuf)
144 return 0;
146 fbuf_debug (u, "fbuf_flush with mode %d: ", mode);
148 if (mode == WRITING)
150 if (u->fbuf->pos > 0)
152 nwritten = swrite (u->s, u->fbuf->buf, u->fbuf->pos);
153 if (nwritten < 0)
154 return -1;
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);
166 u->fbuf->act -= u->fbuf->pos;
167 u->fbuf->pos = 0;
169 return 0;
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. */
178 fbuf_flush_list (gfc_unit *u, unit_mode mode)
180 int nwritten;
182 if (!u->fbuf)
183 return 0;
185 if (u->fbuf->pos < 524288) /* Upper limit for list writing. */
186 return 0;
188 fbuf_debug (u, "fbuf_flush_list with mode %d: ", mode);
190 if (mode == LIST_WRITING)
192 nwritten = swrite (u->s, u->fbuf->buf, u->fbuf->pos);
193 if (nwritten < 0)
194 return -1;
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);
202 u->fbuf->act -= u->fbuf->pos;
203 u->fbuf->pos = 0;
205 return 0;
210 fbuf_seek (gfc_unit *u, int off, int whence)
212 if (!u->fbuf)
213 return -1;
215 switch (whence)
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;
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;
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. */
250 char *
251 fbuf_read (gfc_unit *u, int *len)
253 char *ptr;
254 int oldact, oldpos;
255 int readlen = 0;
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)
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;
271 u->fbuf->act = oldact + readlen;
272 fbuf_debug (u, "fbuf_read done: ");
273 return ptr;
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. */
282 fbuf_getc_refill (gfc_unit *u)
284 int nread;
285 char *p;
287 fbuf_debug (u, "fbuf_getc_refill ");
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;
295 p = fbuf_read (u, &nread);
297 if (p && nread > 0)
298 return (unsigned char) u->fbuf->buf[u->fbuf->pos++];
299 else
300 return EOF;