Fix bug 181: log does not take base into account without mpfr

	* src/ent/floatfns.c (RETURN_WHEN_INDEF): New macro for the common
	handling of indefinites in logarithmic functions.
	(Flog10): Always define, but throw invalid operation if no
	logarithmic primitive is available.
	(Flog2): Ditto.
	(Flog): Try to use Flog10 or Flog2 if the bases match.  In case of
	float operation try to use Flog2 since it is usually more
	efficient.

	* configure.ac: Check for availability of all the logarithmic
	functions.

Signed-off-by: Nelson Ferreira <nelson.ferreira@ieee.org>

diff --git a/configure.ac b/configure.ac
index f779af5..44bf7bb 100644 (file)
--- a/configure.ac
+++ b/configure.ac
@@ -1709,7 +1709,7 @@ dnl Check for POSIX functions.
 dnl ----------------------------------------------------------------
 
 SXE_CHECK_BASIC_FUNS
-AC_CHECK_FUNCS([alarm cbrt closedir dup2 eaccess endpwent floor fmod fpathconf frexp fsync ftime ftruncate getaddrinfo getcwd gethostbyname gethostname getnameinfo getpagesize getrlimit gettimeofday getwd isascii isatty link logb lrand48 matherr memchr memmove memset mkdir mktime munmap perror poll pow putenv random re_comp readlink regcomp rename res_init rint rmdir select setitimer setlocale setpgid setsid sigblock sighold sigprocmask snprintf socket sqrt stpcpy strncpy strncat strcasecmp strchr strdup strerror strlwr strrchr strspn strtol strupr symlink ttyname tzset ulimit umask uname usleep utime vlimit vsnprintf waitpid wcscmp wcslen])
+AC_CHECK_FUNCS([alarm cbrt closedir dup2 eaccess endpwent floor fmod fpathconf frexp fsync ftime ftruncate getaddrinfo getcwd gethostbyname gethostname getnameinfo getpagesize getrlimit gettimeofday getwd isascii isatty link logb log2 log2f log2l log10 log10f log10l log logf logl lrand48 matherr memchr memmove memset mkdir mktime munmap perror poll pow putenv random re_comp readlink regcomp rename res_init rint rmdir select setitimer setlocale setpgid setsid sigblock sighold sigprocmask snprintf socket sqrt stpcpy strncpy strncat strcasecmp strchr strdup strerror strlwr strrchr strspn strtol strupr symlink ttyname tzset ulimit umask uname usleep utime vlimit vsnprintf waitpid wcscmp wcslen])
 
 AS_IF([test "$have_isatty" = "yes"],
        AC_DEFINE([HAVE_ISATTY], [1], [isatty is available]))

diff --git a/src/ent/floatfns.c b/src/ent/floatfns.c
index 863a075..d34bf5d 100644 (file)
--- a/src/ent/floatfns.c
+++ b/src/ent/floatfns.c
@@ -783,65 +783,58 @@ If optional argument PRECISION is non-nil, its value
 }
 
 #if defined(HAVE_FPFLOAT) || defined(HAVE_MPFR) && defined WITH_MPFR
