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)
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
, int 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: %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");
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
)
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 %d, ", 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
, int len
)
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
;
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
)
146 fbuf_debug (u
, "fbuf_flush with mode %d: ", mode
);
150 if (u
->fbuf
->pos
> 0)
152 nwritten
= swrite (u
->s
, u
->fbuf
->buf
, u
->fbuf
->pos
);
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
;
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
)
185 if (u
->fbuf
->pos
< 524288) /* Upper limit for list writing. */
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
);
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
;
210 fbuf_seek (gfc_unit
* u
, int off
, int whence
)
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
237 if (off
< 0 || off
> u
->fbuf
->act
)
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. */
251 fbuf_read (gfc_unit
* u
, int * len
)
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
);
269 *len
= oldact
- oldpos
+ readlen
;
271 u
->fbuf
->act
= oldact
+ readlen
;
272 fbuf_debug (u
, "fbuf_read done: ");
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
)
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
295 p
= fbuf_read (u
, &nread
);
298 return (unsigned char) u
->fbuf
->buf
[u
->fbuf
->pos
++];