Part 1 of PR 25561.
2008-05-15 Janne Blomqvist <jb@gcc.gnu.org> PR libfortran/25561 * Makefile.am: Add fbuf.c to gfor_io_src. * Makefile.in: Regenerate. * io/io.h (read_block): Remove. (struct stream): Remove alloc_r_at function pointer. (salloc_r): Remove. (salloc_r_at): Remove. (salloc_w_at): Remove. (salloc_w): Remove offset argument. (struct fbuf): New struct for format buffer. (struct gfc_unit): Add fbuf. (read_block_form): New prototype. (fbuf_init): Likewise. (fbuf_destroy): Likewise. (fbuf_reset): Likewise. (fbuf_alloc): Likewise. (fbuf_flush): Likewise. (fbuf_seek): Likewise. * io/file_pos.c (formatted_backspace): Change to use sread. (unformatted_backspace): Likewise. (st_backspace): Flush format buffer. (st_rewind): Likewise. * io/list_read.c (next_char): Likewise. (nml_query): Tidying, flush format buffer. * io/open.c (new_unit): Init format buffer. * io/read.c (read_l): Change to use read_block_form. (read_a): Likewise. (read_decimal): Likewise. (read_radix): Likewise. (read_f): Likewise. (read_x): Empty reads also for stream I/O. * io/transfer.c (read_sf): Change to use sread. (read_block): Rename to read_block_form, change prototype, use sread. (read_block_direct): Don't seek stream files. (write_block): Change to use fbuf if external file, don't seek stream files. (write_buf): Don't seek stream files. (formatted_transfer_scalar): Use fbuf for external files. (us_read): Change to use sread. (pre_position): Do nothing for stream I/O. (data_transfer_init): Flush fbuf when switching from write to read, if POS is specified, seek stream file to correct offset. (skip_record): Change to use sread. (min_off): New function. (next_record_r): Change to use sread. (next_record_w): Change to use sset/sseek, flush fbuf. (finalize_transfer): Flush fbuf. * io/unit.c (init_units): Init fbuf for stdout, stderr. (close_unit_1): Destroy fbuf. (finish_last_advance_record): Flush fbuf, no need to seek. * io/unix.c (fd_alloc_r_at): Remove unused where argument. (fd_alloc_w_at): Likewise. (fd_read): Remove third argument to fd_alloc_r_at. (fd_write): Remove third argument to fd_alloc_w_at. (fd_sset): Likewise. (fd_open): Don't set alloc_r_at. (mem_alloc_r_at): Remove unused where argument. (mem_alloc_w_at): Likewise. (mem_read): Don't incorrectly return previous errno, remove unused third argument to alloc function. (mem_write): Likewise. (mem_set): Likewise. (open_internal): Don't set alloc_r_at pointer. * io/fbuf.c: New file. From-SVN: r135373
This commit is contained in:
Janne Blomqvist
parent
2819ae08d2
commit
15877a88eb
10 changed files with 369 additions and 301 deletions
|
|
@ -47,7 +47,8 @@ io/size_from_kind.c \
|
|||
io/transfer.c \
|
||||
io/unit.c \
|
||||
io/unix.c \
|
||||
io/write.c
|
||||
io/write.c \
|
||||
io/fbuf.c
|
||||
|
||||
gfor_io_headers= \
|
||||
io/io.h
|
||||
|
|
|
|||
|
|
@ -401,8 +401,8 @@ am__libgfortran_la_SOURCES_DIST = runtime/backtrace.c \
|
|||
fpu-target.h io/close.c io/file_pos.c io/format.c io/inquire.c \
|
||||
io/intrinsics.c io/list_read.c io/lock.c io/open.c io/read.c \
|
||||
io/size_from_kind.c io/transfer.c io/unit.c io/unix.c \
|
||||
io/write.c intrinsics/associated.c intrinsics/abort.c \
|
||||
intrinsics/access.c intrinsics/args.c \
|
||||
io/write.c io/fbuf.c intrinsics/associated.c \
|
||||
intrinsics/abort.c intrinsics/access.c intrinsics/args.c \
|
||||
intrinsics/c99_functions.c intrinsics/chdir.c \
|
||||
intrinsics/chmod.c intrinsics/clock.c intrinsics/cpu_time.c \
|
||||
intrinsics/cshift0.c intrinsics/ctime.c \
|
||||
|
|
@ -691,7 +691,7 @@ am__objects_33 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \
|
|||
$(am__objects_32)
|
||||
am__objects_34 = close.lo file_pos.lo format.lo inquire.lo \
|
||||
intrinsics.lo list_read.lo lock.lo open.lo read.lo \
|
||||
size_from_kind.lo transfer.lo unit.lo unix.lo write.lo
|
||||
size_from_kind.lo transfer.lo unit.lo unix.lo write.lo fbuf.lo
|
||||
am__objects_35 = associated.lo abort.lo access.lo args.lo \
|
||||
c99_functions.lo chdir.lo chmod.lo clock.lo cpu_time.lo \
|
||||
cshift0.lo ctime.lo date_and_time.lo dtime.lo env.lo \
|
||||
|
|
@ -946,7 +946,8 @@ io/size_from_kind.c \
|
|||
io/transfer.c \
|
||||
io/unit.c \
|
||||
io/unix.c \
|
||||
io/write.c
|
||||
io/write.c \
|
||||
io/fbuf.c
|
||||
|
||||
gfor_io_headers = \
|
||||
io/io.h
|
||||
|
|
@ -1791,6 +1792,7 @@ distclean-compile:
|
|||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exponent_r16.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exponent_r4.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exponent_r8.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fbuf.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/file_pos.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fmain.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fnum.Plo@am__quote@
|
||||
|
|
@ -5124,6 +5126,13 @@ write.lo: io/write.c
|
|||
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
|
||||
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o write.lo `test -f 'io/write.c' || echo '$(srcdir)/'`io/write.c
|
||||
|
||||
fbuf.lo: io/fbuf.c
|
||||
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT fbuf.lo -MD -MP -MF "$(DEPDIR)/fbuf.Tpo" -c -o fbuf.lo `test -f 'io/fbuf.c' || echo '$(srcdir)/'`io/fbuf.c; \
|
||||
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/fbuf.Tpo" "$(DEPDIR)/fbuf.Plo"; else rm -f "$(DEPDIR)/fbuf.Tpo"; exit 1; fi
|
||||
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='io/fbuf.c' object='fbuf.lo' libtool=yes @AMDEPBACKSLASH@
|
||||
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
|
||||
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fbuf.lo `test -f 'io/fbuf.c' || echo '$(srcdir)/'`io/fbuf.c
|
||||
|
||||
associated.lo: intrinsics/associated.c
|
||||
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT associated.lo -MD -MP -MF "$(DEPDIR)/associated.Tpo" -c -o associated.lo `test -f 'intrinsics/associated.c' || echo '$(srcdir)/'`intrinsics/associated.c; \
|
||||
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/associated.Tpo" "$(DEPDIR)/associated.Plo"; else rm -f "$(DEPDIR)/associated.Tpo"; exit 1; fi
|
||||
|
|
|
|||
|
|
@ -39,14 +39,14 @@ Boston, MA 02110-1301, USA. */
|
|||
record, and we have to sift backwards to find the newline before
|
||||
that or the start of the file, whichever comes first. */
|
||||
|
||||
#define READ_CHUNK 4096
|
||||
static const unsigned int READ_CHUNK = 4096;
|
||||
|
||||
static void
|
||||
formatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
|
||||
{
|
||||
gfc_offset base;
|
||||
char *p;
|
||||
int n;
|
||||
char p[READ_CHUNK];
|
||||
size_t n;
|
||||
|
||||
base = file_position (u->s) - 1;
|
||||
|
||||
|
|
@ -54,9 +54,9 @@ formatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
|
|||
{
|
||||
n = (base < READ_CHUNK) ? base : READ_CHUNK;
|
||||
base -= n;
|
||||
|
||||
p = salloc_r_at (u->s, &n, base);
|
||||
if (p == NULL)
|
||||
if (sseek (u->s, base) == FAILURE)
|
||||
goto io_error;
|
||||
if (sread (u->s, p, &n) != 0)
|
||||
goto io_error;
|
||||
|
||||
/* We have moved backwards from the current position, it should
|
||||
|
|
@ -66,15 +66,14 @@ formatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
|
|||
/* There is no memrchr() in the C library, so we have to do it
|
||||
ourselves. */
|
||||
|
||||
n--;
|
||||
while (n >= 0)
|
||||
while (n > 0)
|
||||
{
|
||||
n--;
|
||||
if (p[n] == '\n')
|
||||
{
|
||||
base += n + 1;
|
||||
goto done;
|
||||
}
|
||||
n--;
|
||||
}
|
||||
|
||||
}
|
||||
|
|
@ -104,9 +103,9 @@ unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
|
|||
gfc_offset m, new;
|
||||
GFC_INTEGER_4 m4;
|
||||
GFC_INTEGER_8 m8;
|
||||
int length, length_read;
|
||||
size_t length;
|
||||
int continued;
|
||||
char *p;
|
||||
char p[sizeof (GFC_INTEGER_8)];
|
||||
|
||||
if (compile_options.record_marker == 0)
|
||||
length = sizeof (GFC_INTEGER_4);
|
||||
|
|
@ -115,12 +114,10 @@ unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
|
|||
|
||||
do
|
||||
{
|
||||
length_read = length;
|
||||
|
||||
p = salloc_r_at (u->s, &length_read,
|
||||
file_position (u->s) - length);
|
||||
if (p == NULL || length_read != length)
|
||||
goto io_error;
|
||||
if (sseek (u->s, file_position (u->s) - length) == FAILURE)
|
||||
goto io_error;
|
||||
if (sread (u->s, p, &length) != 0)
|
||||
goto io_error;
|
||||
|
||||
/* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */
|
||||
if (u->flags.convert == GFC_CONVERT_NATIVE)
|
||||
|
|
@ -216,6 +213,9 @@ st_backspace (st_parameter_filepos *fpp)
|
|||
goto done;
|
||||
}
|
||||
|
||||
/* Make sure format buffer is flushed. */
|
||||
fbuf_flush (u, 1);
|
||||
|
||||
/* Check for special cases involving the ENDFILE record first. */
|
||||
|
||||
if (u->endfile == AFTER_ENDFILE)
|
||||
|
|
|
|||
|
|
@ -49,8 +49,7 @@ struct st_parameter_dt;
|
|||
|
||||
typedef struct stream
|
||||
{
|
||||
char *(*alloc_w_at) (struct stream *, int *, gfc_offset);
|
||||
char *(*alloc_r_at) (struct stream *, int *, gfc_offset);
|
||||
char *(*alloc_w_at) (struct stream *, int *);
|
||||
try (*sfree) (struct stream *);
|
||||
try (*close) (struct stream *);
|
||||
try (*seek) (struct stream *, gfc_offset);
|
||||
|
|
@ -70,11 +69,7 @@ io_mode;
|
|||
#define sfree(s) ((s)->sfree)(s)
|
||||
#define sclose(s) ((s)->close)(s)
|
||||
|
||||
#define salloc_r(s, len) ((s)->alloc_r_at)(s, len, -1)
|
||||
#define salloc_w(s, len) ((s)->alloc_w_at)(s, len, -1)
|
||||
|
||||
#define salloc_r_at(s, len, where) ((s)->alloc_r_at)(s, len, where)
|
||||
#define salloc_w_at(s, len, where) ((s)->alloc_w_at)(s, len, where)
|
||||
#define salloc_w(s, len) ((s)->alloc_w_at)(s, len)
|
||||
|
||||
#define sseek(s, pos) ((s)->seek)(s, pos)
|
||||
#define struncate(s) ((s)->trunc)(s)
|
||||
|
|
@ -528,6 +523,25 @@ typedef struct
|
|||
unit_flags;
|
||||
|
||||
|
||||
/* Formatting buffer. This is a temporary scratch buffer. Currently used only
|
||||
by formatted writes. After every
|
||||
formatted write statement, this buffer is flushed. This buffer is needed since
|
||||
not all devices are seekable, and T or TL edit descriptors require
|
||||
moving backwards in the record. However, advance='no' complicates the
|
||||
situation, so the buffer must only be partially flushed from the end of the
|
||||
last flush until the current position in the record. */
|
||||
|
||||
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. */
|
||||
char *ptr; /* Current position in buffer. */
|
||||
}
|
||||
fbuf;
|
||||
|
||||
|
||||
typedef struct gfc_unit
|
||||
{
|
||||
int unit_number;
|
||||
|
|
@ -578,6 +592,9 @@ typedef struct gfc_unit
|
|||
|
||||
int file_len;
|
||||
char *file;
|
||||
|
||||
/* Formatting buffer. */
|
||||
struct fbuf *fbuf;
|
||||
}
|
||||
gfc_unit;
|
||||
|
||||
|
|
@ -812,8 +829,8 @@ internal_proto(free_format_data);
|
|||
extern const char *type_name (bt);
|
||||
internal_proto(type_name);
|
||||
|
||||
extern void *read_block (st_parameter_dt *, int *);
|
||||
internal_proto(read_block);
|
||||
extern try read_block_form (st_parameter_dt *, void *, size_t *);
|
||||
internal_proto(read_block_form);
|
||||
|
||||
extern char *read_sf (st_parameter_dt *, int *, int);
|
||||
internal_proto(read_sf);
|
||||
|
|
@ -931,6 +948,25 @@ internal_proto(size_from_real_kind);
|
|||
extern size_t size_from_complex_kind (int);
|
||||
internal_proto(size_from_complex_kind);
|
||||
|
||||
/* fbuf.c */
|
||||
extern void fbuf_init (gfc_unit *, size_t);
|
||||
internal_proto(fbuf_init);
|
||||
|
||||
extern void fbuf_destroy (gfc_unit *);
|
||||
internal_proto(fbuf_destroy);
|
||||
|
||||
extern void fbuf_reset (gfc_unit *);
|
||||
internal_proto(fbuf_reset);
|
||||
|
||||
extern char * fbuf_alloc (gfc_unit *, size_t);
|
||||
internal_proto(fbuf_alloc);
|
||||
|
||||
extern int fbuf_flush (gfc_unit *, int);
|
||||
internal_proto(fbuf_flush);
|
||||
|
||||
extern int fbuf_seek (gfc_unit *, gfc_offset);
|
||||
internal_proto(fbuf_seek);
|
||||
|
||||
/* lock.c */
|
||||
extern void free_ionml (st_parameter_dt *);
|
||||
internal_proto(free_ionml);
|
||||
|
|
|
|||
|
|
@ -140,9 +140,9 @@ free_line (st_parameter_dt *dtp)
|
|||
static char
|
||||
next_char (st_parameter_dt *dtp)
|
||||
{
|
||||
int length;
|
||||
size_t length;
|
||||
gfc_offset record;
|
||||
char c, *p;
|
||||
char c;
|
||||
|
||||
if (dtp->u.p.last_char != '\0')
|
||||
{
|
||||
|
|
@ -206,43 +206,40 @@ next_char (st_parameter_dt *dtp)
|
|||
|
||||
length = 1;
|
||||
|
||||
p = salloc_r (dtp->u.p.current_unit->s, &length);
|
||||
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))
|
||||
if (is_stream_io (dtp) && length == 1)
|
||||
dtp->u.p.current_unit->strm_pos++;
|
||||
|
||||
if (is_internal_unit (dtp))
|
||||
{
|
||||
if (is_array_io (dtp))
|
||||
{
|
||||
/* End of record is handled in the next pass through, above. The
|
||||
check for NULL here is cautionary. */
|
||||
if (p == NULL)
|
||||
/* Check whether we hit EOF. */
|
||||
if (length == 0)
|
||||
{
|
||||
generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL);
|
||||
return '\0';
|
||||
}
|
||||
|
||||
}
|
||||
dtp->u.p.current_unit->bytes_left--;
|
||||
c = *p;
|
||||
}
|
||||
else
|
||||
{
|
||||
if (p == NULL)
|
||||
if (dtp->u.p.at_eof)
|
||||
longjmp (*dtp->u.p.eof_jump, 1);
|
||||
if (length == 0)
|
||||
c = '\n';
|
||||
else
|
||||
c = *p;
|
||||
{
|
||||
c = '\n';
|
||||
dtp->u.p.at_eof = 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
if (p == NULL)
|
||||
{
|
||||
generate_error (&dtp->common, LIBERROR_OS, NULL);
|
||||
return '\0';
|
||||
}
|
||||
if (length == 0)
|
||||
{
|
||||
if (dtp->u.p.advance_status == ADVANCE_NO)
|
||||
|
|
@ -255,8 +252,6 @@ next_char (st_parameter_dt *dtp)
|
|||
else
|
||||
longjmp (*dtp->u.p.eof_jump, 1);
|
||||
}
|
||||
else
|
||||
c = *p;
|
||||
}
|
||||
done:
|
||||
dtp->u.p.at_eol = (c == '\n' || c == '\r');
|
||||
|
|
@ -2226,6 +2221,15 @@ nml_query (st_parameter_dt *dtp, char c)
|
|||
namelist_info * nl;
|
||||
index_type len;
|
||||
char * p;
|
||||
#ifdef HAVE_CRLF
|
||||
static const index_type endlen = 3;
|
||||
static const char endl[] = "\r\n";
|
||||
static const char nmlend[] = "&end\r\n";
|
||||
#else
|
||||
static const index_type endlen = 2;
|
||||
static const char endl[] = "\n";
|
||||
static const char nmlend[] = "&end\n";
|
||||
#endif
|
||||
|
||||
if (dtp->u.p.current_unit->unit_number != options.stdin_unit)
|
||||
return;
|
||||
|
|
@ -2252,59 +2256,35 @@ nml_query (st_parameter_dt *dtp, char c)
|
|||
/* "&namelist_name\n" */
|
||||
|
||||
len = dtp->namelist_name_len;
|
||||
#ifdef HAVE_CRLF
|
||||
p = write_block (dtp, len + 3);
|
||||
#else
|
||||
p = write_block (dtp, len + 2);
|
||||
#endif
|
||||
if (!p)
|
||||
goto query_return;
|
||||
p = write_block (dtp, len + endlen);
|
||||
if (!p)
|
||||
goto query_return;
|
||||
memcpy (p, "&", 1);
|
||||
memcpy ((char*)(p + 1), dtp->namelist_name, len);
|
||||
#ifdef HAVE_CRLF
|
||||
memcpy ((char*)(p + len + 1), "\r\n", 2);
|
||||
#else
|
||||
memcpy ((char*)(p + len + 1), "\n", 1);
|
||||
#endif
|
||||
memcpy ((char*)(p + len + 1), &endl, endlen - 1);
|
||||
for (nl = dtp->u.p.ionml; nl; nl = nl->next)
|
||||
{
|
||||
/* " var_name\n" */
|
||||
|
||||
len = strlen (nl->var_name);
|
||||
#ifdef HAVE_CRLF
|
||||
p = write_block (dtp, len + 3);
|
||||
#else
|
||||
p = write_block (dtp, len + 2);
|
||||
#endif
|
||||
p = write_block (dtp, len + endlen);
|
||||
if (!p)
|
||||
goto query_return;
|
||||
memcpy (p, " ", 1);
|
||||
memcpy ((char*)(p + 1), nl->var_name, len);
|
||||
#ifdef HAVE_CRLF
|
||||
memcpy ((char*)(p + len + 1), "\r\n", 2);
|
||||
#else
|
||||
memcpy ((char*)(p + len + 1), "\n", 1);
|
||||
#endif
|
||||
memcpy ((char*)(p + len + 1), &endl, endlen - 1);
|
||||
}
|
||||
|
||||
/* "&end\n" */
|
||||
|
||||
#ifdef HAVE_CRLF
|
||||
p = write_block (dtp, 6);
|
||||
#else
|
||||
p = write_block (dtp, 5);
|
||||
#endif
|
||||
if (!p)
|
||||
p = write_block (dtp, endlen + 3);
|
||||
goto query_return;
|
||||
#ifdef HAVE_CRLF
|
||||
memcpy (p, "&end\r\n", 6);
|
||||
#else
|
||||
memcpy (p, "&end\n", 5);
|
||||
#endif
|
||||
memcpy (p, &nmlend, endlen + 3);
|
||||
}
|
||||
|
||||
/* Flush the stream to force immediate output. */
|
||||
|
||||
fbuf_flush (dtp->u.p.current_unit, 1);
|
||||
flush (dtp->u.p.current_unit->s);
|
||||
unlock_unit (dtp->u.p.current_unit);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -626,6 +626,13 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
|
|||
|
||||
if (flags->status == STATUS_SCRATCH && opp->file != NULL)
|
||||
free_mem (opp->file);
|
||||
|
||||
if (flags->form == FORM_FORMATTED && (flags->action != ACTION_READ))
|
||||
fbuf_init (u, 0);
|
||||
else
|
||||
u->fbuf = NULL;
|
||||
|
||||
|
||||
return u;
|
||||
|
||||
cleanup:
|
||||
|
|
|
|||
|
|
@ -36,6 +36,7 @@ Boston, MA 02110-1301, USA. */
|
|||
|
||||
/* read.c -- Deal with formatted reads */
|
||||
|
||||
|
||||
/* set_integer()-- All of the integer assignments come here to
|
||||
* actually place the value into memory. */
|
||||
|
||||
|
|
@ -192,11 +193,13 @@ void
|
|||
read_l (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
|
||||
{
|
||||
char *p;
|
||||
int w;
|
||||
size_t w;
|
||||
|
||||
w = f->u.w;
|
||||
p = read_block (dtp, &w);
|
||||
if (p == NULL)
|
||||
|
||||
p = gfc_alloca (w);
|
||||
|
||||
if (read_block_form (dtp, p, &w) == FAILURE)
|
||||
return;
|
||||
|
||||
while (*p == ' ')
|
||||
|
|
@ -238,24 +241,29 @@ read_l (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
|
|||
void
|
||||
read_a (st_parameter_dt *dtp, const fnode *f, char *p, int length)
|
||||
{
|
||||
char *source;
|
||||
int w, m, n;
|
||||
char *s;
|
||||
int m, n, wi, status;
|
||||
size_t w;
|
||||
|
||||
w = f->u.w;
|
||||
if (w == -1) /* '(A)' edit descriptor */
|
||||
w = length;
|
||||
wi = f->u.w;
|
||||
if (wi == -1) /* '(A)' edit descriptor */
|
||||
wi = length;
|
||||
|
||||
w = wi;
|
||||
|
||||
s = gfc_alloca (w);
|
||||
|
||||
dtp->u.p.sf_read_comma = 0;
|
||||
source = read_block (dtp, &w);
|
||||
status = read_block_form (dtp, s, &w);
|
||||
dtp->u.p.sf_read_comma =
|
||||
dtp->u.p.decimal_status == DECIMAL_COMMA ? 0 : 1;
|
||||
if (source == NULL)
|
||||
if (status == FAILURE)
|
||||
return;
|
||||
if (w > length)
|
||||
source += (w - length);
|
||||
if (w > (size_t) length)
|
||||
s += (w - length);
|
||||
|
||||
m = (w > length) ? length : w;
|
||||
memcpy (p, source, m);
|
||||
m = ((int) w > length) ? length : (int) w;
|
||||
memcpy (p, s, m);
|
||||
|
||||
n = length - w;
|
||||
if (n > 0)
|
||||
|
|
@ -323,14 +331,19 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
|
|||
{
|
||||
GFC_UINTEGER_LARGEST value, maxv, maxv_10;
|
||||
GFC_INTEGER_LARGEST v;
|
||||
int w, negative;
|
||||
int w, negative;
|
||||
size_t wu;
|
||||
char c, *p;
|
||||
|
||||
w = f->u.w;
|
||||
p = read_block (dtp, &w);
|
||||
if (p == NULL)
|
||||
wu = f->u.w;
|
||||
|
||||
p = gfc_alloca (wu);
|
||||
|
||||
if (read_block_form (dtp, p, &wu) == FAILURE)
|
||||
return;
|
||||
|
||||
w = wu;
|
||||
|
||||
p = eat_leading_spaces (&w, p);
|
||||
if (w == 0)
|
||||
{
|
||||
|
|
@ -406,7 +419,7 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
|
|||
generate_error (&dtp->common, LIBERROR_READ_OVERFLOW,
|
||||
"Value overflowed during integer read");
|
||||
next_record (dtp, 1);
|
||||
return;
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -423,12 +436,17 @@ read_radix (st_parameter_dt *dtp, const fnode *f, char *dest, int length,
|
|||
GFC_INTEGER_LARGEST v;
|
||||
int w, negative;
|
||||
char c, *p;
|
||||
size_t wu;
|
||||
|
||||
w = f->u.w;
|
||||
p = read_block (dtp, &w);
|
||||
if (p == NULL)
|
||||
wu = f->u.w;
|
||||
|
||||
p = gfc_alloca (wu);
|
||||
|
||||
if (read_block_form (dtp, p, &wu) == FAILURE)
|
||||
return;
|
||||
|
||||
w = wu;
|
||||
|
||||
p = eat_leading_spaces (&w, p);
|
||||
if (w == 0)
|
||||
{
|
||||
|
|
@ -552,7 +570,7 @@ read_radix (st_parameter_dt *dtp, const fnode *f, char *dest, int length,
|
|||
generate_error (&dtp->common, LIBERROR_READ_OVERFLOW,
|
||||
"Value overflowed during integer read");
|
||||
next_record (dtp, 1);
|
||||
return;
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -565,6 +583,7 @@ read_radix (st_parameter_dt *dtp, const fnode *f, char *dest, int length,
|
|||
void
|
||||
read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
|
||||
{
|
||||
size_t wu;
|
||||
int w, seen_dp, exponent;
|
||||
int exponent_sign, val_sign;
|
||||
int ndigits;
|
||||
|
|
@ -576,11 +595,15 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
|
|||
|
||||
val_sign = 1;
|
||||
seen_dp = 0;
|
||||
w = f->u.w;
|
||||
p = read_block (dtp, &w);
|
||||
if (p == NULL)
|
||||
wu = f->u.w;
|
||||
|
||||
p = gfc_alloca (wu);
|
||||
|
||||
if (read_block_form (dtp, p, &wu) == FAILURE)
|
||||
return;
|
||||
|
||||
w = wu;
|
||||
|
||||
p = eat_leading_spaces (&w, p);
|
||||
if (w == 0)
|
||||
goto zero;
|
||||
|
|
@ -842,7 +865,6 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
|
|||
if (buffer != scratch)
|
||||
free_mem (buffer);
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -850,19 +872,16 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
|
|||
* and never look at it. */
|
||||
|
||||
void
|
||||
read_x (st_parameter_dt *dtp, int n)
|
||||
read_x (st_parameter_dt * dtp, int n)
|
||||
{
|
||||
if (!is_stream_io (dtp))
|
||||
{
|
||||
if ((dtp->u.p.pad_status == PAD_NO || is_internal_unit (dtp))
|
||||
&& dtp->u.p.current_unit->bytes_left < n)
|
||||
n = dtp->u.p.current_unit->bytes_left;
|
||||
if ((dtp->u.p.pad_status == PAD_NO || is_internal_unit (dtp))
|
||||
&& dtp->u.p.current_unit->bytes_left < n)
|
||||
n = dtp->u.p.current_unit->bytes_left;
|
||||
|
||||
dtp->u.p.sf_read_comma = 0;
|
||||
if (n > 0)
|
||||
read_sf (dtp, &n, 1);
|
||||
dtp->u.p.sf_read_comma = 1;
|
||||
}
|
||||
else
|
||||
dtp->u.p.current_unit->strm_pos += (gfc_offset) n;
|
||||
dtp->u.p.sf_read_comma = 0;
|
||||
if (n > 0)
|
||||
read_sf (dtp, &n, 1);
|
||||
dtp->u.p.sf_read_comma = 1;
|
||||
dtp->u.p.current_unit->strm_pos += (gfc_offset) n;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -36,6 +36,7 @@ Boston, MA 02110-1301, USA. */
|
|||
#include "io.h"
|
||||
#include <string.h>
|
||||
#include <assert.h>
|
||||
#include <stdlib.h>
|
||||
|
||||
|
||||
/* Calling conventions: Data transfer statements are unlike other
|
||||
|
|
@ -180,9 +181,10 @@ current_mode (st_parameter_dt *dtp)
|
|||
char *
|
||||
read_sf (st_parameter_dt *dtp, int *length, int no_error)
|
||||
{
|
||||
char *base, *p, *q;
|
||||
int n, readlen, crlf;
|
||||
char *base, *p, q;
|
||||
int n, crlf;
|
||||
gfc_offset pos;
|
||||
size_t readlen;
|
||||
|
||||
if (*length > SCRATCH_SIZE)
|
||||
dtp->u.p.line_buffer = get_mem (*length);
|
||||
|
|
@ -199,15 +201,12 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error)
|
|||
if (is_internal_unit (dtp))
|
||||
{
|
||||
readlen = *length;
|
||||
q = salloc_r (dtp->u.p.current_unit->s, &readlen);
|
||||
if (readlen < *length)
|
||||
if (sread (dtp->u.p.current_unit->s, p, &readlen) != 0 || readlen < (size_t) *length)
|
||||
{
|
||||
generate_error (&dtp->common, LIBERROR_END, NULL);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
if (q != NULL)
|
||||
memcpy (p, q, readlen);
|
||||
goto done;
|
||||
}
|
||||
|
||||
|
|
@ -216,9 +215,11 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error)
|
|||
|
||||
do
|
||||
{
|
||||
q = salloc_r (dtp->u.p.current_unit->s, &readlen);
|
||||
if (q == NULL)
|
||||
break;
|
||||
if (sread (dtp->u.p.current_unit->s, &q, &readlen) != 0)
|
||||
{
|
||||
generate_error (&dtp->common, LIBERROR_END, NULL);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/* If we have a line without a terminating \n, drop through to
|
||||
EOR below. */
|
||||
|
|
@ -230,7 +231,7 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error)
|
|||
return NULL;
|
||||
}
|
||||
|
||||
if (readlen < 1 || *q == '\n' || *q == '\r')
|
||||
if (readlen < 1 || q == '\n' || q == '\r')
|
||||
{
|
||||
/* Unexpected end of line. */
|
||||
|
||||
|
|
@ -241,12 +242,16 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error)
|
|||
|
||||
crlf = 0;
|
||||
/* If we encounter a CR, it might be a CRLF. */
|
||||
if (*q == '\r') /* Probably a CRLF */
|
||||
if (q == '\r') /* Probably a CRLF */
|
||||
{
|
||||
readlen = 1;
|
||||
pos = stream_offset (dtp->u.p.current_unit->s);
|
||||
q = salloc_r (dtp->u.p.current_unit->s, &readlen);
|
||||
if (*q != '\n' && readlen == 1) /* Not a CRLF after all. */
|
||||
if (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;
|
||||
|
|
@ -270,7 +275,7 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error)
|
|||
/* Short circuit the read if a comma is found during numeric input.
|
||||
The flag is set to zero during character reads so that commas in
|
||||
strings are not ignored */
|
||||
if (*q == ',')
|
||||
if (q == ',')
|
||||
if (dtp->u.p.sf_read_comma == 1)
|
||||
{
|
||||
notify_std (&dtp->common, GFC_STD_GNU,
|
||||
|
|
@ -280,7 +285,7 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error)
|
|||
}
|
||||
|
||||
n++;
|
||||
*p++ = *q;
|
||||
*p++ = q;
|
||||
dtp->u.p.sf_seen_eor = 0;
|
||||
}
|
||||
while (n < *length);
|
||||
|
|
@ -296,35 +301,25 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error)
|
|||
|
||||
|
||||
/* Function for reading the next couple of bytes from the current
|
||||
file, advancing the current position. We return a pointer to a
|
||||
buffer containing the bytes. We return NULL on end of record or
|
||||
end of file.
|
||||
file, advancing the current position. We return FAILURE on end of record or
|
||||
end of file. This function is only for formatted I/O, unformatted uses
|
||||
read_block_direct.
|
||||
|
||||
If the read is short, then it is because the current record does not
|
||||
have enough data to satisfy the read request and the file was
|
||||
opened with PAD=YES. The caller must assume tailing spaces for
|
||||
short reads. */
|
||||
|
||||
void *
|
||||
read_block (st_parameter_dt *dtp, int *length)
|
||||
try
|
||||
read_block_form (st_parameter_dt *dtp, void *buf, size_t *nbytes)
|
||||
{
|
||||
char *source;
|
||||
int nread;
|
||||
size_t nread;
|
||||
int nb;
|
||||
|
||||
if (is_stream_io (dtp))
|
||||
if (!is_stream_io (dtp))
|
||||
{
|
||||
if (dtp->u.p.current_unit->strm_pos - 1
|
||||
!= file_position (dtp->u.p.current_unit->s)
|
||||
&& sseek (dtp->u.p.current_unit->s,
|
||||
dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
|
||||
{
|
||||
generate_error (&dtp->common, LIBERROR_END, NULL);
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *length)
|
||||
if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *nbytes)
|
||||
{
|
||||
/* For preconnected units with default record length, set bytes left
|
||||
to unit record length and proceed, otherwise error. */
|
||||
|
|
@ -337,7 +332,7 @@ read_block (st_parameter_dt *dtp, int *length)
|
|||
{
|
||||
/* Not enough data left. */
|
||||
generate_error (&dtp->common, LIBERROR_EOR, NULL);
|
||||
return NULL;
|
||||
return FAILURE;
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -345,10 +340,10 @@ read_block (st_parameter_dt *dtp, int *length)
|
|||
{
|
||||
dtp->u.p.current_unit->endfile = AT_ENDFILE;
|
||||
generate_error (&dtp->common, LIBERROR_END, NULL);
|
||||
return NULL;
|
||||
return FAILURE;
|
||||
}
|
||||
|
||||
*length = dtp->u.p.current_unit->bytes_left;
|
||||
*nbytes = dtp->u.p.current_unit->bytes_left;
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -356,23 +351,32 @@ read_block (st_parameter_dt *dtp, int *length)
|
|||
(dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL ||
|
||||
dtp->u.p.current_unit->flags.access == ACCESS_STREAM))
|
||||
{
|
||||
source = read_sf (dtp, length, 0);
|
||||
nb = *nbytes;
|
||||
source = read_sf (dtp, &nb, 0);
|
||||
*nbytes = nb;
|
||||
dtp->u.p.current_unit->strm_pos +=
|
||||
(gfc_offset) (*length + dtp->u.p.sf_seen_eor);
|
||||
return source;
|
||||
(gfc_offset) (*nbytes + dtp->u.p.sf_seen_eor);
|
||||
if (source == NULL)
|
||||
return FAILURE;
|
||||
memcpy (buf, source, *nbytes);
|
||||
return SUCCESS;
|
||||
}
|
||||
dtp->u.p.current_unit->bytes_left -= (gfc_offset) *length;
|
||||
dtp->u.p.current_unit->bytes_left -= (gfc_offset) *nbytes;
|
||||
|
||||
nread = *length;
|
||||
source = salloc_r (dtp->u.p.current_unit->s, &nread);
|
||||
nread = *nbytes;
|
||||
if (sread (dtp->u.p.current_unit->s, buf, &nread) != 0)
|
||||
{
|
||||
generate_error (&dtp->common, LIBERROR_OS, NULL);
|
||||
return FAILURE;
|
||||
}
|
||||
|
||||
if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
|
||||
dtp->u.p.size_used += (gfc_offset) nread;
|
||||
|
||||
if (nread != *length)
|
||||
if (nread != *nbytes)
|
||||
{ /* Short read, this shouldn't happen. */
|
||||
if (dtp->u.p.pad_status == PAD_YES)
|
||||
*length = nread;
|
||||
*nbytes = nread;
|
||||
else
|
||||
{
|
||||
generate_error (&dtp->common, LIBERROR_EOR, NULL);
|
||||
|
|
@ -382,7 +386,7 @@ read_block (st_parameter_dt *dtp, int *length)
|
|||
|
||||
dtp->u.p.current_unit->strm_pos += (gfc_offset) nread;
|
||||
|
||||
return source;
|
||||
return SUCCESS;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -400,15 +404,6 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
|
|||
|
||||
if (is_stream_io (dtp))
|
||||
{
|
||||
if (dtp->u.p.current_unit->strm_pos - 1
|
||||
!= file_position (dtp->u.p.current_unit->s)
|
||||
&& sseek (dtp->u.p.current_unit->s,
|
||||
dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
|
||||
{
|
||||
generate_error (&dtp->common, LIBERROR_END, NULL);
|
||||
return;
|
||||
}
|
||||
|
||||
to_read_record = *nbytes;
|
||||
have_read_record = to_read_record;
|
||||
if (sread (dtp->u.p.current_unit->s, buf, &have_read_record) != 0)
|
||||
|
|
@ -576,18 +571,7 @@ write_block (st_parameter_dt *dtp, int length)
|
|||
{
|
||||
char *dest;
|
||||
|
||||
if (is_stream_io (dtp))
|
||||
{
|
||||
if (dtp->u.p.current_unit->strm_pos - 1
|
||||
!= file_position (dtp->u.p.current_unit->s)
|
||||
&& sseek (dtp->u.p.current_unit->s,
|
||||
dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
|
||||
{
|
||||
generate_error (&dtp->common, LIBERROR_OS, NULL);
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
else
|
||||
if (!is_stream_io (dtp))
|
||||
{
|
||||
if (dtp->u.p.current_unit->bytes_left < (gfc_offset) length)
|
||||
{
|
||||
|
|
@ -607,17 +591,29 @@ write_block (st_parameter_dt *dtp, int length)
|
|||
dtp->u.p.current_unit->bytes_left -= (gfc_offset) length;
|
||||
}
|
||||
|
||||
dest = salloc_w (dtp->u.p.current_unit->s, &length);
|
||||
|
||||
if (dest == NULL)
|
||||
if (is_internal_unit (dtp))
|
||||
{
|
||||
dest = salloc_w (dtp->u.p.current_unit->s, &length);
|
||||
|
||||
if (dest == NULL)
|
||||
{
|
||||
generate_error (&dtp->common, LIBERROR_END, NULL);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
if (dtp->u.p.current_unit->endfile == AT_ENDFILE)
|
||||
generate_error (&dtp->common, LIBERROR_END, NULL);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
if (is_internal_unit (dtp) && dtp->u.p.current_unit->endfile == AT_ENDFILE)
|
||||
generate_error (&dtp->common, LIBERROR_END, NULL);
|
||||
|
||||
else
|
||||
{
|
||||
dest = fbuf_alloc (dtp->u.p.current_unit, length);
|
||||
if (dest == NULL)
|
||||
{
|
||||
generate_error (&dtp->common, LIBERROR_OS, NULL);
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
|
||||
if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
|
||||
dtp->u.p.size_used += (gfc_offset) length;
|
||||
|
||||
|
|
@ -642,15 +638,6 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes)
|
|||
|
||||
if (is_stream_io (dtp))
|
||||
{
|
||||
if (dtp->u.p.current_unit->strm_pos - 1
|
||||
!= file_position (dtp->u.p.current_unit->s)
|
||||
&& sseek (dtp->u.p.current_unit->s,
|
||||
dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
|
||||
{
|
||||
generate_error (&dtp->common, LIBERROR_OS, NULL);
|
||||
return FAILURE;
|
||||
}
|
||||
|
||||
if (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0)
|
||||
{
|
||||
generate_error (&dtp->common, LIBERROR_OS, NULL);
|
||||
|
|
@ -866,7 +853,7 @@ static void
|
|||
write_constant_string (st_parameter_dt *dtp, const fnode *f)
|
||||
{
|
||||
char c, delimiter, *p, *q;
|
||||
int length;
|
||||
int length;
|
||||
|
||||
length = f->u.string.length;
|
||||
if (length == 0)
|
||||
|
|
@ -875,7 +862,7 @@ write_constant_string (st_parameter_dt *dtp, const fnode *f)
|
|||
p = write_block (dtp, length);
|
||||
if (p == NULL)
|
||||
return;
|
||||
|
||||
|
||||
q = f->u.string.p;
|
||||
delimiter = q[-1];
|
||||
|
||||
|
|
@ -993,7 +980,10 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int len,
|
|||
}
|
||||
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);
|
||||
dtp->u.p.current_unit->bytes_left -= (gfc_offset) dtp->u.p.skips;
|
||||
}
|
||||
dtp->u.p.skips = dtp->u.p.pending_spaces = 0;
|
||||
|
|
@ -1606,9 +1596,7 @@ transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind,
|
|||
static void
|
||||
us_read (st_parameter_dt *dtp, int continued)
|
||||
{
|
||||
char *p;
|
||||
int n;
|
||||
int nr;
|
||||
size_t n, nr;
|
||||
GFC_INTEGER_4 i4;
|
||||
GFC_INTEGER_8 i8;
|
||||
gfc_offset i;
|
||||
|
|
@ -1623,7 +1611,11 @@ us_read (st_parameter_dt *dtp, int continued)
|
|||
|
||||
nr = n;
|
||||
|
||||
p = salloc_r (dtp->u.p.current_unit->s, &n);
|
||||
if (sread (dtp->u.p.current_unit->s, &i, &n) != 0)
|
||||
{
|
||||
generate_error (&dtp->common, LIBERROR_BAD_US, NULL);
|
||||
return;
|
||||
}
|
||||
|
||||
if (n == 0)
|
||||
{
|
||||
|
|
@ -1631,7 +1623,7 @@ us_read (st_parameter_dt *dtp, int continued)
|
|||
return; /* end of file */
|
||||
}
|
||||
|
||||
if (p == NULL || n != nr)
|
||||
if (n != nr)
|
||||
{
|
||||
generate_error (&dtp->common, LIBERROR_BAD_US, NULL);
|
||||
return;
|
||||
|
|
@ -1643,12 +1635,12 @@ us_read (st_parameter_dt *dtp, int continued)
|
|||
switch (nr)
|
||||
{
|
||||
case sizeof(GFC_INTEGER_4):
|
||||
memcpy (&i4, p, sizeof (i4));
|
||||
memcpy (&i4, &i, sizeof (i4));
|
||||
i = i4;
|
||||
break;
|
||||
|
||||
case sizeof(GFC_INTEGER_8):
|
||||
memcpy (&i8, p, sizeof (i8));
|
||||
memcpy (&i8, &i, sizeof (i8));
|
||||
i = i8;
|
||||
break;
|
||||
|
||||
|
|
@ -1661,12 +1653,12 @@ us_read (st_parameter_dt *dtp, int continued)
|
|||
switch (nr)
|
||||
{
|
||||
case sizeof(GFC_INTEGER_4):
|
||||
reverse_memcpy (&i4, p, sizeof (i4));
|
||||
reverse_memcpy (&i4, &i, sizeof (i4));
|
||||
i = i4;
|
||||
break;
|
||||
|
||||
case sizeof(GFC_INTEGER_8):
|
||||
reverse_memcpy (&i8, p, sizeof (i8));
|
||||
reverse_memcpy (&i8, &i, sizeof (i8));
|
||||
i = i8;
|
||||
break;
|
||||
|
||||
|
|
@ -1734,10 +1726,10 @@ pre_position (st_parameter_dt *dtp)
|
|||
{
|
||||
case FORMATTED_STREAM:
|
||||
case UNFORMATTED_STREAM:
|
||||
/* There are no records with stream I/O. Set the default position
|
||||
to the beginning of the file if no position was specified. */
|
||||
if ((dtp->common.flags & IOPARM_DT_HAS_REC) == 0)
|
||||
dtp->u.p.current_unit->strm_pos = 1;
|
||||
/* There are no records with stream I/O. If the position was specified
|
||||
data_transfer_init has already positioned the file. If no position
|
||||
was specified, we continue from where we last left off. I.e.
|
||||
there is nothing to do here. */
|
||||
break;
|
||||
|
||||
case UNFORMATTED_SEQUENTIAL:
|
||||
|
|
@ -2070,7 +2062,10 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
|
|||
if (dtp->u.p.mode == READING
|
||||
&& dtp->u.p.current_unit->mode == WRITING
|
||||
&& !is_internal_unit (dtp))
|
||||
flush(dtp->u.p.current_unit->s);
|
||||
{
|
||||
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. */
|
||||
|
|
@ -2094,11 +2089,21 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
|
|||
}
|
||||
}
|
||||
else
|
||||
dtp->u.p.current_unit->strm_pos = dtp->rec;
|
||||
{
|
||||
if (dtp->u.p.current_unit->strm_pos != dtp->rec)
|
||||
{
|
||||
fbuf_flush (dtp->u.p.current_unit, 1);
|
||||
flush (dtp->u.p.current_unit->s);
|
||||
if (sseek (dtp->u.p.current_unit->s, dtp->rec - 1) == FAILURE)
|
||||
{
|
||||
generate_error (&dtp->common, LIBERROR_OS, NULL);
|
||||
return;
|
||||
}
|
||||
dtp->u.p.current_unit->strm_pos = dtp->rec;
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
else
|
||||
dtp->rec = 0;
|
||||
|
||||
/* Overwriting an existing sequential file ?
|
||||
it is always safe to truncate the file on the first write */
|
||||
|
|
@ -2118,6 +2123,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
|
|||
dtp->u.p.max_pos = dtp->u.p.current_unit->saved_pos;
|
||||
|
||||
pre_position (dtp);
|
||||
|
||||
|
||||
/* Set up the subroutine that will handle the transfers. */
|
||||
|
||||
|
|
@ -2256,14 +2262,13 @@ next_array_record (st_parameter_dt *dtp, array_loop_spec *ls, int *finished)
|
|||
read chunks of size MAX_READ until we get to the right
|
||||
position. */
|
||||
|
||||
#define MAX_READ 4096
|
||||
|
||||
static void
|
||||
skip_record (st_parameter_dt *dtp, size_t bytes)
|
||||
{
|
||||
gfc_offset new;
|
||||
int rlength, length;
|
||||
char *p;
|
||||
size_t rlength;
|
||||
static const size_t MAX_READ = 4096;
|
||||
char p[MAX_READ];
|
||||
|
||||
dtp->u.p.current_unit->bytes_left_subrecord += bytes;
|
||||
if (dtp->u.p.current_unit->bytes_left_subrecord == 0)
|
||||
|
|
@ -2283,24 +2288,22 @@ skip_record (st_parameter_dt *dtp, size_t bytes)
|
|||
{ /* Seek by reading data. */
|
||||
while (dtp->u.p.current_unit->bytes_left_subrecord > 0)
|
||||
{
|
||||
rlength = length =
|
||||
(MAX_READ > dtp->u.p.current_unit->bytes_left_subrecord) ?
|
||||
rlength =
|
||||
(MAX_READ > (size_t) dtp->u.p.current_unit->bytes_left_subrecord) ?
|
||||
MAX_READ : dtp->u.p.current_unit->bytes_left_subrecord;
|
||||
|
||||
p = salloc_r (dtp->u.p.current_unit->s, &rlength);
|
||||
if (p == NULL)
|
||||
if (sread (dtp->u.p.current_unit->s, p, &rlength) != 0)
|
||||
{
|
||||
generate_error (&dtp->common, LIBERROR_OS, NULL);
|
||||
return;
|
||||
}
|
||||
|
||||
dtp->u.p.current_unit->bytes_left_subrecord -= length;
|
||||
dtp->u.p.current_unit->bytes_left_subrecord -= rlength;
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
#undef MAX_READ
|
||||
|
||||
/* Advance to the next record reading unformatted files, taking
|
||||
care of subrecords. If complete_record is nonzero, we loop
|
||||
|
|
@ -2328,14 +2331,23 @@ next_record_r_unf (st_parameter_dt *dtp, int complete_record)
|
|||
}
|
||||
}
|
||||
|
||||
|
||||
static inline gfc_offset
|
||||
min_off (gfc_offset a, gfc_offset b)
|
||||
{
|
||||
return (a < b ? a : b);
|
||||
}
|
||||
|
||||
|
||||
/* Space to the next record for read mode. */
|
||||
|
||||
static void
|
||||
next_record_r (st_parameter_dt *dtp)
|
||||
{
|
||||
gfc_offset record;
|
||||
int length, bytes_left;
|
||||
char *p;
|
||||
int bytes_left;
|
||||
size_t length;
|
||||
char p;
|
||||
|
||||
switch (current_mode (dtp))
|
||||
{
|
||||
|
|
@ -2384,18 +2396,24 @@ next_record_r (st_parameter_dt *dtp)
|
|||
else
|
||||
{
|
||||
bytes_left = (int) dtp->u.p.current_unit->bytes_left;
|
||||
p = salloc_r (dtp->u.p.current_unit->s, &bytes_left);
|
||||
if (p != NULL)
|
||||
dtp->u.p.current_unit->bytes_left
|
||||
= dtp->u.p.current_unit->recl;
|
||||
bytes_left = min_off (bytes_left,
|
||||
file_length (dtp->u.p.current_unit->s)
|
||||
- file_position (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)
|
||||
{
|
||||
generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL);
|
||||
break;
|
||||
}
|
||||
dtp->u.p.current_unit->bytes_left
|
||||
= dtp->u.p.current_unit->recl;
|
||||
}
|
||||
break;
|
||||
}
|
||||
else do
|
||||
{
|
||||
p = salloc_r (dtp->u.p.current_unit->s, &length);
|
||||
|
||||
if (p == NULL)
|
||||
if (sread (dtp->u.p.current_unit->s, &p, &length) != 0)
|
||||
{
|
||||
generate_error (&dtp->common, LIBERROR_OS, NULL);
|
||||
break;
|
||||
|
|
@ -2410,7 +2428,7 @@ next_record_r (st_parameter_dt *dtp)
|
|||
if (is_stream_io (dtp))
|
||||
dtp->u.p.current_unit->strm_pos++;
|
||||
}
|
||||
while (*p != '\n');
|
||||
while (p != '\n');
|
||||
|
||||
break;
|
||||
}
|
||||
|
|
@ -2550,8 +2568,10 @@ next_record_w (st_parameter_dt *dtp, int done)
|
|||
{
|
||||
gfc_offset m, record, max_pos;
|
||||
int length;
|
||||
char *p;
|
||||
|
||||
/* 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;
|
||||
|
|
@ -2576,12 +2596,9 @@ 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;
|
||||
p = salloc_w (dtp->u.p.current_unit->s, &length);
|
||||
memset (p, 0, length);
|
||||
if (sset (dtp->u.p.current_unit->s, 0, length) == FAILURE)
|
||||
goto io_error;
|
||||
}
|
||||
|
||||
if (sfree (dtp->u.p.current_unit->s) == FAILURE)
|
||||
goto io_error;
|
||||
break;
|
||||
|
||||
case UNFORMATTED_SEQUENTIAL:
|
||||
|
|
@ -2609,7 +2626,13 @@ next_record_w (st_parameter_dt *dtp, int done)
|
|||
if (max_pos > m)
|
||||
{
|
||||
length = (int) (max_pos - m);
|
||||
p = salloc_w (dtp->u.p.current_unit->s, &length);
|
||||
if (sseek (dtp->u.p.current_unit->s,
|
||||
file_position (dtp->u.p.current_unit->s)
|
||||
+ length) == FAILURE)
|
||||
{
|
||||
generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL);
|
||||
return;
|
||||
}
|
||||
length = (int) (dtp->u.p.current_unit->recl - max_pos);
|
||||
}
|
||||
|
||||
|
|
@ -2651,7 +2674,13 @@ next_record_w (st_parameter_dt *dtp, int done)
|
|||
if (max_pos > m)
|
||||
{
|
||||
length = (int) (max_pos - m);
|
||||
p = salloc_w (dtp->u.p.current_unit->s, &length);
|
||||
if (sseek (dtp->u.p.current_unit->s,
|
||||
file_position (dtp->u.p.current_unit->s)
|
||||
+ length) == FAILURE)
|
||||
{
|
||||
generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL);
|
||||
return;
|
||||
}
|
||||
length = (int) (dtp->u.p.current_unit->recl - max_pos);
|
||||
}
|
||||
else
|
||||
|
|
@ -2670,15 +2699,6 @@ next_record_w (st_parameter_dt *dtp, int done)
|
|||
size_t len;
|
||||
const char crlf[] = "\r\n";
|
||||
|
||||
/* Move to the farthest position reached in preparation for
|
||||
completing the record. (for file unit) */
|
||||
m = dtp->u.p.current_unit->recl -
|
||||
dtp->u.p.current_unit->bytes_left;
|
||||
if (max_pos > m)
|
||||
{
|
||||
length = (int) (max_pos - m);
|
||||
p = salloc_w (dtp->u.p.current_unit->s, &length);
|
||||
}
|
||||
#ifdef HAVE_CRLF
|
||||
len = 2;
|
||||
#else
|
||||
|
|
@ -2818,6 +2838,7 @@ finalize_transfer (st_parameter_dt *dtp)
|
|||
if (!is_internal_unit (dtp) && dtp->u.p.seen_dollar)
|
||||
{
|
||||
dtp->u.p.seen_dollar = 0;
|
||||
fbuf_flush (dtp->u.p.current_unit, 1);
|
||||
sfree (dtp->u.p.current_unit->s);
|
||||
return;
|
||||
}
|
||||
|
|
@ -2830,6 +2851,7 @@ 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);
|
||||
return;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -567,6 +567,8 @@ init_units (void)
|
|||
u->file_len = strlen (stdout_name);
|
||||
u->file = get_mem (u->file_len);
|
||||
memmove (u->file, stdout_name, u->file_len);
|
||||
|
||||
fbuf_init (u, 0);
|
||||
|
||||
__gthread_mutex_unlock (&u->lock);
|
||||
}
|
||||
|
|
@ -594,6 +596,9 @@ init_units (void)
|
|||
u->file_len = strlen (stderr_name);
|
||||
u->file = get_mem (u->file_len);
|
||||
memmove (u->file, stderr_name, u->file_len);
|
||||
|
||||
fbuf_init (u, 256); /* 256 bytes should be enough, probably not doing
|
||||
any kind of exotic formatting to stderr. */
|
||||
|
||||
__gthread_mutex_unlock (&u->lock);
|
||||
}
|
||||
|
|
@ -613,7 +618,7 @@ static int
|
|||
close_unit_1 (gfc_unit *u, int locked)
|
||||
{
|
||||
int i, rc;
|
||||
|
||||
|
||||
/* If there are previously written bytes from a write with ADVANCE="no"
|
||||
Reposition the buffer before closing. */
|
||||
if (u->previous_nonadvancing_write)
|
||||
|
|
@ -635,6 +640,8 @@ close_unit_1 (gfc_unit *u, int locked)
|
|||
free_mem (u->file);
|
||||
u->file = NULL;
|
||||
u->file_len = 0;
|
||||
|
||||
fbuf_destroy (u);
|
||||
|
||||
if (!locked)
|
||||
__gthread_mutex_unlock (&u->lock);
|
||||
|
|
@ -737,10 +744,11 @@ filename_from_unit (int n)
|
|||
void
|
||||
finish_last_advance_record (gfc_unit *u)
|
||||
{
|
||||
char *p;
|
||||
|
||||
|
||||
if (u->saved_pos > 0)
|
||||
p = salloc_w (u->s, &u->saved_pos);
|
||||
fbuf_seek (u, u->saved_pos);
|
||||
|
||||
fbuf_flush (u, 1);
|
||||
|
||||
if (!(u->unit_number == options.stdout_unit
|
||||
|| u->unit_number == options.stderr_unit))
|
||||
|
|
|
|||
|
|
@ -530,12 +530,10 @@ fd_alloc (unix_stream * s, gfc_offset where,
|
|||
* NULL on I/O error. */
|
||||
|
||||
static char *
|
||||
fd_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
|
||||
fd_alloc_r_at (unix_stream * s, int *len)
|
||||
{
|
||||
gfc_offset m;
|
||||
|
||||
if (where == -1)
|
||||
where = s->logical_offset;
|
||||
gfc_offset where = s->logical_offset;
|
||||
|
||||
if (s->buffer != NULL && s->buffer_offset <= where &&
|
||||
where + *len <= s->buffer_offset + s->active)
|
||||
|
|
@ -593,12 +591,10 @@ fd_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
|
|||
* we've already buffered the data or we need to load it. */
|
||||
|
||||
static char *
|
||||
fd_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
|
||||
fd_alloc_w_at (unix_stream * s, int *len)
|
||||
{
|
||||
gfc_offset n;
|
||||
|
||||
if (where == -1)
|
||||
where = s->logical_offset;
|
||||
gfc_offset where = s->logical_offset;
|
||||
|
||||
if (s->buffer == NULL || s->buffer_offset > where ||
|
||||
where + *len > s->buffer_offset + s->len)
|
||||
|
|
@ -752,7 +748,7 @@ fd_sset (unix_stream * s, int c, size_t n)
|
|||
/* memset() in chunks of BUFFER_SIZE. */
|
||||
trans = (bytes_left < BUFFER_SIZE) ? bytes_left : BUFFER_SIZE;
|
||||
|
||||
p = fd_alloc_w_at (s, &trans, -1);
|
||||
p = fd_alloc_w_at (s, &trans);
|
||||
if (p)
|
||||
memset (p, c, trans);
|
||||
else
|
||||
|
|
@ -779,7 +775,7 @@ fd_read (unix_stream * s, void * buf, size_t * nbytes)
|
|||
if (*nbytes < BUFFER_SIZE && s->method == SYNC_BUFFERED)
|
||||
{
|
||||
tmp = *nbytes;
|
||||
p = fd_alloc_r_at (s, &tmp, -1);
|
||||
p = fd_alloc_r_at (s, &tmp);
|
||||
if (p)
|
||||
{
|
||||
*nbytes = tmp;
|
||||
|
|
@ -827,7 +823,7 @@ fd_write (unix_stream * s, const void * buf, size_t * nbytes)
|
|||
if (*nbytes < BUFFER_SIZE && s->method == SYNC_BUFFERED)
|
||||
{
|
||||
tmp = *nbytes;
|
||||
p = fd_alloc_w_at (s, &tmp, -1);
|
||||
p = fd_alloc_w_at (s, &tmp);
|
||||
if (p)
|
||||
{
|
||||
*nbytes = tmp;
|
||||
|
|
@ -890,7 +886,6 @@ fd_open (unix_stream * s)
|
|||
else
|
||||
s->method = SYNC_BUFFERED;
|
||||
|
||||
s->st.alloc_r_at = (void *) fd_alloc_r_at;
|
||||
s->st.alloc_w_at = (void *) fd_alloc_w_at;
|
||||
s->st.sfree = (void *) fd_sfree;
|
||||
s->st.close = (void *) fd_close;
|
||||
|
|
@ -918,12 +913,10 @@ fd_open (unix_stream * s)
|
|||
|
||||
|
||||
static char *
|
||||
mem_alloc_r_at (int_stream * s, int *len, gfc_offset where)
|
||||
mem_alloc_r_at (int_stream * s, int *len)
|
||||
{
|
||||
gfc_offset n;
|
||||
|
||||
if (where == -1)
|
||||
where = s->logical_offset;
|
||||
gfc_offset where = s->logical_offset;
|
||||
|
||||
if (where < s->buffer_offset || where > s->buffer_offset + s->active)
|
||||
return NULL;
|
||||
|
|
@ -939,15 +932,13 @@ mem_alloc_r_at (int_stream * s, int *len, gfc_offset where)
|
|||
|
||||
|
||||
static char *
|
||||
mem_alloc_w_at (int_stream * s, int *len, gfc_offset where)
|
||||
mem_alloc_w_at (int_stream * s, int *len)
|
||||
{
|
||||
gfc_offset m;
|
||||
gfc_offset where = s->logical_offset;
|
||||
|
||||
assert (*len >= 0); /* Negative values not allowed. */
|
||||
|
||||
if (where == -1)
|
||||
where = s->logical_offset;
|
||||
|
||||
m = where + *len;
|
||||
|
||||
if (where < s->buffer_offset)
|
||||
|
|
@ -962,9 +953,7 @@ mem_alloc_w_at (int_stream * s, int *len, gfc_offset where)
|
|||
}
|
||||
|
||||
|
||||
/* Stream read function for internal units. This is not actually used
|
||||
at the moment, as all internal IO is formatted and the formatted IO
|
||||
routines use mem_alloc_r_at. */
|
||||
/* Stream read function for internal units. */
|
||||
|
||||
static int
|
||||
mem_read (int_stream * s, void * buf, size_t * nbytes)
|
||||
|
|
@ -973,7 +962,7 @@ mem_read (int_stream * s, void * buf, size_t * nbytes)
|
|||
int tmp;
|
||||
|
||||
tmp = *nbytes;
|
||||
p = mem_alloc_r_at (s, &tmp, -1);
|
||||
p = mem_alloc_r_at (s, &tmp);
|
||||
if (p)
|
||||
{
|
||||
*nbytes = tmp;
|
||||
|
|
@ -983,7 +972,7 @@ mem_read (int_stream * s, void * buf, size_t * nbytes)
|
|||
else
|
||||
{
|
||||
*nbytes = 0;
|
||||
return errno;
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -998,10 +987,8 @@ mem_write (int_stream * s, const void * buf, size_t * nbytes)
|
|||
void *p;
|
||||
int tmp;
|
||||
|
||||
errno = 0;
|
||||
|
||||
tmp = *nbytes;
|
||||
p = mem_alloc_w_at (s, &tmp, -1);
|
||||
p = mem_alloc_w_at (s, &tmp);
|
||||
if (p)
|
||||
{
|
||||
*nbytes = tmp;
|
||||
|
|
@ -1011,7 +998,7 @@ mem_write (int_stream * s, const void * buf, size_t * nbytes)
|
|||
else
|
||||
{
|
||||
*nbytes = 0;
|
||||
return errno;
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -1038,7 +1025,7 @@ mem_set (int_stream * s, int c, size_t n)
|
|||
|
||||
len = n;
|
||||
|
||||
p = mem_alloc_w_at (s, &len, -1);
|
||||
p = mem_alloc_w_at (s, &len);
|
||||
if (p)
|
||||
{
|
||||
memset (p, c, len);
|
||||
|
|
@ -1104,7 +1091,6 @@ open_internal (char *base, int length, gfc_offset offset)
|
|||
s->logical_offset = 0;
|
||||
s->active = s->file_length = length;
|
||||
|
||||
s->st.alloc_r_at = (void *) mem_alloc_r_at;
|
||||
s->st.alloc_w_at = (void *) mem_alloc_w_at;
|
||||
s->st.sfree = (void *) mem_sfree;
|
||||
s->st.close = (void *) mem_close;
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue