mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2025-12-15 15:21:03 -08:00
Code Issues Projects Releases Packages Wiki Activity

ieee-fp: introduce new macro for toggling between Lisp and C fpe

Browse source 
This is primarly useful for embedding. Lisp code can be safely
executed without leaking the floating point environment into other C
code.
This commit is contained in:
Marius Gerbershagen 2019-06-21 20:10:09 +02:00
parent 06f0a93421
commit b891630699
11 changed files with 104 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

3
msvc/Makefile
View file

@ -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

6
msvc/c/Makefile
View file

@ -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 \

8
msvc/ecl/config-internal.h.msvc6
View file

@ -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 */

12
msvc/ecl/config.h.msvc6
View file

@ -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

3
src/c/unixint.d
View file

@ -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') {

50
src/doc/manual/user-guide/embedding.txi
View file

@ -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

5
src/h/config-internal.h.in
View file

@ -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 */

9
src/h/config.h.in
View file

@ -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.

1
src/h/ecl.h
View file

@ -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);

21
src/h/impl/math_fenv.h
View file

@ -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)

9
src/h/impl/math_fenv_msvc.h
View file

@ -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()