[svn:parrot] r36057 - in trunk: . config/auto config/auto/format config/gen/config_h include/parrot src t/compilers/imcc/syn t/op

Author: particle
Date: Tue Jan 27 10:24:45 2009
New Revision: 36057

Added:
   trunk/config/auto/format/floatval_maxmin.in   (contents, props changed)
   trunk/config/auto/format/intval_maxmin.in   (props changed)
      - copied unchanged from r35875, /trunk/config/auto/format/maxmin.in
Removed:
   trunk/config/auto/format/maxmin.in
Modified:
   trunk/MANIFEST
   trunk/config/auto/format.pm
   trunk/config/gen/config_h/config_h.in
   trunk/include/parrot/datatypes.h
   trunk/src/datatypes.c
   trunk/src/spf_render.c
   trunk/t/compilers/imcc/syn/veracity.t
   trunk/t/op/arithmetics.t

Log:
[core] portable Inf/NaN support
~ adds configure code to set min/max constants for FLOATVAL
~ modifies Parrot_sprintf_format and string_to_num to handle two-way string/number conversion
~ adds basic Inf/NaN math test
note: currently parrot accepts 'Inf' and 'NaN' values in N registers, which disagrees with the open group's spec, but agrees with Tcl and Perl 6 specs

Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST	(original)
+++ trunk/MANIFEST	Tue Jan 27 10:24:45 2009
@@ -238,7 +238,8 @@
 config/auto/env/test_unsetenv.in                            []
 config/auto/fink.pm                                         []
 config/auto/format.pm                                       []
-config/auto/format/maxmin.in                                []
+config/auto/format/floatval_maxmin.in                       []
+config/auto/format/intval_maxmin.in                         []
 config/auto/funcptr.pm                                      []
 config/auto/funcptr/test_c.in                               []
 config/auto/gc.pm                                           []

Modified: trunk/config/auto/format.pm
==============================================================================
--- trunk/config/auto/format.pm	(original)
+++ trunk/config/auto/format.pm	Tue Jan 27 10:24:45 2009
@@ -38,6 +38,8 @@
 
     _set_floatvalfmt_nvsize($conf);
 
+    _set_floatvalmaxmin($conf);
+
     return 1;
 }
 
@@ -89,7 +91,7 @@
     $conf->data->set( intvalmin   => $ivmin );
     $conf->data->set( intvalmax   => $ivmax );
 
-    $conf->cc_gen('config/auto/format/maxmin.in');
+    $conf->cc_gen('config/auto/format/intval_maxmin.in');
     eval { $conf->cc_build(); };
     if ( $@ ) {
         $ivmin = '0';
@@ -125,6 +127,40 @@
     );
 }
 
+# This is unrelated to format, may be moved to other place later
+sub _set_floatvalmaxmin {
+    my $conf = shift;
+    my $nvmin;
+    my $nvmax;
+    my $nv = $conf->data->get(qw(nv));
+
+    if ( $nv eq "double" ) {
+        $nvmin = 'DBL_MIN';
+        $nvmax = 'DBL_MAX';
+    }
+    elsif ( $nv eq "long double" ) {
+
+        # Stay way from long double for now (it may be 64 or 80 bits)
+        # die "long double not supported at this time, use double.";
+        $nvmin = 'LDBL_MIN';
+        $nvmax = 'LDBL_MAX';
+    }
+    else {
+        die qq{Configure.pl:  Can't find limits for type '$nv'\n};
+    }
+
+    $conf->data->set( floatvalmin => $nvmin );
+    $conf->data->set( floatvalmax => $nvmax );
+
+    $conf->cc_gen('config/auto/format/floatval_maxmin.in');
+    eval { $conf->cc_build(); };
+    if ( $@ ) {
+        $nvmin = '0';
+        $nvmax = '0';
+    }
+
+}
+
 1;
 
 # Local Variables:

Added: trunk/config/auto/format/floatval_maxmin.in
==============================================================================
--- (empty file)
+++ trunk/config/auto/format/floatval_maxmin.in	Tue Jan 27 10:24:45 2009
@@ -0,0 +1,15 @@
+/* Copyright (C) 2008, The Perl Foundation. */
+/* $Id:  */
+
+#include <float.h>
+
+int main(int argc, char *argv[])
+{
+    double i, j;
+
+    i = @floatvalmin@;
+    j = @floatvalmax@;
+
+
+    return 0;
+}

Modified: trunk/config/gen/config_h/config_h.in
==============================================================================
--- trunk/config/gen/config_h/config_h.in	(original)
+++ trunk/config/gen/config_h/config_h.in	Tue Jan 27 10:24:45 2009
@@ -51,6 +51,13 @@
 #define PARROT_INTVAL_MAX              @intvalmax@
 #endif
 
+#ifndef PARROT_FLOATVAL_MIN
+#define PARROT_FLOATVAL_MIN            @floatvalmin@
+#endif
+#ifndef PARROT_FLOATVAL_MAX
+#define PARROT_FLOATVAL_MAX            @floatvalmax@
+#endif
+
 /* Temporary until we find a way to make it work in the right place. */
 struct PackFile;      typedef struct PackFile * Parrot_PackFile;
 

Modified: trunk/include/parrot/datatypes.h
==============================================================================
--- trunk/include/parrot/datatypes.h	(original)
+++ trunk/include/parrot/datatypes.h	Tue Jan 27 10:24:45 2009
@@ -125,6 +125,15 @@
 };
 #endif /* INSIDE_GLOBAL_SETUP */
 