-DEFUN("log", Flog, 1, 3, 0,    /*
-Return the natural logarithm of NUMBER.
-If second optional argument BASE is given, return the logarithm of
-NUMBER using that base.
-If third optional argument PRECISION is given, use its value
+
+#define RETURN_WHEN_INDEF(number)                                   \
+        if (INDEFP(number)) {                                       \
+                if (XINDEF_DATA(number) == POS_INFINITY) {          \
+                        return number;                              \
+                } else if (XINDEF_DATA(number) == NEG_INFINITY) {      \
+                        return make_indef(NOT_A_NUMBER);            \
+                } else {                                            \
+                        return number;                              \
+                }                                                   \
+        }
+
+DEFUN("log10", Flog10, 1, 2, 0,        /*
+Return the logarithm base 10 of NUMBER.
+If second optional argument PRECISION is given, use its value
 (an integer) as precision.
 */
-      (number, base, precision))
+      (number, precision))
 {
+       RETURN_WHEN_INDEF(number);
+
 #if defined HAVE_MPFR && defined WITH_MPFR
        Lisp_Object bfrnumber;
 
-       if (!NILP(base)) {
-               Lisp_Object _logn, _logb;
-               _logn = Flog(number, Qnil, precision);
-               if (UNLIKELY(INDEFP(_logn))) {
-                       return _logn;
-               }
-               _logb = Flog(base, Qnil, precision);
-               return ent_binop(ASE_BINARY_OP_QUO, _logn, _logb);
-       }
-
-       if (INDEFP(number)) {
-               if (XINDEF_DATA(number) == POS_INFINITY) {
-                       return number;
-               } else if (XINDEF_DATA(number) == NEG_INFINITY) {
-                       return make_indef(NOT_A_NUMBER);
-               } else {
-                       return number;
-               }
-       }
-
        bigfr_set_prec(ent_scratch_bigfr,
                       internal_get_precision(precision));
 
        bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
-       bigfr_log(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
+       bigfr_log10(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
        return make_bigfr_bfr(ent_scratch_bigfr);
 
 #else  /* !HAVE_MPFR */
-       if (INDEFP(number)) {
-               goto indefcase;
-       }
-
        number = ent_lift(number, FLOAT_T, NULL);
 
+       RETURN_WHEN_INDEF(number);
+
        if (FLOATP(number)) {
                fpfloat d;
-               d = log(XFLOAT_DATA(number));
+#if HAVE_LOG10
+               d = log10(XFLOAT_DATA(number));
                return make_float(d);
-       } else if (INDEFP(number)) {
-       indefcase:
-               if (XINDEF_DATA(number) == POS_INFINITY) {
-                       return number;
-               } else if (XINDEF_DATA(number) == NEG_INFINITY) {
-                       return make_indef(NOT_A_NUMBER);
-               } else {
-                       return number;
-               }
+#elif HAVE_LOG2
+        static const fpflot log2_10 = log2(10);
+        d = log2(XFLOAT_DATA(number))/log2_10;
+               return make_float(d);
+#elif HAVE_LOG
+        static const fpflot log_10 - log(10);
+        d = log(XFLOAT_DATA(number))/log_10;
+               return make_float(d);
+#else
+        return ase_unary_operation_undefined(number);
+#endif
        }
 
        Fsignal(Qarith_error, list1(number));
@@ -851,51 +844,41 @@ If third optional argument PRECISION is given, use its value
 #endif /* HAVE_MPFR */
 }
 
-DEFUN("log10", Flog10, 1, 2, 0,        /*
-Return the logarithm base 10 of NUMBER.
+DEFUN("log2", Flog2, 1, 2, 0,  /*
+Return the logarithm base 2 of NUMBER.
 If second optional argument PRECISION is given, use its value
 (an integer) as precision.
 */
       (number, precision))
 {
+       RETURN_WHEN_INDEF(number);
+
 #if defined HAVE_MPFR && defined WITH_MPFR
        Lisp_Object bfrnumber;
 
-       if (INDEFP(number)) {
-               if (XINDEF_DATA(number) == POS_INFINITY)
-                       return number;
-               else if (XINDEF_DATA(number) == NEG_INFINITY)
-                       return make_indef(NOT_A_NUMBER);
-               else
-                       return number;
-       }
-
        bigfr_set_prec(ent_scratch_bigfr,
                       internal_get_precision(precision));
 
        bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
-       bigfr_log10(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
+       bigfr_log2(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
        return make_bigfr_bfr(ent_scratch_bigfr);
-
-#else  /* !HAVE_MPFR */
-       if (INDEFP(number)) {
-               goto indefcase;
-       }
-
+#else
        number = ent_lift(number, FLOAT_T, NULL);
 
+       RETURN_WHEN_INDEF(number);
+
        if (FLOATP(number)) {
                fpfloat d;
-               d = log10(XFLOAT_DATA(number));
+#if HAVE_LOG2
+               d = log2(XFLOAT_DATA(number));
                return make_float(d);
-       } else if (INDEFP(number)) {
-       indefcase:
-               if (XINDEF_DATA(number) == POS_INFINITY)
-                       return number;
-               else if (XINDEF_DATA(number) == NEG_INFINITY)
-                       return make_indef(NOT_A_NUMBER);
-               else
-                       return number;
+#elif HAVE_LOG
+        static const fpflot log_2 - log(2);
+        d = log(XFLOAT_DATA(number))/log_2;
+               return make_float(d);
+#else
+        return ase_unary_operation_undefined(number);
+#endif
        }
 
        Fsignal(Qarith_error, list1(number));
@@ -905,34 +888,78 @@ If second optional argument PRECISION is given, use its value
 #endif /* HAVE_MPFR */
 }
 
-#if defined HAVE_MPFR && defined WITH_MPFR
-DEFUN("log2", Flog2, 1, 2, 0,  /*
-Return the logarithm base 2 of NUMBER.
-If second optional argument PRECISION is given, use its value
+DEFUN("log", Flog, 1, 3, 0,    /*
+Return the natural logarithm of NUMBER.
+If second optional argument BASE is given, return the logarithm of
+NUMBER using that base.
+If third optional argument PRECISION is given, use its value
 (an integer) as precision.
 */
-      (number, precision))
+      (number, base, precision))
 {
-       Lisp_Object bfrnumber;
+       RETURN_WHEN_INDEF(number);
 
-       if (INDEFP(number)) {
-               if (XINDEF_DATA(number) == POS_INFINITY)
-                       return number;
-               else if (XINDEF_DATA(number) == NEG_INFINITY)
-                       return make_indef(NOT_A_NUMBER);
-               else
-                       return number;
+       if (INTEGERP(base)) {
+               switch(XINT(base)) {
+               case 2 : return Flog2 (number, precision);
+               case 10: return Flog10(number, precision);
+               default: break; /* Intentional Fall through */
+               }
        }
 
+
+#if defined HAVE_MPFR && defined WITH_MPFR
+       if (!NILP(base)) {
+               /* Not all bignumber libs optimize log2, for instance
+                  MPFR implements log2 in function of log. */
+               Lisp_Object _logn, _logb;
+               _logn = Flog(number, precision);
+               if (UNLIKELY(INDEFP(_logn))) {
+                       return _logn;
+               }
+               _logb = Flog2(base, precision);
+               return ent_binop(ASE_BINARY_OP_QUO, _logn, _logb);
+       }
+
+       Lisp_Object bfrnumber;
+
        bigfr_set_prec(ent_scratch_bigfr,
                       internal_get_precision(precision));
 
        bfrnumber = Fcoerce_number(number, Qbigfr, Qnil);
-       bigfr_log2(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
+       bigfr_log(ent_scratch_bigfr, XBIGFR_DATA(bfrnumber));
        return make_bigfr_bfr(ent_scratch_bigfr);
-}
+
+#else  /* !HAVE_MPFR */
+       if (!NILP(base)) {
+        /* Processor implementations tend to give an edge to log2 */
+               Lisp_Object _logn, _logb;
+               _logn = Flog2(number, precision);
+               if (UNLIKELY(INDEFP(_logn))) {
+                       return _logn;
+               }
+               _logb = Flog2(base, precision);
+               return ent_binop(ASE_BINARY_OP_QUO, _logn, _logb);
+       }
+
+       number = ent_lift(number, FLOAT_T, NULL);
+
+       RETURN_WHEN_INDEF(number);
+
+       if (FLOATP(number)) {
+               fpfloat d;
+               d = log(XFLOAT_DATA(number));
+               return make_float(d);
+       }
+
+       Fsignal(Qarith_error, list1(number));
+       return Qnil;
+
+       if (NILP(precision));
 #endif /* HAVE_MPFR */
+}
 
+#undef RETURN_WHEN_INDEF
 
 DEFUN("sqrt", Fsqrt, 1, 2, 0,  /*
 Return the square root of NUMBER.
@@ -2324,9 +2351,7 @@ void syms_of_floatfns(void)
 #endif
 #if defined(HAVE_FPFLOAT) || defined(HAVE_MPFR) && defined WITH_MPFR
        DEFSUBR(Flog);
-#if defined HAVE_MPFR && defined WITH_MPFR
        DEFSUBR(Flog2);
-#endif /* HAVE_MPFR */
        DEFSUBR(Flog10);
        DEFSUBR(Fsqrt);
        DEFSUBR(Fcube_root);