io/transfer.c \
io/unit.c \
io/unix.c \
-io/write.c
+io/write.c \
+io/fbuf.c
gfor_io_headers= \
io/io.h
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 \
$(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 \
io/transfer.c \
io/unit.c \
io/unix.c \
-io/write.c
+io/write.c \
+io/fbuf.c
gfor_io_headers = \
io/io.h
@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@
@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
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;
{
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
/* 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--;
}
}
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);
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)
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)
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);
#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)
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;
int file_len;
char *file;
+
+ /* Formatting buffer. */
+ struct fbuf *fbuf;
}
gfc_unit;
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);
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);
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')
{
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)
else
longjmp (*dtp->u.p.eof_jump, 1);
}
- else
- c = *p;
}
done:
dtp->u.p.at_eol = (c == '\n' || c == '\r');
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;
/* "&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);
}
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:
/* read.c -- Deal with formatted reads */
+
/* set_integer()-- All of the integer assignments come here to
* actually place the value into memory. */
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 == ' ')
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)
{
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)
{
generate_error (&dtp->common, LIBERROR_READ_OVERFLOW,
"Value overflowed during integer read");
next_record (dtp, 1);
- return;
+
}
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)
{
generate_error (&dtp->common, LIBERROR_READ_OVERFLOW,
"Value overflowed during integer read");
next_record (dtp, 1);
- return;
+
}
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;
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;
if (buffer != scratch)
free_mem (buffer);
- return;
}
* 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;
}
+
#include "io.h"
#include <string.h>
#include <assert.h>
+#include <stdlib.h>
/* Calling conventions: Data transfer statements are unlike other
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);
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;
}
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. */
return NULL;
}
- if (readlen < 1 || *q == '\n' || *q == '\r')
+ if (readlen < 1 || q == '\n' || q == '\r')
{
/* Unexpected end of line. */
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;
/* 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,
}
n++;
- *p++ = *q;
+ *p++ = q;
dtp->u.p.sf_seen_eor = 0;
}
while (n < *length);
/* 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. */
{
/* Not enough data left. */
generate_error (&dtp->common, LIBERROR_EOR, NULL);
- return NULL;
+ return FAILURE;
}
}
{
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;
}
}
(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);
dtp->u.p.current_unit->strm_pos += (gfc_offset) nread;
- return source;
+ return SUCCESS;
}
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)
{
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)
{
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;
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);
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)
p = write_block (dtp, length);
if (p == NULL)
return;
-
+
q = f->u.string.p;
delimiter = q[-1];
}
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;
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;
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)
{
return; /* end of file */
}
- if (p == NULL || n != nr)
+ if (n != nr)
{
generate_error (&dtp->common, LIBERROR_BAD_US, NULL);
return;
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;
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;
{
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:
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. */
}
}
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 */
dtp->u.p.max_pos = dtp->u.p.current_unit->saved_pos;
pre_position (dtp);
+
/* Set up the subroutine that will handle the transfers. */
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)
{ /* 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
}
}
+
+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))
{
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;
if (is_stream_io (dtp))
dtp->u.p.current_unit->strm_pos++;
}
- while (*p != '\n');
+ while (p != '\n');
break;
}
{
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;
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:
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);
}
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
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
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;
}
- 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;
}
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);
}
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);
}
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)
free_mem (u->file);
u->file = NULL;
u->file_len = 0;
+
+ fbuf_destroy (u);
if (!locked)
__gthread_mutex_unlock (&u->lock);
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))
* 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)
* 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)
/* 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
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;
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;
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;
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;
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)
}
-/* 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)
int tmp;
tmp = *nbytes;
- p = mem_alloc_r_at (s, &tmp, -1);
+ p = mem_alloc_r_at (s, &tmp);
if (p)
{
*nbytes = tmp;
else
{
*nbytes = 0;
- return errno;
+ return 0;
}
}
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;
else
{
*nbytes = 0;
- return errno;
+ return 0;
}
}
len = n;
- p = mem_alloc_w_at (s, &len, -1);
+ p = mem_alloc_w_at (s, &len);
if (p)
{
memset (p, c, len);
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;
OSDN Git Service
