Commit f9bfed22 by Janne Blomqvist

string.c (compare0): Use gfc_charlen_type.

2009-04-08  Janne Blomqvist  <jb@gcc.gnu.org>

        * runtime/string.c (compare0): Use gfc_charlen_type.
        * runtime/error.c (gfc_itoa): Move to io/write.c
        (xtoa): Rename to gfc_xtoa.
        * runtime/backtrace.c (show_backtrace): Call gfc_xtoa.
        * intrinsics/cshift0.c (cshift0): Use index_type for shift arg.
        * intrinsics/date_and_time.c (date_and_time): Use index_type.
        (itime_i4): Likewise.
        (itime_i8): Likewise.
        (idate_i4): Likewise.
        (idate_i8): Likewise.
        (gmtime_i4): Likewise.
        (gmtime_i8): Likewise.
        (ltime_i4): Likewise.
        (ltime_i8): Likewise.
        * libgfortran.h (gfc_itoa): Remove prototype.
        (xtoa): Rename prototype to gfc_xtoa.
        * io/list_read.c (nml_read_obj): Use size_t for string length.
        * io/transfer.c (read_block_direct): Change nbytes arg from
        pointer to value.
        (unformatted_read): Minor cleanup, call read_block_directly properly.
        (skip_record): Use ssize_t.
        (next_record_w_unf): Avoid stell() call by calling sseek with SEEK_CUR.
        (iolength_transfer): Make sure to multiply before cast.
        * io/intrinsics.c (fgetc): Remove unnecessary variable.
        * io/format.c (format_hash): Use gfc_charlen_type.
        * io/write.c (itoa): Move from runtime/error.c:gfc_itoa, rename,
        make static.
        (write_i): Call with pointer to itoa.
        (write_z): Call with pointer to gfc_xtoa.
        (write_integer): Pointer to itoa.
        (nml_write_obj): Type cleanup, don't call strlen in loop.

