From 5e74bce403bc8fe8f8afa24f5ba90ff147de699a Mon Sep 17 00:00:00 2001
From: Taylor R Campbell <campbell@mumble.net>
Date: Fri, 26 Oct 2018 23:41:39 +0000
Subject: [PATCH] Extend expt to generate subnormals with exact integer
 exponents.

---
 src/runtime/arith.scm        |  7 ++++++-
 tests/runtime/test-arith.scm | 18 +++++++++++++++++-
 2 files changed, 23 insertions(+), 2 deletions(-)

diff --git a/src/runtime/arith.scm b/src/runtime/arith.scm
index e1afa94c1..658d98c1b 100644
--- 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 4623a9836..df7eddcab 100644
--- 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
-- 
2.25.1