From 15877a88eb5c78571ebc0f718e8ff2bf32c5cc5e Mon Sep 17 00:00:00 2001 From: Janne Blomqvist Date: Thu, 15 May 2008 18:53:34 +0300 Subject: [PATCH] Part 1 of PR 25561. 2008-05-15 Janne Blomqvist 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 --- libgfortran/Makefile.am | 3 +- libgfortran/Makefile.in | 17 ++- libgfortran/io/file_pos.c | 34 ++--- libgfortran/io/io.h | 54 +++++-- libgfortran/io/list_read.c | 88 +++++------ libgfortran/io/open.c | 7 + libgfortran/io/read.c | 101 +++++++----- libgfortran/io/transfer.c | 304 ++++++++++++++++++++----------------- libgfortran/io/unit.c | 16 +- libgfortran/io/unix.c | 48 +++--- 10 files changed, 370 insertions(+), 302 deletions(-) diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am index 1c2fa4c22c0..ed7ad21801c 100644 --- a/libgfortran/Makefile.am +++ b/libgfortran/Makefile.am @@ -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 diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in index dc44e4a29d7..1db39915eab 100644 --- a/libgfortran/Makefile.in +++ b/libgfortran/Makefile.in @@ -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 diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c index 94e29899fb1..f4864884f33 100644 --- a/libgfortran/io/file_pos.c +++ b/libgfortran/io/file_pos.c @@ -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) diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index 30d4051f126..e554d8cccbc 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -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); diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index d3e932e4074..3837f7ecf2e 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -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); } diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c index 83e37ee22fd..e16386cabd7 100644 --- a/libgfortran/io/open.c +++ b/libgfortran/io/open.c @@ -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: diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c index ce86ec00b8f..a09d663dc1c 100644 --- a/libgfortran/io/read.c +++ b/libgfortran/io/read.c @@ -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; - - 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; + 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; + dtp->u.p.current_unit->strm_pos += (gfc_offset) n; } + diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 7071ab9128a..8353f3ddb74 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -36,6 +36,7 @@ Boston, MA 02110-1301, USA. */ #include "io.h" #include #include +#include /* 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 (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 (!is_stream_io (dtp)) { - 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)) { - generate_error (&dtp->common, LIBERROR_END, NULL); - return NULL; - } + dest = salloc_w (dtp->u.p.current_unit->s, &length); - if (is_internal_unit (dtp) && dtp->u.p.current_unit->endfile == AT_ENDFILE) - generate_error (&dtp->common, LIBERROR_END, NULL); + 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); + } + 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; } diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c index 9f9e3513dab..69563187553 100644 --- a/libgfortran/io/unit.c +++ b/libgfortran/io/unit.c @@ -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)) diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c index 3896f04db61..29583802285 100644 --- a/libgfortran/io/unix.c +++ b/libgfortran/io/unix.c @@ -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; -- 2.30.2