From b8916306993e9ab9b5af9ee3405837ac58f959e0 Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Fri, 21 Jun 2019 20:10:09 +0200 Subject: [PATCH 1/4] ieee-fp: introduce new macro for toggling between Lisp and C fpe This is primarly useful for embedding. Lisp code can be safely executed without leaking the floating point environment into other C code. --- msvc/Makefile | 3 +- msvc/c/Makefile | 6 ++- msvc/ecl/config-internal.h.msvc6 | 8 ---- msvc/ecl/config.h.msvc6 | 12 +++++- src/c/unixint.d | 3 -- src/doc/manual/user-guide/embedding.txi | 50 +++++++++++++++++++++++++ src/h/config-internal.h.in | 5 --- src/h/config.h.in | 9 +++++ src/h/ecl.h | 1 + src/h/impl/math_fenv.h | 21 +++++++++++ src/h/impl/math_fenv_msvc.h | 9 ++++- 11 files changed, 104 insertions(+), 23 deletions(-) diff --git a/msvc/Makefile b/msvc/Makefile index 46822a52b..988c86c00 100755 --- a/msvc/Makefile +++ b/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 diff --git a/msvc/c/Makefile b/msvc/c/Makefile index 141c18aa6..07a7db8f1 100755 --- a/msvc/c/Makefile +++ b/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 \ diff --git a/msvc/ecl/config-internal.h.msvc6 b/msvc/ecl/config-internal.h.msvc6 index 758d3977a..49c023043 100644 --- a/msvc/ecl/config-internal.h.msvc6 +++ b/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 */ diff --git a/msvc/ecl/config.h.msvc6 b/msvc/ecl/config.h.msvc6 index 906cb68ec..51e4bf4f8 100755 --- a/msvc/ecl/config.h.msvc6 +++ b/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 diff --git a/src/c/unixint.d b/src/c/unixint.d index 4c5256ab7..c69ba57e5 100644 --- a/src/c/unixint.d +++ b/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') { diff --git a/src/doc/manual/user-guide/embedding.txi b/src/doc/manual/user-guide/embedding.txi index 2516b5fbd..ed6bcf82f 100644 --- a/src/doc/manual/user-guide/embedding.txi +++ b/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 +#include + +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 diff --git a/src/h/config-internal.h.in b/src/h/config-internal.h.in index dbe4b8551..ed39ed7fc 100644 --- a/src/h/config-internal.h.in +++ b/src/h/config-internal.h.in @@ -106,16 +106,11 @@ #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 */ diff --git a/src/h/config.h.in b/src/h/config.h.in index 833f02f7f..7f2d8ddca 100644 --- a/src/h/config.h.in +++ b/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. diff --git a/src/h/ecl.h b/src/h/ecl.h index dc2cb0f44..7825895b4 100644 --- a/src/h/ecl.h +++ b/src/h/ecl.h @@ -89,6 +89,7 @@ #include #include #include +#include typedef void (*ecl_init_function_t)(cl_object block); diff --git a/src/h/impl/math_fenv.h b/src/h/impl/math_fenv.h index 3c072852a..26306fd27 100644 --- a/src/h/impl/math_fenv.h +++ b/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) diff --git a/src/h/impl/math_fenv_msvc.h b/src/h/impl/math_fenv_msvc.h index 46c736605..6c50a9cc5 100644 --- a/src/h/impl/math_fenv_msvc.h +++ b/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 @@ -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() From 34f26e8b71aa73fe5e7708ced2dea3ab86246295 Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Tue, 25 Jun 2019 20:49:05 +0200 Subject: [PATCH 2/4] si:trap-fpe: move into ext package and extend documentation --- src/c/symbols_list.h | 2 +- src/c/symbols_list2.h | 2 +- src/doc/manual/standards/numbers.txi | 26 +++++++++++++++----------- 3 files changed, 17 insertions(+), 13 deletions(-) diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index 9b8c3e79c..b9c054f70 100755 --- a/src/c/symbols_list.h +++ b/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}, diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h index a70a355b1..3dbcaa66b 100644 --- a/src/c/symbols_list2.h +++ b/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}, diff --git a/src/doc/manual/standards/numbers.txi b/src/doc/manual/standards/numbers.txi index affdb2d56..d6f6eba93 100644 --- a/src/doc/manual/standards/numbers.txi +++ b/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 From 9a2ea399874fcf988f5914e1ca1ad20483d8f43f Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Tue, 25 Jun 2019 20:51:30 +0200 Subject: [PATCH 3/4] Revert "prevent floating point exception signals if ECL_OPT_TRAP_SIGFPE is false" This reverts commit 2a9084b105caf26c89bb16ed4dd0bf5aa7ceab59. It turned out that #347 was caused by the Maxima computer algebra system enabling floating point exceptions via si:trap-fpe (see https://trac.sagemath.org/ticket/22191). Hence we can revert to the less intrusive behaviour of not changing the floating point environment if ECL_OPT_TRAP_SIGFPE is false. --- CHANGELOG | 6 ------ src/c/unixint.d | 2 -- 2 files changed, 8 deletions(-) diff --git a/CHANGELOG b/CHANGELOG index 882bab36d..e2a66680c 100644 --- a/CHANGELOG +++ b/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 diff --git a/src/c/unixint.d b/src/c/unixint.d index c69ba57e5..8b0617f5c 100644 --- a/src/c/unixint.d +++ b/src/c/unixint.d @@ -1401,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 } From d1718a1f7ecce5ec53008223d75212c26974f837 Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Sun, 30 Jun 2019 12:55:45 +0200 Subject: [PATCH 4/4] ieee-fp: remove old floating point environment workarounds It is better to let the user disable these features with configure options than having a bunch of unmaintained workarounds lying around. --- src/h/config-internal.h.in | 18 ------------------ src/h/impl/math_fenv.h | 29 ----------------------------- 2 files changed, 47 deletions(-) diff --git a/src/h/config-internal.h.in b/src/h/config-internal.h.in index ed39ed7fc..a18e8107a 100644 --- a/src/h/config-internal.h.in +++ b/src/h/config-internal.h.in @@ -106,11 +106,6 @@ #endif /* isatty() checks whether a file is connected to a */ #undef HAVE_ISATTY -/* 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 have signed zeros */ #undef ECL_SIGNED_ZERO /* has support for large files */ @@ -160,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 diff --git a/src/h/impl/math_fenv.h b/src/h/impl/math_fenv.h index 26306fd27..a97b8409c 100644 --- a/src/h/impl/math_fenv.h +++ b/src/h/impl/math_fenv.h @@ -98,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 */