Skip to content

R
riscv-gcc-1
Commit 9e544d73 by Janne Blomqvist
Options

PR libfortran/25561 libfortran/37754 

2009-03-22  Janne Blomqvist  <jb@gcc.gnu.org>

        PR libfortran/25561 libfortran/37754
	* io/io.h (struct stream): Define new stream interface function
	pointers, and inline functions for accessing it.
	(struct fbuf): Use int instead of size_t, remove flushed element.
	(mem_alloc_w): New prototype.
	(mem_alloc_r): New prototype.
	(stream_at_bof): Remove prototype.
	(stream_at_eof): Remove prototype.
	(file_position): Remove prototype.
	(flush): Remove prototype.
	(stream_offset): Remove prototype.
	(unit_truncate): New prototype.
	(read_block_form): Change to return pointer, int* argument.
	(hit_eof): New prototype.
	(fbuf_init): Change prototype.
	(fbuf_reset): Change prototype.
	(fbuf_alloc): Change prototype.
	(fbuf_flush): Change prototype.
	(fbuf_seek): Change prototype.
	(fbuf_read): New prototype.
	(fbuf_getc_refill): New prototype.
	(fbuf_getc): New inline function.
        * io/fbuf.c (fbuf_init): Use int, get rid of flushed.
	(fbuf_debug): New function.
	(fbuf_reset): Flush, and return position offset.
	(fbuf_alloc): Simplify, don't flush, just realloc.
	(fbuf_flush): Make usable for read mode, salvage remaining bytes.
	(fbuf_seek): New whence argument.
	(fbuf_read): New function.
	(fbuf_getc_refill): New function.
	* io/file_pos.c (formatted_backspace): Use new stream interface.
	(unformatted_backspace): Likewise.
	(st_backspace): Make sure format buffer is reset, use new stream
	interface, use unit_truncate.
	(st_endfile): Likewise.
	(st_rewind): Likewise.
	* io/intrinsics.c: Use new stream interface.
	* io/list_read.c (push_char): Don't use u.p.scratch, use realloc
	to resize.
	(free_saved): Don't check u.p.scratch.
	(next_char): Use new stream interface, use fbuf_getc() for external files.
	(finish_list_read): flush format buffer.
	(nml_query): Update to use modified interface:s
	* io/open.c (test_endfile): Use new stream interface.
	(edit_modes): Likewise.
	(new_unit): Likewise, set bytes_left to 1 for stream files.
	* io/read.c (read_l): Use new read_block_form interface.
	(read_utf8): Likewise.
	(read_utf8_char1): Likewise.
	(read_default_char1): Likewise.
	(read_utf8_char4): Likewise.
	(read_default_char4): Likewise.
	(read_a): Likewise.
	(read_a_char4): Likewise.
	(read_decimal): Likewise.
	(read_radix): Likewise.
	(read_f): Likewise.
	* io/transfer.c (read_sf): Use fbuf_read and mem_alloc_r, remove
	usage of u.p.line_buffer.
	(read_block_form): Update interface to return pointer, use
	fbuf_read for direct access.
	(read_block_direct): Update to new stream interface.
	(write_block): Use mem_alloc_w for internal I/O.
	(write_buf): Update to new stream interface.
	(formatted_transfer_scalar): Don't use u.p.line_buffer, use
	fbuf_seek for external files.
	(us_read): Update to new stream interface.
	(us_write): Likewise.
	(data_transfer_init): Always check if we switch modes and flush.
	(skip_record): Use new stream interface, fix comparison.
	(next_record_r): Check for and reset u.p.at_eof, use new stream
	interface, use fbuf_getc for spacing.
	(write_us_marker): Update to new stream interface, don't inline.
	(next_record_w_unf): Likewise.
	(sset): New function.
	(next_record_w): Use new stream interface, use fbuf for printing
	newline.
	(next_record): Use new stream interface.
	(finalize_transfer): Remove sfree call, use new stream interface.
	(st_iolength_done): Don't use u.p.scratch.
	(st_read): Don't check for end of file.
	(st_read_done): Don't use u.p.scratch, use unit_truncate.
	(hit_eof): New function.
	* io/unit.c (init_units): Always init fbuf for formatted units.
	(update_position): Use new stream interface.
	(unit_truncate): New function.
	(finish_last_advance_record): Use fbuf to print newline.
	* io/unix.c: Remove unused SSIZE_MAX macro.
	(BUFFER_SIZE): Make static const variable rather than macro.
	(struct unix_stream): Remove dirty_offset, len, method,
	small_buffer. Order elements by decreasing size.
	(struct int_stream): Remove.
	(move_pos_offset): Remove usage of dirty_offset.
	(reset_stream): Remove.
	(do_read): Rename to raw_read, update to match new stream
	interface.
	(do_write): Rename to raw_write, update to new stream interface.
	(raw_seek): New function.
	(raw_tell): New function.
	(raw_truncate): New function.
	(raw_close): New function.
	(raw_flush): New function.
	(raw_init): New function.
	(fd_alloc): Remove.
	(fd_alloc_r_at): Remove.
	(fd_alloc_w_at): Remove.
	(fd_sfree): Remove.
	(fd_seek): Remove.
	(fd_truncate): Remove.
	(fd_sset): Remove.
	(fd_read): Remove.
	(fd_write): Remove.
	(fd_close): Remove.
	(fd_open): Remove.
	(fd_flush): Rename to buf_flush, update to new stream interface
	and unix_stream.
	(buf_read): New function.
	(buf_write): New function.
	(buf_seek): New function.
	(buf_tell): New function.
	(buf_truncate): New function.
	(buf_close): New function.
	(buf_init): New function.
	(mem_alloc_r_at): Rename to mem_alloc_r, change prototype.
	(mem_alloc_w_at): Rename to mem_alloc_w, change prototype.
	(mem_read): Change to match new stream interface.
	(mem_write): Likewise.
	(mem_seek): Likewise.
	(mem_tell): Likewise.
	(mem_truncate): Likewise.
	(mem_close): Likewise.
	(mem_flush): New function.
	(mem_sfree): Remove.
	(empty_internal_buffer): Cast to correct type.
	(open_internal): Use correct type, init function pointers.
	(fd_to_stream): Test whether to open file as buffered or raw.
	(output_stream): Remove mode set.
	(error_stream): Likewise.
	(flush_all_units_1): Use new stream interface.
	(flush_all_units): Likewise.
	(stream_at_bof): Remove.
	(stream_at_eof): Remove.
	(file_position): Remove.
	(file_length): Update logic to use stream interface.
	(flush): Remove.
	(stream_offset): Remove.
	* io/write.c (write_utf8_char4): Use int instead of size_t.
	(write_x): Extra safety check.
	(namelist_write_newline): Use new stream interface.

[[Split portion of a mixed commit.]]

