Merge branch 'infinity-fix' into 'develop'

Infinity fix

Produce valid C code for all kinds of infinity

I have also pending NaN changes, but this requires more work.

See merge request !9

CHANGELOG

@@ -57,6 +57,9 @@
      (read-from-string
       "(#1=\"Hello\" #S(sharp-s-reader.1.example-struct :A #1#))")
 
+   - Generated C code works well with IEEE 754 infinities
+     (regression tests created)
+
 * 16.0.0 changes since 15.3.7
 ** API changes
 

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*))

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")
            )))))

src/h/internal.h

@@ -604,6 +604,18 @@ extern cl_object si_wait_for_all_processes _ECL_ARGS((cl_narg narg, ...));
 # define ldexpf(x,y) ldexp((float)x,y)
 #endif
 
+/*
+ * Fake INFINITY and NAN defined in ISO C99 (portably)
+ */
+
+#ifndef INFINITY
+# define INFINITY (1.0/0.0)
+#endif
+
+#ifndef NAN
+# define NAN (0.0/0.0)
+#endif
+
 #ifdef __cplusplus
 }
 #endif

src/tests/regressions/tests/compiler.lsp

@@ -1108,3 +1108,32 @@
 1 
 2 
 3 ")
+
+
+
+;;; Date: 2015-09-04
+;;; Fixed: Daniel Kochmański
+;;; Description
+;;;     Compiler signalled arithmetic-error when producing C code for infinity
+;;;     and NaN float values (part of ieee floating point extensions).
+
+#+ieee-floating-point
+(deftest compiler.0047.infinity-test.1
+    (progn
+      (defun aux-compiler-0047.infty-test.1 ()
+        (> 0.0 ext:single-float-negative-infinity))
+      (compile 'aux-compiler-0047.infty-test.1))
+  aux-compiler-0047.infty-test.1 NIL NIL)
+
+#+ieee-floating-point
+(deftest compiler.0048.infinity-test.2
+    (progn
+      (with-compiler ("aux-compiler-0048.infty-test.2.lsp")
+        '(defun doit () (> 0.0 ext:single-float-negative-infinity)))
+      (load "aux-compiler-0048.infty-test.2.fas")
+      (delete-file "aux-compiler-0048.infty-test.2.lsp")
+      (delete-file "aux-compiler-0048.infty-test.2.fas")
+      (doit))
+  T)
+
+