From: Daniel Kochmański <daniel@turtleware.eu>
Date: Fri, 4 Sep 2015 10:59:59 +0000 (+0200)
Subject: cmpc: when infinity is used, emit macro "INFINITY"
X-Git-Url: http://git.pulsar-zone.net/?a=commitdiff_plain;h=899f51106eaccf32f9629c972c6c66be8217737d;p=ecl.git

cmpc: when infinity is used, emit macro "INFINITY"

and "-INFINITY" for negative infinity. These corner-cases lead to
compilation error, so no regression will be imposed even against
non-c99 compilers.

INFINITY and NAN macros are introduced by C99 standard, so such code
requires C-backend to support this math extension. Fixes #156.

Signed-off-by: Daniel Kochmański <daniel@turtleware.eu>
---

diff --git a/src/cmp/cmpc-wt.lsp b/src/cmp/cmpc-wt.lsp
index 92e10fb..db1da1a 100644
--- a/src/cmp/cmpc-wt.lsp
+++ b/src/cmp/cmpc-wt.lsp
@@ -17,18 +17,26 @@
 (in-package #-new-cmp "COMPILER" #+new-cmp "C-BACKEND")
 
 (defun wt1 (form)
-  (typecase form
-    ((or STRING INTEGER CHARACTER)
-     (princ form *compiler-output1*))
-    (SINGLE-FLOAT
-     (format *compiler-output1* "(float)~10,,,,,,'eG" form))
-    (DOUBLE-FLOAT
-     (format *compiler-output1* "~10,,,,,,'eG" form))
-    (LONG-FLOAT
-     (format *compiler-output1* "~,,,,,,'eEl" form))
-    (VAR (wt-var form))
-    (t (wt-loc form)))
-  nil)
+  (cond ((not (floatp form))
+         (typecase form
+           ((or STRING INTEGER CHARACTER)
+            (princ form *compiler-output1*))
+           (VAR (wt-var form))
+           (t (wt-loc form))))
+        ;; ((ext:float-nan-p form)
+        ;;  (format *compiler-output1* "NAN"))
+        ((ext:float-infinity-p form)
+         (if (minusp form)
+             (format *compiler-output1* "-INFINITY")
+             (format *compiler-output1* "INFINITY")))
+        (T
+         (typecase form
+           (SINGLE-FLOAT
+            (format *compiler-output1* "(float)~10,,,,,,'eG" form))
+           (DOUBLE-FLOAT
+            (format *compiler-output1* "~10,,,,,,'eG" form))
+           (LONG-FLOAT
+            (format *compiler-output1* "~,,,,,,'eEl" form))))))
 
 (defun wt-h1 (form)
   (let ((*compiler-output1* *compiler-output2*))
diff --git a/src/cmp/cmpct.lsp b/src/cmp/cmpct.lsp
index d3940a1..b98a9ea 100644
--- a/src/cmp/cmpct.lsp
+++ b/src/cmp/cmpct.lsp
@@ -152,6 +152,14 @@
        (LEAST-NEGATIVE-DOUBLE-FLOAT "-DBL_MIN")
        (LEAST-NEGATIVE-NORMALIZED-DOUBLE-FLOAT "-DBL_MIN")
 
+       (SHORT-FLOAT-POSITIVE-INFINITY  "INFINITY")
+       (SINGLE-FLOAT-POSITIVE-INFINITY "INFINITY")
+       (DOUBLE-FLOAT-POSITIVE-INFINITY "INFINITY")
+
+       (SHORT-FLOAT-NEGATIVE-INFINITY  "-INFINITY")
+       (SINGLE-FLOAT-NEGATIVE-INFINITY "-INFINITY")
+       (DOUBLE-FLOAT-NEGATIVE-INFINITY "-INFINITY")
+
        #+long-float
        ,@'(
            (MOST-POSITIVE-LONG-FLOAT "LDBL_MAX")
@@ -160,4 +168,6 @@
            (LEAST-POSITIVE-NORMALIZED-LONG-FLOAT" LDBL_MIN")
            (LEAST-NEGATIVE-LONG-FLOAT "-LDBL_MIN")
            (LEAST-NEGATIVE-NORMALIZED-LONG-FLOAT "-LDBL_MIN")
+           (LONG-FLOAT-POSITIVE-INFINITY   "INFINITY")
+           (LONG-FLOAT-NEGATIVE-INFINITY   "-INFINITY")
            )))))