1 /* Copyright (C) 2008-2018 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)
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/>. */
36 fbuf_init (gfc_unit
*u
, size_t len
)
39 len
= 512; /* Default size. */
41 u
->fbuf
= xmalloc (sizeof (struct fbuf
));
42 u
->fbuf
->buf
= xmalloc (len
);
44 u
->fbuf
->act
= u
->fbuf
->pos
= 0;
49 fbuf_destroy (gfc_unit
*u
)
61 fbuf_debug (gfc_unit
*u
, const char *format
, ...)
64 va_start(args
, format
);
65 vfprintf(stderr
, format
, 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
++)
71 putc (u
->fbuf
->buf
[ii
], stderr
);
73 fprintf (stderr
, "''\n");
76 fbuf_debug (gfc_unit
*u
__attribute__ ((unused
)),
77 const char *format
__attribute__ ((unused
)),
83 /* You should probably call this before doing a physical seek on the
84 underlying device. Returns how much the physical position was
88 fbuf_reset (gfc_unit
*u
)
90 ptrdiff_t seekval
= 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
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 %ld, ", (long) seekval
);
104 u
->fbuf
->act
= u
->fbuf
->pos
= 0;
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. */
114 fbuf_alloc (gfc_unit
*u
, size_t len
)
118 fbuf_debug (u
, "fbuf_alloc len %lu, ", (long unsigned) 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
;
129 if (u
->fbuf
->pos
> u
->fbuf
->act
)
130 u
->fbuf
->act
= u
->fbuf
->pos
;
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
)
144 fbuf_debug (u
, "fbuf_flush with mode %d: ", mode
);
148 if (u
->fbuf
->pos
> 0)
150 ptrdiff_t nwritten
= swrite (u
->s
, u
->fbuf
->buf
, u
->fbuf
->pos
);
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
);
164 u
->fbuf
->act
-= u
->fbuf
->pos
;
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. */
176 fbuf_flush_list (gfc_unit
*u
, unit_mode mode
)
181 if (u
->fbuf
->pos
< 524288) /* Upper limit for list writing. */
184 fbuf_debug (u
, "fbuf_flush_list with mode %d: ", mode
);
186 if (mode
== LIST_WRITING
)
188 ptrdiff_t nwritten
= swrite (u
->s
, u
->fbuf
->buf
, u
->fbuf
->pos
);
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
);
198 u
->fbuf
->act
-= u
->fbuf
->pos
;
206 fbuf_seek (gfc_unit
*u
, ptrdiff_t off
, int whence
)
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
233 if (off
< 0 || off
> (ptrdiff_t) u
->fbuf
->act
)
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. */
247 fbuf_read (gfc_unit
*u
, size_t *len
)
250 size_t oldact
, oldpos
;
251 ptrdiff_t readlen
= 0;
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
)
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
);
266 *len
= oldact
- oldpos
+ readlen
;
268 u
->fbuf
->act
= oldact
+ readlen
;
269 fbuf_debug (u
, "fbuf_read done: ");
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. */
279 fbuf_getc_refill (gfc_unit
*u
)
283 fbuf_debug (u
, "fbuf_getc_refill ");
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
291 p
= fbuf_read (u
, &nread
);
294 return (unsigned char) u
->fbuf
->buf
[u
->fbuf
->pos
++];