tweak the non-IEEE case

git-svn-id: https://svn.r-project.org/R/branches/R-exp-API@7016 00db46b3-68df-0310-9c12-caf00c1e9a41
wch · Dec 13, 1999 · 2cff428 · 2cff428
1 parent 6d4600c
commit 2cff428
Show file tree

Hide file tree

Showing 6 changed files with 27 additions and 16 deletions.
diff --git a/src/include/Defn.h b/src/include/Defn.h
@@ -77,7 +77,12 @@
 #ifdef IEEE_754
 # define MATH_CHECK(call)	(call)
 #else
-# define MATH_CHECK(call)	(errno=0,R_tmp=call,(errno==0)?R_tmp:R_NaN)
+# ifdef __MAIN__
+    double R_tmp;
+# else
+    extern double R_tmp;
+# endif
+#  define MATH_CHECK(call)	(errno=0,R_tmp=call,(errno==0)?R_tmp:R_NaN)
 #endif
 
 

diff --git a/src/include/Mathlib.h b/src/include/Mathlib.h
@@ -206,6 +206,7 @@ extern double m_one;
 #define ML_VALID(x)	(!isnan(x))
 
 #else/*--- NO IEEE: No +/-Inf, NAN,... ---*/
+void ml_error(int n);
 #define ML_ERROR(x)	ml_error(x)
 #define ML_POSINF	DBL_MAX
 #define ML_NEGINF	(-DBL_MAX)

diff --git a/src/include/R_ext/Blas.h b/src/include/R_ext/Blas.h
@@ -22,9 +22,10 @@
  *  Some minor fixups and formatting has been done.
  */
 
-#ifndef BLAS_H
-#define BLAS_H
-#include "R_ext/Complex.h"
+#ifndef R_EXT_BLAS_H
+#define R_EXT_BLAS_H
+
+#include "R_ext/F77.h"		/* for F77_SYMBOL */
 
 	/* Double Precision Blas */
 
@@ -42,7 +43,8 @@ extern int    F77_SYMBOL(idamax)(int*, double*, int*);
 
 
 	/* Double Precision Complex Blas */
-
+#ifdef COMPLEX_BLAS
+#include "R_ext/Complex.h"
 extern double F77_SYMBOL(dznrm2)(int*, Rcomplex *x, int*);
 extern int    F77_SYMBOL(izamax)(int*, Rcomplex *zx, int*);
 extern int    F77_SYMBOL(zaxpy)(int*, Rcomplex *za, Rcomplex *zx, int*, Rcomplex *zy, int*);
@@ -53,5 +55,6 @@ extern int    F77_SYMBOL(zdscal)(int*, double*, Rcomplex *zx, int*);
 extern int    F77_SYMBOL(zrotg)(Rcomplex *ca, Rcomplex *cb, double*, Rcomplex *s);
 extern int    F77_SYMBOL(zscal)(int*, Rcomplex *za, Rcomplex *zx, int*);
 extern int    F77_SYMBOL(zswap)(int*, Rcomplex *zx, int*, Rcomplex *zy, int*);
+#endif
 
 #endif
diff --git a/src/include/R_ext/Linpack.h b/src/include/R_ext/Linpack.h
@@ -18,10 +18,10 @@
  *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  */
 
-#ifndef LINPACK_H_
-#define LINPACK_H_
+#ifndef R_EXT_LINPACK_H_
+#define R_EXT_LINPACK_H_
 
-#include "Rconfig.h"		/* for F77_SYMBOL */
+#include "R_ext/F77.h"		/* for F77_SYMBOL */
 #include "R_ext/Blas.h"
 
 	/* Double Precision Linpack */

diff --git a/src/main/arithmetic.c b/src/main/arithmetic.c
@@ -72,7 +72,7 @@ double R_Zero_Hack = 0.0;	/* Silence the Sun compiler */
 #  include <ieeefp.h>		/* others [Solaris 2.5.x], .. */
 # endif
 #endif
-#if defined(Win32) && defined( _MSC_VER)
+#if defined(Win32) && defined(_MSC_VER)
 #include <float.h>
 #endif 
 
@@ -157,6 +157,12 @@ int R_IsNA(double x)
     return (x == R_NaReal);
 }
 
+/* NaN but not NA: never true */
+int R_IsNaN(double x)
+{
+    return 0;
+}
+
 int R_IsNaNorNA(double x)
 {
 # ifndef HAVE_ISNAN

diff --git a/src/main/coerce.c b/src/main/coerce.c
@@ -1376,10 +1376,6 @@ SEXP do_isna(SEXP call, SEXP op, SEXP args, SEXP rho)
     return ans;
 }
 
-/* Convenience for using LIST_VEC_NAN macro later */
-#ifndef IEEE_754
-# define R_IsNaN(x) (0)
-#endif
 SEXP do_isnan(SEXP call, SEXP op, SEXP args, SEXP rho)
 {
     SEXP ans, dims, names, x;
@@ -1479,9 +1475,6 @@ SEXP do_isnan(SEXP call, SEXP op, SEXP args, SEXP rho)
     UNPROTECT(1);
     return ans;
 }
-#ifndef IEEE_754
-# undef R_isNaN
-#endif
 
 SEXP do_isfinite(SEXP call, SEXP op, SEXP args, SEXP rho)
 {
@@ -1535,8 +1528,11 @@ SEXP do_isfinite(SEXP call, SEXP op, SEXP args, SEXP rho)
 SEXP do_isinfinite(SEXP call, SEXP op, SEXP args, SEXP rho)
 {
     SEXP ans, x, names, dims;
+#ifdef IEEE_754
     double xr, xi;
+#endif
     int i, n;
+
     checkArity(op, args);
 #ifdef stringent_is
     if (!isList(CAR(args)) && !isVector(CAR(args)))