diff --git a/CHANGELOG b/CHANGELOG index db0d5b9ea..5cb3ce30b 100644 --- a/CHANGELOG +++ b/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 diff --git a/src/cmp/cmpc-wt.lsp b/src/cmp/cmpc-wt.lsp index 92e10fb82..db1da1abc 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 d3940a154..b98a9ea53 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") ))))) diff --git a/src/h/internal.h b/src/h/internal.h index dba0d8fd3..0b24cf15a 100755 --- a/src/h/internal.h +++ b/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 diff --git a/src/tests/regressions/tests/compiler.lsp b/src/tests/regressions/tests/compiler.lsp index 4b0163590..6e8c21ed7 100644 --- a/src/tests/regressions/tests/compiler.lsp +++ b/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) + +