This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.
| Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
|---|---|---|
| Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
| Other format: | [Raw text] | |
Hello,
this is an almost complete patch for part I of getting rid of the alloc
stream facility (the low level libgfortran I/O stuff). The patch
converts all users of salloc_* to the sread/swrite/sseek interface, with
the exception of write_x(). The exception is an issue with T/TL edit
descriptors, and as it turns out these don't work correctly now either,
see PR 36142. See the PR for some ideas on how to solve it.
After this patch and the T/TL fix is in, I plan to continue to part II,
which means to simplify the library by getting rid of the
{fd,mem}_alloc* functions. For external files (fd_*()) the main idea
I've been thinking about is to replace the current buffered I/O
implementation with C stdio. This would, IMHO, have the following benefits:
* Due to the extremely widespread usage of stdio, we can be quite sure
there are no bugs in the buffering. And even if there are, it's the
headache of the upstream libc. This is in contrast to our current
implementation that does plenty of flushing to cover up bugs.
* Better performance, stdio is mature and has been tweaked over many
years. Also lack of unnecessary flushing, see above.
* Well documented, with well defined semantics.
* When doing formatted reads, we must usually read one character at a
time. This has a huge overhead in our current implementation. It would
be relatively simple to use getc() here. Or actually getc_unlocked() if
available, since we would lock the stream for the duration of a
READ/WRITE statement (flockfile()/funlockfile()).
* Make life slightly easier for people doing mixed language programming,
since gfortran would use the same buffering as C. And C++ with
sync_with_stdio() or any other language whose runtime is implemented in
terms of stdio. Of course, mixed language I/O to the same file would
still be somewhat dangerous.
Patch is regtested on i686-pc-linux-gnu, ok for trunk?
--
Janne Blomqvist
2008-05-06 Janne Blomqvist <jb@gcc.gnu.org> PR libfortran/25561 * 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. (read_block_form): New prototype. (write_block): Remove. (write_block_form): New prototype. * io/file_pos.c (formatted_backspace): Change to use sread. * io/list_read.c (next_char): Likewise. (nml_query): Change to use write_block_form. * io/read.c (read_l): Change to use read_block_form. (read_a): Likewise. (read_decimal): Likewise. (read_radix): Likewise. (read_f): Likewise. * io/transfer.c (read_sf): Change to use sread. (read_block): Rename to read_block_form, change prototype, use sread. (write_block): Rename to write_block_form, change prototype, use swrite. (write_constant_string): Change to use write_block_form. (us_read): Change to use sread. (skip_record): Likewise. (min_off): New function. (next_record_r): Change to use sread. (next_record_w): Change to use sset/sseek. * io/unit.c (filename_from_unit): Change to use sseek. * io/unix.c (mem_read): Don't incorrectly return previous errno. (fd_open): Don't set alloc_r_at. (open_internal): Likewise. * io/write.c (write_a): Change to use write_block_form. (write_l): Likewise. (write_int): Likewise. (write_decimal): Likewise. (write_x): Likewise. (write_char): Likewise. (write_integer): Likewise. (write_character): Likewise. (write_complex): Likewise. * io/write_float.def (output_float): Likewise. (write_infnan): Likewise. (output_float_FMT_G_): Likewise.
diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c
index 94e2989..b2ad546 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)
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 30d4051..fc199ad 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -50,7 +50,6 @@ 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);
try (*sfree) (struct stream *);
try (*close) (struct stream *);
try (*seek) (struct stream *, gfc_offset);
@@ -70,12 +69,8 @@ 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 sseek(s, pos) ((s)->seek)(s, pos)
#define struncate(s) ((s)->trunc)(s)
#define sread(s, buf, nbytes) ((s)->read)(s, buf, nbytes)
@@ -812,8 +807,11 @@ 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 void read_block_direct (st_parameter_dt *, void *, size_t *);
+internal_proto(read_block_direct);
extern char *read_sf (st_parameter_dt *, int *, int);
internal_proto(read_sf);
@@ -821,6 +819,9 @@ internal_proto(read_sf);
extern void *write_block (st_parameter_dt *, int);
internal_proto(write_block);
+extern try write_block_form (st_parameter_dt *, const void *, size_t);
+internal_proto(write_block_form);
+
extern gfc_offset next_array_record (st_parameter_dt *, array_loop_spec *,
int*);
internal_proto(next_array_record);
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 802bf9e..f39d652 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,43 @@ 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;
+ // printf("c is now %c", c);
}
else
{
- if (p == NULL)
+ //printf("non-array internal io, c is now :%c:, length is %d\n", c, length);
+ //fflush(stdout);
+ 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,11 +255,11 @@ 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');
+ //printf("returning, c is now :%c:\n", c);
+ //fflush(stdout);
return c;
}
@@ -2234,6 +2234,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;
@@ -2260,55 +2269,28 @@ 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 = gfc_alloca (len + endlen);
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);
+ if (write_block_form (dtp, p, len + endlen) == FAILURE)
+ goto query_return;
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
- 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);
+ if (write_block_form (dtp, p, len + endlen) == FAILURE)
+ goto query_return;
}
/* "&end\n" */
-#ifdef HAVE_CRLF
- p = write_block (dtp, 6);
-#else
- p = write_block (dtp, 5);
-#endif
- if (!p)
+ if (write_block_form (dtp, &nmlend, endlen + 3) == FAILURE)
goto query_return;
-#ifdef HAVE_CRLF
- memcpy (p, "&end\r\n", 6);
-#else
- memcpy (p, "&end\n", 5);
-#endif
}
/* Flush the stream to force immediate output. */
diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index ce86ec0..16b979b 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;
}
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 8741758..cec34eb 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -180,9 +180,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 +200,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 +214,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 +230,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 +241,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 +274,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 +284,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,20 +300,21 @@ 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))
{
@@ -319,12 +324,12 @@ read_block (st_parameter_dt *dtp, int *length)
dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
{
generate_error (&dtp->common, LIBERROR_END, NULL);
- return NULL;
+ return FAILURE;
}
}
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 +342,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 +350,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 +361,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,14 +396,14 @@ read_block (st_parameter_dt *dtp, int *length)
dtp->u.p.current_unit->strm_pos += (gfc_offset) nread;
- return source;
+ return SUCCESS;
}
/* Reads a block directly into application data space. This is for
unformatted files. */
-static void
+void
read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
{
size_t to_read_record;
@@ -627,6 +641,60 @@ write_block (st_parameter_dt *dtp, int length)
}
+/* Write a formatted block. */
+
+try
+write_block_form (st_parameter_dt *dtp, const 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;
+ }
+ }
+ else
+ {
+ 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. */
+ if ((dtp->u.p.current_unit->unit_number == options.stdout_unit
+ || dtp->u.p.current_unit->unit_number == options.stderr_unit)
+ && dtp->u.p.current_unit->recl == DEFAULT_RECL)
+ dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
+ else
+ {
+ generate_error (&dtp->common, LIBERROR_EOR, NULL);
+ return FAILURE;
+ }
+ }
+
+ dtp->u.p.current_unit->bytes_left -= (gfc_offset) nbytes;
+ }
+
+ if (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0)
+ {
+ generate_error (&dtp->common, LIBERROR_END, NULL);
+ return FAILURE;
+ }
+
+ if (is_internal_unit (dtp) && dtp->u.p.current_unit->endfile == AT_ENDFILE)
+ generate_error (&dtp->common, LIBERROR_END, NULL);
+
+ if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
+ dtp->u.p.size_used += (gfc_offset) nbytes;
+
+ dtp->u.p.current_unit->strm_pos += (gfc_offset) nbytes;
+
+ return SUCCESS;
+}
+
+
/* High level interface to swrite(), taking care of errors. This is only
called for unformatted files. There are three cases to consider:
Stream I/O, unformatted direct, unformatted sequential. */
@@ -865,16 +933,15 @@ type_name (bt type)
static void
write_constant_string (st_parameter_dt *dtp, const fnode *f)
{
- char c, delimiter, *p, *q;
- int length;
+ char c, delimiter, *p, *porig, *q;
+ int length;
+ size_t lorig;
- length = f->u.string.length;
+ length = lorig = f->u.string.length;
if (length == 0)
return;
- p = write_block (dtp, length);
- if (p == NULL)
- return;
+ p = porig = gfc_alloca (length);
q = f->u.string.p;
delimiter = q[-1];
@@ -885,6 +952,8 @@ write_constant_string (st_parameter_dt *dtp, const fnode *f)
if (c == delimiter && c != 'H' && c != 'h')
q++; /* Skip the doubled delimiter. */
}
+
+ write_block_form (dtp, porig, lorig);
}
@@ -1611,9 +1680,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;
@@ -1628,7 +1695,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)
{
@@ -1636,7 +1707,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;
@@ -1648,12 +1719,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;
@@ -1666,12 +1737,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;
@@ -2261,14 +2332,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)
@@ -2288,24 +2358,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
@@ -2333,14 +2401,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))
{
@@ -2389,18 +2466,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;
@@ -2415,7 +2498,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;
}
@@ -2555,7 +2638,6 @@ next_record_w (st_parameter_dt *dtp, int done)
{
gfc_offset m, record, max_pos;
int length;
- char *p;
/* Zero counters for X- and T-editing. */
max_pos = dtp->u.p.max_pos;
@@ -2581,12 +2663,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:
@@ -2614,7 +2693,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);
}
@@ -2656,7 +2741,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
diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index 9f9e351..02cb935 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -737,10 +737,8 @@ 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);
+ sseek (u->s, file_position (u->s) + u->saved_pos);
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 3896f04..714d6a9 100644
--- a/libgfortran/io/unix.c
+++ b/libgfortran/io/unix.c
@@ -890,7 +890,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;
@@ -971,9 +970,19 @@ mem_read (int_stream * s, void * buf, size_t * nbytes)
{
void *p;
int tmp;
+ int myerrno;
tmp = *nbytes;
+ myerrno = errno;
+ errno = 0;
p = mem_alloc_r_at (s, &tmp, -1);
+ if (errno != 0)
+ myerrno = errno;
+ else
+ {
+ errno = myerrno;
+ myerrno = 0;
+ }
if (p)
{
*nbytes = tmp;
@@ -983,7 +992,7 @@ mem_read (int_stream * s, void * buf, size_t * nbytes)
else
{
*nbytes = 0;
- return errno;
+ return myerrno;
}
}
@@ -1104,7 +1113,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;
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index ea8ad94..cdaa25f 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -61,10 +61,10 @@ write_a (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
/* Write out any padding if needed. */
if (len < wlen)
{
- p = write_block (dtp, wlen - len);
- if (p == NULL)
- return;
+ p = gfc_alloca (wlen - len);
memset (p, ' ', wlen - len);
+ if (write_block_form (dtp, p, wlen - len) == FAILURE)
+ return;
}
/* Scan the source string looking for '\n' and convert it if found. */
@@ -75,20 +75,18 @@ write_a (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
/* Write out the previously scanned characters in the string. */
if (bytes > 0)
{
- p = write_block (dtp, bytes);
- if (p == NULL)
- return;
+ p = gfc_alloca (bytes);
memcpy (p, &source[q], bytes);
q += bytes;
+ if (write_block_form (dtp, p, bytes) == FAILURE)
+ return;
bytes = 0;
}
/* Write out the CR_LF sequence. */
q++;
- p = write_block (dtp, 2);
- if (p == NULL)
+ if (write_block_form (dtp, &crlf, 2) == FAILURE)
return;
- memcpy (p, crlf, 2);
}
else
bytes++;
@@ -97,18 +95,14 @@ write_a (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
/* Write out any remaining bytes if no LF was found. */
if (bytes > 0)
{
- p = write_block (dtp, bytes);
- if (p == NULL)
+ if (write_block_form (dtp, &source[q], bytes) == FAILURE)
return;
- memcpy (p, &source[q], bytes);
}
}
else
{
#endif
- p = write_block (dtp, wlen);
- if (p == NULL)
- return;
+ p = gfc_alloca (wlen);
if (wlen < len)
memcpy (p, source, wlen);
@@ -117,6 +111,7 @@ write_a (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
memset (p, ' ', wlen - len);
memcpy (p + wlen - len, source, len);
}
+ write_block_form (dtp, p, wlen);
#ifdef HAVE_CRLF
}
#endif
@@ -237,13 +232,11 @@ write_l (st_parameter_dt *dtp, const fnode *f, char *source, int len)
char *p;
GFC_INTEGER_LARGEST n;
- p = write_block (dtp, f->u.w);
- if (p == NULL)
- return;
-
+ p = gfc_alloca (f->u.w);
memset (p, ' ', f->u.w - 1);
n = extract_int (source, len);
p[f->u.w - 1] = (n) ? 'T' : 'F';
+ write_block_form (dtp, p, f->u.w);
}
@@ -253,7 +246,7 @@ write_int (st_parameter_dt *dtp, const fnode *f, const char *source, int len,
{
GFC_UINTEGER_LARGEST n = 0;
int w, m, digits, nzero, nblank;
- char *p;
+ char *p, *porig;
const char *q;
char itoa_buf[GFC_BTOA_BUF_SIZE];
@@ -269,9 +262,7 @@ write_int (st_parameter_dt *dtp, const fnode *f, const char *source, int len,
if (w == 0)
w = 1;
- p = write_block (dtp, w);
- if (p == NULL)
- return;
+ p = porig = gfc_alloca (w);
memset (p, ' ', w);
goto done;
@@ -286,9 +277,7 @@ write_int (st_parameter_dt *dtp, const fnode *f, const char *source, int len,
if (w == 0)
w = ((digits < m) ? m : digits);
- p = write_block (dtp, w);
- if (p == NULL)
- return;
+ p = porig = gfc_alloca (w);
nzero = 0;
if (digits < m)
@@ -324,6 +313,7 @@ write_int (st_parameter_dt *dtp, const fnode *f, const char *source, int len,
}
done:
+ write_block_form (dtp, porig, w);
return;
}
@@ -334,7 +324,7 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
{
GFC_INTEGER_LARGEST n = 0;
int w, m, digits, nsign, nzero, nblank;
- char *p;
+ char *p, *porig;
const char *q;
sign_t sign;
char itoa_buf[GFC_BTOA_BUF_SIZE];
@@ -351,9 +341,7 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
if (w == 0)
w = 1;
- p = write_block (dtp, w);
- if (p == NULL)
- return;
+ p = porig = gfc_alloca (w);
memset (p, ' ', w);
goto done;
@@ -374,9 +362,7 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
if (w == 0)
w = ((digits < m) ? m : digits) + nsign;
- p = write_block (dtp, w);
- if (p == NULL)
- return;
+ p = porig = gfc_alloca (w);
nzero = 0;
if (digits < m)
@@ -413,6 +399,7 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
memcpy (p, q, digits);
done:
+ write_block_form (dtp, porig, w);
return;
}
@@ -536,12 +523,16 @@ write_x (st_parameter_dt *dtp, int len, int nspaces)
{
char *p;
+// printf ("in write_x, len: %d, nspaces: %d\n", len, nspaces);
p = write_block (dtp, len);
if (p == NULL)
return;
+// p = gfc_alloca (len);
if (nspaces > 0)
memset (&p[len - nspaces], ' ', nspaces);
+
+// write_block_form (dtp, p, len);
}
@@ -554,14 +545,9 @@ write_x (st_parameter_dt *dtp, int len, int nspaces)
static int
write_char (st_parameter_dt *dtp, char c)
{
- char *p;
-
- p = write_block (dtp, 1);
- if (p == NULL)
+ if (write_block_form (dtp, &c, 1) == FAILURE)
return 1;
- *p = c;
-
return 0;
}
@@ -615,9 +601,7 @@ write_integer (st_parameter_dt *dtp, const char *source, int length)
if (width < digits)
width = digits;
- p = write_block (dtp, width);
- if (p == NULL)
- return;
+ p = gfc_alloca (width);
if (dtp->u.p.no_leading_blank)
{
memcpy (p, q, digits);
@@ -628,6 +612,7 @@ write_integer (st_parameter_dt *dtp, const char *source, int length)
memset (p, ' ', width - digits);
memcpy (p + width - digits, q, digits);
}
+ write_block_form (dtp, p, width);
}
@@ -638,7 +623,7 @@ static void
write_character (st_parameter_dt *dtp, const char *source, int length)
{
int i, extra;
- char *p, d;
+ char *p, *porig, d;
switch (dtp->u.p.delim_status)
{
@@ -664,9 +649,7 @@ write_character (st_parameter_dt *dtp, const char *source, int length)
extra++;
}
- p = write_block (dtp, length + extra);
- if (p == NULL)
- return;
+ p = porig = gfc_alloca (length + extra);
if (d == ' ')
memcpy (p, source, length);
@@ -683,6 +666,8 @@ write_character (st_parameter_dt *dtp, const char *source, int length)
*p = d;
}
+
+ write_block_form (dtp, porig, length + extra);
}
@@ -750,13 +735,7 @@ write_complex (st_parameter_dt *dtp, const char *source, int kind, size_t size)
static void
write_separator (st_parameter_dt *dtp)
{
- char *p;
-
- p = write_block (dtp, options.separator_len);
- if (p == NULL)
- return;
-
- memcpy (p, options.separator, options.separator_len);
+ write_block_form (dtp, options.separator, options.separator_len);
}
diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def
index 090bd71..286410f 100644
--- a/libgfortran/io/write_float.def
+++ b/libgfortran/io/write_float.def
@@ -69,7 +69,7 @@ static void
output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
int sign_bit, bool zero_flag, int ndigits, int edigits)
{
- char *out;
+ char *out, *outorig;
char *digits;
int e;
char expchar;
@@ -340,9 +340,7 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
w = nbefore + nzero + nafter + (sign != S_NONE ? 2 : 1);
/* Create the ouput buffer. */
- out = write_block (dtp, w);
- if (out == NULL)
- return;
+ out = outorig = gfc_alloca (w);
/* Zero values always output as positive, even if the value was negative
before rounding. */
@@ -469,6 +467,8 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
memset( out , ' ' , nblanks );
dtp->u.p.no_leading_blank = 0;
}
+
+ write_block_form (dtp, outorig, w);
#undef STR
#undef STR1
#undef MIN_FIELD_WIDTH
@@ -491,13 +491,11 @@ write_infnan (st_parameter_dt *dtp, const fnode *f, int isnan_flag, int sign_bit
not zero. 4 is chosen to allow output of '-Inf' or '+Inf' */
if (nb == 0) nb = 4;
- p = write_block (dtp, nb);
- if (p == NULL)
- return;
+ p = gfc_alloca (nb);
if (nb < 3)
{
memset (p, '*',nb);
- return;
+ goto write;
}
memset(p, ' ', nb);
@@ -512,7 +510,7 @@ write_infnan (st_parameter_dt *dtp, const fnode *f, int isnan_flag, int sign_bit
if (nb == 3)
{
memset (p, '*',nb);
- return;
+ goto write;
}
/* The negative sign is mandatory */
@@ -542,7 +540,9 @@ write_infnan (st_parameter_dt *dtp, const fnode *f, int isnan_flag, int sign_bit
}
else
memcpy(p + nb - 3, "NaN", 3);
- return;
+
+ write:
+ write_block_form (dtp, p, nb);
}
}
@@ -681,10 +681,9 @@ output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \
\
if (nb > 0)\
{ \
- p = write_block (dtp, nb);\
- if (p == NULL)\
- return;\
+ p = gfc_alloca (nb);\
memset (p, ' ', nb);\
+ write_block_form (dtp, p, nb);\
}\
}\
Attachment:
signature.asc
Description: OpenPGP digital signature
| Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
|---|---|---|
| Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |