]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
trans-expr.c (gfc_conv_power_op): Handle floating-point types other than long double.
authorFrancois-Xavier Coudert <fxcoudert@gcc.gnu.org>
Wed, 1 Sep 2010 08:40:53 +0000 (08:40 +0000)
committerFrançois-Xavier Coudert <fxcoudert@gcc.gnu.org>
Wed, 1 Sep 2010 08:40:53 +0000 (08:40 +0000)
* trans-expr.c (gfc_conv_power_op): Handle floating-point types
other than long double.
* mathbuiltins.def: Add builtins from the POW and CPOW family.
* trans.h (gfc_builtin_decl_for_float_kind): New prototype.
* trans-intrinsic.c (gfc_builtin_decl_for_float_kind): Add gfc_
prefix to function name.
(gfc_build_intrinsic_lib_fndecls): Add cpow prototype.
(gfc_conv_intrinsic_aint): Use gfc_builtin_decl_for_float_kind
function name.
(gfc_conv_intrinsic_exponent): Likewise.
(gfc_conv_intrinsic_abs): Likewise.
(gfc_conv_intrinsic_mod): Likewise.
(gfc_conv_intrinsic_sign): Likewise.
(gfc_conv_intrinsic_arith): Likewise.
(gfc_conv_intrinsic_fraction): Likewise.
(gfc_conv_intrinsic_nearest): Likewise.
(gfc_conv_intrinsic_spacing): Likewise.
(gfc_conv_intrinsic_rrspacing): Likewise.
(gfc_conv_intrinsic_scale): Likewise.
(gfc_conv_intrinsic_set_exponent): Likewise.

From-SVN: r163721

gcc/fortran/ChangeLog
gcc/fortran/mathbuiltins.def
gcc/fortran/trans-expr.c
gcc/fortran/trans-intrinsic.c
gcc/fortran/trans.h

index e943469eaf7f01795e7f93a93f8c1a0090df859e..638350b2dc6a9331c9e2505f421d283a51432efd 100644 (file)
@@ -1,3 +1,26 @@
+2010-09-01  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+       * trans-expr.c (gfc_conv_power_op): Handle floating-point types
+       other than long double.
+       * mathbuiltins.def: Add builtins from the POW and CPOW family.
+       * trans.h (gfc_builtin_decl_for_float_kind): New prototype.
+       * trans-intrinsic.c (gfc_builtin_decl_for_float_kind): Add gfc_
+       prefix to function name.
+       (gfc_build_intrinsic_lib_fndecls): Add cpow prototype.
+       (gfc_conv_intrinsic_aint): Use gfc_builtin_decl_for_float_kind
+       function name.
+       (gfc_conv_intrinsic_exponent): Likewise.
+       (gfc_conv_intrinsic_abs): Likewise.
+       (gfc_conv_intrinsic_mod): Likewise.
+       (gfc_conv_intrinsic_sign): Likewise.
+       (gfc_conv_intrinsic_arith): Likewise.
+       (gfc_conv_intrinsic_fraction): Likewise.
+       (gfc_conv_intrinsic_nearest): Likewise.
+       (gfc_conv_intrinsic_spacing): Likewise.
+       (gfc_conv_intrinsic_rrspacing): Likewise.
+       (gfc_conv_intrinsic_scale): Likewise.
+       (gfc_conv_intrinsic_set_exponent): Likewise.
+
 2010-09-01  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
        * intrinsic.c: Add EXECUTE_COMMAND_LINE intrinsic.
index 074390e9631fe02b701652ea14100e7d6720b3f0..660fee8ec376eb580738e0bd7b4c6f5a002ab9b8 100644 (file)
@@ -58,6 +58,7 @@ DEFINE_MATH_BUILTIN   (HYPOT, "hypot",  1)
    double and long double) and to build the quad-precision decls.  */
 OTHER_BUILTIN (CABS,      "cabs",      cabs,    true)
 OTHER_BUILTIN (COPYSIGN,  "copysign",  2,       true)
+OTHER_BUILTIN (CPOW,      "cpow",      cpow,    true)
 OTHER_BUILTIN (FABS,      "fabs",      1,       true)
 OTHER_BUILTIN (FMOD,      "fmod",      2,       true)
 OTHER_BUILTIN (FREXP,     "frexp",     frexp,   false)
@@ -65,6 +66,7 @@ OTHER_BUILTIN (HUGE_VAL,  "huge_val",  0,       true)
 OTHER_BUILTIN (LLROUND,   "llround",   llround, true)
 OTHER_BUILTIN (LROUND,    "lround",    lround,  true)
 OTHER_BUILTIN (NEXTAFTER, "nextafter", 2,       true)
+OTHER_BUILTIN (POW,       "pow",       1,       true)
 OTHER_BUILTIN (ROUND,     "round",     1,       true)
 OTHER_BUILTIN (SCALBN,    "scalbn",    scalbn,  true)
 OTHER_BUILTIN (TRUNC,     "trunc",     1,       true)
index 103bc2461f0e8850c89d28cc50b3347f06827fb3..b4bc8caa69613461ccb4a78e667363e170bfc251 100644 (file)
@@ -958,7 +958,7 @@ gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
   int ikind;
   gfc_se lse;
   gfc_se rse;
-  tree fndecl;
+  tree fndecl = NULL;
 
   gfc_init_se (&lse, se);
   gfc_conv_expr_val (&lse, expr->value.op.op1);
@@ -1056,15 +1056,24 @@ gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
                  break;
 
                case 2:
-               case 3:
                  fndecl = built_in_decls[BUILT_IN_POWIL];
                  break;
 
+               case 3:
+                 /* Use the __builtin_powil() only if real(kind=16) is 
+                    actually the C long double type.  */
+                 if (!gfc_real16_is_float128)
+                   fndecl = built_in_decls[BUILT_IN_POWIL];
+                 break;
+
                default:
                  gcc_unreachable ();
                }
            }
-         else
+
+         /* If we don't have a good builtin for this, go for the 
+            library function.  */
+         if (!fndecl)
            fndecl = gfor_fndecl_math_powi[kind][ikind].real;
          break;
 
@@ -1078,39 +1087,11 @@ gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
       break;
 
     case BT_REAL:
-      switch (kind)
-       {
-       case 4:
-         fndecl = built_in_decls[BUILT_IN_POWF];
-         break;
-       case 8:
-         fndecl = built_in_decls[BUILT_IN_POW];
-         break;
-       case 10:
-       case 16:
-         fndecl = built_in_decls[BUILT_IN_POWL];
-         break;
-       default:
-         gcc_unreachable ();
-       }
+      fndecl = gfc_builtin_decl_for_float_kind (BUILT_IN_POW, kind);
       break;
 
     case BT_COMPLEX:
-      switch (kind)
-       {
-       case 4:
-         fndecl = built_in_decls[BUILT_IN_CPOWF];
-         break;
-       case 8:
-         fndecl = built_in_decls[BUILT_IN_CPOW];
-         break;
-       case 10:
-       case 16:
-         fndecl = built_in_decls[BUILT_IN_CPOWL];
-         break;
-       default:
-         gcc_unreachable ();
-       }
+      fndecl = gfc_builtin_decl_for_float_kind (BUILT_IN_CPOW, kind);
       break;
 
     default:
index c0f39b22309fe1aac693b607f67a986e3e164ceb..2937734b9cffa2a1738819e2a0c229c2a261bfd2 100644 (file)
@@ -162,8 +162,9 @@ builtin_decl_for_precision (enum built_in_function base_built_in,
 }
 
 