From-SVN: r145758
parent 75ccc1e7
2009-04-08 Janne Blomqvist <jb@gcc.gnu.org>
* runtime/string.c (compare0): Use gfc_charlen_type.
* runtime/error.c (gfc_itoa): Move to io/write.c
(xtoa): Rename to gfc_xtoa.
* runtime/backtrace.c (show_backtrace): Call gfc_xtoa.
* intrinsics/cshift0.c (cshift0): Use index_type for shift arg.
* intrinsics/date_and_time.c (date_and_time): Use index_type.
(itime_i4): Likewise.
(itime_i8): Likewise.
(idate_i4): Likewise.
(idate_i8): Likewise.
(gmtime_i4): Likewise.
(gmtime_i8): Likewise.
(ltime_i4): Likewise.
(ltime_i8): Likewise.
* libgfortran.h (gfc_itoa): Remove prototype.
(xtoa): Rename prototype to gfc_xtoa.
* io/list_read.c (nml_read_obj): Use size_t for string length.
* io/transfer.c (read_block_direct): Change nbytes arg from
pointer to value.
(unformatted_read): Minor cleanup, call read_block_directly properly.
(skip_record): Use ssize_t.
(next_record_w_unf): Avoid stell() call by calling sseek with SEEK_CUR.
(iolength_transfer): Make sure to multiply before cast.
* io/intrinsics.c (fgetc): Remove unnecessary variable.
* io/format.c (format_hash): Use gfc_charlen_type.
* io/write.c (itoa): Move from runtime/error.c:gfc_itoa, rename,
make static.
(write_i): Call with pointer to itoa.
(write_z): Call with pointer to gfc_xtoa.
(write_integer): Pointer to itoa.
(nml_write_obj): Type cleanup, don't call strlen in loop.
2009-04-06 H.J. Lu <hongjiu.lu@intel.com> 2009-04-06 H.J. Lu <hongjiu.lu@intel.com>
PR libgfortran/39664 PR libgfortran/39664
......
/* Generic implementation of the CSHIFT intrinsic /* Generic implementation of the CSHIFT intrinsic
Copyright 2003, 2005, 2006, 2007 Free Software Foundation, Inc. Copyright 2003, 2005, 2006, 2007, 2009 Free Software Foundation, Inc.
Contributed by Feng Wang <wf_cs@yahoo.com> Contributed by Feng Wang <wf_cs@yahoo.com>
This file is part of the GNU Fortran 95 runtime library (libgfortran). This file is part of the GNU Fortran 95 runtime library (libgfortran).
...@@ -35,7 +35,7 @@ Boston, MA 02110-1301, USA. */ ...@@ -35,7 +35,7 @@ Boston, MA 02110-1301, USA. */
static void static void
cshift0 (gfc_array_char * ret, const gfc_array_char * array, cshift0 (gfc_array_char * ret, const gfc_array_char * array,
ssize_t shift, int which, index_type size) index_type shift, int which, index_type size)
{ {
/* r.* indicates the return array. */ /* r.* indicates the return array. */
index_type rstride[GFC_MAX_DIMENSIONS]; index_type rstride[GFC_MAX_DIMENSIONS];
...@@ -311,7 +311,7 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array, ...@@ -311,7 +311,7 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array,
rptr = ret->data; rptr = ret->data;
sptr = array->data; sptr = array->data;
shift = len == 0 ? 0 : shift % (ssize_t)len; shift = len == 0 ? 0 : shift % len;
if (shift < 0) if (shift < 0)
shift += len; shift += len;
......
/* Implementation of the DATE_AND_TIME intrinsic. /* Implementation of the DATE_AND_TIME intrinsic.
Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Copyright (C) 2003, 2004, 2005, 2006, 2007, 2009 Free Software Foundation, Inc.
Contributed by Steven Bosscher. Contributed by Steven Bosscher.
This file is part of the GNU Fortran 95 runtime library (libgfortran). This file is part of the GNU Fortran 95 runtime library (libgfortran).
...@@ -242,7 +242,7 @@ date_and_time (char *__date, char *__time, char *__zone, ...@@ -242,7 +242,7 @@ date_and_time (char *__date, char *__time, char *__zone,
/* Copy the values into the arguments. */ /* Copy the values into the arguments. */
if (__values) if (__values)
{ {
size_t len, delta, elt_size; index_type len, delta, elt_size;
elt_size = GFC_DESCRIPTOR_SIZE (__values); elt_size = GFC_DESCRIPTOR_SIZE (__values);
len = __values->dim[0].ubound + 1 - __values->dim[0].lbound; len = __values->dim[0].ubound + 1 - __values->dim[0].lbound;
...@@ -384,7 +384,7 @@ void ...@@ -384,7 +384,7 @@ void
itime_i4 (gfc_array_i4 *__values) itime_i4 (gfc_array_i4 *__values)
{ {
int x[3], i; int x[3], i;
size_t len, delta; index_type len, delta;
GFC_INTEGER_4 *vptr; GFC_INTEGER_4 *vptr;
/* Call helper function. */ /* Call helper function. */
...@@ -410,7 +410,7 @@ void ...@@ -410,7 +410,7 @@ void
itime_i8 (gfc_array_i8 *__values) itime_i8 (gfc_array_i8 *__values)
{ {
int x[3], i; int x[3], i;
size_t len, delta; index_type len, delta;
GFC_INTEGER_8 *vptr; GFC_INTEGER_8 *vptr;
/* Call helper function. */ /* Call helper function. */
...@@ -466,7 +466,7 @@ void ...@@ -466,7 +466,7 @@ void
idate_i4 (gfc_array_i4 *__values) idate_i4 (gfc_array_i4 *__values)
{ {
int x[3], i; int x[3], i;
size_t len, delta; index_type len, delta;
GFC_INTEGER_4 *vptr; GFC_INTEGER_4 *vptr;
/* Call helper function. */ /* Call helper function. */
...@@ -492,7 +492,7 @@ void ...@@ -492,7 +492,7 @@ void
idate_i8 (gfc_array_i8 *__values) idate_i8 (gfc_array_i8 *__values)
{ {
int x[3], i; int x[3], i;
size_t len, delta; index_type len, delta;
GFC_INTEGER_8 *vptr; GFC_INTEGER_8 *vptr;
/* Call helper function. */ /* Call helper function. */
...@@ -554,7 +554,7 @@ void ...@@ -554,7 +554,7 @@ void
gmtime_i4 (GFC_INTEGER_4 * t, gfc_array_i4 * tarray) gmtime_i4 (GFC_INTEGER_4 * t, gfc_array_i4 * tarray)
{ {
int x[9], i; int x[9], i;
size_t len, delta; index_type len, delta;
GFC_INTEGER_4 *vptr; GFC_INTEGER_4 *vptr;
time_t tt; time_t tt;
...@@ -581,7 +581,7 @@ void ...@@ -581,7 +581,7 @@ void
gmtime_i8 (GFC_INTEGER_8 * t, gfc_array_i8 * tarray) gmtime_i8 (GFC_INTEGER_8 * t, gfc_array_i8 * tarray)
{ {
int x[9], i; int x[9], i;
size_t len, delta; index_type len, delta;
GFC_INTEGER_8 *vptr; GFC_INTEGER_8 *vptr;
time_t tt; time_t tt;
...@@ -646,7 +646,7 @@ void ...@@ -646,7 +646,7 @@ void
ltime_i4 (GFC_INTEGER_4 * t, gfc_array_i4 * tarray) ltime_i4 (GFC_INTEGER_4 * t, gfc_array_i4 * tarray)
{ {
int x[9], i; int x[9], i;
size_t len, delta; index_type len, delta;
GFC_INTEGER_4 *vptr; GFC_INTEGER_4 *vptr;
time_t tt; time_t tt;
...@@ -673,7 +673,7 @@ void ...@@ -673,7 +673,7 @@ void
ltime_i8 (GFC_INTEGER_8 * t, gfc_array_i8 * tarray) ltime_i8 (GFC_INTEGER_8 * t, gfc_array_i8 * tarray)
{ {
int x[9], i; int x[9], i;
size_t len, delta; index_type len, delta;
GFC_INTEGER_8 *vptr; GFC_INTEGER_8 *vptr;
time_t tt; time_t tt;
......
/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 /* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
Free Software Foundation, Inc. Free Software Foundation, Inc.
Contributed by Andy Vaught Contributed by Andy Vaught
F2003 I/O support contributed by Jerry DeLisle F2003 I/O support contributed by Jerry DeLisle
...@@ -140,9 +140,9 @@ static inline ...@@ -140,9 +140,9 @@ static inline
uint32_t format_hash (st_parameter_dt *dtp) uint32_t format_hash (st_parameter_dt *dtp)
{ {
char *key; char *key;
size_t key_len; gfc_charlen_type key_len;
uint32_t hash = 0; uint32_t hash = 0;
size_t i; gfc_charlen_type i;
/* Hash the format string. Super simple, but what the heck! */ /* Hash the format string. Super simple, but what the heck! */
key = dtp->format; key = dtp->format;
......
/* Implementation of the FGET, FGETC, FPUT, FPUTC, FLUSH /* Implementation of the FGET, FGETC, FPUT, FPUTC, FLUSH
FTELL, TTYNAM and ISATTY intrinsics. FTELL, TTYNAM and ISATTY intrinsics.
Copyright (C) 2005, 2007 Free Software Foundation, Inc. Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc.
This file is part of the GNU Fortran 95 runtime library (libgfortran). This file is part of the GNU Fortran 95 runtime library (libgfortran).
...@@ -46,15 +46,13 @@ int ...@@ -46,15 +46,13 @@ int
PREFIX(fgetc) (const int * unit, char * c, gfc_charlen_type c_len) PREFIX(fgetc) (const int * unit, char * c, gfc_charlen_type c_len)
{ {
int ret; int ret;
size_t s;
gfc_unit * u = find_unit (*unit); gfc_unit * u = find_unit (*unit);
if (u == NULL) if (u == NULL)
return -1; return -1;
s = 1;
memset (c, ' ', c_len); memset (c, ' ', c_len);
ret = sread (u->s, c, s); ret = sread (u->s, c, 1);
unlock_unit (u); unlock_unit (u);
if (ret < 0) if (ret < 0)
......
...@@ -2305,7 +2305,7 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset, ...@@ -2305,7 +2305,7 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset,
int dim; int dim;
index_type dlen; index_type dlen;
index_type m; index_type m;
index_type obj_name_len; size_t obj_name_len;
void * pdata; void * pdata;
/* This object not touched in name parsing. */ /* This object not touched in name parsing. */
......
/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 /* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
Free Software Foundation, Inc. Free Software Foundation, Inc.
Contributed by Andy Vaught Contributed by Andy Vaught
Namelist transfer functions contributed by Paul Thomas Namelist transfer functions contributed by Paul Thomas
...@@ -397,7 +397,7 @@ read_block_form (st_parameter_dt *dtp, int * nbytes) ...@@ -397,7 +397,7 @@ read_block_form (st_parameter_dt *dtp, int * nbytes)
unformatted files. */ unformatted files. */
static void static void
read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) read_block_direct (st_parameter_dt *dtp, void *buf, size_t nbytes)
{ {
ssize_t to_read_record; ssize_t to_read_record;
ssize_t have_read_record; ssize_t have_read_record;
...@@ -407,9 +407,8 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) ...@@ -407,9 +407,8 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
if (is_stream_io (dtp)) if (is_stream_io (dtp))
{ {
to_read_record = *nbytes;
have_read_record = sread (dtp->u.p.current_unit->s, buf, have_read_record = sread (dtp->u.p.current_unit->s, buf,
to_read_record); nbytes);
if (unlikely (have_read_record < 0)) if (unlikely (have_read_record < 0))
{ {
generate_error (&dtp->common, LIBERROR_OS, NULL); generate_error (&dtp->common, LIBERROR_OS, NULL);
...@@ -418,29 +417,27 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) ...@@ -418,29 +417,27 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
dtp->u.p.current_unit->strm_pos += (gfc_offset) have_read_record; dtp->u.p.current_unit->strm_pos += (gfc_offset) have_read_record;
if (unlikely (to_read_record != have_read_record)) if (unlikely ((ssize_t) nbytes != have_read_record))
{ {
/* Short read, e.g. if we hit EOF. For stream files, /* Short read, e.g. if we hit EOF. For stream files,
we have to set the end-of-file condition. */ we have to set the end-of-file condition. */
hit_eof (dtp); hit_eof (dtp);
return;
} }
return; return;
} }
if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT) if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
{ {
if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *nbytes) if (dtp->u.p.current_unit->bytes_left < (gfc_offset) nbytes)
{ {
short_record = 1; short_record = 1;
to_read_record = (size_t) dtp->u.p.current_unit->bytes_left; to_read_record = dtp->u.p.current_unit->bytes_left;
*nbytes = to_read_record; nbytes = to_read_record;
} }
else else
{ {
short_record = 0; short_record = 0;
to_read_record = *nbytes; to_read_record = nbytes;
} }
dtp->u.p.current_unit->bytes_left -= to_read_record; dtp->u.p.current_unit->bytes_left -= to_read_record;
...@@ -452,18 +449,16 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) ...@@ -452,18 +449,16 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
return; return;
} }
if (to_read_record != (ssize_t) *nbytes) if (to_read_record != (ssize_t) nbytes)
{ {
/* Short read, e.g. if we hit EOF. Apparently, we read /* Short read, e.g. if we hit EOF. Apparently, we read
more than was written to the last record. */ more than was written to the last record. */
*nbytes = to_read_record;
return; return;
} }
if (unlikely (short_record)) if (unlikely (short_record))
{ {
generate_error (&dtp->common, LIBERROR_SHORT_RECORD, NULL); generate_error (&dtp->common, LIBERROR_SHORT_RECORD, NULL);
return;
} }
return; return;
} }
...@@ -475,14 +470,14 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) ...@@ -475,14 +470,14 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
/* Check whether we exceed the total record length. */ /* Check whether we exceed the total record length. */
if (dtp->u.p.current_unit->flags.has_recl if (dtp->u.p.current_unit->flags.has_recl
&& (*nbytes > (size_t) dtp->u.p.current_unit->bytes_left)) && (nbytes > dtp->u.p.current_unit->bytes_left))
{ {
to_read_record = (ssize_t) dtp->u.p.current_unit->bytes_left; to_read_record = dtp->u.p.current_unit->bytes_left;
short_record = 1; short_record = 1;
} }
else else
{ {
to_read_record = *nbytes; to_read_record = nbytes;
short_record = 0; short_record = 0;
} }
have_read_record = 0; have_read_record = 0;
...@@ -492,7 +487,7 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) ...@@ -492,7 +487,7 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
if (dtp->u.p.current_unit->bytes_left_subrecord if (dtp->u.p.current_unit->bytes_left_subrecord
< (gfc_offset) to_read_record) < (gfc_offset) to_read_record)
{ {
to_read_subrecord = (ssize_t) dtp->u.p.current_unit->bytes_left_subrecord; to_read_subrecord = dtp->u.p.current_unit->bytes_left_subrecord;
to_read_record -= to_read_subrecord; to_read_record -= to_read_subrecord;
} }
else else
...@@ -520,7 +515,6 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) ...@@ -520,7 +515,6 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
structure has been corrupted, or the trailing record structure has been corrupted, or the trailing record
marker would still be present. */ marker would still be present. */
*nbytes = have_read_record;
generate_error (&dtp->common, LIBERROR_CORRUPT_FILE, NULL); generate_error (&dtp->common, LIBERROR_CORRUPT_FILE, NULL);
return; return;
} }
...@@ -737,20 +731,18 @@ static void ...@@ -737,20 +731,18 @@ static void
unformatted_read (st_parameter_dt *dtp, bt type, unformatted_read (st_parameter_dt *dtp, bt type,
void *dest, int kind, size_t size, size_t nelems) void *dest, int kind, size_t size, size_t nelems)
{ {
size_t i, sz;
if (likely (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE) if (likely (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE)
|| kind == 1) || kind == 1)
{ {
sz = size * nelems;
if (type == BT_CHARACTER) if (type == BT_CHARACTER)
sz *= GFC_SIZE_OF_CHAR_KIND(kind); size *= GFC_SIZE_OF_CHAR_KIND(kind);
read_block_direct (dtp, dest, &sz); read_block_direct (dtp, dest, size * nelems);
} }
else else
{ {
char buffer[16]; char buffer[16];
char *p; char *p;
size_t i;
p = dest; p = dest;
...@@ -773,7 +765,7 @@ unformatted_read (st_parameter_dt *dtp, bt type, ...@@ -773,7 +765,7 @@ unformatted_read (st_parameter_dt *dtp, bt type,
for (i = 0; i < nelems; i++) for (i = 0; i < nelems; i++)
{ {
read_block_direct (dtp, buffer, &size); read_block_direct (dtp, buffer, size);
reverse_memcpy (p, buffer, size); reverse_memcpy (p, buffer, size);
p += size; p += size;
} }
...@@ -2571,11 +2563,10 @@ next_array_record (st_parameter_dt *dtp, array_loop_spec *ls, int *finished) ...@@ -2571,11 +2563,10 @@ next_array_record (st_parameter_dt *dtp, array_loop_spec *ls, int *finished)
position. */ position. */
static void static void
skip_record (st_parameter_dt *dtp, size_t bytes) skip_record (st_parameter_dt *dtp, ssize_t bytes)
{ {
size_t rlength; ssize_t rlength, readb;
ssize_t readb; static const ssize_t MAX_READ = 4096;
static const size_t MAX_READ = 4096;
char p[MAX_READ]; char p[MAX_READ];
dtp->u.p.current_unit->bytes_left_subrecord += bytes; dtp->u.p.current_unit->bytes_left_subrecord += bytes;
...@@ -2595,8 +2586,8 @@ skip_record (st_parameter_dt *dtp, size_t bytes) ...@@ -2595,8 +2586,8 @@ skip_record (st_parameter_dt *dtp, size_t bytes)
while (dtp->u.p.current_unit->bytes_left_subrecord > 0) while (dtp->u.p.current_unit->bytes_left_subrecord > 0)
{ {
rlength = rlength =
(MAX_READ < (size_t) dtp->u.p.current_unit->bytes_left_subrecord) ? (MAX_READ < dtp->u.p.current_unit->bytes_left_subrecord) ?
MAX_READ : (size_t) dtp->u.p.current_unit->bytes_left_subrecord; MAX_READ : dtp->u.p.current_unit->bytes_left_subrecord;
readb = sread (dtp->u.p.current_unit->s, p, rlength); readb = sread (dtp->u.p.current_unit->s, p, rlength);
if (readb < 0) if (readb < 0)
...@@ -2811,13 +2802,11 @@ write_us_marker (st_parameter_dt *dtp, const gfc_offset buf) ...@@ -2811,13 +2802,11 @@ write_us_marker (st_parameter_dt *dtp, const gfc_offset buf)
static void static void
next_record_w_unf (st_parameter_dt *dtp, int next_subrecord) next_record_w_unf (st_parameter_dt *dtp, int next_subrecord)
{ {
gfc_offset c, m, m_write; gfc_offset m, m_write, record_marker;
size_t record_marker;
/* Bytes written. */ /* Bytes written. */
m = dtp->u.p.current_unit->recl_subrecord m = dtp->u.p.current_unit->recl_subrecord
- dtp->u.p.current_unit->bytes_left_subrecord; - dtp->u.p.current_unit->bytes_left_subrecord;
c = stell (dtp->u.p.current_unit->s);
/* Write the length tail. If we finish a record containing /* Write the length tail. If we finish a record containing
subrecords, we write out the negative length. */ subrecords, we write out the negative length. */
...@@ -2838,8 +2827,8 @@ next_record_w_unf (st_parameter_dt *dtp, int next_subrecord) ...@@ -2838,8 +2827,8 @@ next_record_w_unf (st_parameter_dt *dtp, int next_subrecord)
/* Seek to the head and overwrite the bogus length with the real /* Seek to the head and overwrite the bogus length with the real
length. */ length. */
if (unlikely (sseek (dtp->u.p.current_unit->s, c - m - record_marker, if (unlikely (sseek (dtp->u.p.current_unit->s, - m - 2 * record_marker,
SEEK_SET) < 0)) SEEK_CUR) < 0))
goto io_error; goto io_error;
if (next_subrecord) if (next_subrecord)
...@@ -2852,8 +2841,8 @@ next_record_w_unf (st_parameter_dt *dtp, int next_subrecord) ...@@ -2852,8 +2841,8 @@ next_record_w_unf (st_parameter_dt *dtp, int next_subrecord)
/* Seek past the end of the current record. */ /* Seek past the end of the current record. */
if (unlikely (sseek (dtp->u.p.current_unit->s, c + record_marker, if (unlikely (sseek (dtp->u.p.current_unit->s, m + record_marker,
SEEK_SET) < 0)) SEEK_CUR) < 0))
goto io_error; goto io_error;
return; return;
...@@ -3207,7 +3196,7 @@ iolength_transfer (st_parameter_dt *dtp, bt type __attribute__((unused)), ...@@ -3207,7 +3196,7 @@ iolength_transfer (st_parameter_dt *dtp, bt type __attribute__((unused)),
size_t size, size_t nelems) size_t size, size_t nelems)
{ {
if ((dtp->common.flags & IOPARM_DT_HAS_IOLENGTH) != 0) if ((dtp->common.flags & IOPARM_DT_HAS_IOLENGTH) != 0)
*dtp->iolength += (GFC_IO_INT) size * nelems; *dtp->iolength += (GFC_IO_INT) (size * nelems);
} }
......
/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 /* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
Free Software Foundation, Inc. Free Software Foundation, Inc.
Contributed by Andy Vaught Contributed by Andy Vaught
Namelist output contributed by Paul Thomas Namelist output contributed by Paul Thomas
...@@ -602,7 +602,7 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source, ...@@ -602,7 +602,7 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
n = -n; n = -n;
nsign = sign == S_NONE ? 0 : 1; nsign = sign == S_NONE ? 0 : 1;
/* conv calls gfc_itoa which sets the negative sign needed /* conv calls itoa which sets the negative sign needed
by write_integer. The sign '+' or '-' is set below based on sign by write_integer. The sign '+' or '-' is set below based on sign
calculated above, so we just point past the sign in the string calculated above, so we just point past the sign in the string
before proceeding to avoid double signs in corner cases. before proceeding to avoid double signs in corner cases.
...@@ -712,10 +712,47 @@ btoa (GFC_UINTEGER_LARGEST n, char *buffer, size_t len) ...@@ -712,10 +712,47 @@ btoa (GFC_UINTEGER_LARGEST n, char *buffer, size_t len)
} }
/* itoa()-- Integer to decimal conversion. */
static const char *
itoa (GFC_INTEGER_LARGEST n, char *buffer, size_t len)
{
int negative;
char *p;
GFC_UINTEGER_LARGEST t;
assert (len >= GFC_ITOA_BUF_SIZE);
if (n == 0)
return "0";
negative = 0;
t = n;
if (n < 0)
{
negative = 1;
t = -n; /*must use unsigned to protect from overflow*/
}
p = buffer + GFC_ITOA_BUF_SIZE - 1;
*p = '\0';
while (t != 0)
{
*--p = '0' + (t % 10);
t /= 10;
}
if (negative)
*--p = '-';
return p;
}
void void
write_i (st_parameter_dt *dtp, const fnode *f, const char *p, int len) write_i (st_parameter_dt *dtp, const fnode *f, const char *p, int len)
{ {
write_decimal (dtp, f, p, len, (void *) gfc_itoa); write_decimal (dtp, f, p, len, (void *) itoa);
} }
...@@ -735,7 +772,7 @@ write_o (st_parameter_dt *dtp, const fnode *f, const char *p, int len) ...@@ -735,7 +772,7 @@ write_o (st_parameter_dt *dtp, const fnode *f, const char *p, int len)
void void
write_z (st_parameter_dt *dtp, const fnode *f, const char *p, int len) write_z (st_parameter_dt *dtp, const fnode *f, const char *p, int len)
{ {
write_int (dtp, f, p, len, xtoa); write_int (dtp, f, p, len, gfc_xtoa);
} }
...@@ -830,7 +867,7 @@ write_integer (st_parameter_dt *dtp, const char *source, int length) ...@@ -830,7 +867,7 @@ write_integer (st_parameter_dt *dtp, const char *source, int length)
int width; int width;
char itoa_buf[GFC_ITOA_BUF_SIZE]; char itoa_buf[GFC_ITOA_BUF_SIZE];
q = gfc_itoa (extract_int (source, length), itoa_buf, sizeof (itoa_buf)); q = itoa (extract_int (source, length), itoa_buf, sizeof (itoa_buf));
switch (length) switch (length)
{ {
...@@ -1193,13 +1230,13 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, ...@@ -1193,13 +1230,13 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
int rep_ctr; int rep_ctr;
int num; int num;
int nml_carry; int nml_carry;
index_type len; int len;
index_type obj_size; index_type obj_size;
index_type nelem; index_type nelem;
index_type dim_i; size_t dim_i;
index_type clen; size_t clen;
index_type elem_ctr; index_type elem_ctr;
index_type obj_name_len; size_t obj_name_len;
void * p ; void * p ;
char cup; char cup;
char * obj_name; char * obj_name;
...@@ -1229,14 +1266,16 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, ...@@ -1229,14 +1266,16 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
len = 0; len = 0;
if (base) if (base)
{ {
len =strlen (base->var_name); len = strlen (base->var_name);
for (dim_i = 0; dim_i < (index_type) strlen (base_name); dim_i++) base_name_len = strlen (base_name);
for (dim_i = 0; dim_i < base_name_len; dim_i++)
{ {
cup = toupper (base_name[dim_i]); cup = toupper (base_name[dim_i]);
write_character (dtp, &cup, 1, 1); write_character (dtp, &cup, 1, 1);
} }
} }
for (dim_i =len; dim_i < (index_type) strlen (obj->var_name); dim_i++) clen = strlen (obj->var_name);
for (dim_i = len; dim_i < clen; dim_i++)
{ {
cup = toupper (obj->var_name[dim_i]); cup = toupper (obj->var_name[dim_i]);
write_character (dtp, &cup, 1, 1); write_character (dtp, &cup, 1, 1);
...@@ -1275,7 +1314,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, ...@@ -1275,7 +1314,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
/* Set the index vector and count the number of elements. */ /* Set the index vector and count the number of elements. */
nelem = 1; nelem = 1;
for (dim_i=0; dim_i < obj->var_rank; dim_i++) for (dim_i = 0; dim_i < (size_t) obj->var_rank; dim_i++)
{ {
obj->ls[dim_i].idx = obj->dim[dim_i].lbound; obj->ls[dim_i].idx = obj->dim[dim_i].lbound;
nelem = nelem * (obj->dim[dim_i].ubound + 1 - obj->dim[dim_i].lbound); nelem = nelem * (obj->dim[dim_i].ubound + 1 - obj->dim[dim_i].lbound);
...@@ -1378,7 +1417,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, ...@@ -1378,7 +1417,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
/* Append the qualifier. */ /* Append the qualifier. */
tot_len = base_name_len + clen; tot_len = base_name_len + clen;
for (dim_i = 0; dim_i < obj->var_rank; dim_i++) for (dim_i = 0; dim_i < (size_t) obj->var_rank; dim_i++)
{ {
if (!dim_i) if (!dim_i)
{ {
...@@ -1387,7 +1426,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, ...@@ -1387,7 +1426,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
} }
sprintf (ext_name + tot_len, "%d", (int) obj->ls[dim_i].idx); sprintf (ext_name + tot_len, "%d", (int) obj->ls[dim_i].idx);
tot_len += strlen (ext_name + tot_len); tot_len += strlen (ext_name + tot_len);
ext_name[tot_len] = (dim_i == obj->var_rank - 1) ? ')' : ','; ext_name[tot_len] = ((int) dim_i == obj->var_rank - 1) ? ')' : ',';
tot_len++; tot_len++;
} }
...@@ -1441,11 +1480,11 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, ...@@ -1441,11 +1480,11 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
obj_loop: obj_loop:
nml_carry = 1; nml_carry = 1;
for (dim_i = 0; nml_carry && (dim_i < obj->var_rank); dim_i++) for (dim_i = 0; nml_carry && (dim_i < (size_t) obj->var_rank); dim_i++)
{ {
obj->ls[dim_i].idx += nml_carry ; obj->ls[dim_i].idx += nml_carry ;
nml_carry = 0; nml_carry = 0;
if (obj->ls[dim_i].idx > (ssize_t)obj->dim[dim_i].ubound) if (obj->ls[dim_i].idx > (index_type) obj->dim[dim_i].ubound)
{ {
obj->ls[dim_i].idx = obj->dim[dim_i].lbound; obj->ls[dim_i].idx = obj->dim[dim_i].lbound;
nml_carry = 1; nml_carry = 1;
......
/* Common declarations for all of libgfortran. /* Common declarations for all of libgfortran.
Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
Free Software Foundation, Inc. Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>, and Contributed by Paul Brook <paul@nowt.org>, and
Andy Vaught <andy@xena.eas.asu.edu> Andy Vaught <andy@xena.eas.asu.edu>
...@@ -635,11 +635,8 @@ internal_proto(show_backtrace); ...@@ -635,11 +635,8 @@ internal_proto(show_backtrace);
extern void sys_exit (int) __attribute__ ((noreturn)); extern void sys_exit (int) __attribute__ ((noreturn));
internal_proto(sys_exit); internal_proto(sys_exit);
extern const char *gfc_itoa (GFC_INTEGER_LARGEST, char *, size_t); extern const char *gfc_xtoa (GFC_UINTEGER_LARGEST, char *, size_t);
internal_proto(gfc_itoa); internal_proto(gfc_xtoa);
extern const char *xtoa (GFC_UINTEGER_LARGEST, char *, size_t);
internal_proto(xtoa);
extern void os_error (const char *) __attribute__ ((noreturn)); extern void os_error (const char *) __attribute__ ((noreturn));
iexport_proto(os_error); iexport_proto(os_error);
......
/* Copyright (C) 2006, 2007 Free Software Foundation, Inc. /* Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc.
Contributed by François-Xavier Coudert Contributed by François-Xavier Coudert
This file is part of the GNU Fortran 95 runtime library (libgfortran). This file is part of the GNU Fortran 95 runtime library (libgfortran).
...@@ -152,7 +152,7 @@ show_backtrace (void) ...@@ -152,7 +152,7 @@ show_backtrace (void)
/* Write the list of addresses in hexadecimal format. */ /* Write the list of addresses in hexadecimal format. */
for (i = 0; i < depth; i++) for (i = 0; i < depth; i++)
addr[i] = xtoa ((GFC_UINTEGER_LARGEST) (intptr_t) trace[i], addr_buf[i], addr[i] = gfc_xtoa ((GFC_UINTEGER_LARGEST) (intptr_t) trace[i], addr_buf[i],
sizeof (addr_buf[i])); sizeof (addr_buf[i]));
/* Don't output an error message if something goes wrong, we'll simply /* Don't output an error message if something goes wrong, we'll simply
......
/* Copyright (C) 2002, 2003, 2005, 2006, 2007 Free Software Foundation, Inc. /* Copyright (C) 2002, 2003, 2005, 2006, 2007, 2009 Free Software Foundation, Inc.
Contributed by Andy Vaught Contributed by Andy Vaught
This file is part of the GNU Fortran 95 runtime library (libgfortran). This file is part of the GNU Fortran 95 runtime library (libgfortran).
...@@ -116,47 +116,10 @@ sys_exit (int code) ...@@ -116,47 +116,10 @@ sys_exit (int code)
* Other error returns are reserved for the STOP statement with a numeric code. * Other error returns are reserved for the STOP statement with a numeric code.
*/ */
/* gfc_itoa()-- Integer to decimal conversion. */ /* gfc_xtoa()-- Integer to hexadecimal conversion. */
const char * const char *
gfc_itoa (GFC_INTEGER_LARGEST n, char *buffer, size_t len) gfc_xtoa (GFC_UINTEGER_LARGEST n, char *buffer, size_t len)
{
int negative;
char *p;
GFC_UINTEGER_LARGEST t;
assert (len >= GFC_ITOA_BUF_SIZE);
if (n == 0)
return "0";
negative = 0;
t = n;
if (n < 0)
{
negative = 1;
t = -n; /*must use unsigned to protect from overflow*/
}
p = buffer + GFC_ITOA_BUF_SIZE - 1;
*p = '\0';
while (t != 0)
{
*--p = '0' + (t % 10);
t /= 10;
}
if (negative)
*--p = '-';
return p;
}
/* xtoa()-- Integer to hexadecimal conversion. */
const char *
xtoa (GFC_UINTEGER_LARGEST n, char *buffer, size_t len)
{ {
int digit; int digit;
char *p; char *p;
......
/* Copyright (C) 2002, 2003, 2005, 2007 Free Software Foundation, Inc. /* Copyright (C) 2002, 2003, 2005, 2007, 2009 Free Software Foundation, Inc.
Contributed by Paul Brook Contributed by Paul Brook
This file is part of the GNU Fortran 95 runtime library (libgfortran). This file is part of the GNU Fortran 95 runtime library (libgfortran).
...@@ -37,7 +37,7 @@ Boston, MA 02110-1301, USA. */ ...@@ -37,7 +37,7 @@ Boston, MA 02110-1301, USA. */
static int static int
compare0 (const char *s1, gfc_charlen_type s1_len, const char *s2) compare0 (const char *s1, gfc_charlen_type s1_len, const char *s2)
{ {
size_t len; gfc_charlen_type len;
/* Strip trailing blanks from the Fortran string. */ /* Strip trailing blanks from the Fortran string. */
len = fstrlen (s1, s1_len); len = fstrlen (s1, s1_len);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment