From: Taylor R Campbell <campbell@mumble.net>
Date: Thu, 8 Nov 2018 07:49:02 +0000 (+0000)
Subject: Let the system math library elicit IEEE 754 exceptions.
X-Git-Tag: mit-scheme-pucked-10.1.2~16^2~116^2~13
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=6f9b22ca9011a0bc9425a4087c83389a7fa4ccb8;p=mit-scheme.git

Let the system math library elicit IEEE 754 exceptions.

Don't trap in our ucode primitive wrappers if the floating-point
exception isn't trapped.
---

diff --git a/src/microcode/flonum.c b/src/microcode/flonum.c
index 4d323cf15..cf150a256 100644
--- a/src/microcode/flonum.c
+++ b/src/microcode/flonum.c
@@ -214,9 +214,9 @@ DEFINE_PRIMITIVE ("FLONUM-COS", Prim_flonum_cos, 1, 1, 0)
 DEFINE_PRIMITIVE ("FLONUM-TAN", Prim_flonum_tan, 1, 1, 0)
      SIMPLE_TRANSCENDENTAL_FUNCTION (tan)
 DEFINE_PRIMITIVE ("FLONUM-ASIN", Prim_flonum_asin, 1, 1, 0)
-     RESTRICTED_TRANSCENDENTAL_FUNCTION (asin, ((x >= -1) && (x <= 1)))
+     SIMPLE_TRANSCENDENTAL_FUNCTION (asin)
 DEFINE_PRIMITIVE ("FLONUM-ACOS", Prim_flonum_acos, 1, 1, 0)
-     RESTRICTED_TRANSCENDENTAL_FUNCTION (acos, ((x >= -1) && (x <= 1)))
+     SIMPLE_TRANSCENDENTAL_FUNCTION (acos)
 DEFINE_PRIMITIVE ("FLONUM-ATAN", Prim_flonum_atan, 1, 1, 0)
      SIMPLE_TRANSCENDENTAL_FUNCTION (atan)
 
@@ -233,7 +233,7 @@ DEFINE_PRIMITIVE ("FLONUM-ATAN2", Prim_flonum_atan2, 2, 2, 0)
 }
 
 DEFINE_PRIMITIVE ("FLONUM-SQRT", Prim_flonum_sqrt, 1, 1, 0)
-     RESTRICTED_TRANSCENDENTAL_FUNCTION (sqrt, (x >= 0))
+     SIMPLE_TRANSCENDENTAL_FUNCTION (sqrt)
 DEFINE_PRIMITIVE ("FLONUM-CBRT", Prim_flonum_cbrt, 1, 1, 0)
      SIMPLE_TRANSCENDENTAL_FUNCTION (cbrt)
 
diff --git a/tests/microcode/test-flonum-except.scm b/tests/microcode/test-flonum-except.scm
index f3c5fb515..6c611d0e2 100644
--- a/tests/microcode/test-flonum-except.scm
+++ b/tests/microcode/test-flonum-except.scm
@@ -178,11 +178,9 @@ USA.
 (define-invop-trap-test 'flonum-sqrt (applicator flo:sqrt -1.))	;(g)
 
 (define-invop-flag-test 'flonum-sqrt
-  (applicator (make-primitive-procedure 'flonum-sqrt) -1.)
-  'xerror)
+  (applicator (make-primitive-procedure 'flonum-sqrt) -1.))
 (define-invop-trap-test 'flonum-sqrt
-  (applicator (make-primitive-procedure 'flonum-sqrt) -1.)
-  'xerror)
+  (applicator (make-primitive-procedure 'flonum-sqrt) -1.))
 
 ;;; IEEE 754-2008, Sec. 7.3
 
@@ -246,11 +244,11 @@ USA.
 
 ;; XXX atanpi, atan2pi
 
-(define-invop-flag-test 'flonum-asin (applicator flo:asin 2.) 'xerror)
-(define-invop-trap-test 'flonum-asin (applicator flo:asin 2.) 'xerror)
+(define-invop-flag-test 'flonum-asin (applicator flo:asin 2.))
+(define-invop-trap-test 'flonum-asin (applicator flo:asin 2.))
 ;; XXX Not clear how to make asin underflow reliably.
-(define-invop-flag-test 'flonum-acos (applicator flo:acos 2.) 'xerror)
-(define-invop-trap-test 'flonum-acos (applicator flo:acos 2.) 'xerror)
+(define-invop-flag-test 'flonum-acos (applicator flo:acos 2.))
+(define-invop-trap-test 'flonum-acos (applicator flo:acos 2.))
 ;; XXX Not clear how to make atan underflow reliably.
 
 ;; XXX sinh, cosh, tanh, asinh, acosh, atanh