+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>
PR libgfortran/39664
/* 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>
This file is part of the GNU Fortran 95 runtime library (libgfortran).
static void
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. */
index_type rstride[GFC_MAX_DIMENSIONS];
rptr = ret->data;
sptr = array->data;
- shift = len == 0 ? 0 : shift % (ssize_t)len;
+ shift = len == 0 ? 0 : shift % len;
if (shift < 0)
shift += len;
/* 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.
This file is part of the GNU Fortran 95 runtime library (libgfortran).
/* Copy the values into the arguments. */
if (__values)
{
- size_t len, delta, elt_size;
+ index_type len, delta, elt_size;
elt_size = GFC_DESCRIPTOR_SIZE (__values);
len = __values->dim[0].ubound + 1 - __values->dim[0].lbound;
itime_i4 (gfc_array_i4 *__values)
{
int x[3], i;
- size_t len, delta;
+ index_type len, delta;
GFC_INTEGER_4 *vptr;
/* Call helper function. */
itime_i8 (gfc_array_i8 *__values)
{
int x[3], i;
- size_t len, delta;
+ index_type len, delta;
GFC_INTEGER_8 *vptr;
/* Call helper function. */
idate_i4 (gfc_array_i4 *__values)
{
int x[3], i;
- size_t len, delta;
+ index_type len, delta;
GFC_INTEGER_4 *vptr;
/* Call helper function. */
idate_i8 (gfc_array_i8 *__values)
{
int x[3], i;
- size_t len, delta;
+ index_type len, delta;
GFC_INTEGER_8 *vptr;
/* Call helper function. */
gmtime_i4 (GFC_INTEGER_4 * t, gfc_array_i4 * tarray)
{
int x[9], i;
- size_t len, delta;
+ index_type len, delta;
GFC_INTEGER_4 *vptr;
time_t tt;
gmtime_i8 (GFC_INTEGER_8 * t, gfc_array_i8 * tarray)
{
int x[9], i;
- size_t len, delta;
+ index_type len, delta;
GFC_INTEGER_8 *vptr;
time_t tt;
ltime_i4 (GFC_INTEGER_4 * t, gfc_array_i4 * tarray)
{
int x[9], i;
- size_t len, delta;
+ index_type len, delta;
GFC_INTEGER_4 *vptr;
time_t tt;
ltime_i8 (GFC_INTEGER_8 * t, gfc_array_i8 * tarray)
{
int x[9], i;
- size_t len, delta;
+ index_type len, delta;
GFC_INTEGER_8 *vptr;
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.
Contributed by Andy Vaught
F2003 I/O support contributed by Jerry DeLisle
uint32_t format_hash (st_parameter_dt *dtp)
{
char *key;
- size_t key_len;
+ gfc_charlen_type key_len;
uint32_t hash = 0;
- size_t i;
+ gfc_charlen_type i;
/* Hash the format string. Super simple, but what the heck! */
key = dtp->format;
/* Implementation of the FGET, FGETC, FPUT, FPUTC, FLUSH
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).
PREFIX(fgetc) (const int * unit, char * c, gfc_charlen_type c_len)
{
int ret;
- size_t s;
gfc_unit * u = find_unit (*unit);
if (u == NULL)
return -1;
- s = 1;
memset (c, ' ', c_len);
- ret = sread (u->s, c, s);
+ ret = sread (u->s, c, 1);
unlock_unit (u);
if (ret < 0)
int dim;
index_type dlen;
index_type m;
- index_type obj_name_len;
+ size_t obj_name_len;
void * pdata;
/* 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.
Contributed by Andy Vaught
Namelist transfer functions contributed by Paul Thomas
unformatted files. */
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 have_read_record;
if (is_stream_io (dtp))
{
- to_read_record = *nbytes;
have_read_record = sread (dtp->u.p.current_unit->s, buf,
- to_read_record);
+ nbytes);
if (unlikely (have_read_record < 0))
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
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,
we have to set the end-of-file condition. */
hit_eof (dtp);
- return;
}
return;
}
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;
- to_read_record = (size_t) dtp->u.p.current_unit->bytes_left;
- *nbytes = to_read_record;
+ to_read_record = dtp->u.p.current_unit->bytes_left;
+ nbytes = to_read_record;
}
-
else
{
short_record = 0;
- to_read_record = *nbytes;
+ to_read_record = nbytes;
}
dtp->u.p.current_unit->bytes_left -= to_read_record;
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
more than was written to the last record. */
- *nbytes = to_read_record;
return;
}
if (unlikely (short_record))
{
generate_error (&dtp->common, LIBERROR_SHORT_RECORD, NULL);
- return;
}
return;
}
/* Check whether we exceed the total record length. */
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;
}
else
{
- to_read_record = *nbytes;
+ to_read_record = nbytes;
short_record = 0;
}
have_read_record = 0;
if (dtp->u.p.current_unit->bytes_left_subrecord
< (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;
}
else
structure has been corrupted, or the trailing record
marker would still be present. */
- *nbytes = have_read_record;
generate_error (&dtp->common, LIBERROR_CORRUPT_FILE, NULL);
return;
}
unformatted_read (st_parameter_dt *dtp, bt type,
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)
|| kind == 1)
{
- sz = size * nelems;
if (type == BT_CHARACTER)
- sz *= GFC_SIZE_OF_CHAR_KIND(kind);
- read_block_direct (dtp, dest, &sz);
+ size *= GFC_SIZE_OF_CHAR_KIND(kind);
+ read_block_direct (dtp, dest, size * nelems);
}
else
{
char buffer[16];
char *p;
+ size_t i;
p = dest;
for (i = 0; i < nelems; i++)
{
- read_block_direct (dtp, buffer, &size);
+ read_block_direct (dtp, buffer, size);
reverse_memcpy (p, buffer, size);
p += size;
}
position. */
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 readb;
- static const size_t MAX_READ = 4096;
+ ssize_t rlength, readb;
+ static const ssize_t MAX_READ = 4096;
char p[MAX_READ];
dtp->u.p.current_unit->bytes_left_subrecord += bytes;
while (dtp->u.p.current_unit->bytes_left_subrecord > 0)
{
rlength =
- (MAX_READ < (size_t) 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) ?
+ MAX_READ : dtp->u.p.current_unit->bytes_left_subrecord;
readb = sread (dtp->u.p.current_unit->s, p, rlength);
if (readb < 0)
static void
next_record_w_unf (st_parameter_dt *dtp, int next_subrecord)
{
- gfc_offset c, m, m_write;
- size_t record_marker;
+ gfc_offset m, m_write, record_marker;
/* Bytes written. */
m = dtp->u.p.current_unit->recl_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
subrecords, we write out the negative length. */
/* Seek to the head and overwrite the bogus length with the real
length. */
- if (unlikely (sseek (dtp->u.p.current_unit->s, c - m - record_marker,
- SEEK_SET) < 0))
+ if (unlikely (sseek (dtp->u.p.current_unit->s, - m - 2 * record_marker,
+ SEEK_CUR) < 0))
goto io_error;
if (next_subrecord)
/* Seek past the end of the current record. */
- if (unlikely (sseek (dtp->u.p.current_unit->s, c + record_marker,
- SEEK_SET) < 0))
+ if (unlikely (sseek (dtp->u.p.current_unit->s, m + record_marker,
+ SEEK_CUR) < 0))
goto io_error;
return;
size_t size, size_t nelems)
{
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.
Contributed by Andy Vaught
Namelist output contributed by Paul Thomas
n = -n;
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
calculated above, so we just point past the sign in the string
before proceeding to avoid double signs in corner cases.
}
+/* 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
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);
}
void
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);
}
int width;
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)
{
int rep_ctr;
int num;
int nml_carry;
- index_type len;
+ int len;
index_type obj_size;
index_type nelem;
- index_type dim_i;
- index_type clen;
+ size_t dim_i;
+ size_t clen;
index_type elem_ctr;
- index_type obj_name_len;
+ size_t obj_name_len;
void * p ;
char cup;
char * obj_name;
len = 0;
if (base)
{
- len =strlen (base->var_name);
- for (dim_i = 0; dim_i < (index_type) strlen (base_name); dim_i++)
+ len = strlen (base->var_name);
+ base_name_len = strlen (base_name);
+ for (dim_i = 0; dim_i < base_name_len; dim_i++)
{
cup = toupper (base_name[dim_i]);
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]);
write_character (dtp, &cup, 1, 1);
/* Set the index vector and count the number of elements. */
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;
nelem = nelem * (obj->dim[dim_i].ubound + 1 - obj->dim[dim_i].lbound);
/* Append the qualifier. */
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)
{
}
sprintf (ext_name + tot_len, "%d", (int) obj->ls[dim_i].idx);
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++;
}
obj_loop:
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 ;
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;
nml_carry = 1;
/* 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.
Contributed by Paul Brook <paul@nowt.org>, and
Andy Vaught <andy@xena.eas.asu.edu>
extern void sys_exit (int) __attribute__ ((noreturn));
internal_proto(sys_exit);
-extern const char *gfc_itoa (GFC_INTEGER_LARGEST, char *, size_t);
-internal_proto(gfc_itoa);
-
-extern const char *xtoa (GFC_UINTEGER_LARGEST, char *, size_t);
-internal_proto(xtoa);
+extern const char *gfc_xtoa (GFC_UINTEGER_LARGEST, char *, size_t);
+internal_proto(gfc_xtoa);
extern void os_error (const char *) __attribute__ ((noreturn));
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
This file is part of the GNU Fortran 95 runtime library (libgfortran).
/* Write the list of addresses in hexadecimal format. */
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]));
/* 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
This file is part of the GNU Fortran 95 runtime library (libgfortran).
* 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 *
-gfc_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;
-}
-
-
-/* xtoa()-- Integer to hexadecimal conversion. */
-
-const char *
-xtoa (GFC_UINTEGER_LARGEST n, char *buffer, size_t len)
+gfc_xtoa (GFC_UINTEGER_LARGEST n, char *buffer, size_t len)
{
int digit;
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
This file is part of the GNU Fortran 95 runtime library (libgfortran).
static int
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. */
len = fstrlen (s1, s1_len);
OSDN Git Service