-static tree
-builtin_decl_for_float_kind (enum built_in_function double_built_in, int kind)
+tree
+gfc_builtin_decl_for_float_kind (enum built_in_function double_built_in,
+                                int kind)
 {
   int i = gfc_validate_kind (BT_REAL, kind, false);
 
@@ -462,11 +463,11 @@ gfc_conv_intrinsic_aint (gfc_se * se, gfc_expr * expr, enum rounding_mode op)
   switch (op)
     {
     case RND_ROUND:
-      decl = builtin_decl_for_float_kind (BUILT_IN_ROUND, kind);
+      decl = gfc_builtin_decl_for_float_kind (BUILT_IN_ROUND, kind);
       break;
 
     case RND_TRUNC:
-      decl = builtin_decl_for_float_kind (BUILT_IN_TRUNC, kind);
+      decl = gfc_builtin_decl_for_float_kind (BUILT_IN_TRUNC, kind);
       break;
 
     default:
@@ -613,7 +614,7 @@ gfc_build_intrinsic_lib_fndecls (void)
        q-suffixed functions.  */
 
     tree tmp, func_0, func_1, func_2, func_cabs, func_frexp;
-    tree func_lround, func_llround, func_scalbn;
+    tree func_lround, func_llround, func_scalbn, func_cpow;
 
     memset (quad_decls, 0, sizeof(tree) * (int) END_BUILTINS);
 
@@ -640,6 +641,9 @@ gfc_build_intrinsic_lib_fndecls (void)
     /* type (*) (complex type) */
     tmp = tree_cons (NULL_TREE, complex_float128_type_node, void_list_node);
     func_cabs = build_function_type (float128_type_node, tmp);
+    /* complex type (*) (complex type, complex type) */
+    tmp = tree_cons (NULL_TREE, complex_float128_type_node, tmp);
+    func_cpow = build_function_type (complex_float128_type_node, tmp);
 
 #define DEFINE_MATH_BUILTIN(ID, NAME, ARGTYPE)
 #define DEFINE_MATH_BUILTIN_C(ID, NAME, ARGTYPE)
@@ -895,7 +899,7 @@ gfc_conv_intrinsic_exponent (gfc_se *se, gfc_expr *expr)
 {
   tree arg, type, res, tmp, frexp;
 
-  frexp = builtin_decl_for_float_kind (BUILT_IN_FREXP,
+  frexp = gfc_builtin_decl_for_float_kind (BUILT_IN_FREXP,
                                       expr->value.function.actual->expr->ts.kind);
 
   gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
@@ -1094,7 +1098,7 @@ gfc_conv_intrinsic_abs (gfc_se * se, gfc_expr * expr)
       break;
 
     case BT_COMPLEX:
-      cabs = builtin_decl_for_float_kind (BUILT_IN_CABS, expr->ts.kind);
+      cabs = gfc_builtin_decl_for_float_kind (BUILT_IN_CABS, expr->ts.kind);
       se->expr = build_call_expr_loc (input_location, cabs, 1, arg);
       break;
 
@@ -1169,7 +1173,7 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo)
     case BT_REAL:
       fmod = NULL_TREE;
       /* Check if we have a builtin fmod.  */
-      fmod = builtin_decl_for_float_kind (BUILT_IN_FMOD, expr->ts.kind);
+      fmod = gfc_builtin_decl_for_float_kind (BUILT_IN_FMOD, expr->ts.kind);
 
       /* Use it if it exists.  */
       if (fmod != NULL_TREE)
@@ -1291,8 +1295,8 @@ gfc_conv_intrinsic_sign (gfc_se * se, gfc_expr * expr)
     {
       tree abs;
 
-      tmp = builtin_decl_for_float_kind (BUILT_IN_COPYSIGN, expr->ts.kind);
-      abs = builtin_decl_for_float_kind (BUILT_IN_FABS, expr->ts.kind);
+      tmp = gfc_builtin_decl_for_float_kind (BUILT_IN_COPYSIGN, expr->ts.kind);
+      abs = gfc_builtin_decl_for_float_kind (BUILT_IN_FABS, expr->ts.kind);
 
       /* We explicitly have to ignore the minus sign. We do so by using
         result = (arg1 == 0) ? abs(arg0) : copysign(arg0, arg1).  */
@@ -2137,7 +2141,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
     {
       /* result = scale * sqrt(result).  */
       tree sqrt;
-      sqrt = builtin_decl_for_float_kind (BUILT_IN_SQRT, expr->ts.kind);
+      sqrt = gfc_builtin_decl_for_float_kind (BUILT_IN_SQRT, expr->ts.kind);
       resvar = build_call_expr_loc (input_location,
                                    sqrt, 1, resvar);
       resvar = fold_build2 (MULT_EXPR, type, scale, resvar);
@@ -3842,7 +3846,7 @@ gfc_conv_intrinsic_fraction (gfc_se * se, gfc_expr * expr)
 {
   tree arg, type, tmp, frexp;
 
-  frexp = builtin_decl_for_float_kind (BUILT_IN_FREXP, expr->ts.kind);
+  frexp = gfc_builtin_decl_for_float_kind (BUILT_IN_FREXP, expr->ts.kind);
 
   type = gfc_typenode_for_spec (&expr->ts);
   gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
@@ -3863,9 +3867,9 @@ gfc_conv_intrinsic_nearest (gfc_se * se, gfc_expr * expr)
 {
   tree args[2], type, tmp, nextafter, copysign, huge_val;
 
-  nextafter = builtin_decl_for_float_kind (BUILT_IN_NEXTAFTER, expr->ts.kind);
-  copysign = builtin_decl_for_float_kind (BUILT_IN_COPYSIGN, expr->ts.kind);
-  huge_val = builtin_decl_for_float_kind (BUILT_IN_HUGE_VAL, expr->ts.kind);
+  nextafter = gfc_builtin_decl_for_float_kind (BUILT_IN_NEXTAFTER, expr->ts.kind);
+  copysign = gfc_builtin_decl_for_float_kind (BUILT_IN_COPYSIGN, expr->ts.kind);
+  huge_val = gfc_builtin_decl_for_float_kind (BUILT_IN_HUGE_VAL, expr->ts.kind);
 
   type = gfc_typenode_for_spec (&expr->ts);
   gfc_conv_intrinsic_function_args (se, expr, args, 2);
@@ -3908,8 +3912,8 @@ gfc_conv_intrinsic_spacing (gfc_se * se, gfc_expr * expr)
   emin = build_int_cst (NULL_TREE, gfc_real_kinds[k].min_exponent - 1);
   tiny = gfc_conv_mpfr_to_tree (gfc_real_kinds[k].tiny, expr->ts.kind, 0);
 
-  frexp = builtin_decl_for_float_kind (BUILT_IN_FREXP, expr->ts.kind);
-  scalbn = builtin_decl_for_float_kind (BUILT_IN_SCALBN, expr->ts.kind);
+  frexp = gfc_builtin_decl_for_float_kind (BUILT_IN_FREXP, expr->ts.kind);
+  scalbn = gfc_builtin_decl_for_float_kind (BUILT_IN_SCALBN, expr->ts.kind);
 
   gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
   arg = gfc_evaluate_now (arg, &se->pre);
@@ -3967,9 +3971,9 @@ gfc_conv_intrinsic_rrspacing (gfc_se * se, gfc_expr * expr)
   k = gfc_validate_kind (BT_REAL, expr->ts.kind, false);
   prec = gfc_real_kinds[k].digits;
 
-  frexp = builtin_decl_for_float_kind (BUILT_IN_FREXP, expr->ts.kind);
-  scalbn = builtin_decl_for_float_kind (BUILT_IN_SCALBN, expr->ts.kind);
-  fabs = builtin_decl_for_float_kind (BUILT_IN_FABS, expr->ts.kind);
+  frexp = gfc_builtin_decl_for_float_kind (BUILT_IN_FREXP, expr->ts.kind);
+  scalbn = gfc_builtin_decl_for_float_kind (BUILT_IN_SCALBN, expr->ts.kind);
+  fabs = gfc_builtin_decl_for_float_kind (BUILT_IN_FABS, expr->ts.kind);
 
   type = gfc_typenode_for_spec (&expr->ts);
   gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
@@ -4007,7 +4011,7 @@ gfc_conv_intrinsic_scale (gfc_se * se, gfc_expr * expr)
 {
   tree args[2], type, scalbn;
 
-  scalbn = builtin_decl_for_float_kind (BUILT_IN_SCALBN, expr->ts.kind);
+  scalbn = gfc_builtin_decl_for_float_kind (BUILT_IN_SCALBN, expr->ts.kind);
 
   type = gfc_typenode_for_spec (&expr->ts);
   gfc_conv_intrinsic_function_args (se, expr, args, 2);
@@ -4025,8 +4029,8 @@ gfc_conv_intrinsic_set_exponent (gfc_se * se, gfc_expr * expr)
 {
   tree args[2], type, tmp, frexp, scalbn;
 
-  frexp = builtin_decl_for_float_kind (BUILT_IN_FREXP, expr->ts.kind);
-  scalbn = builtin_decl_for_float_kind (BUILT_IN_SCALBN, expr->ts.kind);
+  frexp = gfc_builtin_decl_for_float_kind (BUILT_IN_FREXP, expr->ts.kind);
+  scalbn = gfc_builtin_decl_for_float_kind (BUILT_IN_SCALBN, expr->ts.kind);
 
   type = gfc_typenode_for_spec (&expr->ts);
   gfc_conv_intrinsic_function_args (se, expr, args, 2);
index ff91413edf559f47d5df071147052dcb466cd98e..970ae0291b95c4b66eab4d7870846280346c46e7 100644 (file)
@@ -339,6 +339,9 @@ void gfc_conv_label_variable (gfc_se * se, gfc_expr * expr);
 /* If the value is not constant, Create a temporary and copy the value.  */
 tree gfc_evaluate_now (tree, stmtblock_t *);
 
+/* Find the appropriate variant of a math intrinsic.  */
+tree gfc_builtin_decl_for_float_kind (enum built_in_function, int);
+
 /* Intrinsic function handling.  */
 void gfc_conv_intrinsic_function (gfc_se *, gfc_expr *);