path: root/sagemath-ecl-20.04.patch

diff --git a/src/sage/interfaces/interface.py b/src/sage/interfaces/interface.py
index 616c13d..430ba80 100644
--- a/src/sage/interfaces/interface.py
+++ b/src/sage/interfaces/interface.py
@@ -589,9 +589,9 @@ class Interface(WithEqualityById, ParentWithBase):
         EXAMPLES::
 
             sage: maxima.quad_qags(x, x, 0, 1, epsrel=1e-4)
-            [0.5,0.55511151231257...e-14,21,0]
+            [0.5,5.5511151231257...e-15,21,0]
             sage: maxima.function_call('quad_qags', [x, x, 0, 1], {'epsrel':'1e-4'})
-            [0.5,0.55511151231257...e-14,21,0]
+            [0.5,5.5511151231257...e-15,21,0]
         """
         args, kwds = self._convert_args_kwds(args, kwds)
         self._check_valid_function_name(function)
diff --git a/src/sage/interfaces/maxima.py b/src/sage/interfaces/maxima.py
index 9ab456e..3e8f4a6 100644
--- a/src/sage/interfaces/maxima.py
+++ b/src/sage/interfaces/maxima.py
@@ -128,9 +128,9 @@ http://maxima.sourceforge.net/docs/intromax/intromax.html.
 
     sage: a = maxima('(1 + sqrt(2))^5')
     sage: float(a)
-    82.01219330881975
+    82.0121933088197...
     sage: a.numer()
-    82.01219330881975
+    82.0121933088197...
 
 ::
 
diff --git a/src/sage/interfaces/maxima_abstract.py b/src/sage/interfaces/maxima_abstract.py
index 86fbe75..ed3055d 100644
--- a/src/sage/interfaces/maxima_abstract.py
+++ b/src/sage/interfaces/maxima_abstract.py
@@ -1518,7 +1518,7 @@ class MaximaAbstractElement(ExtraTabCompletion, InterfaceElement):
         EXAMPLES::
 
             sage: maxima('exp(-sqrt(x))').nintegral('x',0,1)
-            (0.5284822353142306, 0.41633141378838...e-10, 231, 0)
+            (0.5284822353142306, 4.1633141378838...e-11, 231, 0)
 
         Note that GP also does numerical integration, and can do so to very
         high precision very quickly::
diff --git a/src/sage/interfaces/tests.py b/src/sage/interfaces/tests.py
index fc77f12..a6847a9 100644
--- a/src/sage/interfaces/tests.py
+++ b/src/sage/interfaces/tests.py
@@ -31,8 +31,8 @@ Test that write errors to stderr are handled gracefully by GAP
     ....: except IOError:
     ....:     f = open('/dev/null', 'w')
     sage: kwds = dict(shell=True, stdout=f, stderr=f)
-    sage: subprocess.call("echo syntax error | ecl", **kwds)
-    0
+    sage: subprocess.call("echo syntax error | ecl", **kwds) in (0, 255)
+    True
     sage: subprocess.call("echo syntax error | gap", **kwds) in (0, 1)
     True
     sage: subprocess.call("echo syntax error | gp", **kwds)
diff --git a/src/sage/libs/ecl.pxd b/src/sage/libs/ecl.pxd
index 4dd273f..f0b30de 100644
--- a/src/sage/libs/ecl.pxd
+++ b/src/sage/libs/ecl.pxd
@@ -30,7 +30,7 @@ cdef extern from "ecl/ecl.h":
     ctypedef long int cl_fixnum
     ctypedef cl_fixnum cl_narg
     ctypedef void *cl_object
-    ctypedef unsigned int cl_index
+    ctypedef unsigned long int cl_index
 
     ctypedef enum ecl_option:
         ECL_OPT_INCREMENTAL_GC = 0,
@@ -39,7 +39,6 @@ cdef extern from "ecl/ecl.h":
         ECL_OPT_TRAP_SIGINT,
         ECL_OPT_TRAP_SIGILL,
         ECL_OPT_TRAP_SIGBUS,
-        ECL_OPT_TRAP_SIGCHLD,
         ECL_OPT_TRAP_SIGPIPE,
         ECL_OPT_TRAP_INTERRUPT_SIGNAL,
         ECL_OPT_SIGNAL_HANDLING_THREAD,
@@ -53,7 +52,6 @@ cdef extern from "ecl/ecl.h":
         ECL_OPT_LISP_STACK_SAFETY_AREA,
         ECL_OPT_C_STACK_SIZE,
         ECL_OPT_C_STACK_SAFETY_AREA,
-        ECL_OPT_SIGALTSTACK_SIZE,
         ECL_OPT_HEAP_SIZE,
         ECL_OPT_HEAP_SAFETY_AREA,
         ECL_OPT_THREAD_INTERRUPT_SIGNAL,
@@ -127,6 +125,7 @@ cdef extern from "ecl/ecl.h":
     cl_object cl_cddr(cl_object x)
     cl_object cl_rplaca(cl_object x, cl_object v)
     cl_object cl_rplacd(cl_object x, cl_object v)
+    cl_object ecl_list1(cl_object a)
 
     # string parsing and string IO
 
@@ -147,6 +146,10 @@ cdef extern from "ecl/ecl.h":
     int ecl_nvalues "NVALUES"
     cl_object ecl_values "VALUES"(int n)
 
-    #Common Lisp "EQUAL" compatible hash function
+    # Common Lisp "EQUAL" compatible hash function
 
     cl_object cl_sxhash(cl_object key)
+
+    # symbols
+
+    cl_object ecl_make_symbol(const char *name, const char *package)
\ No newline at end of file
diff --git a/src/sage/libs/ecl.pyx b/src/sage/libs/ecl.pyx
index 1f05f4a..978e19b 100644
--- a/src/sage/libs/ecl.pyx
+++ b/src/sage/libs/ecl.pyx
@@ -15,7 +15,7 @@ Library interface to Embeddable Common Lisp (ECL)
 #adapted to work with pure Python types.
 
 from libc.stdlib cimport abort
-from libc.signal cimport SIGINT, SIGBUS, SIGSEGV, SIGCHLD
+from libc.signal cimport SIGINT, SIGBUS, SIGFPE, SIGSEGV
 from libc.signal cimport raise_ as signal_raise
 from posix.signal cimport sigaction, sigaction_t
 cimport cysignals.signals
@@ -47,9 +47,16 @@ cdef extern from "eclsig.h":
     void ecl_sig_off()
     cdef sigaction_t ecl_sigint_handler
     cdef sigaction_t ecl_sigbus_handler
+    cdef sigaction_t ecl_sigfpe_handler
     cdef sigaction_t ecl_sigsegv_handler
     cdef mpz_t ecl_mpz_from_bignum(cl_object obj)
     cdef cl_object ecl_bignum_from_mpz(mpz_t num)
+    cdef cl_object conditions_to_handle_clobj
+    void safe_cl_boot(int argc, char** argv)
+    cl_object safe_cl_funcall(cl_object *error, cl_object fun, cl_object arg)
+    cl_object safe_cl_apply(cl_object *error, cl_object fun, cl_object args)
+    cl_object safe_cl_eval(cl_object *error, cl_object form)
+
 
 cdef cl_object string_to_object(char * s):
     return ecl_read_from_cstring(s)
@@ -93,9 +100,6 @@ cdef void remove_node(cl_object node):
 
 cdef cl_object list_of_objects
 
-cdef cl_object safe_eval_clobj         #our own error catching eval
-cdef cl_object safe_apply_clobj        #our own error catching apply
-cdef cl_object safe_funcall_clobj      #our own error catching funcall
 cdef cl_object read_from_string_clobj  #our own error catching reader
 
 cdef bint ecl_has_booted = 0
@@ -139,7 +143,6 @@ def test_ecl_options():
         ECL_OPT_TRAP_SIGINT = 1
         ECL_OPT_TRAP_SIGILL = 1
         ECL_OPT_TRAP_SIGBUS = 1
-        ECL_OPT_TRAP_SIGCHLD = 0
         ECL_OPT_TRAP_SIGPIPE = 1
         ECL_OPT_TRAP_INTERRUPT_SIGNAL = 1
         ECL_OPT_SIGNAL_HANDLING_THREAD = 0
@@ -153,7 +156,6 @@ def test_ecl_options():
         ECL_OPT_LISP_STACK_SAFETY_AREA = ...
         ECL_OPT_C_STACK_SIZE = ...
         ECL_OPT_C_STACK_SAFETY_AREA = ...
-        ECL_OPT_SIGALTSTACK_SIZE = 1
         ECL_OPT_HEAP_SIZE = ...
         ECL_OPT_HEAP_SAFETY_AREA = ...
         ECL_OPT_THREAD_INTERRUPT_SIGNAL = ...
@@ -171,8 +173,6 @@ def test_ecl_options():
         ecl_get_option(ECL_OPT_TRAP_SIGILL)))
     print('ECL_OPT_TRAP_SIGBUS = {0}'.format(
         ecl_get_option(ECL_OPT_TRAP_SIGBUS)))
-    print('ECL_OPT_TRAP_SIGCHLD = {0}'.format(
-        ecl_get_option(ECL_OPT_TRAP_SIGCHLD)))
     print('ECL_OPT_TRAP_SIGPIPE = {0}'.format(
         ecl_get_option(ECL_OPT_TRAP_SIGPIPE)))
     print('ECL_OPT_TRAP_INTERRUPT_SIGNAL = {0}'.format(
@@ -199,8 +199,6 @@ def test_ecl_options():
         ecl_get_option(ECL_OPT_C_STACK_SIZE)))
     print('ECL_OPT_C_STACK_SAFETY_AREA = {0}'.format(
         ecl_get_option(ECL_OPT_C_STACK_SAFETY_AREA)))
-    print('ECL_OPT_SIGALTSTACK_SIZE = {0}'.format(
-        ecl_get_option(ECL_OPT_SIGALTSTACK_SIZE)))
     print('ECL_OPT_HEAP_SIZE = {0}'.format(
         ecl_get_option(ECL_OPT_HEAP_SIZE)))
     print('ECL_OPT_HEAP_SAFETY_AREA = {0}'.format(
@@ -231,10 +229,8 @@ def init_ecl():
         RuntimeError: ECL is already initialized
     """
     global list_of_objects
-    global safe_eval_clobj
-    global safe_apply_clobj
-    global safe_funcall_clobj
     global read_from_string_clobj
+    global conditions_to_handle_clobj
     global ecl_has_booted
     cdef char *argv[1]
     cdef sigaction_t sage_action[32]
@@ -243,9 +239,6 @@ def init_ecl():
     if ecl_has_booted:
         raise RuntimeError("ECL is already initialized")
 
-    # we need it to stop handling SIGCHLD
-    ecl_set_option(ECL_OPT_TRAP_SIGCHLD, 0);
-
     #we keep our own GMP memory functions. ECL should not claim them
     ecl_set_option(ECL_OPT_SET_GMP_MEMORY_FUNCTIONS,0);
 
@@ -259,19 +252,14 @@ def init_ecl():
 
     #initialize ECL
     ecl_set_option(ECL_OPT_SIGNAL_HANDLING_THREAD, 0)
-    cl_boot(1, argv)
+    safe_cl_boot(1, argv)
 
     #save signal handler from ECL
     sigaction(SIGINT, NULL, &ecl_sigint_handler)
     sigaction(SIGBUS, NULL, &ecl_sigbus_handler)
+    sigaction(SIGFPE, NULL, &ecl_sigfpe_handler)
     sigaction(SIGSEGV, NULL, &ecl_sigsegv_handler)
 
-    #verify that no SIGCHLD handler was installed
-    cdef sigaction_t sig_test
-    sigaction(SIGCHLD, NULL, &sig_test)
-    assert sage_action[SIGCHLD].sa_handler == NULL  # Sage does not set SIGCHLD handler
-    assert sig_test.sa_handler == NULL              # And ECL bootup did not set one 
-
     #and put the Sage signal handlers back
     for i in range(1,32):
         sigaction(i, &sage_action[i], NULL)
@@ -293,32 +281,8 @@ def init_ecl():
 
     read_from_string_clobj=cl_eval(string_to_object(b"(symbol-function 'read-from-string)"))
 
-    cl_eval(string_to_object(b"""
-        (defun sage-safe-eval (form)
-            (handler-case
-                (values (eval form))
-                (serious-condition (cnd)
-                    (values nil (princ-to-string cnd)))))
-        """))
-    safe_eval_clobj=cl_eval(string_to_object(b"(symbol-function 'sage-safe-eval)"))
-
-    cl_eval(string_to_object(b"""
-        (defun sage-safe-apply (func args)
-            (handler-case
-                (values (apply func args))
-                (serious-condition (cnd)
-                    (values nil (princ-to-string cnd)))))
-        """))
-
-    safe_apply_clobj=cl_eval(string_to_object(b"(symbol-function 'sage-safe-apply)"))
-    cl_eval(string_to_object(b"""
-        (defun sage-safe-funcall (func arg)
-            (handler-case
-                (values (funcall func arg))
-                (serious-condition (cnd)
-                    (values nil (princ-to-string cnd)))))
-        """))
-    safe_funcall_clobj=cl_eval(string_to_object(b"(symbol-function 'sage-safe-funcall)"))
+    conditions_to_handle_clobj=ecl_list1(ecl_make_symbol(b"SERIOUS-CONDITION", b"COMMON-LISP"))
+    insert_node_after(list_of_objects,conditions_to_handle_clobj)
 
     ecl_has_booted = 1
 
@@ -339,45 +303,46 @@ cdef cl_object ecl_safe_eval(cl_object form) except NULL:
         ...
         RuntimeError: ECL says: Console interrupt.
     """
-    cdef cl_object s
+    cdef cl_object ret, error = NULL
+
     ecl_sig_on()
-    cl_funcall(2,safe_eval_clobj,form)
+    ret = safe_cl_eval(&error,form)
     ecl_sig_off()
 
-    if ecl_nvalues > 1:
-        s = si_coerce_to_base_string(ecl_values(1))
+    if error != NULL:
+        error = si_coerce_to_base_string(error)
         raise RuntimeError("ECL says: {}".format(
-            char_to_str(ecl_base_string_pointer_safe(s))))
+            char_to_str(ecl_base_string_pointer_safe(error))))
     else:
-        return ecl_values(0)
+        return ret
 
 cdef cl_object ecl_safe_funcall(cl_object func, cl_object arg) except NULL:
-    cdef cl_object l, s
-    l = cl_cons(func,cl_cons(arg,Cnil));
+    cdef cl_object ret, error = NULL
 
     ecl_sig_on()
-    cl_apply(2,safe_funcall_clobj,cl_cons(func,cl_cons(arg,Cnil)))
+    ret = safe_cl_funcall(&error,func,arg)
     ecl_sig_off()
 
-    if ecl_nvalues > 1:
-        s = si_coerce_to_base_string(ecl_values(1))
+    if error != NULL:
+        error = si_coerce_to_base_string(error)
         raise RuntimeError("ECL says: {}".format(
-            char_to_str(ecl_base_string_pointer_safe(s))))
+            char_to_str(ecl_base_string_pointer_safe(error))))
     else:
-        return ecl_values(0)
+        return ret
 
 cdef cl_object ecl_safe_apply(cl_object func, cl_object args) except NULL:
-    cdef cl_object s
+    cdef cl_object ret, error = NULL
+
     ecl_sig_on()
-    cl_funcall(3,safe_apply_clobj,func,args)
+    ret = safe_cl_apply(&error,func,args)
     ecl_sig_off()
 
-    if ecl_nvalues > 1:
-        s = si_coerce_to_base_string(ecl_values(1))
+    if error != NULL:
+        error = si_coerce_to_base_string(error)
         raise RuntimeError("ECL says: {}".format(
-            char_to_str(ecl_base_string_pointer_safe(s))))
+            char_to_str(ecl_base_string_pointer_safe(error))))
     else:
-        return ecl_values(0)
+        return ret
 
 cdef cl_object ecl_safe_read_string(char * s) except NULL:
     cdef cl_object o
diff --git a/src/sage/libs/eclsig.h b/src/sage/libs/eclsig.h
index f9f2690..e249ccf 100644
--- a/src/sage/libs/eclsig.h
+++ b/src/sage/libs/eclsig.h
@@ -11,15 +11,18 @@
 #include <signal.h>
 static struct sigaction ecl_sigint_handler;
 static struct sigaction ecl_sigbus_handler;
+static struct sigaction ecl_sigfpe_handler;
 static struct sigaction ecl_sigsegv_handler;
 static struct sigaction sage_sigint_handler;
 static struct sigaction sage_sigbus_handler;
+static struct sigaction sage_sigfpe_handler;
 static struct sigaction sage_sigsegv_handler;
 
 static inline void set_ecl_signal_handler(void)
 {
     sigaction(SIGINT, &ecl_sigint_handler, &sage_sigint_handler);
     sigaction(SIGBUS, &ecl_sigbus_handler, &sage_sigbus_handler);
+    sigaction(SIGFPE, &ecl_sigfpe_handler, &sage_sigfpe_handler);
     sigaction(SIGSEGV, &ecl_sigsegv_handler, &sage_sigsegv_handler);
 }
 
@@ -27,6 +30,7 @@ static inline void unset_ecl_signal_handler(void)
 {
     sigaction(SIGINT, &sage_sigint_handler, NULL);
     sigaction(SIGBUS, &sage_sigbus_handler, NULL);
+    sigaction(SIGFPE, &sage_sigfpe_handler, NULL);
     sigaction(SIGSEGV, &sage_sigsegv_handler, NULL);
 }
 
@@ -49,3 +53,52 @@ cl_object ecl_bignum_from_mpz(mpz_t num)
     mpz_set(ecl_mpz_from_bignum(z), num);
     return _ecl_big_register_copy(z);
 }
+
+static inline void safe_cl_boot(int argc, char** argv) {
+   ECL_WITH_LISP_FPE_BEGIN {
+      cl_boot(argc, argv);
+   } ECL_WITH_LISP_FPE_END;
+}
+
+/* List of conditions to catch in the following functions. Is
+ * initialized after cl_boot in init_ecl. */
+static cl_object conditions_to_handle_clobj = ECL_NIL;
+
+static inline cl_object safe_cl_funcall(cl_object *error, cl_object fun, cl_object arg) {
+   cl_object ret = NULL;
+   cl_env_ptr the_env = ecl_process_env();
+   ECL_WITH_LISP_FPE_BEGIN {
+       ECL_HANDLER_CASE_BEGIN(the_env, conditions_to_handle_clobj) {
+           ret = cl_funcall(2, fun, arg);
+       } ECL_HANDLER_CASE(1, condition) {
+           *error = cl_princ_to_string(condition);
+       } ECL_HANDLER_CASE_END;
+   } ECL_WITH_LISP_FPE_END;
+   return ret;
+}
+
+static inline cl_object safe_cl_apply(cl_object *error, cl_object fun, cl_object args) {
+   cl_object ret = NULL;
+   cl_env_ptr the_env = ecl_process_env();
+   ECL_WITH_LISP_FPE_BEGIN {
+       ECL_HANDLER_CASE_BEGIN(the_env, conditions_to_handle_clobj) {
+           ret = cl_apply(2, fun, args);
+       } ECL_HANDLER_CASE(1, condition) {
+           *error = cl_princ_to_string(condition);
+       } ECL_HANDLER_CASE_END;
+   } ECL_WITH_LISP_FPE_END;
+   return ret;
+}
+
+static inline cl_object safe_cl_eval(cl_object *error, cl_object form) {
+   cl_object ret = NULL;
+   cl_env_ptr the_env = ecl_process_env();
+   ECL_WITH_LISP_FPE_BEGIN {
+       ECL_HANDLER_CASE_BEGIN(the_env, conditions_to_handle_clobj) {
+           ret = cl_eval(form);
+       } ECL_HANDLER_CASE(1, condition) {
+           *error = cl_princ_to_string(condition);
+       } ECL_HANDLER_CASE_END;
+   } ECL_WITH_LISP_FPE_END;
+   return ret;
+}