Insert FWAIT routines in make_{short,long}float to detect floating point exceptions under x86

src/CHANGELOG

@@ -67,9 +67,9 @@ ECL 0.9h
    applications must be compiled and linked against ECL so that the
    appropiate replacements for pthread_create()/CreateThread() are used.
 
- - On systems with GNU libc, we are able to signal and trap floating point
+ - On some systems we are able to signal and trap floating point
    exceptions of the following kinds: overflow, underflow and division by zero.
-   Trapping of these exceptions can be disabled with (SI::TRAP-FPE NIL). In
+   Trapping of these exceptions can be disabled with (SI::TRAP-FPE T NIL). In
    practice this means overflows in routines like EXP, EXPT, etc, are now
    detected.
 

src/aclocal.m4

@@ -531,3 +531,22 @@ AC_TRY_COMPILE(,[static __thread void *data;],
 dnl We deactivate this test because it seems to slow down ECL A LOT!!!
 ac_cv_ecl___thread=no
 ])
+
+dnl ----------------------------------------------------------------------
+dnl Choose the type of code to detect floating point exceptions and
+dnl raise them.
+dnl
+AC_DEFUN([ECL_FPE_MODEL],
+[AC_MSG_CHECKING([for code to detect FP exceptions])
+case "${host_cpu}" in
+   i686 |i586 | pentium* | athlon* )
+	ECL_FPE_CODE="${srcdir}/c/arch/fpe_x86.c"
+	AC_MSG_RESULT([x86])
+	;;
+   *)
+        ECL_FPE_CODE="${srcdir}/c/arch/fpe_none.c"
+	AC_MSG_RESULT([not available])
+	;;
+esac
+AC_SUBST(ECL_FPE_CODE)
+])

src/c/arch/fpe_none.c

@@ -0,0 +1,26 @@
+/*
+    fpe_none.c -- Nonportable component of the floating point code (dummy)
+*/
+/*
+    Copyright (c) 2005, Juan Jose Garcia Ripoll.
+
+    ECL is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+/*
+ * The ecl_detect_fpe() is a macro (or a function) that detects whether a
+ * floating point exception has been produced in a recent time. Currently
+ * it is of great importance in the x86 architecture because exceptions
+ * are not signaled on the instruction that originates the problem, but on
+ * the next FP instruction. However, we could conceivably write a more
+ * complex code on architectures that do not signal FP exceptions by
+ * checking the control word of the FPU and doing the dispatching ourselves
+ * instead of using signal().
+ */
+
+#define ecl_detect_fpe() (void)0

src/c/arch/fpe_x86.c

@@ -0,0 +1,25 @@
+/*
+    fpe_x86.c -- Nonportable component of the floating point code
+*/
+/*
+    Copyright (c) 2005, Juan Jose Garcia Ripoll.
+
+    ECL is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public
+    License as published by the Free Software Foundation; either
+    version 2 of the License, or (at your option) any later version.
+
+    See file '../Copyright' for full details.
+*/
+
+/*
+ * See fpe_none.c for a description
+ */
+
+#ifdef _MSVC
+#define ecl_detect_fpe() __asm fwait
+#endif
+
+#ifdef __GNUC__
+#define ecl_detect_fpe() asm("fwait")
+#endif

src/c/number.d

