procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

string.c (compare0): Use gfc_charlen_type.

Browse source 
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
This commit is contained in:
Janne Blomqvist 2009-04-08 19:48:07 +03:00
parent 75ccc1e7fa
commit f9bfed2243
12 changed files with 147 additions and 127 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
libgfortran/ChangeLog
View file

@ -1,3 +1,37 @@
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

6
libgfortran/intrinsics/cshift0.c
View file

@ -1,5 +1,5 @@
/* 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).
@ -35,7 +35,7 @@ Boston, MA 02110-1301, USA. */
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];
@ -311,7 +311,7 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array,
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;

20
libgfortran/intrinsics/date_and_time.c
View file

@ -1,5 +1,5 @@
/* 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).
@ -242,7 +242,7 @@ date_and_time (char *__date, char *__time, char *__zone,
/* 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;
@ -384,7 +384,7 @@ void
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. */
@ -410,7 +410,7 @@ void
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. */
@ -466,7 +466,7 @@ void
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. */
@ -492,7 +492,7 @@ void
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. */
@ -554,7 +554,7 @@ void
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;
@ -581,7 +581,7 @@ void
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;
@ -646,7 +646,7 @@ void
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;
@ -673,7 +673,7 @@ void
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;

6
libgfortran/io/format.c
View file

@ -1,4 +1,4 @@
/* 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
@ -140,9 +140,9 @@ static inline
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;

6
libgfortran/io/intrinsics.c
View file

@ -1,6 +1,6 @@
/* 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).
@ -46,15 +46,13 @@ int
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)

2
libgfortran/io/list_read.c
View file

@ -2305,7 +2305,7 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset,
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. */

67
libgfortran/io/transfer.c
View file

@ -1,4 +1,4 @@
/* 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
@ -397,7 +397,7 @@ read_block_form (st_parameter_dt *dtp, int * nbytes)
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;
@ -407,9 +407,8 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
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);
@ -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;
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;
@ -452,18 +449,16 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
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;
}
@ -475,14 +470,14 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
/* 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;
@ -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
< (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
@ -520,7 +515,6 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
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;
}
@ -737,20 +731,18 @@ static void
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;
@ -773,7 +765,7 @@ unformatted_read (st_parameter_dt *dtp, bt type,
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;
}
@ -2571,11 +2563,10 @@ next_array_record (st_parameter_dt *dtp, array_loop_spec *ls, int *finished)
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;
@ -2595,8 +2586,8 @@ skip_record (st_parameter_dt *dtp, size_t 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)
@ -2811,13 +2802,11 @@ write_us_marker (st_parameter_dt *dtp, const gfc_offset buf)
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. */
@ -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
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)
@ -2852,8 +2841,8 @@ next_record_w_unf (st_parameter_dt *dtp, int 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;
@ -3207,7 +3196,7 @@ iolength_transfer (st_parameter_dt *dtp, bt type __attribute__((unused)),
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);
}

73
libgfortran/io/write.c
View file

@ -1,4 +1,4 @@
/* 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
@ -602,7 +602,7 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
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.
@ -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
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)
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);
}
@ -830,7 +867,7 @@ write_integer (st_parameter_dt *dtp, const char *source, int length)
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)
{
@ -1193,13 +1230,13 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
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;
@ -1229,14 +1266,16 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
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);
@ -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. */
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);
@ -1378,7 +1417,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
/* 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)
{
@ -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);
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++;
}
@ -1441,11 +1480,11 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
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;

9
libgfortran/libgfortran.h
View file

@ -1,5 +1,5 @@
/* 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>
@ -635,11 +635,8 @@ internal_proto(show_backtrace);
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);

4
libgfortran/runtime/backtrace.c
View file

@ -1,4 +1,4 @@
/* 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).
@ -152,7 +152,7 @@ show_backtrace (void)
/* 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

43
libgfortran/runtime/error.c
View file

@ -1,4 +1,4 @@
/* 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).
@ -116,47 +116,10 @@ sys_exit (int 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 *
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;

4
libgfortran/runtime/string.c
View file

@ -1,4 +1,4 @@
/* 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).
@ -37,7 +37,7 @@ Boston, MA 02110-1301, USA. */
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);