Merge branch 'fpe' into 'develop'

Floating point environment changes

See merge request embeddable-common-lisp/ecl!154

CHANGELOG

@@ -114,12 +114,6 @@ in C code
   is still referenced in the memory, it's programmer duty to call wait.
 - The ECL_OPT_SIGALTSTACK_SIZE option has been removed, because it had no
   effect.
-- A false value of the ECL_OPT_TRAP_SIGFPE option now prevents floating
-  point exception signals from being generated by default. In version
-  16.1.3, ECL would not change the options controlling the generation of
-  such signals and simply not install a signal handler for floating point
-  exceptions. This could lead to such signals being generated and caught by
-  another signal handler if ECL was used as an embedded library.
 - Non-standard package nicknames (USER for COMMON-LISP-USER and LISP for
   COMMON-LISP) have been removed.
 * 16.1.3 changes since 16.1.2

msvc/Makefile

@@ -385,9 +385,10 @@ install:
 	$(CP) ecl-config.bat "$(bindir)\ecl-config.bat"
 	$(CP) ecl-cc.bat "$(bindir)\ecl-cc.bat"
 	IF NOT EXIST "$(includedir)\ecl" $(MKDIR) "$(includedir)\ecl"
+	IF NOT EXIST "$(includedir)\ecl\impl" $(MKDIR) "$(includedir)\ecl\impl"
 	IF NOT EXIST "$(includedir)\ecl\gc" $(MKDIR) $(includedir)\ecl\gc
 	IF NOT EXIST "$(includedir)\ecl\gc\private" $(MKDIR) "$(includedir)\ecl\gc\private"
-	for %i in (ecl\*.h ecl\gc\*.h ecl\gc\private\*.h) do $(CP) %i $(includedir)\%i
+	for %i in (ecl\*.h ecl\impl\*.h ecl\gc\*.h ecl\gc\private\*.h) do $(CP) %i $(includedir)\%i
 	IF EXIST "$(include)\ecl\atomic_ops" rmdir /S /Q "$(include)\ecl\atomic_ops"
 	IF EXIST "ecl\atomic_ops" xcopy /S /Y "ecl\atomic_ops" "$(includedir)\atomic_ops\"
 	cd c

msvc/c/Makefile

@@ -71,8 +71,10 @@ HFILES	= ..\ecl\config.h ..\ecl\config-internal.h ..\ecl\atomic_ops.h \
 	$(HDIR)\external.h $(HDIR)\cons.h $(HDIR)\legacy.h \
 	$(HDIR)\number.h $(HDIR)\page.h \
 	$(HDIR)\internal.h $(HDIR)\ecl-inl.h $(HDIR)\bytecodes.h \
-	$(HDIR)\impl\math_dispatch.h $(HDIR)\cache.h $(HDIR)\stack-resize.h \
-	$(HDIR)\ecl-atomic-ops.h
+	$(HDIR)\impl\math_dispatch.h $(HDIR)\impl\math_dispatch2.h \
+	$(HDIR)\impl\math_fenv.h $(HDIR)\impl\math_fenv_msvc.h \
+	$(HDIR)\cache.h $(HDIR)\stack-resize.h \
+	$(HDIR)\ecl_atomics.h
 
 OBJS	= main.obj symbol.obj package.obj cons.obj list.obj\
 	apply.obj eval.obj \

msvc/ecl/config-internal.h.msvc6

@@ -79,16 +79,8 @@
 /* #undef HAVE_SIGPROCMASK */
 /* isatty() checks whether a file is connected to a                     */ 
 #define HAVE_ISATTY  1 
-/* can manipulate floating point environment				*/
-/* #undef HAVE_FENV_H */
-/* can activate individual traps in floating point environment		*/
-/* #undef HAVE_FEENABLEEXCEPT */
-/* do we want to deactivate all support for floating point exceptions   */
-/* #undef ECL_AVOID_FPE_H */
 /* do we want to have signed zeros					*/
 #define ECL_SIGNED_ZERO 1
-/* do we want NaNs and Infs						*/
-#define ECL_IEEE_FP 1
 /* has support for large files						*/
 /* #undef HAVE_FSEEKO */
 /* compiler understands long long                                       */ 

msvc/ecl/config.h.msvc6

@@ -203,8 +203,16 @@ typedef unsigned char ecl_base_char;
 /* compiler understands long double                                     */
 #define ECL_LONG_FLOAT
 /* compiler understands complex                                         */
