Extend expt to generate subnormals with exact integer exponents.

diff --git a/src/runtime/arith.scm b/src/runtime/arith.scm
index e1afa94c13ed2e75f24d2660fbd0d5db73f95a20..658d98c1b36a8f940d5fb8b95c3f2d6381ba7d9a 100644 (file)
--- a/src/runtime/arith.scm
+++ b/src/runtime/arith.scm
@@ -1265,7 +1265,12 @@ USA.
                                      (loop x y answer)))))))))
                 (cond ((int:positive? y) (exact-method y))
                       ((int:negative? y)
-                       (flo:/ flo:1 (exact-method (int:negate y))))
+                       (if (int:< y microcode-id/floating-exponent-min)
+                           ;; The exact method cannot generate
+                           ;; subnormals because the negated exponent
+                           ;; overflows, so use the general case.
+                           (general-case x (int:->flonum y))
+                           (flo:/ flo:1 (exact-method (int:negate y)))))
                       (else flo:1))))
              (else
               (general-case x (rat:->inexact y))))

diff --git a/tests/runtime/test-arith.scm b/tests/runtime/test-arith.scm
index 4623a98363557920d95946dba3a7338185fe2f0b..df7eddcab4bb73e189de4b933f348991cd771f18 100644 (file)
--- a/tests/runtime/test-arith.scm
+++ b/tests/runtime/test-arith.scm
@@ -220,10 +220,26 @@ USA.
           (begin
             (assert-<= (relerr (- 1 p) (logistic (- x))) 1e-15)
             (if (<= 1/2 p)
+                ;; In this case, 1 - p is evaluated exactly.
                 (assert-<= (relerr (- x) (logit (- 1 p))) 1e-15)))
           (assert-<= (logistic (- x)) 1e-300))
       (assert-<= (relerr t (log-logistic x)) 1e-15)
       (if (<= x 709)
           (assert-<= (relerr x (logit-exp t)) 1e-15))
       (if (< p 1)
-          (assert-<= (relerr (log1p (- p)) (log-logistic (- x))) 1e-15)))))
\ No newline at end of file
+          (assert-<= (relerr (log1p (- p)) (log-logistic (- x))) 1e-15)))))
+
+(define-enumerated-test 'expt-exact
+  (vector
+   (vector 2. -1075 "0.")
+   (vector 2. -1074 "4.9406564584124654e-324")
+   (vector 2. -1024 "5.562684646268004e-309")
+   (vector 2. -1023 "1.1125369292536007e-308")
+   (vector 2. -1022 "2.2250738585072014e-308"))
+  (lambda (v)
+    (flo:with-trapped-exceptions 0
+      (lambda ()
+        (let ((x (vector-ref v 0))
+              (y (vector-ref v 1))
+              (x^y (string->number (vector-ref v 2))))
+          (assert-eqv (expt x y) x^y))))))
\ No newline at end of file