improve support for floating point exceptions.

C/exec.c

@@ -1078,7 +1078,7 @@ exec_absmi(bool top, yap_reset_t reset_mode USES_REGS)
 	/* must be done here, otherwise siglongjmp will clobber all the registers */
 	Yap_Error(LOCAL_matherror ,TermNil,NULL);
 	/* reset the registers so that we don't have trash in abstract machine */
-	Yap_set_fpu_exceptions(yap_flags[LANGUAGE_MODE_FLAG] == 1);
+	Yap_set_fpu_exceptions(true);
 	P = (yamop *)FAILCODE;
 	LOCAL_PrologMode = UserMode;
       }

C/sysbits.c

@@ -107,7 +107,7 @@ static Int p_srandom( USES_REGS1 );
 static Int p_alarm( USES_REGS1 );
 static Int p_getenv( USES_REGS1 );
 static Int p_putenv( USES_REGS1 );
-static void  set_fpu_exceptions(int);
+static bool set_fpu_exceptions(bool);
 #ifdef MACYAP
 static int chdir(char *);
 /* #define signal	skel_signal */
@@ -1424,8 +1424,23 @@ HandleMatherr(int  sig, void *sipv, void *uapv)
   yap_error_number error_no;
 
   /* reset the registers so that we don't have trash in abstract machine */
+#if HAVE_FETESTEXCEPT
+  int raised = fetestexcept(FE_ALL_EXCEPT);
 
-#if (defined(__svr4__) || defined(__SVR4))
+  if (raised & FE_OVERFLOW) {
+    LOCAL_matherror  = EVALUATION_ERROR_FLOAT_OVERFLOW;
+  } else if (raised & (FE_INVALID|FE_INEXACT)) {
+    LOCAL_matherror  = EVALUATION_ERROR_UNDEFINED;
+  } else if (raised & FE_DIVBYZERO) {
+    LOCAL_matherror  = EVALUATION_ERROR_ZERO_DIVISOR;
+  } else if (raised & FE_UNDERFLOW) {
+    LOCAL_matherror  = EVALUATION_ERROR_FLOAT_UNDERFLOW;
+  } else
+    LOCAL_matherror  = EVALUATION_ERROR_UNDEFINED;
+  if (!feclearexcept())
+    return;
+  Yap_Error(LOCAL_matherror , TermNil, "Arithmetic Exception");
+#elif (defined(__svr4__) || defined(__SVR4))
   switch(sip->si_code) {
   case FPE_INTDIV:
     error_no = EVALUATION_ERROR_ZERO_DIVISOR;
@@ -2164,10 +2179,7 @@ p_system ( USES_REGS1 )
 /* Rename a file */
 /** @pred  rename(+ _F_,+ _G_) 
 
-
 Renames file  _F_ to  _G_.
-
- 
 */
 static Int
 p_mv ( USES_REGS1 )
@@ -2526,11 +2538,17 @@ p_virtual_alarm( USES_REGS1 )
 #endif
 
 /* by default Linux with glibc is IEEE compliant anyway..., but we will pretend it is not. */
-static void
+static bool
-set_fpu_exceptions(int flag)
+set_fpu_exceptions(bool flag)
 {
   if (flag) {
-#if defined(__hpux)
+#if HAVE_FESETEXCEPTFLAG
+      fexcept_t excepts;
+      return fesetexceptflag(&excepts, FE_DIVBYZERO| FE_UNDERFLOW|FE_OVERFLOW) == 0;
+#elif HAVE_FEENABLEEXCEPT
+      /* I shall ignore de-normalization and precision errors */
+  feenableexcept(FE_DIVBYZERO| FE_INVALID|FE_OVERFLOW);
+#elif defined(__hpux)
 # if HAVE_FESETTRAPENABLE
 /* From HP-UX 11.0 onwards: */
       fesettrapenable(FE_INVALID|FE_DIVBYZERO|FE_OVERFLOW|FE_UNDERFLOW);
@@ -2560,7 +2578,13 @@ set_fpu_exceptions(int flag)
 #endif
   } else {
     /* do IEEE arithmetic in the way the big boys do */
-#if defined(__hpux)
+#if HAVE_FESETEXCEPTFLAG
+      fexcept_t excepts;
+      return fesetexceptflag(&excepts, 0) == 0;
+#elif HAVE_FEENABLEEXCEPT
+      /* I shall ignore de-normalization and precision errors */
+      feenableexcept(0);
+#elif defined(__hpux)
 # if HAVE_FESETTRAPENABLE
       fesettrapenable(FE_ALL_EXCEPT);
 # else
@@ -2576,21 +2600,22 @@ set_fpu_exceptions(int flag)
       my_signal (SIGFPE, SIG_IGN);
 #endif
   }
+  return true;
 }
 
-void
+bool
-Yap_set_fpu_exceptions(int flag)
+Yap_set_fpu_exceptions(bool flag)
 {
-  set_fpu_exceptions(flag);
+  return set_fpu_exceptions(flag);
 }
+
 static Int
 p_set_fpu_exceptions( USES_REGS1 ) {
-  if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {
+  if (Deref(ARG1) == MkAtomTerm(AtomTrue)) {
-    set_fpu_exceptions(FALSE); /* can't make it work right */
+    return set_fpu_exceptions(true);
   } else {
-    set_fpu_exceptions(FALSE);
+    return set_fpu_exceptions( false );
   }
-  return(TRUE);
 }
 
 static Int
@@ -2989,7 +3014,7 @@ Yap_InitSysPreds(void)
   Yap_InitCPred ("$alarm", 4, p_alarm, SafePredFlag|SyncPredFlag);
   Yap_InitCPred ("$getenv", 2, p_getenv, SafePredFlag);
   Yap_InitCPred ("$putenv", 2, p_putenv, SafePredFlag|SyncPredFlag);
-  Yap_InitCPred ("$set_fpu_exceptions", 0, p_set_fpu_exceptions, SafePredFlag|SyncPredFlag);
+  Yap_InitCPred ("$set_fpu_exceptions", 	1, p_set_fpu_exceptions, SafePredFlag|SyncPredFlag);
   Yap_InitCPred ("$host_type", 1, p_host_type, SafePredFlag|SyncPredFlag);
   Yap_InitCPred ("$env_separator", 1, p_env_separator, SafePredFlag);
   Yap_InitCPred ("$unix", 0, p_unix, SafePredFlag);

H/Yapproto.h

@@ -364,7 +364,7 @@ int	Yap_IsOpMaxPrio(Atom);
 
 /* sysbits.c */
 void    Yap_InitPageSize(void);
-void	Yap_set_fpu_exceptions(int);
+bool	Yap_set_fpu_exceptions(bool);
 UInt	Yap_cputime(void);
 Int	Yap_walltime(void);
 int	Yap_dir_separator(int);

config.h.in

@@ -226,9 +226,18 @@
 /* Define to 1 if you have the `feclearexcept' function. */
 #undef HAVE_FECLEAREXCEPT
 
+/* Define to 1 if you have the `feenableexcept' function. */
+#undef HAVE_FEENABLEEXCEPT
+
 /* Define to 1 if you have the <fenv.h> header file. */
 #undef HAVE_FENV_H
 
+/* Define to 1 if you have the `fesetexceptflag' function. */
+#undef HAVE_FESETEXCEPTFLAG
+
+/* Define to 1 if you have the `fesetround' function. */
+#undef HAVE_FESETROUND
+
 /* Define to 1 if you have the `fesettrapenable' function. */
 #undef HAVE_FESETTRAPENABLE
 

configure

@@ -9546,7 +9546,7 @@ _ACEOF
 fi
 done
 
-for ac_func in fesettrapenable ffsl ffsll fgetpos finite
+for ac_func in feenableexcept fesetexceptflag fesettrapenable fesetround ffsl ffsll fgetpos finite
 do :
   as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
 ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"

configure.in

@@ -1639,7 +1639,7 @@ AC_CHECK_FUNCS(_NSGetEnviron _chsize_s access acosh)
 AC_CHECK_FUNCS(alloca asinh atanh chdir clock clock_gettime)
 AC_CHECK_FUNCS(ctime dlopen dup2)
 AC_CHECK_FUNCS(erf feclearexcept)
-AC_CHECK_FUNCS(fesettrapenable ffsl ffsll fgetpos finite)
+AC_CHECK_FUNCS(feenableexcept fesetexceptflag fesettrapenable fesetround ffsl ffsll fgetpos finite)
 AC_CHECK_FUNCS(flsl flsll fpclass ftime ftruncate getcwd getenv)
 AC_CHECK_FUNCS(getexecname)
 AC_CHECK_FUNCS(gethostbyname gethostent gethostid gethostname)

pl/boot.yap

@@ -329,6 +329,7 @@ true :- true.
 '$init_system' :-
     get_value('$yap_inited', true), !.
 '$init_system' :-
+    '$set_fpu_exceptions'(true),
     set_value('$yap_inited', true),
     % do catch as early as possible
     (

pl/flags.yap

@@ -1147,7 +1147,7 @@ yap_flag(max_threads,X) :-
 	'$syntax_check_multiple'(_,off),
 	'$swi_set_prolog_flag'(character_escapes, false), % disable character escapes.
 	'$set_yap_flags'(14,1),
-	'$set_fpu_exceptions',
+%	'$set_fpu_exceptions'(false),
 	unknown(_,fail).
 '$adjust_language'(sicstus) :-
 	'$switch_log_upd'(1),
@@ -1162,7 +1162,7 @@ yap_flag(max_threads,X) :-
 	'$set_yap_flags'(14,0),
 	% CHARACTER_ESCAPE
 	'$swi_set_prolog_flag'(character_escapes, true), % disable character escapes.
-	'$set_fpu_exceptions',
+	'$set_fpu_exceptions'(true),
 	'$swi_set_prolog_flag'(fileerrors, true),
 	unknown(_,error).
 '$adjust_language'(iso) :-
@@ -1177,7 +1177,7 @@ yap_flag(max_threads,X) :-
 	'$set_yap_flags'(14,0),
 	% CHARACTER_ESCAPE
 	'$swi_set_prolog_flag'(character_escapes, true), % disable character escapes.
-	'$set_fpu_exceptions',
+	'$set_fpu_exceptions'(true),
 	unknown(_,error).