-/* #undef HAVE_DOUBLE_COMPLEX */
-/* #undef HAVE_FLOAT_COMPLEX */
+/* #undef ECL_COMPLEX_FLOAT */
+
+/* do we want NaNs and Infs						*/
+#define ECL_IEEE_FP 1
+/* can manipulate floating point environment				*/
+/* #undef HAVE_FENV_H */
+/* can activate individual traps in floating point environment		*/
+/* #undef HAVE_FEENABLEEXCEPT */
+/* do we want to deactivate all support for floating point exceptions   */
+/* #undef ECL_AVOID_FPE_H */
 
 /* Missing integer types */
 #if _MSC_VER < 1600

src/c/symbols_list.h

@@ -1797,7 +1797,7 @@ cl_symbols[] = {
 {KEY_ "CDECL", KEYWORD, NULL, -1, OBJNULL},
 {KEY_ "STDCALL", KEYWORD, NULL, -1, OBJNULL},
 
-{SYS_ "TRAP-FPE", SI_ORDINARY, si_trap_fpe, 2, OBJNULL},
+{EXT_ "TRAP-FPE", EXT_ORDINARY, si_trap_fpe, 2, OBJNULL},
 
 {EXT_ "*ACTION-ON-UNDEFINED-VARIABLE*", EXT_SPECIAL, NULL, -1, ECL_NIL},
 

src/c/symbols_list2.h

@@ -1797,7 +1797,7 @@ cl_symbols[] = {
 {KEY_ "CDECL",NULL},
 {KEY_ "STDCALL",NULL},
 
-{SYS_ "TRAP-FPE","si_trap_fpe"},
+{EXT_ "TRAP-FPE","si_trap_fpe"},
 
 {EXT_ "*ACTION-ON-UNDEFINED-VARIABLE*",NULL},
 

src/c/unixint.d

@@ -1199,9 +1199,6 @@ cl_object
 si_trap_fpe(cl_object condition, cl_object flag)
 {
         cl_env_ptr the_env = ecl_process_env();
-#ifndef FE_ALL_EXCEPT
-# define FE_ALL_EXCEPT FE_DIVBYZERO | FE_OVERFLOW | FE_UNDERFLOW | FE_INVALID
-#endif
         const int all = FE_ALL_EXCEPT;
         int bits = 0;
         if (condition == @'last') {
@@ -1404,8 +1401,6 @@ install_fpe_signal_handlers()
 /*                 si_trap_fpe(@'division-by-zero', ECL_NIL); */
 /*                 si_trap_fpe(@'floating-point-overflow', ECL_NIL); */
 /* # endif */
-        } else {
-                si_trap_fpe(ECL_T, ECL_NIL);
         }
 #endif
 }

src/doc/manual/standards/numbers.txi

@@ -59,33 +59,37 @@ or the value is silently used as it is. There are multiple options
 controlling which behaviour is selected: If ECL is built with the
 @code{--with-ieee-fp=no} configure option, then a condition is
 signaled for every infinity or NaN encountered. If not, the behaviour
-can be controlled by @code{si:trap-fpe}. By default, a condition is
+can be controlled by @code{ext:trap-fpe}. By default, a condition is
 signaled for invalid operation, division by zero and floating point
 overflows. If the @code{ECL_OPT_TRAP_SIGFPE} option is false, no
 conditions are signaled by default (Note that in this case, if you
-enable trapping of floating point exceptions with @code{si:trap-fpe},
+enable trapping of floating point exceptions with @code{ext:trap-fpe},
 then you have to install your own signal handler).
 
-@lspindex si:trap-fpe
-@defun si:trap-fpe condition flag
+@lspindex ext:trap-fpe
+@defun ext:trap-fpe condition flag
 Control the signaling of the floating point exceptions
 
 @subsubheading Synopsis
 @table @var
 @item condition
-a symbol - one of @code{t}, @code{division-by-zero},
+a symbol - one of @code{last}, @code{t}, @code{division-by-zero},
 @code{floating-point-overflow}, @code{floating-point-underflow},
-@code{floating-point-invalid-operation} or
-@code{floating-point-inexact}
+@code{floating-point-invalid-operation},
+@code{floating-point-inexact} or an integer.
 @item flag
 a generalized boolean
 @end table
 
 @subsubheading Description
-If flag is true, arranges for the current thread to signal a
-@var{condition} if the corresponding floating point exception is
-detected in the future. If @var{condition} is @code{t}, the exceptions
-which are signaled by default are disabled or enabled all at once.
+If @var{condition} is @code{last}, @var{flag} is ignored and the
+currently enabled floating point exceptions are returned in an
+implementation depended format (currently an integer). Otherwise,
+@var{flag} determines whether current thread will signal a floating
+point exception for the conditions passed in @var{condition}.
+@var{condition} can be either a symbol denoting a single condition,
+@code{t} for all conditions that are enabled by default or a value
+obtained from an earlier call to @code{ext:trap-fpe} with @code{last}.
 @end defun
 
 @node Numbers - Random-States

src/doc/manual/user-guide/embedding.txi

@@ -214,3 +214,53 @@ This macro sets a thread-local flag indicating that all received signals can be
 @subsubheading See also
 @code{ecl_disable_interrupts} and @code{ecl_clear_interrupts}. 
 @end defmac
+
+@cppindex ECL_WITH_LISP_FPE
+@defmac ECL_WITH_LISP_FPE
+Execute Lisp code with correct floating point environment
+
+@subsubheading Description
+Unless floating point exceptions are disabled (via the
+@code{--without-fpe} configure option or @code{ECL_OPT_TRAP_SIGFPE}
+runtime option), ECL will change the floating point environment when
+booting. This macro allows for execution of Lisp code while saving and
+later restoring the floating point environment of surrounding C code
+so that changes in the floating point environment don't leak outside.
+
+@code{ECL_WITH_LISP_FPE} can be also used before ECL has booted or
+before ECL has been attached to a newly created thread.
+
+@exindex Safely executing Lisp code with floating point exceptions in embedding program
+@subsubheading Example
+@example
+@verbatim
+#include <ecl/ecl.h>
+#include <stdio.h>
+
+int main(int argc, char **argv) {
+  ECL_WITH_LISP_FPE_BEGIN {
+    cl_boot(argc, argv);
+  } ECL_WITH_LISP_FPE_END;
+
+  double a = 1.0 / 0.0;
+  double b;
+
+  ECL_WITH_LISP_FPE_BEGIN {
+    cl_object form = ecl_read_from_cstring("(handler-case"
+                                               "(/ 1d0 0d0)"
+                                             "(division-by-zero () 0d0))");
+    b = ecl_to_double(si_safe_eval(3, form, ECL_NIL, ECL_NIL));
+  } ECL_WITH_LISP_FPE_END;
+
+  printf("%g %g\n", a, b);
+
+  cl_shutdown();
+  return 0;
+}
+@end verbatim
+@end example
+will output
+@verbatim
+inf 0
+@end verbatim
+@end defmac

src/h/config-internal.h.in

@@ -106,16 +106,6 @@
 #endif
 /* isatty() checks whether a file is connected to a			*/
 #undef HAVE_ISATTY
-/* can manipulate floating point environment				*/
-#undef HAVE_FENV_H
-/* can activate individual traps in floating point environment          */
-/* this flag has to be deactivated for the Itanium architecture, where  */
-/* the GNU libc functions are broken                                    */
-#if !defined(__ia64__) && !defined(PPC)
-#undef HAVE_FEENABLEEXCEPT
-#endif
-/* do we want to deactivate all support for floating point exceptions   */
-#undef ECL_AVOID_FPE_H
 /* do we want to have signed zeros                                      */
 #undef ECL_SIGNED_ZERO
 /* has support for large files                                          */
@@ -165,19 +155,6 @@
 #undef HAVE_BACKTRACE_SYMBOLS
 #undef HAVE_SCHED_H
 
-/*
- * we do not manage to get proper signal handling of floating point
- * arithmetics in the Alpha chips.
- */
-#if defined(__alpha__)
-# ifdef HAVE_FENV_H
-#  undef HAVE_FENV_H
-# endif
-# ifdef HAVE_FEENABLEEXCEPT
-#  undef HAVE_FEENABLEEXCEPT
-# endif
-#endif
-
 /* what characters are used to mark beginning of new line               */
 #undef ECL_NEWLINE_IS_CRLF
 #undef ECL_NEWLINE_IS_LFCR

src/h/config.h.in

@@ -221,6 +221,15 @@ typedef unsigned char ecl_base_char;
 /* Use the serialization framework                                      */
 #undef ECL_EXTERNALIZABLE
 
+/* do we want to deactivate all support for floating point exceptions   */
+#undef ECL_AVOID_FPE_H
+
+/* can manipulate floating point environment				*/
+#undef HAVE_FENV_H
+
+/* feenableexcept is available */
+#undef HAVE_FEENABLEEXCEPT
+
 /*
  * C macros for inlining, denoting probable code paths and other stuff
  * that makes better code. Most of it is GCC specific.

src/h/ecl.h

@@ -89,6 +89,7 @@
 #include <ecl/stacks.h>
 #include <ecl/number.h>
 #include <ecl/legacy.h>
+#include <ecl/impl/math_fenv.h>
 
 typedef void (*ecl_init_function_t)(cl_object block);
 

src/h/impl/math_fenv.h

@@ -66,6 +66,27 @@
 # define feclearexcept(x)
 #endif /* !HAVE_FENV_H */
 
+#ifndef FE_ALL_EXCEPT
+# define FE_ALL_EXCEPT FE_DIVBYZERO | FE_OVERFLOW | FE_UNDERFLOW | FE_INVALID
+#endif
+
+#if defined(HAVE_FENV_H) && !defined(ECL_AVOID_FPE_H) && defined(HAVE_FEENABLEEXCEPT)
+# define ECL_WITH_LISP_FPE_BEGIN do { \
+        fenv_t __fenv; \
+        fegetenv(&__fenv); \
+        cl_env_ptr __the_env = ecl_process_env_unsafe(); \
+        if (__the_env) { \
+                int bits = __the_env->trap_fpe_bits;    \
+                fedisableexcept(FE_ALL_EXCEPT & ~bits); \
+                feenableexcept(FE_ALL_EXCEPT & bits); \
+        }
+# define ECL_WITH_LISP_FPE_END \
+        fesetenv(&__fenv); } while (0)
+#else
+# define ECL_WITH_LISP_FPE_BEGIN do {
+# define ECL_WITH_LISP_FPE_END } while (0)
+#endif
+
 #if defined(HAVE_FENV_H) && !defined(HAVE_FEENABLEEXCEPT) && !defined(ECL_AVOID_FPE_H)
 # define ECL_USED_EXCEPTIONS (FE_DIVBYZERO|FE_INVALID|FE_OVERFLOW|FE_UNDERFLOW)
 # define ECL_MATHERR_CLEAR feclearexcept(FE_ALL_EXCEPT)
@@ -77,35 +98,6 @@
 # define ECL_MATHERR_TEST
 #endif
 
-#if defined(__APPLE__) && defined(__amd64__)
-#define feclearexcept myfeclearexcept
-static inline void myfeclearexcept(int flags)
-{
-    int aux;
-    int f = ~(0x3d);
-    __asm__ (
-    "fnclex  \n\t"
-    "stmxcsr %0\n\t"
-    "andl    %1,%0\n\t"
-    "ldmxcsr %0\n\t"
-    : "=m"(aux) : "a"(f));
-}
-#define fetestexcept myfetestexcept
-static inline int myfetestexcept(cl_fixnum flags)
-{
-    cl_fixnum output = (flags & 0x3d);
-    int sw;
-    __asm__ (
-    "fnstsw  %0\n\t"
-    "movzwl  %0,%%eax\n\t"
-    "stmxcsr %0\n\t"
-    "orl     %0,%%eax\n\t"
-    "and     %%rax,%1\n\t"
-    : "=m"(sw), "=d"(output) : "d"(output) : "%rax");
-    return output;
-}
-#endif /* __APPLE__ && __amd64__ */
-
 extern void ecl_deliver_fpe(int flags);
 
 #endif /* !ECL_MATH_FENV_H */

src/h/impl/math_fenv_msvc.h

@@ -18,8 +18,12 @@
 #ifndef ECL_MATH_FENV_MSVC_H
 #define ECL_MATH_FENV_MSVC_H
 
-#define HAVE_FEENABLEEXCEPT
-#define HAVE_FENV_H
+#ifndef HAVE_FEENABLEEXCEPT
+# define HAVE_FEENABLEEXCEPT
+#endif
+#ifndef HAVE_FENV_H
+# define HAVE_FENV_H
+#endif
 
 #include <float.h>
 
@@ -45,6 +49,7 @@ typedef int fenv_t;
     int cw = _controlfp(0,0); cw |= (bits); _controlfp(cw,MCW_EM); } while(0)
 #define feholdexcept(bits) do { \
     *(bits) = _controlfp(0,0); _controlfp(0xffffffff, MCW_EM); } while(0)
+#define fegetenv(bits) do { *(bits) = _controlfp(0,0); } while (0)
 #define fesetenv(bits) do { _controlfp(*(bits), MCW_EM); } while (0)
 #define feupdateenv(bits) fesetenv(bits)
 #define feclearexcept(bits) _clearfp()