@@ -136,10 +136,15 @@ make_shortfloat(float f)
 {
 	cl_object x;
 
+	ecl_detect_fpe();
 	if (f == (float)0.0)
 		return(cl_core.shortfloat_zero);
-	if (isnanf(f) || !finite(f))
-		FEerror("Not a number.",0);
+	if (isnanf(f)) {
+		cl_error(1, @'division-by-zero');
+	}
+	if (!finite(f)) {
+		cl_error(1, @'floating-point-overflow');
+	}
 	x = cl_alloc_object(t_shortfloat);
 	sf(x) = f;
 	return(x);
@@ -150,10 +155,15 @@ make_longfloat(double f)
 {
 	cl_object x;
 
+	ecl_detect_fpe();
 	if (f == (double)0.0)
 		return(cl_core.longfloat_zero);
-	if (isnan(f) || !finite(f))
-		FEerror("Not a number.",0);
+	if (isnan(f)) {
+		cl_error(1, @'division-by-zero');
+	}
+	if (!finite(f)) {
+		cl_error(1, @'floating-point-overflow');
+	}
 	x = cl_alloc_object(t_longfloat);
 	lf(x) = f;
 	return(x);

src/configure

@@ -310,7 +310,7 @@ ac_includes_default="\
 # include <unistd.h>
 #endif"
 
-ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS docdir buildir ECL_CFLAGS FASL_LIBS CORE_LIBS SHARED_LDFLAGS BUNDLE_LDFLAGS SHORT_SITE_NAME LONG_SITE_NAME EXTRA_OBJS TARGETS SUBDIRS LIBRARIES LSP_LIBRARIES LSP_FEATURES build build_cpu build_vendor build_os host host_cpu host_vendor host_os CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CXX CXXFLAGS ac_ct_CXX CPP RANLIB ac_ct_RANLIB INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA LN_S SET_MAKE true_srcdir true_builddir CP RM MV EXE_SUFFIX ARCHITECTURE SOFTWARE_TYPE SOFTWARE_VERSION MACHINE_INSTANCE MACHINE_VERSION LDRPATH LIBPREFIX LIBEXT SHAREDEXT SHAREDPREFIX INSTALL_TARGET thehost INFOEXT INSTALL_INFO EGREP ECL_SETJMP ECL_LONGJMP ECL_FILE_CNT CL_FIXNUM_TYPE CL_FIXNUM_BITS CL_FIXNUM_MAX CL_FIXNUM_MIN LIBOBJS POW_LIB ECL_CC CLX_INFO LTLIBOBJS'
+ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS docdir buildir ECL_CFLAGS FASL_LIBS CORE_LIBS SHARED_LDFLAGS BUNDLE_LDFLAGS SHORT_SITE_NAME LONG_SITE_NAME EXTRA_OBJS TARGETS SUBDIRS LIBRARIES LSP_LIBRARIES LSP_FEATURES build build_cpu build_vendor build_os host host_cpu host_vendor host_os CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CXX CXXFLAGS ac_ct_CXX CPP RANLIB ac_ct_RANLIB INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA LN_S SET_MAKE true_srcdir true_builddir CP RM MV EXE_SUFFIX ARCHITECTURE SOFTWARE_TYPE SOFTWARE_VERSION MACHINE_INSTANCE MACHINE_VERSION LDRPATH LIBPREFIX LIBEXT SHAREDEXT SHAREDPREFIX INSTALL_TARGET thehost INFOEXT INSTALL_INFO EGREP ECL_SETJMP ECL_LONGJMP ECL_FILE_CNT ECL_FPE_CODE CL_FIXNUM_TYPE CL_FIXNUM_BITS CL_FIXNUM_MAX CL_FIXNUM_MIN LIBOBJS POW_LIB ECL_CC CLX_INFO LTLIBOBJS'
 ac_subst_files=''
 
 # Initialize some variables set by options.
@@ -6881,6 +6881,22 @@ _ACEOF
 
 fi
 
+echo "$as_me:$LINENO: checking for code to detect FP exceptions" >&5
+echo $ECHO_N "checking for code to detect FP exceptions... $ECHO_C" >&6
+case "${host_cpu}" in
+   i686 |i586 | pentium* | athlon* )
+	ECL_FPE_CODE="${srcdir}/c/arch/fpe_x86.c"
+	echo "$as_me:$LINENO: result: x86" >&5
+echo "${ECHO_T}x86" >&6
+	;;
+   *)
+        ECL_FPE_CODE="${srcdir}/c/arch/fpe_none.c"
+	echo "$as_me:$LINENO: result: not available" >&5
+echo "${ECHO_T}not available" >&6
+	;;
+esac
+
+
 
 
   echo "$as_me:$LINENO: checking whether stack growns downwards" >&5
@@ -10498,6 +10514,7 @@ s,@EGREP@,$EGREP,;t t
 s,@ECL_SETJMP@,$ECL_SETJMP,;t t
 s,@ECL_LONGJMP@,$ECL_LONGJMP,;t t
 s,@ECL_FILE_CNT@,$ECL_FILE_CNT,;t t
+s,@ECL_FPE_CODE@,$ECL_FPE_CODE,;t t
 s,@CL_FIXNUM_TYPE@,$CL_FIXNUM_TYPE,;t t
 s,@CL_FIXNUM_BITS@,$CL_FIXNUM_BITS,;t t
 s,@CL_FIXNUM_MAX@,$CL_FIXNUM_MAX,;t t

src/configure.in

@@ -338,6 +338,7 @@ ECL_LINEFEED_MODE
 ECL_FIND_SETJMP
 ECL_FILE_STRUCTURE
 ECL_FFI
+ECL_FPE_MODEL
 
 dnl -----------------------------------------------------------------------
 dnl Study the call conventions

src/h/config.h.in

@@ -275,3 +275,5 @@ typedef unsigned @CL_FIXNUM_TYPE@ cl_hashkey;
 #endif /* MSDOS */
 
 #define ECL_ARCHITECTURE "@ARCHITECTURE@"
+
+#include "@ECL_FPE_CODE@"