From-SVN: r144993.2
parent 048fd785
Showing with 530 additions and 440 deletions
libgfortran/io/io.h
......@@ -49,34 +49,59 @@ struct st_parameter_dt;
typedef struct stream
{
char *(*alloc_w_at) (struct stream *, int *);
try (*sfree) (struct stream *);
try (*close) (struct stream *);
try (*seek) (struct stream *, gfc_offset);
try (*trunc) (struct stream *);
int (*read) (struct stream *, void *, size_t *);
int (*write) (struct stream *, const void *, size_t *);
try (*set) (struct stream *, int, size_t);
ssize_t (*read) (struct stream *, void *, ssize_t);
ssize_t (*write) (struct stream *, const void *, ssize_t);
off_t (*seek) (struct stream *, off_t, int);
off_t (*tell) (struct stream *);
int (*truncate) (struct stream *, off_t);
int (*flush) (struct stream *);
int (*close) (struct stream *);
}
stream;
typedef enum
{ SYNC_BUFFERED, SYNC_UNBUFFERED, ASYNC }
io_mode;
/* Inline functions for doing file I/O given a stream. */
static inline ssize_t
sread (stream * s, void * buf, ssize_t nbyte)
{
return s->read (s, buf, nbyte);
}
/* Macros for doing file I/O given a stream. */
static inline ssize_t
swrite (stream * s, const void * buf, ssize_t nbyte)
{
return s->write (s, buf, nbyte);
}
#define sfree(s) ((s)->sfree)(s)
#define sclose(s) ((s)->close)(s)
static inline off_t
sseek (stream * s, off_t offset, int whence)
{
return s->seek (s, offset, whence);
}
#define salloc_w(s, len) ((s)->alloc_w_at)(s, len)
static inline off_t
stell (stream * s)
{
return s->tell (s);
}
#define sseek(s, pos) ((s)->seek)(s, pos)
#define struncate(s) ((s)->trunc)(s)
#define sread(s, buf, nbytes) ((s)->read)(s, buf, nbytes)
#define swrite(s, buf, nbytes) ((s)->write)(s, buf, nbytes)
static inline int
struncate (stream * s, off_t length)
{
return s->truncate (s, length);
}
static inline int
sflush (stream * s)
{
return s->flush (s);
}
static inline int
sclose (stream * s)
{
return s->close (s);
}
#define sset(s, c, n) ((s)->set)(s, c, n)
/* Macros for testing what kinds of I/O we are doing. */
......@@ -538,10 +563,9 @@ unit_flags;
typedef struct fbuf
{
char *buf; /* Start of buffer. */
size_t len; /* Length of buffer. */
size_t act; /* Active bytes in buffer. */
size_t flushed; /* Flushed bytes from beginning of buffer. */
size_t pos; /* Current position in buffer. */
int len; /* Length of buffer. */
int act; /* Active bytes in buffer. */
int pos; /* Current position in buffer. */
}
fbuf;
......@@ -683,6 +707,12 @@ internal_proto(open_external);
extern stream *open_internal (char *, int, gfc_offset);
internal_proto(open_internal);
extern char * mem_alloc_w (stream *, int *);
internal_proto(mem_alloc_w);
extern char * mem_alloc_r (stream *, int *);
internal_proto(mem_alloc_w);
extern stream *input_stream (void);
internal_proto(input_stream);
......@@ -698,12 +728,6 @@ internal_proto(compare_file_filename);
extern gfc_unit *find_file (const char *file, gfc_charlen_type file_len);
internal_proto(find_file);
extern int stream_at_bof (stream *);
internal_proto(stream_at_bof);
extern int stream_at_eof (stream *);
internal_proto(stream_at_eof);
extern int delete_file (gfc_unit *);
internal_proto(delete_file);
......@@ -734,9 +758,6 @@ internal_proto(inquire_readwrite);
extern gfc_offset file_length (stream *);
internal_proto(file_length);
extern gfc_offset file_position (stream *);
internal_proto(file_position);
extern int is_seekable (stream *);
internal_proto(is_seekable);
......@@ -752,18 +773,12 @@ internal_proto(flush_if_preconnected);
extern void empty_internal_buffer(stream *);
internal_proto(empty_internal_buffer);
extern try flush (stream *);
internal_proto(flush);
extern int stream_isatty (stream *);
internal_proto(stream_isatty);
extern char * stream_ttyname (stream *);
internal_proto(stream_ttyname);
extern gfc_offset stream_offset (stream *s);
internal_proto(stream_offset);
extern int unpack_filename (char *, const char *, int);
internal_proto(unpack_filename);
......@@ -807,6 +822,9 @@ internal_proto(update_position);
extern void finish_last_advance_record (gfc_unit *u);
internal_proto (finish_last_advance_record);
extern int unit_truncate (gfc_unit *, gfc_offset, st_parameter_common *);
internal_proto (unit_truncate);
/* open.c */
extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *);
......@@ -836,7 +854,7 @@ internal_proto(free_format_data);
extern const char *type_name (bt);
internal_proto(type_name);
extern try read_block_form (st_parameter_dt *, void *, size_t *);
extern void * read_block_form (st_parameter_dt *, int *);
internal_proto(read_block_form);
extern char *read_sf (st_parameter_dt *, int *, int);
......@@ -862,6 +880,9 @@ internal_proto (reverse_memcpy);
extern void st_wait (st_parameter_wait *);
export_proto(st_wait);
extern void hit_eof (st_parameter_dt *);
internal_proto(hit_eof);
/* read.c */
extern void set_integer (void *, GFC_INTEGER_LARGEST, int);
......@@ -968,24 +989,39 @@ extern size_t size_from_complex_kind (int);
internal_proto(size_from_complex_kind);
/* fbuf.c */
extern void fbuf_init (gfc_unit *, size_t);
extern void fbuf_init (gfc_unit *, int);
internal_proto(fbuf_init);
extern void fbuf_destroy (gfc_unit *);
internal_proto(fbuf_destroy);
extern void fbuf_reset (gfc_unit *);
extern int fbuf_reset (gfc_unit *);
internal_proto(fbuf_reset);
extern char * fbuf_alloc (gfc_unit *, size_t);
extern char * fbuf_alloc (gfc_unit *, int);
internal_proto(fbuf_alloc);
extern int fbuf_flush (gfc_unit *, int);
extern int fbuf_flush (gfc_unit *, unit_mode);
internal_proto(fbuf_flush);
extern int fbuf_seek (gfc_unit *, gfc_offset);
extern int fbuf_seek (gfc_unit *, int, int);
internal_proto(fbuf_seek);
extern char * fbuf_read (gfc_unit *, int *);
internal_proto(fbuf_read);
/* Never call this function, only use fbuf_getc(). */
extern int fbuf_getc_refill (gfc_unit *);
internal_proto(fbuf_getc_refill);
static inline int
fbuf_getc (gfc_unit * u)
{
if (u->fbuf->pos < u->fbuf->act)
return (unsigned char) u->fbuf->buf[u->fbuf->pos++];
return fbuf_getc_refill (u);
}
/* lock.c */
extern void free_ionml (st_parameter_dt *);
internal_proto(free_ionml);
......
libgfortran/io/list_read.c
......@@ -33,6 +33,7 @@ Boston, MA 02110-1301, USA. */
#include "io.h"
#include <string.h>
#include <stdlib.h>
#include <ctype.h>
......@@ -79,9 +80,8 @@ push_char (st_parameter_dt *dtp, char c)
if (dtp->u.p.saved_string == NULL)
{
if (dtp->u.p.scratch == NULL)
dtp->u.p.scratch = get_mem (SCRATCH_SIZE);
dtp->u.p.saved_string = dtp->u.p.scratch;
dtp->u.p.saved_string = get_mem (SCRATCH_SIZE);
// memset below should be commented out.
memset (dtp->u.p.saved_string, 0, SCRATCH_SIZE);
dtp->u.p.saved_length = SCRATCH_SIZE;
dtp->u.p.saved_used = 0;
......@@ -90,15 +90,15 @@ push_char (st_parameter_dt *dtp, char c)
if (dtp->u.p.saved_used >= dtp->u.p.saved_length)
{
dtp->u.p.saved_length = 2 * dtp->u.p.saved_length;
new = get_mem (2 * dtp->u.p.saved_length);
memset (new, 0, 2 * dtp->u.p.saved_length);
memcpy (new, dtp->u.p.saved_string, dtp->u.p.saved_used);
if (dtp->u.p.saved_string != dtp->u.p.scratch)
free_mem (dtp->u.p.saved_string);
new = realloc (dtp->u.p.saved_string, dtp->u.p.saved_length);
if (new == NULL)
generate_error (&dtp->common, LIBERROR_OS, NULL);
dtp->u.p.saved_string = new;
// Also this should not be necessary.
memset (new + dtp->u.p.saved_used, 0,
dtp->u.p.saved_length - dtp->u.p.saved_used);
}
dtp->u.p.saved_string[dtp->u.p.saved_used++] = c;
......@@ -113,8 +113,7 @@ free_saved (st_parameter_dt *dtp)
if (dtp->u.p.saved_string == NULL)
return;
if (dtp->u.p.saved_string != dtp->u.p.scratch)
free_mem (dtp->u.p.saved_string);
free_mem (dtp->u.p.saved_string);
dtp->u.p.saved_string = NULL;
dtp->u.p.saved_used = 0;
......@@ -140,9 +139,10 @@ free_line (st_parameter_dt *dtp)
static char
next_char (st_parameter_dt *dtp)
{
size_t length;
ssize_t length;
gfc_offset record;
char c;
int cc;
if (dtp->u.p.last_char != '\0')
{
......@@ -194,7 +194,7 @@ next_char (st_parameter_dt *dtp)
}
record *= dtp->u.p.current_unit->recl;
if (sseek (dtp->u.p.current_unit->s, record) == FAILURE)
if (sseek (dtp->u.p.current_unit->s, record, SEEK_SET) < 0)
longjmp (*dtp->u.p.eof_jump, 1);
dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
......@@ -204,19 +204,15 @@ next_char (st_parameter_dt *dtp)
/* Get the next character and handle end-of-record conditions. */
length = 1;
if (sread (dtp->u.p.current_unit->s, &c, &length) != 0)
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
return '\0';
}
if (is_stream_io (dtp) && length == 1)
dtp->u.p.current_unit->strm_pos++;
if (is_internal_unit (dtp))
{
length = sread (dtp->u.p.current_unit->s, &c, 1);
if (length < 0)
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
return '\0';
}
if (is_array_io (dtp))
{
/* Check whether we hit EOF. */
......@@ -240,13 +236,20 @@ next_char (st_parameter_dt *dtp)
}
else
{
if (length == 0)
cc = fbuf_getc (dtp->u.p.current_unit);
if (cc == EOF)
{
if (dtp->u.p.current_unit->endfile == AT_ENDFILE)
longjmp (*dtp->u.p.eof_jump, 1);
dtp->u.p.current_unit->endfile = AT_ENDFILE;
c = '\n';
}
else
c = (char) cc;
if (is_stream_io (dtp) && cc != EOF)
dtp->u.p.current_unit->strm_pos++;
}
done:
dtp->u.p.at_eol = (c == '\n' || c == '\r');
......@@ -1698,7 +1701,7 @@ list_formatted_read_scalar (st_parameter_dt *dtp, volatile bt type, void *p,
dtp->u.p.input_complete = 0;
dtp->u.p.repeat_count = 1;
dtp->u.p.at_eol = 0;
c = eat_spaces (dtp);
if (is_separator (c))
{
......@@ -1853,6 +1856,8 @@ finish_list_read (st_parameter_dt *dtp)
free_saved (dtp);
fbuf_flush (dtp->u.p.current_unit, dtp->u.p.mode);
if (dtp->u.p.at_eol)
{
dtp->u.p.at_eol = 0;
......@@ -2261,8 +2266,8 @@ nml_query (st_parameter_dt *dtp, char c)
/* Flush the stream to force immediate output. */
fbuf_flush (dtp->u.p.current_unit, 1);
flush (dtp->u.p.current_unit->s);
fbuf_flush (dtp->u.p.current_unit, WRITING);
sflush (dtp->u.p.current_unit->s);
unlock_unit (dtp->u.p.current_unit);
}
......@@ -2903,7 +2908,7 @@ find_nml_name:
st_printf ("%s\n", nml_err_msg);
if (u != NULL)
{
flush (u->s);
sflush (u->s);
unlock_unit (u);
}
}
......
libgfortran/io/transfer.c
......@@ -37,6 +37,7 @@ Boston, MA 02110-1301, USA. */
#include <string.h>
#include <assert.h>
#include <stdlib.h>
#include <errno.h>
/* Calling conventions: Data transfer statements are unlike other
......@@ -183,60 +184,58 @@ current_mode (st_parameter_dt *dtp)
heap. Hopefully this won't happen very often. */
char *
read_sf (st_parameter_dt *dtp, int *length, int no_error)
read_sf (st_parameter_dt *dtp, int * length, int no_error)
{
static char *empty_string[0];
char *base, *p, q;
int n, crlf;
gfc_offset pos;
size_t readlen;
int n, lorig, memread, seen_comma;
if (*length > SCRATCH_SIZE)
dtp->u.p.line_buffer = get_mem (*length);
p = base = dtp->u.p.line_buffer;
/* If we hit EOF previously with the no_error flag set (i.e. X, T,
TR edit descriptors), and we now try to read again, this time
without setting no_error. */
if (!no_error && dtp->u.p.at_eof)
{
*length = 0;
hit_eof (dtp);
return NULL;
}
/* If we have seen an eor previously, return a length of 0. The
caller is responsible for correctly padding the input field. */
if (dtp->u.p.sf_seen_eor)
{
*length = 0;
return base;
/* Just return something that isn't a NULL pointer, otherwise the
caller thinks an error occured. */
return (char*) empty_string;
}
if (is_internal_unit (dtp))
{
readlen = *length;
if (unlikely (sread (dtp->u.p.current_unit->s, p, &readlen) != 0
|| readlen < (size_t) *length))
memread = *length;
base = mem_alloc_r (dtp->u.p.current_unit->s, length);
if (unlikely (memread > *length))
{
generate_error (&dtp->common, LIBERROR_END, NULL);
hit_eof (dtp);
return NULL;
}
n = *length;
goto done;
}
readlen = 1;
n = 0;
n = seen_comma = 0;
do
{
if (unlikely (sread (dtp->u.p.current_unit->s, &q, &readlen) != 0))
{
generate_error (&dtp->common, LIBERROR_END, NULL);
return NULL;
}
/* Read data into format buffer and scan through it. */
lorig = *length;
base = p = fbuf_read (dtp->u.p.current_unit, length);
if (base == NULL)
return NULL;
/* If we have a line without a terminating \n, drop through to
EOR below. */
if (readlen < 1 && n == 0)
{
if (likely (no_error))
break;
generate_error (&dtp->common, LIBERROR_END, NULL);
return NULL;
}
while (n < *length)
{
q = *p;
if (readlen < 1 || q == '\n' || q == '\r')
if (q == '\n' || q == '\r')
{
/* Unexpected end of line. */
......@@ -245,23 +244,14 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error)
if (dtp->u.p.advance_status == ADVANCE_NO || dtp->u.p.seen_dollar)
dtp->u.p.eor_condition = 1;
crlf = 0;
/* If we encounter a CR, it might be a CRLF. */
if (q == '\r') /* Probably a CRLF */
{
readlen = 1;
pos = stream_offset (dtp->u.p.current_unit->s);
if (unlikely (sread (dtp->u.p.current_unit->s, &q, &readlen)
!= 0))
{
generate_error (&dtp->common, LIBERROR_END, NULL);
return NULL;
}
if (q != '\n' && readlen == 1) /* Not a CRLF after all. */
sseek (dtp->u.p.current_unit->s, pos);
else
crlf = 1;
if (n < *length && *(p + 1) == '\n')
dtp->u.p.sf_seen_eor = 2;
}
else
dtp->u.p.sf_seen_eor = 1;
/* Without padding, terminate the I/O statement without assigning
the value. With padding, the value still needs to be assigned,
......@@ -275,7 +265,6 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error)
}
*length = n;
dtp->u.p.sf_seen_eor = (crlf ? 2 : 1);
break;
}
/* Short circuit the read if a comma is found during numeric input.
......@@ -284,6 +273,7 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error)
if (q == ',')
if (dtp->u.p.sf_read_comma == 1)
{
seen_comma = 1;
notify_std (&dtp->common, GFC_STD_GNU,
"Comma in formatted numeric read.");
*length = n;
......@@ -291,16 +281,31 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error)
}
n++;
*p++ = q;
dtp->u.p.sf_seen_eor = 0;
p++;
}
fbuf_seek (dtp->u.p.current_unit, n + dtp->u.p.sf_seen_eor + seen_comma,
SEEK_CUR);
/* A short read implies we hit EOF, unless we hit EOR, a comma, or
some other stuff. Set the relevant flags. */
if (lorig > *length && !dtp->u.p.sf_seen_eor && !seen_comma)
{
if (no_error)
dtp->u.p.at_eof = 1;
else
{
hit_eof (dtp);
return NULL;
}
}
while (n < *length);
done:
dtp->u.p.current_unit->bytes_left -= *length;
dtp->u.p.current_unit->bytes_left -= n;
if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
dtp->u.p.size_used += (GFC_IO_INT) *length;
dtp->u.p.size_used += (GFC_IO_INT) n;
return base;
}
......@@ -316,12 +321,11 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error)
opened with PAD=YES. The caller must assume tailing spaces for
short reads. */
try
read_block_form (st_parameter_dt *dtp, void *buf, size_t *nbytes)
void *
read_block_form (st_parameter_dt *dtp, int * nbytes)
{
char *source;
size_t nread;
int nb;
int norig;
if (!is_stream_io (dtp))
{
......@@ -338,15 +342,14 @@ read_block_form (st_parameter_dt *dtp, void *buf, size_t *nbytes)
{
/* Not enough data left. */
generate_error (&dtp->common, LIBERROR_EOR, NULL);
return FAILURE;
return NULL;
}
}
if (unlikely (dtp->u.p.current_unit->bytes_left == 0))
{
dtp->u.p.current_unit->endfile = AT_ENDFILE;
generate_error (&dtp->common, LIBERROR_END, NULL);
return FAILURE;
hit_eof (dtp);
return NULL;
}
*nbytes = dtp->u.p.current_unit->bytes_left;
......@@ -357,42 +360,36 @@ read_block_form (st_parameter_dt *dtp, void *buf, size_t *nbytes)
(dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL ||
dtp->u.p.current_unit->flags.access == ACCESS_STREAM))
{
nb = *nbytes;
source = read_sf (dtp, &nb, 0);
*nbytes = nb;
source = read_sf (dtp, nbytes, 0);
dtp->u.p.current_unit->strm_pos +=
(gfc_offset) (*nbytes + dtp->u.p.sf_seen_eor);
if (source == NULL)
return FAILURE;
memcpy (buf, source, *nbytes);
return SUCCESS;
return source;
}
/* If we reach here, we can assume it's direct access. */
dtp->u.p.current_unit->bytes_left -= (gfc_offset) *nbytes;
nread = *nbytes;
if (unlikely (sread (dtp->u.p.current_unit->s, buf, &nread) != 0))
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
return FAILURE;
}
norig = *nbytes;
source = fbuf_read (dtp->u.p.current_unit, nbytes);
fbuf_seek (dtp->u.p.current_unit, *nbytes, SEEK_CUR);
if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
dtp->u.p.size_used += (GFC_IO_INT) nread;
dtp->u.p.size_used += (GFC_IO_INT) *nbytes;
if (nread != *nbytes)
{ /* Short read, this shouldn't happen. */
if (likely (dtp->u.p.current_unit->pad_status == PAD_YES))
*nbytes = nread;
else
if (norig != *nbytes)
{
/* Short read, this shouldn't happen. */
if (!dtp->u.p.current_unit->pad_status == PAD_YES)
{
generate_error (&dtp->common, LIBERROR_EOR, NULL);
source = NULL;
}
}
dtp->u.p.current_unit->strm_pos += (gfc_offset) nread;
dtp->u.p.current_unit->strm_pos += (gfc_offset) *nbytes;
return SUCCESS;
return source;
}
......@@ -402,18 +399,18 @@ read_block_form (st_parameter_dt *dtp, void *buf, size_t *nbytes)
static void
read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
{
size_t to_read_record;
size_t have_read_record;
size_t to_read_subrecord;
size_t have_read_subrecord;
ssize_t to_read_record;
ssize_t have_read_record;
ssize_t to_read_subrecord;
ssize_t have_read_subrecord;
int short_record;
if (is_stream_io (dtp))
{
to_read_record = *nbytes;
have_read_record = to_read_record;
if (unlikely (sread (dtp->u.p.current_unit->s, buf, &have_read_record)
!= 0))
have_read_record = sread (dtp->u.p.current_unit->s, buf,
to_read_record);
if (unlikely (have_read_record < 0))
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
return;
......@@ -425,7 +422,7 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
{
/* Short read, e.g. if we hit EOF. For stream files,
we have to set the end-of-file condition. */
generate_error (&dtp->common, LIBERROR_END, NULL);
hit_eof (dtp);
return;
}
return;
......@@ -448,14 +445,14 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
dtp->u.p.current_unit->bytes_left -= to_read_record;
if (unlikely (sread (dtp->u.p.current_unit->s, buf, &to_read_record)
!= 0))
to_read_record = sread (dtp->u.p.current_unit->s, buf, to_read_record);
if (unlikely (to_read_record < 0))
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
return;
}
if (to_read_record != *nbytes)
if (to_read_record != (ssize_t) *nbytes)
{
/* Short read, e.g. if we hit EOF. Apparently, we read
more than was written to the last record. */
......@@ -475,18 +472,12 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
until the request has been fulfilled or the record has run out
of continuation subrecords. */
if (unlikely (dtp->u.p.current_unit->endfile == AT_ENDFILE))
{
generate_error (&dtp->common, LIBERROR_END, NULL);
return;
}
/* Check whether we exceed the total record length. */
if (dtp->u.p.current_unit->flags.has_recl
&& (*nbytes > (size_t) dtp->u.p.current_unit->bytes_left))
{
to_read_record = (size_t) dtp->u.p.current_unit->bytes_left;
to_read_record = (ssize_t) dtp->u.p.current_unit->bytes_left;
short_record = 1;
}
else
......@@ -501,7 +492,7 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
if (dtp->u.p.current_unit->bytes_left_subrecord
< (gfc_offset) to_read_record)
{
to_read_subrecord = (size_t) dtp->u.p.current_unit->bytes_left_subrecord;
to_read_subrecord = (ssize_t) dtp->u.p.current_unit->bytes_left_subrecord;
to_read_record -= to_read_subrecord;
}
else
......@@ -512,9 +503,9 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
dtp->u.p.current_unit->bytes_left_subrecord -= to_read_subrecord;
have_read_subrecord = to_read_subrecord;
if (unlikely (sread (dtp->u.p.current_unit->s, buf + have_read_record,
&have_read_subrecord) != 0))
have_read_subrecord = sread (dtp->u.p.current_unit->s,
buf + have_read_record, to_read_subrecord);
if (unlikely (have_read_subrecord) < 0)
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
return;
......@@ -603,7 +594,7 @@ write_block (st_parameter_dt *dtp, int length)
if (is_internal_unit (dtp))
{
dest = salloc_w (dtp->u.p.current_unit->s, &length);
dest = mem_alloc_w (dtp->u.p.current_unit->s, &length);
if (dest == NULL)
{
......@@ -641,20 +632,22 @@ static try
write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes)
{
size_t have_written, to_write_subrecord;
ssize_t have_written;
ssize_t to_write_subrecord;
int short_record;
/* Stream I/O. */
if (is_stream_io (dtp))
{
if (unlikely (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0))
have_written = swrite (dtp->u.p.current_unit->s, buf, nbytes);
if (unlikely (have_written < 0))
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
return FAILURE;
}
dtp->u.p.current_unit->strm_pos += (gfc_offset) nbytes;
dtp->u.p.current_unit->strm_pos += (gfc_offset) have_written;
return SUCCESS;
}
......@@ -672,14 +665,15 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes)
if (buf == NULL && nbytes == 0)
return SUCCESS;
if (unlikely (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0))
have_written = swrite (dtp->u.p.current_unit->s, buf, nbytes);
if (unlikely (have_written < 0))
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
return FAILURE;
}
dtp->u.p.current_unit->strm_pos += (gfc_offset) nbytes;
dtp->u.p.current_unit->bytes_left -= (gfc_offset) nbytes;
dtp->u.p.current_unit->strm_pos += (gfc_offset) have_written;
dtp->u.p.current_unit->bytes_left -= (gfc_offset) have_written;
return SUCCESS;
}
......@@ -709,8 +703,9 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes)
dtp->u.p.current_unit->bytes_left_subrecord -=
(gfc_offset) to_write_subrecord;
if (unlikely (swrite (dtp->u.p.current_unit->s, buf + have_written,
&to_write_subrecord) != 0))
to_write_subrecord = swrite (dtp->u.p.current_unit->s,
buf + have_written, to_write_subrecord);
if (unlikely (to_write_subrecord < 0))
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
return FAILURE;
......@@ -932,7 +927,6 @@ static void
formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int kind,
size_t size)
{
char scratch[SCRATCH_SIZE];
int pos, bytes_used;
const fnode *f;
format_token t;
......@@ -959,8 +953,6 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int kind,
dtp->u.p.sf_read_comma =
dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA ? 0 : 1;
dtp->u.p.line_buffer = scratch;
for (;;)
{
/* If reversion has occurred and there is another real data item,
......@@ -1010,7 +1002,7 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int kind,
if (is_internal_unit (dtp))
move_pos_offset (dtp->u.p.current_unit->s, dtp->u.p.skips);
else
fbuf_seek (dtp->u.p.current_unit, dtp->u.p.skips);
fbuf_seek (dtp->u.p.current_unit, dtp->u.p.skips, SEEK_CUR);
dtp->u.p.current_unit->bytes_left -= (gfc_offset) dtp->u.p.skips;
}
dtp->u.p.skips = dtp->u.p.pending_spaces = 0;
......@@ -1221,7 +1213,7 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int kind,
break;
case BT_REAL:
if (f->u.real.w == 0)
write_real_g0 (dtp, p, kind, f->u.real.d);
write_real_g0 (dtp, p, kind, f->u.real.d);
else
write_d (dtp, f, p, kind);
break;
......@@ -1251,7 +1243,6 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int kind,
dtp->u.p.skips += f->u.n;
pos = bytes_used + dtp->u.p.skips - 1;
dtp->u.p.pending_spaces = pos - dtp->u.p.max_pos + 1;
/* Writes occur just before the switch on f->format, above, so
that trailing blanks are suppressed, unless we are doing a
non-advancing write in which case we want to output the blanks
......@@ -1316,24 +1307,17 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int kind,
/* Adjust everything for end-of-record condition */
if (dtp->u.p.sf_seen_eor && !is_internal_unit (dtp))
{
if (dtp->u.p.sf_seen_eor == 2)
{
/* The EOR was a CRLF (two bytes wide). */
dtp->u.p.current_unit->bytes_left -= 2;
dtp->u.p.skips -= 2;
}
else
{
/* The EOR marker was only one byte wide. */
dtp->u.p.current_unit->bytes_left--;
dtp->u.p.skips--;
}
dtp->u.p.current_unit->bytes_left -= dtp->u.p.sf_seen_eor;
dtp->u.p.skips -= dtp->u.p.sf_seen_eor;
bytes_used = pos;
dtp->u.p.sf_seen_eor = 0;
}
if (dtp->u.p.skips < 0)
{
move_pos_offset (dtp->u.p.current_unit->s, dtp->u.p.skips);
if (is_internal_unit (dtp))
move_pos_offset (dtp->u.p.current_unit->s, dtp->u.p.skips);
else
fbuf_seek (dtp->u.p.current_unit, dtp->u.p.skips, SEEK_CUR);
dtp->u.p.current_unit->bytes_left
-= (gfc_offset) dtp->u.p.skips;
dtp->u.p.skips = dtp->u.p.pending_spaces = 0;
......@@ -1409,16 +1393,6 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int kind,
internal_error (&dtp->common, "Bad format node");
}
/* Free a buffer that we had to allocate during a sequential
formatted read of a block that was larger than the static
buffer. */
if (dtp->u.p.line_buffer != scratch)
{
free_mem (dtp->u.p.line_buffer);
dtp->u.p.line_buffer = scratch;
}
/* Adjust the item count and data pointer. */
if ((consume_data_flag > 0) && (n > 0))
......@@ -1657,34 +1631,28 @@ transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind,
static void
us_read (st_parameter_dt *dtp, int continued)
{
size_t n, nr;
ssize_t n, nr;
GFC_INTEGER_4 i4;
GFC_INTEGER_8 i8;
gfc_offset i;
if (dtp->u.p.current_unit->endfile == AT_ENDFILE)
return;
if (compile_options.record_marker == 0)
n = sizeof (GFC_INTEGER_4);
else
n = compile_options.record_marker;
nr = n;
if (unlikely (sread (dtp->u.p.current_unit->s, &i, &n) != 0))
nr = sread (dtp->u.p.current_unit->s, &i, n);
if (unlikely (nr < 0))
{
generate_error (&dtp->common, LIBERROR_BAD_US, NULL);
return;
}
if (n == 0)
else if (nr == 0)
{
dtp->u.p.current_unit->endfile = AT_ENDFILE;
hit_eof (dtp);
return; /* end of file */
}
if (unlikely (n != nr))
else if (unlikely (n != nr))
{
generate_error (&dtp->common, LIBERROR_BAD_US, NULL);
return;
......@@ -1750,7 +1718,7 @@ us_read (st_parameter_dt *dtp, int continued)
static void
us_write (st_parameter_dt *dtp, int continued)
{
size_t nbytes;
ssize_t nbytes;
gfc_offset dummy;
dummy = 0;
......@@ -1760,7 +1728,7 @@ us_write (st_parameter_dt *dtp, int continued)
else
nbytes = compile_options.record_marker ;
if (swrite (dtp->u.p.current_unit->s, &dummy, &nbytes) != 0)
if (swrite (dtp->u.p.current_unit->s, &dummy, nbytes) != nbytes)
generate_error (&dtp->common, LIBERROR_OS, NULL);
/* For sequential unformatted, if RECL= was not specified in the OPEN
......@@ -1962,7 +1930,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
return;
}
/* Check the record number. */
/* Check the record or position number. */
if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT
&& (cf & IOPARM_DT_HAS_REC) == 0)
......@@ -2111,65 +2079,71 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
if (dtp->u.p.current_unit->pad_status == PAD_UNSPECIFIED)
dtp->u.p.current_unit->pad_status = dtp->u.p.current_unit->flags.pad;
/* Check to see if we might be reading what we wrote before */
if (dtp->u.p.mode != dtp->u.p.current_unit->mode
&& !is_internal_unit (dtp))
{
int pos = fbuf_reset (dtp->u.p.current_unit);
if (pos != 0)
sseek (dtp->u.p.current_unit->s, pos, SEEK_CUR);
sflush(dtp->u.p.current_unit->s);
}
/* Check the POS= specifier: that it is in range and that it is used with a
unit that has been connected for STREAM access. F2003 9.5.1.10. */
if (((cf & IOPARM_DT_HAS_POS) != 0))
{
if (is_stream_io (dtp))
{
if (dtp->pos <= 0)
{
generate_error (&dtp->common, LIBERROR_BAD_OPTION,
"POS=specifier must be positive");
return;
}
if (dtp->pos >= dtp->u.p.current_unit->maxrec)
{
generate_error (&dtp->common, LIBERROR_BAD_OPTION,
"POS=specifier too large");
return;
}
dtp->rec = dtp->pos;
if (dtp->u.p.mode == READING)
{
/* Required for compatibility between 4.3 and 4.4 runtime. Check
to see if we might be reading what we wrote before */
if (dtp->u.p.current_unit->mode == WRITING)
{
fbuf_flush (dtp->u.p.current_unit, 1);
flush(dtp->u.p.current_unit->s);
}
if (dtp->pos < file_length (dtp->u.p.current_unit->s))
dtp->u.p.current_unit->endfile = NO_ENDFILE;
}
if (dtp->pos != dtp->u.p.current_unit->strm_pos)
{
fbuf_flush (dtp->u.p.current_unit, 1);
flush (dtp->u.p.current_unit->s);
if (sseek (dtp->u.p.current_unit->s, dtp->pos - 1) == FAILURE)
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
return;
}
dtp->u.p.current_unit->strm_pos = dtp->pos;
}
}
{
if (dtp->pos <= 0)
{
generate_error (&dtp->common, LIBERROR_BAD_OPTION,
"POS=specifier must be positive");
return;
}
if (dtp->pos >= dtp->u.p.current_unit->maxrec)
{
generate_error (&dtp->common, LIBERROR_BAD_OPTION,
"POS=specifier too large");
return;
}
dtp->rec = dtp->pos;
if (dtp->u.p.mode == READING)
{
/* Reset the endfile flag; if we hit EOF during reading
we'll set the flag and generate an error at that point
rather than worrying about it here. */
dtp->u.p.current_unit->endfile = NO_ENDFILE;
}
if (dtp->pos != dtp->u.p.current_unit->strm_pos)
{
fbuf_flush (dtp->u.p.current_unit, dtp->u.p.mode);
sflush (dtp->u.p.current_unit->s);
if (sseek (dtp->u.p.current_unit->s, dtp->pos - 1, SEEK_SET) < 0)
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
return;
}
dtp->u.p.current_unit->strm_pos = dtp->pos;
}
}
else
{
generate_error (&dtp->common, LIBERROR_BAD_OPTION,
"POS=specifier not allowed, "
"Try OPEN with ACCESS='stream'");
return;
}
{
generate_error (&dtp->common, LIBERROR_BAD_OPTION,
"POS=specifier not allowed, "
"Try OPEN with ACCESS='stream'");
return;
}
}
/* Sanity checks on the record number. */
if ((cf & IOPARM_DT_HAS_REC) != 0)
......@@ -2188,15 +2162,10 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
return;
}
/* Check to see if we might be reading what we wrote before */
/* Make sure format buffer is reset. */
if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED)
fbuf_reset (dtp->u.p.current_unit);
if (dtp->u.p.mode == READING
&& dtp->u.p.current_unit->mode == WRITING
&& !is_internal_unit (dtp))
{
fbuf_flush (dtp->u.p.current_unit, 1);
flush(dtp->u.p.current_unit->s);
}
/* Check whether the record exists to be read. Only
a partial record needs to exist. */
......@@ -2211,37 +2180,28 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
/* Position the file. */
if (sseek (dtp->u.p.current_unit->s, (gfc_offset) (dtp->rec - 1)
* dtp->u.p.current_unit->recl) == FAILURE)
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
return;
}
* dtp->u.p.current_unit->recl, SEEK_SET) < 0)
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
return;
}
/* TODO: This is required to maintain compatibility between
4.3 and 4.4 runtime. Remove when ABI changes from 4.3 */
4.3 and 4.4 runtime. Remove when ABI changes from 4.3 */
if (is_stream_io (dtp))
dtp->u.p.current_unit->strm_pos = dtp->rec;
dtp->u.p.current_unit->strm_pos = dtp->rec;
/* TODO: Un-comment this code when ABI changes from 4.3.
if (dtp->u.p.current_unit->flags.access == ACCESS_STREAM)
{
generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT,
"Record number not allowed for stream access "
"data transfer");
return;
} */
{
generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT,
"Record number not allowed for stream access "
"data transfer");
return;
} */
}
/* Overwriting an existing sequential file ?
it is always safe to truncate the file on the first write */
if (dtp->u.p.mode == WRITING
&& dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL
&& dtp->u.p.current_unit->last_record == 0
&& !is_preconnected(dtp->u.p.current_unit->s))
struncate(dtp->u.p.current_unit->s);
/* Bugware for badly written mixed C-Fortran I/O. */
flush_if_preconnected(dtp->u.p.current_unit->s);
......@@ -2394,8 +2354,8 @@ next_array_record (st_parameter_dt *dtp, array_loop_spec *ls, int *finished)
static void
skip_record (st_parameter_dt *dtp, size_t bytes)
{
gfc_offset new;
size_t rlength;
ssize_t readb;
static const size_t MAX_READ = 4096;
char p[MAX_READ];
......@@ -2405,12 +2365,10 @@ skip_record (st_parameter_dt *dtp, size_t bytes)
if (is_seekable (dtp->u.p.current_unit->s))
{
new = file_position (dtp->u.p.current_unit->s)
+ dtp->u.p.current_unit->bytes_left_subrecord;
/* Direct access files do not generate END conditions,
only I/O errors. */
if (sseek (dtp->u.p.current_unit->s, new) == FAILURE)
if (sseek (dtp->u.p.current_unit->s,
dtp->u.p.current_unit->bytes_left_subrecord, SEEK_CUR) < 0)
generate_error (&dtp->common, LIBERROR_OS, NULL);
}
else
......@@ -2418,16 +2376,17 @@ skip_record (st_parameter_dt *dtp, size_t bytes)
while (dtp->u.p.current_unit->bytes_left_subrecord > 0)
{
rlength =
(MAX_READ > (size_t) dtp->u.p.current_unit->bytes_left_subrecord) ?
(MAX_READ < (size_t) dtp->u.p.current_unit->bytes_left_subrecord) ?
MAX_READ : (size_t) dtp->u.p.current_unit->bytes_left_subrecord;
if (sread (dtp->u.p.current_unit->s, p, &rlength) != 0)
readb = sread (dtp->u.p.current_unit->s, p, rlength);
if (readb < 0)
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
return;
}
dtp->u.p.current_unit->bytes_left_subrecord -= rlength;
dtp->u.p.current_unit->bytes_left_subrecord -= readb;
}
}
......@@ -2475,8 +2434,8 @@ next_record_r (st_parameter_dt *dtp)
{
gfc_offset record;
int bytes_left;
size_t length;
char p;
int cc;
switch (current_mode (dtp))
{
......@@ -2496,11 +2455,12 @@ next_record_r (st_parameter_dt *dtp)
case FORMATTED_STREAM:
case FORMATTED_SEQUENTIAL:
length = 1;
/* sf_read has already terminated input because of an '\n' */
if (dtp->u.p.sf_seen_eor)
/* read_sf has already terminated input because of an '\n', or
we have hit EOF. */
if (dtp->u.p.sf_seen_eor || dtp->u.p.at_eof)
{
dtp->u.p.sf_seen_eor = 0;
dtp->u.p.at_eof = 0;
break;
}
......@@ -2515,7 +2475,7 @@ next_record_r (st_parameter_dt *dtp)
/* Now seek to this record. */
record = record * dtp->u.p.current_unit->recl;
if (sseek (dtp->u.p.current_unit->s, record) == FAILURE)
if (sseek (dtp->u.p.current_unit->s, record, SEEK_SET) < 0)
{
generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL);
break;
......@@ -2527,10 +2487,9 @@ next_record_r (st_parameter_dt *dtp)
bytes_left = (int) dtp->u.p.current_unit->bytes_left;
bytes_left = min_off (bytes_left,
file_length (dtp->u.p.current_unit->s)
- file_position (dtp->u.p.current_unit->s));
- stell (dtp->u.p.current_unit->s));
if (sseek (dtp->u.p.current_unit->s,
file_position (dtp->u.p.current_unit->s)
+ bytes_left) == FAILURE)
bytes_left, SEEK_CUR) < 0)
{
generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL);
break;
......@@ -2540,42 +2499,37 @@ next_record_r (st_parameter_dt *dtp)
}
break;
}
else do
else
{
if (sread (dtp->u.p.current_unit->s, &p, &length) != 0)
do
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
break;
}
if (length == 0)
{
dtp->u.p.current_unit->endfile = AT_ENDFILE;
break;
errno = 0;
cc = fbuf_getc (dtp->u.p.current_unit);
if (cc == EOF)
{
if (errno != 0)
generate_error (&dtp->common, LIBERROR_OS, NULL);
else
hit_eof (dtp);
break;
}
if (is_stream_io (dtp))
dtp->u.p.current_unit->strm_pos++;
p = (char) cc;
}
if (is_stream_io (dtp))
dtp->u.p.current_unit->strm_pos++;
while (p != '\n');
}
while (p != '\n');
break;
}
if (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL
&& !dtp->u.p.namelist_mode
&& dtp->u.p.current_unit->endfile == NO_ENDFILE
&& (file_length (dtp->u.p.current_unit->s) ==
file_position (dtp->u.p.current_unit->s)))
dtp->u.p.current_unit->endfile = AT_ENDFILE;
}
/* Small utility function to write a record marker, taking care of
byte swapping and of choosing the correct size. */
inline static int
static int
write_us_marker (st_parameter_dt *dtp, const gfc_offset buf)
{
size_t len;
......@@ -2595,12 +2549,12 @@ write_us_marker (st_parameter_dt *dtp, const gfc_offset buf)
{
case sizeof (GFC_INTEGER_4):
buf4 = buf;
return swrite (dtp->u.p.current_unit->s, &buf4, &len);
return swrite (dtp->u.p.current_unit->s, &buf4, len);
break;
case sizeof (GFC_INTEGER_8):
buf8 = buf;
return swrite (dtp->u.p.current_unit->s, &buf8, &len);
return swrite (dtp->u.p.current_unit->s, &buf8, len);
break;
default:
......@@ -2615,13 +2569,13 @@ write_us_marker (st_parameter_dt *dtp, const gfc_offset buf)
case sizeof (GFC_INTEGER_4):
buf4 = buf;
reverse_memcpy (p, &buf4, sizeof (GFC_INTEGER_4));
return swrite (dtp->u.p.current_unit->s, p, &len);
return swrite (dtp->u.p.current_unit->s, p, len);
break;
case sizeof (GFC_INTEGER_8):
buf8 = buf;
reverse_memcpy (p, &buf8, sizeof (GFC_INTEGER_8));
return swrite (dtp->u.p.current_unit->s, p, &len);
return swrite (dtp->u.p.current_unit->s, p, len);
break;
default:
......@@ -2644,7 +2598,7 @@ next_record_w_unf (st_parameter_dt *dtp, int next_subrecord)
/* Bytes written. */
m = dtp->u.p.current_unit->recl_subrecord
- dtp->u.p.current_unit->bytes_left_subrecord;
c = file_position (dtp->u.p.current_unit->s);
c = stell (dtp->u.p.current_unit->s);
/* Write the length tail. If we finish a record containing
subrecords, we write out the negative length. */
......@@ -2654,7 +2608,7 @@ next_record_w_unf (st_parameter_dt *dtp, int next_subrecord)
else
m_write = m;
if (unlikely (write_us_marker (dtp, m_write) != 0))
if (unlikely (write_us_marker (dtp, m_write) < 0))
goto io_error;
if (compile_options.record_marker == 0)
......@@ -2665,8 +2619,8 @@ next_record_w_unf (st_parameter_dt *dtp, int next_subrecord)
/* Seek to the head and overwrite the bogus length with the real
length. */
if (unlikely (sseek (dtp->u.p.current_unit->s, c - m - record_marker)
== FAILURE))
if (unlikely (sseek (dtp->u.p.current_unit->s, c - m - record_marker,
SEEK_SET) < 0))
goto io_error;
if (next_subrecord)
......@@ -2674,13 +2628,13 @@ next_record_w_unf (st_parameter_dt *dtp, int next_subrecord)
else
m_write = m;
if (unlikely (write_us_marker (dtp, m_write) != 0))
if (unlikely (write_us_marker (dtp, m_write) < 0))
goto io_error;
/* Seek past the end of the current record. */
if (unlikely (sseek (dtp->u.p.current_unit->s, c + record_marker)
== FAILURE))
if (unlikely (sseek (dtp->u.p.current_unit->s, c + record_marker,
SEEK_SET) < 0))
goto io_error;
return;
......@@ -2691,6 +2645,35 @@ next_record_w_unf (st_parameter_dt *dtp, int next_subrecord)
}
/* Utility function like memset() but operating on streams. Return
value is same as for POSIX write(). */
static ssize_t
sset (stream * s, int c, ssize_t nbyte)
{
static const int WRITE_CHUNK = 256;
char p[WRITE_CHUNK];
ssize_t bytes_left, trans;
if (nbyte < WRITE_CHUNK)
memset (p, c, nbyte);
else
memset (p, c, WRITE_CHUNK);
bytes_left = nbyte;
while (bytes_left > 0)
{
trans = (bytes_left < WRITE_CHUNK) ? bytes_left : WRITE_CHUNK;
trans = swrite (s, p, trans);
if (trans < 0)
return trans;
bytes_left -= trans;
}
return nbyte - bytes_left;
}
/* Position to the next record in write mode. */
static void
......@@ -2699,9 +2682,6 @@ next_record_w (st_parameter_dt *dtp, int done)
gfc_offset m, record, max_pos;
int length;
/* Flush and reset the format buffer. */
fbuf_flush (dtp->u.p.current_unit, 1);
/* Zero counters for X- and T-editing. */
max_pos = dtp->u.p.max_pos;
dtp->u.p.max_pos = dtp->u.p.skips = dtp->u.p.pending_spaces = 0;
......@@ -2716,8 +2696,11 @@ next_record_w (st_parameter_dt *dtp, int done)
if (dtp->u.p.current_unit->bytes_left == 0)
break;
fbuf_seek (dtp->u.p.current_unit, 0, SEEK_END);
fbuf_flush (dtp->u.p.current_unit, WRITING);
if (sset (dtp->u.p.current_unit->s, ' ',
dtp->u.p.current_unit->bytes_left) == FAILURE)
dtp->u.p.current_unit->bytes_left)
!= dtp->u.p.current_unit->bytes_left)
goto io_error;
break;
......@@ -2726,7 +2709,7 @@ next_record_w (st_parameter_dt *dtp, int done)
if (dtp->u.p.current_unit->bytes_left > 0)
{
length = (int) dtp->u.p.current_unit->bytes_left;
if (sset (dtp->u.p.current_unit->s, 0, length) == FAILURE)
if (sset (dtp->u.p.current_unit->s, 0, length) != length)
goto io_error;
}
break;
......@@ -2757,8 +2740,7 @@ next_record_w (st_parameter_dt *dtp, int done)
{
length = (int) (max_pos - m);
if (sseek (dtp->u.p.current_unit->s,
file_position (dtp->u.p.current_unit->s)
+ length) == FAILURE)
length, SEEK_CUR) < 0)
{
generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL);
return;
......@@ -2766,7 +2748,7 @@ next_record_w (st_parameter_dt *dtp, int done)
length = (int) (dtp->u.p.current_unit->recl - max_pos);
}
if (sset (dtp->u.p.current_unit->s, ' ', length) == FAILURE)
if (sset (dtp->u.p.current_unit->s, ' ', length) != length)
{
generate_error (&dtp->common, LIBERROR_END, NULL);
return;
......@@ -2782,7 +2764,7 @@ next_record_w (st_parameter_dt *dtp, int done)
/* Now seek to this record */
record = record * dtp->u.p.current_unit->recl;
if (sseek (dtp->u.p.current_unit->s, record) == FAILURE)
if (sseek (dtp->u.p.current_unit->s, record, SEEK_SET) < 0)
{
generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL);
return;
......@@ -2805,8 +2787,7 @@ next_record_w (st_parameter_dt *dtp, int done)
{
length = (int) (max_pos - m);
if (sseek (dtp->u.p.current_unit->s,
file_position (dtp->u.p.current_unit->s)
+ length) == FAILURE)
length, SEEK_CUR) < 0)
{
generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL);
return;
......@@ -2817,7 +2798,7 @@ next_record_w (st_parameter_dt *dtp, int done)
length = (int) dtp->u.p.current_unit->bytes_left;
}
if (sset (dtp->u.p.current_unit->s, ' ', length) == FAILURE)
if (sset (dtp->u.p.current_unit->s, ' ', length) != length)
{
generate_error (&dtp->common, LIBERROR_END, NULL);
return;
......@@ -2826,23 +2807,27 @@ next_record_w (st_parameter_dt *dtp, int done)
}
else
{
size_t len;
const char crlf[] = "\r\n";
#ifdef HAVE_CRLF
len = 2;
const int len = 2;
#else
len = 1;
const int len = 1;
#endif
if (swrite (dtp->u.p.current_unit->s, &crlf[2-len], &len) != 0)
goto io_error;
fbuf_seek (dtp->u.p.current_unit, 0, SEEK_END);
char * p = fbuf_alloc (dtp->u.p.current_unit, len);
if (!p)
goto io_error;
#ifdef HAVE_CRLF
*(p++) = '\r';
#endif
*p = '\n';
if (is_stream_io (dtp))
{
dtp->u.p.current_unit->strm_pos += len;
if (dtp->u.p.current_unit->strm_pos
< file_length (dtp->u.p.current_unit->s))
struncate (dtp->u.p.current_unit->s);
unit_truncate (dtp->u.p.current_unit,
dtp->u.p.current_unit->strm_pos - 1,
&dtp->common);
}
}
......@@ -2880,7 +2865,7 @@ next_record (st_parameter_dt *dtp, int done)
dtp->u.p.current_unit->current_record = 0;
if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
{
fp = file_position (dtp->u.p.current_unit->s);
fp = stell (dtp->u.p.current_unit->s);
/* Calculate next record, rounding up partial records. */
dtp->u.p.current_unit->last_record =
(fp + dtp->u.p.current_unit->recl - 1) /
......@@ -2892,6 +2877,8 @@ next_record (st_parameter_dt *dtp, int done)
if (!done)
pre_position (dtp);
fbuf_flush (dtp->u.p.current_unit, dtp->u.p.mode);
}
......@@ -2940,7 +2927,6 @@ finalize_transfer (st_parameter_dt *dtp)
if ((cf & IOPARM_DT_LIST_FORMAT) != 0 && dtp->u.p.mode == READING)
{
finish_list_read (dtp);
sfree (dtp->u.p.current_unit->s);
return;
}
......@@ -2955,10 +2941,9 @@ finalize_transfer (st_parameter_dt *dtp)
next_record (dtp, 1);
if (dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED
&& file_position (dtp->u.p.current_unit->s) >= dtp->rec)
&& stell (dtp->u.p.current_unit->s) >= dtp->rec)
{
flush (dtp->u.p.current_unit->s);
sfree (dtp->u.p.current_unit->s);
sflush (dtp->u.p.current_unit->s);
}
return;
}
......@@ -2967,9 +2952,8 @@ finalize_transfer (st_parameter_dt *dtp)
if (!is_internal_unit (dtp) && dtp->u.p.seen_dollar)
{
fbuf_flush (dtp->u.p.current_unit, dtp->u.p.mode);
dtp->u.p.seen_dollar = 0;
fbuf_flush (dtp->u.p.current_unit, 1);
sfree (dtp->u.p.current_unit->s);
return;
}
......@@ -2981,15 +2965,17 @@ finalize_transfer (st_parameter_dt *dtp)
- dtp->u.p.current_unit->bytes_left);
dtp->u.p.current_unit->saved_pos =
dtp->u.p.max_pos > 0 ? dtp->u.p.max_pos - bytes_written : 0;
fbuf_flush (dtp->u.p.current_unit, 0);
flush (dtp->u.p.current_unit->s);
fbuf_flush (dtp->u.p.current_unit, dtp->u.p.mode);
sflush (dtp->u.p.current_unit->s);
return;
}
else if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED
&& dtp->u.p.mode == WRITING && !is_internal_unit (dtp))
fbuf_seek (dtp->u.p.current_unit, 0, SEEK_END);
dtp->u.p.current_unit->saved_pos = 0;
next_record (dtp, 1);
sfree (dtp->u.p.current_unit->s);
}
/* Transfer function for IOLENGTH. It doesn't actually do any
......@@ -3046,8 +3032,6 @@ void
st_iolength_done (st_parameter_dt *dtp __attribute__((unused)))
{
free_ionml (dtp);
if (dtp->u.p.scratch != NULL)
free_mem (dtp->u.p.scratch);
library_end ();
}
......@@ -3063,29 +3047,6 @@ st_read (st_parameter_dt *dtp)
library_start (&dtp->common);
data_transfer_init (dtp, 1);
/* Handle complications dealing with the endfile record. */
if (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL)
switch (dtp->u.p.current_unit->endfile)
{
case NO_ENDFILE:
break;
case AT_ENDFILE:
if (!is_internal_unit (dtp))
{
generate_error (&dtp->common, LIBERROR_END, NULL);
dtp->u.p.current_unit->endfile = AFTER_ENDFILE;
dtp->u.p.current_unit->current_record = 0;
}
break;
case AFTER_ENDFILE:
generate_error (&dtp->common, LIBERROR_ENDFILE, NULL);
dtp->u.p.current_unit->current_record = 0;
break;
}
}
extern void st_read_done (st_parameter_dt *);
......@@ -3097,8 +3058,6 @@ st_read_done (st_parameter_dt *dtp)
finalize_transfer (dtp);
free_format_data (dtp);
free_ionml (dtp);
if (dtp->u.p.scratch != NULL)
free_mem (dtp->u.p.scratch);
if (dtp->u.p.current_unit != NULL)
unlock_unit (dtp->u.p.current_unit);
......@@ -3141,19 +3100,15 @@ st_write_done (st_parameter_dt *dtp)
case NO_ENDFILE:
/* Get rid of whatever is after this record. */
if (!is_internal_unit (dtp))
{
flush (dtp->u.p.current_unit->s);
if (struncate (dtp->u.p.current_unit->s) == FAILURE)
generate_error (&dtp->common, LIBERROR_OS, NULL);
}
unit_truncate (dtp->u.p.current_unit,
stell (dtp->u.p.current_unit->s),
&dtp->common);
dtp->u.p.current_unit->endfile = AT_ENDFILE;
break;
}
free_format_data (dtp);
free_ionml (dtp);
if (dtp->u.p.scratch != NULL)
free_mem (dtp->u.p.scratch);
if (dtp->u.p.current_unit != NULL)
unlock_unit (dtp->u.p.current_unit);
......@@ -3267,3 +3222,46 @@ void reverse_memcpy (void *dest, const void *src, size_t n)
for (i=0; i<n; i++)
*(d++) = *(s--);
}
/* Once upon a time, a poor innocent Fortran program was reading a
file, when suddenly it hit the end-of-file (EOF). Unfortunately
the OS doesn't tell whether we're at the EOF or whether we already
went past it. Luckily our hero, libgfortran, keeps track of this.
Call this function when you detect an EOF condition. See Section
9.10.2 in F2003. */
void
hit_eof (st_parameter_dt * dtp)
{
dtp->u.p.current_unit->flags.position = POSITION_APPEND;
if (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL)
switch (dtp->u.p.current_unit->endfile)
{
case NO_ENDFILE:
case AT_ENDFILE:
generate_error (&dtp->common, LIBERROR_END, NULL);
if (!is_internal_unit (dtp))
{
dtp->u.p.current_unit->endfile = AFTER_ENDFILE;
dtp->u.p.current_unit->current_record = 0;
}
else
dtp->u.p.current_unit->endfile = AT_ENDFILE;
break;
case AFTER_ENDFILE:
generate_error (&dtp->common, LIBERROR_ENDFILE, NULL);
dtp->u.p.current_unit->current_record = 0;
break;
}
else
{
/* Non-sequential files don't have an ENDFILE record, so we
can't be at AFTER_ENDFILE. */
dtp->u.p.current_unit->endfile = AT_ENDFILE;
generate_error (&dtp->common, LIBERROR_END, NULL);
dtp->u.p.current_unit->current_record = 0;
}
}
libgfortran/io/unit.c
......@@ -540,6 +540,8 @@ init_units (void)
u->file_len = strlen (stdin_name);
u->file = get_mem (u->file_len);
memmove (u->file, stdin_name, u->file_len);
fbuf_init (u, 0);
__gthread_mutex_unlock (&u->lock);
}
......@@ -697,15 +699,62 @@ close_units (void)
void
update_position (gfc_unit *u)
{
if (file_position (u->s) == 0)
if (stell (u->s) == 0)
u->flags.position = POSITION_REWIND;
else if (file_length (u->s) == file_position (u->s))
else if (file_length (u->s) == stell (u->s))
u->flags.position = POSITION_APPEND;
else
u->flags.position = POSITION_ASIS;
}
/* High level interface to truncate a file safely, i.e. flush format
buffers, check that it's a regular file, and generate error if that
occurs. Just like POSIX ftruncate, returns 0 on success, -1 on
failure. */
int
unit_truncate (gfc_unit * u, gfc_offset pos, st_parameter_common * common)
{
int ret;
/* Make sure format buffer is flushed. */
if (u->flags.form == FORM_FORMATTED)
{
if (u->mode == READING)
pos += fbuf_reset (u);
else
fbuf_flush (u, u->mode);
}
/* Don't try to truncate a special file, just pretend that it
succeeds. */
if (is_special (u->s) || !is_seekable (u->s))
{
sflush (u->s);
return 0;
}
/* struncate() should flush the stream buffer if necessary, so don't
bother calling sflush() here. */
ret = struncate (u->s, pos);
if (ret != 0)
{
generate_error (common, LIBERROR_OS, NULL);
u->endfile = NO_ENDFILE;
u->flags.position = POSITION_ASIS;
}
else
{
u->endfile = AT_ENDFILE;
u->flags.position = POSITION_APPEND;
}
return ret;
}
/* filename_from_unit()-- If the unit_number exists, return a pointer to the
name of the associated file, otherwise return the empty string. The caller
must free memory allocated for the filename string. */
......@@ -746,23 +795,25 @@ finish_last_advance_record (gfc_unit *u)
{
if (u->saved_pos > 0)
fbuf_seek (u, u->saved_pos);
fbuf_flush (u, 1);
fbuf_seek (u, u->saved_pos, SEEK_CUR);
if (!(u->unit_number == options.stdout_unit
|| u->unit_number == options.stderr_unit))
{
size_t len;
const char crlf[] = "\r\n";
#ifdef HAVE_CRLF
len = 2;
const int len = 2;
#else
len = 1;
const int len = 1;
#endif
if (swrite (u->s, &crlf[2-len], &len) != 0)
char *p = fbuf_alloc (u, len);
if (!p)
os_error ("Completing record after ADVANCE_NO failed");
#ifdef HAVE_CRLF
*(p++) = '\r';
#endif
*p = '\n';
}
fbuf_flush (u, u->mode);
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment