Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

consolidate float boundary constants

  • Loading branch information...
commit 7a6ad1441ae3da89eed9fcaf91ee443eee041d67 1 parent 56d42db
james anderson authored April 22, 2011
2  package.lisp
@@ -661,6 +661,7 @@
661 661
    :double-float-nan                    ; variable
662 662
    :double-float-negative-infinity      ; variable
663 663
    :double-float-positive-infinity      ; variable
  664
+   :double-float-nan                    ; variable
664 665
    :dtx-channel                         ; function
665 666
    :encode-method                       ; function
666 667
    :enqueue
@@ -732,6 +733,7 @@
732 733
    :simple-stream                       ; class
733 734
    :single-float-nan                    ; variable
734 735
    :single-float-negative-infinity      ; variable
  736
+   :single-float-nan                    ; variable
735 737
    :single-float-positive-infinity      ; variable
736 738
    :stream-advance-to-column            ; function
737 739
    :stream-buffer                       ; function
78  parameters.lisp
@@ -80,81 +80,3 @@
80 80
 (def-mime-type-key :sexp :if-does-not-exist :create)
81 81
 (def-mime-type (:application :sexp))
82 82
 
83  
-;;;
84  
-;;; constants and parameters used for codec operators
85  
-;;;
86  
-;;; floating point boundary constants
87  
-;;; define them where an implementation has not prepared them
88  
-;;;
89  
-;;; extended from corkill's openmcl addition
90  
-
91  
-#+mcl
92  
-(unless (boundp 'double-float-positive-infinity)
93  
-  (eval-when (:compile-toplevel :load-toplevel :execute)
94  
-    (defconstant double-float-positive-infinity
95  
-      (unwind-protect
96  
-        (progn
97  
-          (ccl::set-fpu-mode :division-by-zero nil)
98  
-          (funcall '/ 0d0))
99  
-        (ccl::set-fpu-mode :division-by-zero t)))
100  
-    
101  
-    (defconstant double-float-negative-infinity
102  
-      (unwind-protect
103  
-        (progn
104  
-          (ccl::set-fpu-mode :division-by-zero nil)
105  
-          (funcall '/ -0d0))
106  
-        (ccl::set-fpu-mode :division-by-zero t)))))
107  
-
108  
-#+(or mcl (and clozure (not ccl-1.4)))
109  
-(unless (boundp 'double-float-nan)
110  
-  (defconstant double-float-nan
111  
-    (unwind-protect
112  
-      (locally (declare (special double-float-positive-infinity double-float-negative-infinity))
113  
-        (ccl::set-fpu-mode :invalid nil)
114  
-        (funcall '+ double-float-positive-infinity double-float-negative-infinity))
115  
-      (ccl::set-fpu-mode :invalid t))))
116  
-
117  
-#+(or mcl clozure)
118  
-(unless (boundp 'single-float-positive-infinity)
119  
-  (eval-when (:compile-toplevel :load-toplevel :execute)
120  
-    (defconstant single-float-positive-infinity
121  
-      (unwind-protect
122  
-        (progn
123  
-          (ccl::set-fpu-mode :division-by-zero nil)
124  
-          (funcall '/ 0s0))
125  
-        (ccl::set-fpu-mode :division-by-zero t)))
126  
-    
127  
-    (defconstant single-float-negative-infinity
128  
-      (unwind-protect
129  
-        (progn
130  
-          (ccl::set-fpu-mode :division-by-zero nil)
131  
-          (funcall '/ -0s0))
132  
-        (ccl::set-fpu-mode :division-by-zero t)))))
133  
-
134  
-#+(or mcl clozure)
135  
-(unless (boundp 'single-float-nan)
136  
-  (defconstant single-float-nan
137  
-    (unwind-protect
138  
-      (locally (declare (special single-float-positive-infinity single-float-negative-infinity))
139  
-        (ccl::set-fpu-mode :invalid nil)
140  
-        (funcall '+ single-float-positive-infinity single-float-negative-infinity))
141  
-      (ccl::set-fpu-mode :invalid t))))
142  
-
143  
-#+sbcl  ;; works on osx and linux
144  
-(unless (boundp 'single-float-nan)
145  
-  (sb-vm::with-float-traps-masked (:invalid)
146  
-    (defconstant single-float-nan
147  
-      (eval '(+ single-float-positive-infinity single-float-negative-infinity)))
148  
-    (defconstant double-float-nan
149  
-      (eval '(+ double-float-positive-infinity double-float-negative-infinity)))))
150  
-
151  
-#+lispworks
152  
-(progn
153  
-  (defconstant double-float-positive-infinity system::*plus-infinity-double*)
154  
-  (defconstant double-float-negative-infinity system::*minus-infinity-double*)
155  
-  (defconstant single-float-positive-infinity (coerce system::*plus-infinity-double* 'single-float))
156  
-  (defconstant single-float-negative-infinity (coerce system::*minus-infinity-double* 'single-float))
157  
-
158  
-  (defconstant single-float-nan (+ single-float-positive-infinity single-float-negative-infinity))
159  
-  (defconstant double-float-nan (+ double-float-positive-infinity double-float-negative-infinity))
160  
-  )

0 notes on commit 7a6ad14

Please sign in to comment.
Something went wrong with that request. Please try again.