From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 3 May 2018 06:07:46 +0000 (-0700)
Subject: Add procedures to generate infinities and a nan.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~79
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=9ac0fe20f84a7bcaa9c724189e3ab08a19769456;p=mit-scheme.git

Add procedures to generate infinities and a nan.
---

diff --git a/src/runtime/floenv.scm b/src/runtime/floenv.scm
index 1a1df9cfa..325b98f11 100644
--- a/src/runtime/floenv.scm
+++ b/src/runtime/floenv.scm
@@ -362,3 +362,34 @@ USA.
    (lambda ()
      (flo:untrap-exceptions! exceptions)
      (procedure))))
+
+(define flo:nan.0)
+(define flo:+inf.0)
+(define flo:-inf.0)
+;;; ZERO can be eliminated after 9.3 is released.  It works around
+;;; overly-aggressive constant folding in SF and LIAR.
+(let ((zero (lambda () (identity-procedure 0.))))
+  (if (flo:have-trap-enable/disable?)
+      (begin
+	(set! flo:nan.0
+	      (named-lambda (flo:nan.0)
+		(flo:with-exceptions-untrapped (flo:exception:invalid-operation)
+		  (lambda ()
+		    (flo:/ 0. (zero))))))
+	(set! flo:+inf.0
+	      (named-lambda (flo:+inf.0)
+		(flo:with-exceptions-untrapped (flo:exception:divide-by-zero)
+		  (lambda ()
+		    (flo:/ +1. (zero))))))
+	(set! flo:-inf.0
+	      (named-lambda (flo:-inf.0)
+		(flo:with-exceptions-untrapped (flo:exception:divide-by-zero)
+		  (lambda ()
+		    (flo:/ -1. (zero))))))
+	unspecific)
+      ;; This works on macOS.  YMMV.
+      (begin
+	(set! flo:nan.0 (named-lambda (flo:nan.0) (flo:/ 0. (zero))))
+	(set! flo:+inf.0 (named-lambda (flo:+inf.0) (flo:/ +1. (zero))))
+	(set! flo:-inf.0 (named-lambda (flo:-inf.0) (flo:/ -1. (zero))))
+	unspecific)))
\ No newline at end of file
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 9747d4e4c..f2564da60 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -370,6 +370,8 @@ USA.
   (files "floenv")
   (parent (runtime))
   (export ()
+	  flo:+inf.0
+	  flo:-inf.0
 	  flo:clear-exceptions!
 	  flo:default-environment
 	  flo:default-rounding-mode
@@ -387,6 +389,7 @@ USA.
 	  flo:have-trap-enable/disable?
 	  flo:ignoring-exception-traps
 	  flo:names->exceptions
+	  flo:nan.0
 	  flo:preserving-environment
 	  flo:raise-exceptions!
 	  flo:restore-exception-flags!