Add fmod as primitive FLONUM-MODULO.

diff --git a/src/microcode/configure.ac b/src/microcode/configure.ac
index 3e2e3a32b53a9bf6b93afee311fbb4e9a06ba3f2..bd05c00cfdbf46e2a9ea73e64a0981cb03fda2d0 100644 (file)
--- a/src/microcode/configure.ac
+++ b/src/microcode/configure.ac
@@ -524,8 +524,8 @@ AC_CHECK_FUNCS([expm1])
 AC_CHECK_FUNCS([fcntl fdatasync feclearexcept fedisableexcept feenableexcept])
 AC_CHECK_FUNCS([fegetenv fegetexcept fegetexceptflag fegetround feholdexcept])
 AC_CHECK_FUNCS([feraiseexcept fesetenv fesetexceptflag fesetround])
-AC_CHECK_FUNCS([fetestexcept feupdateenv floor fpathconf frexp fpgetround])
-AC_CHECK_FUNCS([fpsetround fsync fsync_range ftruncate])
+AC_CHECK_FUNCS([fetestexcept feupdateenv floor fmod fpathconf fpgetround])
+AC_CHECK_FUNCS([fpsetround frexp fsync fsync_range ftruncate])
 AC_CHECK_FUNCS([getcwd gethostbyname gethostname getlogin getpagesize getpgrp])
 AC_CHECK_FUNCS([getpt gettimeofday getwd grantpt])
 AC_CHECK_FUNCS([kill])

diff --git a/src/microcode/flonum.c b/src/microcode/flonum.c
index 0c2ad1b5757841755be8ac0d51aab7ba68d12a16..26c45a1830097b0e9ecc42118abb1139c0091ab2 100644 (file)
--- a/src/microcode/flonum.c
+++ b/src/microcode/flonum.c
@@ -81,6 +81,24 @@ DEFINE_PRIMITIVE ("FLONUM-DIVIDE", Prim_flonum_divide, 2, 2, 0)
   }
 }
 
+DEFINE_PRIMITIVE ("FLONUM-MODULO", Prim_flonum_modulo, 2, 2, 0)
+#ifdef HAVE_FMOD
+{
+  PRIMITIVE_HEADER (2);
+  {
+    double denominator = (arg_flonum (2));
+    if (denominator == 0)
+      error_bad_range_arg (2);
+    FLONUM_RESULT (fmod ((arg_flonum (1)), denominator));
+  }
+}
+#else
+{
+  error_unimplemented_primitive ();
+  PRIMITIVE_RETURN (UNSPECIFIC);
+}
+#endif
+
 DEFINE_PRIMITIVE ("FLONUM-NEGATE", Prim_flonum_negate, 1, 1, 0)
 {
   PRIMITIVE_HEADER (1);

diff --git a/src/microcode/ntutl/config.h b/src/microcode/ntutl/config.h
index ba3744058fbed9a4eb1cc8aba2e3b6f0a1a73042..57e38fca15f9b6e4e917458861d45444f123e5a0 100644 (file)
--- a/src/microcode/ntutl/config.h
+++ b/src/microcode/ntutl/config.h
@@ -121,6 +121,9 @@ typedef unsigned char cc_t;
 /* Define if you have the floor function.  */
 #define HAVE_FLOOR 1
 
+/* Define if you have the fmod function.  */
+#define HAVE_FMOD 1
+
 /* Define if you have the frexp function.  */
 #define HAVE_FREXP 1
 

diff --git a/src/microcode/os2utl/config.h b/src/microcode/os2utl/config.h
index 08630064937ee4a4bd1c5c4bfbc027478533e773..cbe17f5e81cc7a6cfb8049b6dd52226ababeed68 100644 (file)
--- a/src/microcode/os2utl/config.h
+++ b/src/microcode/os2utl/config.h
@@ -57,6 +57,9 @@ typedef unsigned char cc_t;
 /* Define if you have the floor function.  */
 #define HAVE_FLOOR 1
 
+/* Define if you have the fmod function.  */
+#define HAVE_FMOD 1
+
 /* Define if you have the frexp function.  */
 #define HAVE_FREXP 1