+#define PARROT_FLOATVAL_INF_POSITIVE  floatval_divide_by_zero(interp, 1.0)
+#define PARROT_FLOATVAL_INF_NEGATIVE  floatval_divide_by_zero(interp, -1.0)
+#define PARROT_FLOATVAL_NAN_QUIET     floatval_divide_by_zero(interp, 0.0)
+
+#define PARROT_CSTRING_INF_POSITIVE    "Inf"
+#define PARROT_CSTRING_INF_NEGATIVE    "-Inf"
+#define PARROT_CSTRING_NAN_QUIET       "NaN"
+
+
 /* HEADERIZER BEGIN: src/datatypes.c */
 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
 
@@ -141,6 +150,10 @@
 STRING * Parrot_get_datatype_name(PARROT_INTERP, INTVAL type)
         __attribute__nonnull__(1);
 
+PARROT_EXPORT
+FLOATVAL
+floatval_divide_by_zero(PARROT_INTERP, FLOATVAL num);
+
 #define ASSERT_ARGS_Parrot_get_datatype_enum __attribute__unused__ int _ASSERT_ARGS_CHECK = \
        PARROT_ASSERT_ARG(interp) \
     || PARROT_ASSERT_ARG(type_name)

Modified: trunk/src/datatypes.c
==============================================================================
--- trunk/src/datatypes.c	(original)
+++ trunk/src/datatypes.c	Tue Jan 27 10:24:45 2009
@@ -81,6 +81,16 @@
     return string_make(interp, s, strlen(s), NULL, PObj_external_FLAG);
 }
 
+
+PARROT_EXPORT
+FLOATVAL
+floatval_divide_by_zero(PARROT_INTERP, FLOATVAL num)
+{
+    FLOATVAL zero = 0.0;
+    return num / zero;
+}
+
+
 /*
 
 =back

Modified: trunk/src/spf_render.c
==============================================================================
--- trunk/src/spf_render.c	(original)
+++ trunk/src/spf_render.c	Tue Jan 27 10:24:45 2009
@@ -741,9 +741,26 @@
                             const HUGEFLOATVAL thefloat =
                                 obj->getfloat(interp, info.type, obj);
 
-                            /* turn -0.0 into 0.0 */
-                            gen_sprintf_call(tc, &info, ch);
-                            ts = cstr2pstr(tc);
+                            /* check for Inf and NaN values */
+                            if (thefloat == PARROT_FLOATVAL_INF_POSITIVE) {
+                                ts = cstr2pstr(PARROT_CSTRING_INF_POSITIVE);
+                            }
+                            else if (thefloat == PARROT_FLOATVAL_INF_NEGATIVE) {
+                                ts = cstr2pstr(PARROT_CSTRING_INF_NEGATIVE);
+                            }
+                            /* XXX for some reason, this comparison isn't working
+                            else if (thefloat == PARROT_FLOATVAL_NAN_QUIET) {
+                                ts = cstr2pstr(PARROT_CSTRING_NAN_QUIET);
+                            }
+                            */
+                            else if (thefloat != thefloat) {
+                                ts = cstr2pstr(PARROT_CSTRING_NAN_QUIET);
+                            }
+                            else {
+                                /* turn -0.0 into 0.0 */
+                                gen_sprintf_call(tc, &info, ch);
+                                ts = cstr2pstr(tc);
+                            }
 
                             /* XXX lost precision if %Hg or whatever */
                             {

Modified: trunk/t/compilers/imcc/syn/veracity.t
==============================================================================
--- trunk/t/compilers/imcc/syn/veracity.t	(original)
+++ trunk/t/compilers/imcc/syn/veracity.t	Tue Jan 27 10:24:45 2009
@@ -107,12 +107,11 @@
 
 #}
 
-SKIP: {
-    skip 'failing on win32' => 1 if $^O =~ m/win32/i;
 
 pir_output_is( <<'CODE', <<'OUT', "Float NaN" );
 .sub test :main
     $N0 = 'NaN'
+    say $N0
     unless $N0 goto not_nan
     say "NaN is true"
 
@@ -120,10 +119,10 @@
     end
 .end
 CODE
+NaN
 NaN is true
 OUT
 
-}
 
 # Local Variables:
 #   mode: cperl

Modified: trunk/t/op/arithmetics.t
==============================================================================
--- trunk/t/op/arithmetics.t	(original)
+++ trunk/t/op/arithmetics.t	Tue Jan 27 10:24:45 2009
@@ -7,7 +7,7 @@
 use lib qw( . lib ../lib ../../lib );
 
 use Test::More;
-use Parrot::Test tests => 27;
+use Parrot::Test tests => 28;
 
 # test for GMP
 use Parrot::Config;
@@ -866,7 +866,7 @@
 # In the meantime, make sure it overflows nicely
 # on 32 bit.
     unless i2 > 40 goto next
-.end
+`.end
 CODE
 2
 4
@@ -911,6 +911,20 @@
 OUTPUT
 }
 
+
+pir_output_is( <<'CODE', <<OUTPUT, "Inf/NaN - basic arith" );
+.sub 'test' :main
+    $N0 = 'Inf'
+    say $N0
+    $N0 -= $N0
+    say $N0
+.end
+CODE
+Inf
+NaN
+OUTPUT
+
+
 # Local Variables:
 #   mode: cperl
 #   cperl-indent-level: 4

• [svn:parrot] r36057 - in trunk: . config/auto config/auto/format config/gen/config_h include/parrot src t/compilers/imcc/syn t/op by particle