Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

use >= 64-bit integer accumulator

git-svn-id: https://svn.r-project.org/R/trunk@62391 00db46b3-68df-0310-9c12-caf00c1e9a41
  • Loading branch information...
commit dc6aefcebf84627710d06bba364a5a03dc847d11 1 parent d6969b0
ripley authored
View
153 configure
@@ -2771,6 +2771,82 @@ $as_echo "$ac_res" >&6; }
} # ac_fn_c_find_uintX_t
+# ac_fn_c_find_intX_t LINENO BITS VAR
+# -----------------------------------
+# Finds a signed integer type with width BITS, setting cache variable VAR
+# accordingly.
+ac_fn_c_find_intX_t ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for int$2_t" >&5
+$as_echo_n "checking for int$2_t... " >&6; }
+if eval \${$3+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ eval "$3=no"
+ # Order is important - never check a type that is potentially smaller
+ # than half of the expected target width.
+ for ac_type in int$2_t 'int' 'long int' \
+ 'long long int' 'short int' 'signed char'; do
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$ac_includes_default
+ enum { N = $2 / 2 - 1 };
+int
+main ()
+{
+static int test_array [1 - 2 * !(0 < ($ac_type) ((((($ac_type) 1 << N) << N) - 1) * 2 + 1))];
+test_array [0] = 0;
+return test_array [0];
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$ac_includes_default
+ enum { N = $2 / 2 - 1 };
+int
+main ()
+{
+static int test_array [1 - 2 * !(($ac_type) ((((($ac_type) 1 << N) << N) - 1) * 2 + 1)
+ < ($ac_type) ((((($ac_type) 1 << N) << N) - 1) * 2 + 2))];
+test_array [0] = 0;
+return test_array [0];
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+
+else
+ case $ac_type in #(
+ int$2_t) :
+ eval "$3=yes" ;; #(
+ *) :
+ eval "$3=\$ac_type" ;;
+esac
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ if eval test \"x\$"$3"\" = x"no"; then :
+
+else
+ break
+fi
+ done
+fi
+eval ac_res=\$$3
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_c_find_intX_t
+
# ac_fn_c_check_type LINENO TYPE VAR INCLUDES
# -------------------------------------------
# Tests whether TYPE exists after having included INCLUDES, setting cache
@@ -8949,13 +9025,13 @@ if ${lt_cv_nm_interface+:} false; then :
else
lt_cv_nm_interface="BSD nm"
echo "int some_variable = 0;" > conftest.$ac_ext
- (eval echo "\"\$as_me:8952: $ac_compile\"" >&5)
+ (eval echo "\"\$as_me:9028: $ac_compile\"" >&5)
(eval "$ac_compile" 2>conftest.err)
cat conftest.err >&5
- (eval echo "\"\$as_me:8955: $NM \\\"conftest.$ac_objext\\\"\"" >&5)
+ (eval echo "\"\$as_me:9031: $NM \\\"conftest.$ac_objext\\\"\"" >&5)
(eval "$NM \"conftest.$ac_objext\"" 2>conftest.err > conftest.out)
cat conftest.err >&5
- (eval echo "\"\$as_me:8958: output\"" >&5)
+ (eval echo "\"\$as_me:9034: output\"" >&5)
cat conftest.out >&5
if $GREP 'External.*some_variable' conftest.out > /dev/null; then
lt_cv_nm_interface="MS dumpbin"
@@ -11803,11 +11879,11 @@ else
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
- (eval echo "\"\$as_me:11806: $lt_compile\"" >&5)
+ (eval echo "\"\$as_me:11882: $lt_compile\"" >&5)
(eval "$lt_compile" 2>conftest.err)
ac_status=$?
cat conftest.err >&5
- echo "$as_me:11810: \$? = $ac_status" >&5
+ echo "$as_me:11886: \$? = $ac_status" >&5
if (exit $ac_status) && test -s "$ac_outfile"; then
# The compiler can only warn and ignore the option if not recognized
# So say no if there are warnings other than the usual output.
@@ -12142,11 +12218,11 @@ else
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
- (eval echo "\"\$as_me:12145: $lt_compile\"" >&5)
+ (eval echo "\"\$as_me:12221: $lt_compile\"" >&5)
(eval "$lt_compile" 2>conftest.err)
ac_status=$?
cat conftest.err >&5
- echo "$as_me:12149: \$? = $ac_status" >&5
+ echo "$as_me:12225: \$? = $ac_status" >&5
if (exit $ac_status) && test -s "$ac_outfile"; then
# The compiler can only warn and ignore the option if not recognized
# So say no if there are warnings other than the usual output.
@@ -12247,11 +12323,11 @@ else
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
- (eval echo "\"\$as_me:12250: $lt_compile\"" >&5)
+ (eval echo "\"\$as_me:12326: $lt_compile\"" >&5)
(eval "$lt_compile" 2>out/conftest.err)
ac_status=$?
cat out/conftest.err >&5
- echo "$as_me:12254: \$? = $ac_status" >&5
+ echo "$as_me:12330: \$? = $ac_status" >&5
if (exit $ac_status) && test -s out/conftest2.$ac_objext
then
# The compiler can only warn and ignore the option if not recognized
@@ -12302,11 +12378,11 @@ else
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
- (eval echo "\"\$as_me:12305: $lt_compile\"" >&5)
+ (eval echo "\"\$as_me:12381: $lt_compile\"" >&5)
(eval "$lt_compile" 2>out/conftest.err)
ac_status=$?
cat out/conftest.err >&5
- echo "$as_me:12309: \$? = $ac_status" >&5
+ echo "$as_me:12385: \$? = $ac_status" >&5
if (exit $ac_status) && test -s out/conftest2.$ac_objext
then
# The compiler can only warn and ignore the option if not recognized
@@ -14669,7 +14745,7 @@ else
lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
lt_status=$lt_dlunknown
cat > conftest.$ac_ext <<_LT_EOF
-#line 14672 "configure"
+#line 14748 "configure"
#include "confdefs.h"
#if HAVE_DLFCN_H
@@ -14765,7 +14841,7 @@ else
lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
lt_status=$lt_dlunknown
cat > conftest.$ac_ext <<_LT_EOF
-#line 14768 "configure"
+#line 14844 "configure"
#include "confdefs.h"
#if HAVE_DLFCN_H
@@ -16714,11 +16790,11 @@ else
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
- (eval echo "\"\$as_me:16717: $lt_compile\"" >&5)
+ (eval echo "\"\$as_me:16793: $lt_compile\"" >&5)
(eval "$lt_compile" 2>conftest.err)
ac_status=$?
cat conftest.err >&5
- echo "$as_me:16721: \$? = $ac_status" >&5
+ echo "$as_me:16797: \$? = $ac_status" >&5
if (exit $ac_status) && test -s "$ac_outfile"; then
# The compiler can only warn and ignore the option if not recognized
# So say no if there are warnings other than the usual output.
@@ -16813,11 +16889,11 @@ else
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
- (eval echo "\"\$as_me:16816: $lt_compile\"" >&5)
+ (eval echo "\"\$as_me:16892: $lt_compile\"" >&5)
(eval "$lt_compile" 2>out/conftest.err)
ac_status=$?
cat out/conftest.err >&5
- echo "$as_me:16820: \$? = $ac_status" >&5
+ echo "$as_me:16896: \$? = $ac_status" >&5
if (exit $ac_status) && test -s out/conftest2.$ac_objext
then
# The compiler can only warn and ignore the option if not recognized
@@ -16865,11 +16941,11 @@ else
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
- (eval echo "\"\$as_me:16868: $lt_compile\"" >&5)
+ (eval echo "\"\$as_me:16944: $lt_compile\"" >&5)
(eval "$lt_compile" 2>out/conftest.err)
ac_status=$?
cat out/conftest.err >&5
- echo "$as_me:16872: \$? = $ac_status" >&5
+ echo "$as_me:16948: \$? = $ac_status" >&5
if (exit $ac_status) && test -s out/conftest2.$ac_objext
then
# The compiler can only warn and ignore the option if not recognized
@@ -18245,11 +18321,11 @@ else
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
- (eval echo "\"\$as_me:18248: $lt_compile\"" >&5)
+ (eval echo "\"\$as_me:18324: $lt_compile\"" >&5)
(eval "$lt_compile" 2>conftest.err)
ac_status=$?
cat conftest.err >&5
- echo "$as_me:18252: \$? = $ac_status" >&5
+ echo "$as_me:18328: \$? = $ac_status" >&5
if (exit $ac_status) && test -s "$ac_outfile"; then
# The compiler can only warn and ignore the option if not recognized
# So say no if there are warnings other than the usual output.
@@ -18344,11 +18420,11 @@ else
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
- (eval echo "\"\$as_me:18347: $lt_compile\"" >&5)
+ (eval echo "\"\$as_me:18423: $lt_compile\"" >&5)
(eval "$lt_compile" 2>out/conftest.err)
ac_status=$?
cat out/conftest.err >&5
- echo "$as_me:18351: \$? = $ac_status" >&5
+ echo "$as_me:18427: \$? = $ac_status" >&5
if (exit $ac_status) && test -s out/conftest2.$ac_objext
then
# The compiler can only warn and ignore the option if not recognized
@@ -18396,11 +18472,11 @@ else
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
- (eval echo "\"\$as_me:18399: $lt_compile\"" >&5)
+ (eval echo "\"\$as_me:18475: $lt_compile\"" >&5)
(eval "$lt_compile" 2>out/conftest.err)
ac_status=$?
cat out/conftest.err >&5
- echo "$as_me:18403: \$? = $ac_status" >&5
+ echo "$as_me:18479: \$? = $ac_status" >&5
if (exit $ac_status) && test -s out/conftest2.$ac_objext
then
# The compiler can only warn and ignore the option if not recognized
@@ -21549,6 +21625,17 @@ _ACEOF
;;
esac
+ac_fn_c_find_intX_t "$LINENO" "64" "ac_cv_c_int64_t"
+case $ac_cv_c_int64_t in #(
+ no|yes) ;; #(
+ *)
+
+cat >>confdefs.h <<_ACEOF
+#define int64_t $ac_cv_c_int64_t
+_ACEOF
+;;
+esac
+
ac_fn_c_check_type "$LINENO" "pid_t" "ac_cv_type_pid_t" "$ac_includes_default"
if test "x$ac_cv_type_pid_t" = xyes; then :
@@ -23070,7 +23157,7 @@ _ACEOF
# flags.
r_save_CFLAGS=$CFLAGS
CFLAGS="$CFLAGS $r_verb"
-(eval echo $as_me:23073: \"$ac_link\") >&5
+(eval echo $as_me:23160: \"$ac_link\") >&5
r_c_v_output=`eval $ac_link 5>&1 2>&1 | grep -v 'Driving:'`
echo "$r_c_v_output" >&5
CFLAGS=$r_save_CFLAGS
@@ -23145,7 +23232,7 @@ _ACEOF
# flags.
r_save_CFLAGS=$CFLAGS
CFLAGS="$CFLAGS $r_cv_prog_c_v"
-(eval echo $as_me:23148: \"$ac_link\") >&5
+(eval echo $as_me:23235: \"$ac_link\") >&5
r_c_v_output=`eval $ac_link 5>&1 2>&1 | grep -v 'Driving:'`
echo "$r_c_v_output" >&5
CFLAGS=$r_save_CFLAGS
@@ -35584,11 +35671,11 @@ else
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
- (eval echo "\"\$as_me:35587: $lt_compile\"" >&5)
+ (eval echo "\"\$as_me:35674: $lt_compile\"" >&5)
(eval "$lt_compile" 2>conftest.err)
ac_status=$?
cat conftest.err >&5
- echo "$as_me:35591: \$? = $ac_status" >&5
+ echo "$as_me:35678: \$? = $ac_status" >&5
if (exit $ac_status) && test -s "$ac_outfile"; then
# The compiler can only warn and ignore the option if not recognized
# So say no if there are warnings other than the usual output.
@@ -35683,11 +35770,11 @@ else
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
- (eval echo "\"\$as_me:35686: $lt_compile\"" >&5)
+ (eval echo "\"\$as_me:35773: $lt_compile\"" >&5)
(eval "$lt_compile" 2>out/conftest.err)
ac_status=$?
cat out/conftest.err >&5
- echo "$as_me:35690: \$? = $ac_status" >&5
+ echo "$as_me:35777: \$? = $ac_status" >&5
if (exit $ac_status) && test -s out/conftest2.$ac_objext
then
# The compiler can only warn and ignore the option if not recognized
@@ -35735,11 +35822,11 @@ else
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
- (eval echo "\"\$as_me:35738: $lt_compile\"" >&5)
+ (eval echo "\"\$as_me:35825: $lt_compile\"" >&5)
(eval "$lt_compile" 2>out/conftest.err)
ac_status=$?
cat out/conftest.err >&5
- echo "$as_me:35742: \$? = $ac_status" >&5
+ echo "$as_me:35829: \$? = $ac_status" >&5
if (exit $ac_status) && test -s out/conftest2.$ac_objext
then
# The compiler can only warn and ignore the option if not recognized
View
1  configure.ac
@@ -813,6 +813,7 @@ R_HEADER_GLIBC2
AC_TYPE_SIGNAL
## xz needs uint64_t
AC_TYPE_UINT64_T
+AC_TYPE_INT64_T
AC_TYPE_PID_T
AC_TYPE_SIZE_T
R_SIZE_MAX
View
6 doc/NEWS.Rd
@@ -23,6 +23,12 @@
new default is \code{FALSE} which makes child processes
non-interactive by default (this prevents lock-ups due to children
waiting for interactive input).
+
+ \item \code{sum()} for integer arguments now uses an integer
+ accumulator of at least 64 bits and so will be more accurate in
+ the very rare case that a cumulative sum exceeds
+ \eqn{2^{53}}{2^53} (necessarily summing more than 4 million
+ elements).
}
}
View
14 src/include/Defn.h
@@ -1246,6 +1246,20 @@ extern void *alloca(size_t);
# define LDOUBLE double
#endif
+/* int_fast64_t is required by C99/C11
+ Alternative would be to use intmax_t.
+ */
+#ifdef int64_t
+# define LONG_INT int64_t
+# define LONG_INT_MAX INT64_MAX
+#elif defined(int_fast64_t)
+# define LONG_INT int_fast64_t
+# define LONG_INT_MAX INT_FAST64_MAX
+#else
+# define LONG_INT int
+# define LONG_INT_MAX INT_MAX
+#endif
+
#endif /* DEFN_H_ */
/*
*- Local Variables:
View
4 src/include/config.h.in
@@ -1111,6 +1111,10 @@
#undef inline
#endif
+/* Define to the type of a signed integer type of width exactly 64 bits if
+ such a type exists and the standard includes do not define it. */
+#undef int64_t
+
/* Define to `int' if <sys/types.h> does not define. */
#undef pid_t
View
86 src/main/summary.c
@@ -1,7 +1,7 @@
/*
* R : A Computer Language for Statistical Data Analysis
* Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka
- * Copyright (C) 1997-2012 The R Core Team
+ * Copyright (C) 1997-2013 The R Core Team
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -42,22 +42,20 @@
#define DbgP3(s,a,b)
#endif
-
-/* FIXME: use 64-bit integer accumulator? */
+/* Since we have long vectors, this could integer overflow */
static Rboolean isum(int *x, R_xlen_t n, int *value, Rboolean narm, SEXP call)
{
- double s = 0.0;
- R_xlen_t i;
+ LONG_INT s = 0; // at least 64-bit
Rboolean updated = FALSE;
- for (i = 0; i < n; i++) {
+ for (R_xlen_t i = 0; i < n; i++) {
if (x[i] != NA_INTEGER) {
if(!updated) updated = TRUE;
s += x[i];
} else if (!narm) {
if(!updated) updated = TRUE;
*value = NA_INTEGER;
- return(updated);
+ return updated;
}
}
if(s > INT_MAX || s < R_INT_MIN){
@@ -66,16 +64,15 @@ static Rboolean isum(int *x, R_xlen_t n, int *value, Rboolean narm, SEXP call)
}
else *value = (int) s;
- return(updated);
+ return updated;
}
static Rboolean rsum(double *x, R_xlen_t n, double *value, Rboolean narm)
{
LDOUBLE s = 0.0;
- R_xlen_t i;
Rboolean updated = FALSE;
- for (i = 0; i < n; i++) {
+ for (R_xlen_t i = 0; i < n; i++) {
if (!narm || !ISNAN(x[i])) {
if(!updated) updated = TRUE;
s += x[i];
@@ -83,16 +80,15 @@ static Rboolean rsum(double *x, R_xlen_t n, double *value, Rboolean narm)
}
*value = (double) s;
- return(updated);
+ return updated;
}
static Rboolean csum(Rcomplex *x, R_xlen_t n, Rcomplex *value, Rboolean narm)
{
LDOUBLE sr = 0.0, si = 0.0;
- R_xlen_t i;
Rboolean updated = FALSE;
- for (i = 0; i < n; i++) {
+ for (R_xlen_t i = 0; i < n; i++) {
if (!narm || (!ISNAN(x[i].r) && !ISNAN(x[i].i))) {
if(!updated) updated = TRUE;
sr += x[i].r;
@@ -102,17 +98,16 @@ static Rboolean csum(Rcomplex *x, R_xlen_t n, Rcomplex *value, Rboolean narm)
value->r = (double) sr;
value->i = (double) si;
- return(updated);
+ return updated;
}
static Rboolean imin(int *x, R_xlen_t n, int *value, Rboolean narm)
{
int s = 0 /* -Wall */;
- R_xlen_t i;
Rboolean updated = FALSE;
/* Used to set s = INT_MAX, but this ignored INT_MAX in the input */
- for (i = 0; i < n; i++) {
+ for (R_xlen_t i = 0; i < n; i++) {
if (x[i] != NA_INTEGER) {
if (!updated || s > x[i]) {
s = x[i];
@@ -126,17 +121,16 @@ static Rboolean imin(int *x, R_xlen_t n, int *value, Rboolean narm)
}
*value = s;
- return(updated);
+ return updated;
}
static Rboolean rmin(double *x, R_xlen_t n, double *value, Rboolean narm)
{
double s = 0.0; /* -Wall */
- R_xlen_t i;
Rboolean updated = FALSE;
/* s = R_PosInf; */
- for (i = 0; i < n; i++) {
+ for (R_xlen_t i = 0; i < n; i++) {
if (ISNAN(x[i])) {/* Na(N) */
if (!narm) {
if(!ISNA(s)) s = x[i]; /* so any NA trumps all NaNs */
@@ -150,16 +144,15 @@ static Rboolean rmin(double *x, R_xlen_t n, double *value, Rboolean narm)
}
*value = s;
- return(updated);
+ return updated;
}
static Rboolean smin(SEXP x, SEXP *value, Rboolean narm)
{
- R_xlen_t i;
SEXP s = NA_STRING; /* -Wall */
Rboolean updated = FALSE;
- for (i = 0; i < XLENGTH(x); i++) {
+ for (R_xlen_t i = 0; i < XLENGTH(x); i++) {
if (STRING_ELT(x, i) != NA_STRING) {
if (!updated ||
(s != STRING_ELT(x, i) && Scollate(s, STRING_ELT(x, i)) > 0)) {
@@ -174,16 +167,15 @@ static Rboolean smin(SEXP x, SEXP *value, Rboolean narm)
}
*value = s;
- return(updated);
+ return updated;
}
static Rboolean imax(int *x, R_xlen_t n, int *value, Rboolean narm)
{
int s = 0 /* -Wall */;
- R_xlen_t i;
Rboolean updated = FALSE;
- for (i = 0; i < n; i++) {
+ for (R_xlen_t i = 0; i < n; i++) {
if (x[i] != NA_INTEGER) {
if (!updated || s < x[i]) {
s = x[i];
@@ -196,16 +188,15 @@ static Rboolean imax(int *x, R_xlen_t n, int *value, Rboolean narm)
}
*value = s;
- return(updated);
+ return updated;
}
static Rboolean rmax(double *x, R_xlen_t n, double *value, Rboolean narm)
{
double s = 0.0 /* -Wall */;
- R_xlen_t i;
Rboolean updated = FALSE;
- for (i = 0; i < n; i++) {
+ for (R_xlen_t i = 0; i < n; i++) {
if (ISNAN(x[i])) {/* Na(N) */
if (!narm) {
if(!ISNA(s)) s = x[i]; /* so any NA trumps all NaNs */
@@ -219,16 +210,15 @@ static Rboolean rmax(double *x, R_xlen_t n, double *value, Rboolean narm)
}
*value = s;
- return(updated);
+ return updated;
}
static Rboolean smax(SEXP x, SEXP *value, Rboolean narm)
{
- R_xlen_t i;
SEXP s = NA_STRING; /* -Wall */
Rboolean updated = FALSE;
- for (i = 0; i < XLENGTH(x); i++) {
+ for (R_xlen_t i = 0; i < XLENGTH(x); i++) {
if (STRING_ELT(x, i) != NA_STRING) {
if (!updated ||
(s != STRING_ELT(x, i) && Scollate(s, STRING_ELT(x, i)) < 0)) {
@@ -243,16 +233,15 @@ static Rboolean smax(SEXP x, SEXP *value, Rboolean narm)
}
*value = s;
- return(updated);
+ return updated;
}
static Rboolean iprod(int *x, R_xlen_t n, double *value, Rboolean narm)
{
- double s = 1.0;
- R_xlen_t i;
+ LDOUBLE s = 1.0;
Rboolean updated = FALSE;
- for (i = 0; i < n; i++) {
+ for (R_xlen_t i = 0; i < n; i++) {
if (x[i] != NA_INTEGER) {
s *= x[i];
if(!updated) updated = TRUE;
@@ -260,26 +249,25 @@ static Rboolean iprod(int *x, R_xlen_t n, double *value, Rboolean narm)
else if (!narm) {
if(!updated) updated = TRUE;
*value = NA_REAL;
- return(updated);
+ return updated;
}
if(ISNAN(s)) { /* how can this happen? */
*value = NA_REAL;
- return(updated);
+ return updated;
}
}
*value = s;
- return(updated);
+ return updated;
}
static Rboolean rprod(double *x, R_xlen_t n, double *value, Rboolean narm)
{
LDOUBLE s = 1.0;
- R_xlen_t i;
Rboolean updated = FALSE;
- for (i = 0; i < n; i++) {
+ for (R_xlen_t i = 0; i < n; i++) {
if (!narm || !ISNAN(x[i])) {
if(!updated) updated = TRUE;
s *= x[i];
@@ -287,21 +275,17 @@ static Rboolean rprod(double *x, R_xlen_t n, double *value, Rboolean narm)
}
*value = (double) s;
- return(updated);
+ return updated;
}
static Rboolean cprod(Rcomplex *x, R_xlen_t n, Rcomplex *value, Rboolean narm)
{
- LDOUBLE sr, si, tr, ti;
- R_xlen_t i;
+ LDOUBLE sr = 1.0, si = 0.0;
Rboolean updated = FALSE;
- sr = 1;
- si = 0;
- for (i = 0; i < n; i++) {
+ for (R_xlen_t i = 0; i < n; i++) {
if (!narm || (!ISNAN(x[i].r) && !ISNAN(x[i].i))) {
if(!updated) updated = TRUE;
- tr = sr;
- ti = si;
+ LDOUBLE tr = sr, ti = si;
sr = tr * x[i].r - ti * x[i].i;
si = tr * x[i].i + ti * x[i].r;
}
@@ -309,7 +293,7 @@ static Rboolean cprod(Rcomplex *x, R_xlen_t n, Rcomplex *value, Rboolean narm)
value->r = (double) sr;
value->i = (double) si;
- return(updated);
+ return updated;
}
@@ -359,7 +343,7 @@ SEXP attribute_hidden do_summary(SEXP call, SEXP op, SEXP args, SEXP env)
SEXP ans, a, stmp = NA_STRING /* -Wall */, scum = NA_STRING, call2;
double tmp = 0.0, s;
Rcomplex z, ztmp, zcum={0.0, 0.0} /* -Wall */;
- int itmp = 0, icum=0, int_a, real_a, empty, warn = 0 /* dummy */;
+ int itmp = 0, icum = 0, int_a, real_a, empty, warn = 0 /* dummy */;
SEXPTYPE ans_type;/* only INTEGER, REAL, COMPLEX or STRSXP here */
Rboolean narm;
@@ -648,7 +632,7 @@ SEXP attribute_hidden do_summary(SEXP call, SEXP op, SEXP args, SEXP env)
break;/* prod() part */
- }/* switch(iop) */
+ } /* switch(iop) */
} else { /* len(a)=0 */
/* Even though this has length zero it can still be invalid,
Please sign in to comment.
Something went wrong with that request. Please try again.