From 4ad597b04b5edc1fd5f593e07a0cf22b04c932c0 Mon Sep 17 00:00:00 2001 From: Joe Marshall Date: Thu, 2 Aug 2012 10:34:45 -0700 Subject: [PATCH] Add fmod as primitive FLONUM-MODULO. --- src/microcode/configure.ac | 4 ++-- src/microcode/flonum.c | 18 ++++++++++++++++++ src/microcode/ntutl/config.h | 3 +++ src/microcode/os2utl/config.h | 3 +++ 4 files changed, 26 insertions(+), 2 deletions(-) diff --git a/src/microcode/configure.ac b/src/microcode/configure.ac index 3e2e3a32b..bd05c00cf 100644 --- 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 0c2ad1b57..26c45a183 100644 --- 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 ba3744058..57e38fca1 100644 --- 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 086300649..cbe17f5e8 100644 --- 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 -- 2.25.1