Repositories / ecl.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 43c3f21)
cmpc: when infinity is used, emit macro "INFINITY"
authorDaniel Kochmański <daniel@turtleware.eu>
Fri, 4 Sep 2015 10:59:59 +0000 (12:59 +0200)
committerDaniel Kochmański <daniel@turtleware.eu>
Fri, 4 Sep 2015 19:32:08 +0000 (21:32 +0200)
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>
src/cmp/cmpc-wt.lsp patch | blob | blame | history
src/cmp/cmpct.lsp patch | blob | blame | history

diff --git a/src/cmp/cmpc-wt.lsp b/src/cmp/cmpc-wt.lsp
index 92e10fb..db1da1a 100644 (file)
--- 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 (file)
--- 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")
            )))))
Embeddable Common Lisp (Official: https://gitlab.com/embeddable-common-lisp/ecl)