re PR fortran/32049 (Support on x86_64 also kind=16)

	PR fortran/32049

	* gfortran.h (gfc_real_info): Add c_float128 field.
	* mathbuiltins.def: Indicate which builtins are const.
	* trans-types.h (float128_type_node, complex_float128_type_node,
	gfc_real16_is_float128): New variables.
	* trans-types.c (float128_type_node, complex_float128_type_node,
	gfc_real16_is_float128): New variables.
	(gfc_init_kinds): Allow TFmode.
	(gfc_build_real_type): Mark __float128 types as such.
	(gfc_init_types): Initialize float128_type_node and
	complex_float128_type_node
	* f95-lang.c (gfc_init_builtin_functions): Adjust for new
	argument of OTHER_BUILTIN macro.
	* trans-intrinsic.c (gfc_intrinsic_map_t): Likewise.
	(builtin_decl_for_precision): Special case for __float128.
	(builtin_decl_for_float_kind): Likewise.
	(define_quad_builtin): New function.
	(gfc_build_intrinsic_lib_fndecls): Create all __float128
	library decls if necessary. Store them in the real16_decl and
	complex16_decl builtin map fields.
	(gfc_get_intrinsic_lib_fndecl): Handle q-suffixed __float128
	library function names.

	* gfortran.dg/random_seed_1.f90: Adjust test.
	* gfortran.dg/float128_1.f90: New test.

From-SVN: r163597

gcc/fortran/ChangeLog

+2010-08-27  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/32049
+	* gfortran.h (gfc_real_info): Add c_float128 field.
+	* mathbuiltins.def: Indicate which builtins are const.
+	* trans-types.h (float128_type_node, complex_float128_type_node,
+	gfc_real16_is_float128): New variables.
+	* trans-types.c (float128_type_node, complex_float128_type_node,
+	gfc_real16_is_float128): New variables.
+	(gfc_init_kinds): Allow TFmode.
+	(gfc_build_real_type): Mark __float128 types as such.
+	(gfc_init_types): Initialize float128_type_node and
+	complex_float128_type_node
+	* f95-lang.c (gfc_init_builtin_functions): Adjust for new
+	argument of OTHER_BUILTIN macro.
+	* trans-intrinsic.c (gfc_intrinsic_map_t): Likewise.
+	(builtin_decl_for_precision): Special case for __float128.
+	(builtin_decl_for_float_kind): Likewise.
+	(define_quad_builtin): New function.
+	(gfc_build_intrinsic_lib_fndecls): Create all __float128
+	library decls if necessary. Store them in the real16_decl and
+	complex16_decl builtin map fields.
+	(gfc_get_intrinsic_lib_fndecl): Handle q-suffixed __float128
+	library function names.
+
 2010-08-27  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/33197

gcc/fortran/f95-lang.c

@@ -788,7 +788,7 @@ gfc_init_builtin_functions (void)
     build_function_type_list (void_type_node, ptype, ptype, NULL_TREE);
 
 /* Non-math builtins are defined manually, so they're not included here.  */
-#define OTHER_BUILTIN(ID,NAME,TYPE)
+#define OTHER_BUILTIN(ID,NAME,TYPE,CONST)
 
 #include "mathbuiltins.def"
 

gcc/fortran/gfortran.h

@@ -1822,6 +1822,7 @@ typedef struct
   unsigned int c_float : 1;
   unsigned int c_double : 1;
   unsigned int c_long_double : 1;
+  unsigned int c_float128 : 1;
 }
 gfc_real_info;
 

gcc/fortran/mathbuiltins.def

@@ -52,19 +52,19 @@ DEFINE_MATH_BUILTIN   (TGAMMA,"tgamma", 0)
 DEFINE_MATH_BUILTIN   (LGAMMA,"lgamma", 0)
 DEFINE_MATH_BUILTIN   (HYPOT, "hypot",  1)
 
-/* OTHER_BUILTIN (CODE, NAME, PROTOTYPE_TYPE)
+/* OTHER_BUILTIN (CODE, NAME, PROTOTYPE_TYPE, CONST)
    For floating-point builtins that do not directly correspond to a
    Fortran intrinsic. This is used to map the different variants (float,
    double and long double) and to build the quad-precision decls.  */
-OTHER_BUILTIN (CABS,      "cabs",      cabs)
-OTHER_BUILTIN (COPYSIGN,  "copysign",  2)
-OTHER_BUILTIN (FABS,      "fabs",      1)
-OTHER_BUILTIN (FMOD,      "fmod",      2)
-OTHER_BUILTIN (FREXP,     "frexp",     frexp)
-OTHER_BUILTIN (HUGE_VAL,  "huge_val",  0)
-OTHER_BUILTIN (LLROUND,   "llround",   llround)
-OTHER_BUILTIN (LROUND,    "lround",    lround)
-OTHER_BUILTIN (NEXTAFTER, "nextafter", 2)
-OTHER_BUILTIN (ROUND,     "round",     1)
-OTHER_BUILTIN (SCALBN,    "scalbn",    scalbn)
-OTHER_BUILTIN (TRUNC,     "trunc",     1)
+OTHER_BUILTIN (CABS,      "cabs",      cabs,    true)
+OTHER_BUILTIN (COPYSIGN,  "copysign",  2,       true)
+OTHER_BUILTIN (FABS,      "fabs",      1,       true)
+OTHER_BUILTIN (FMOD,      "fmod",      2,       true)
+OTHER_BUILTIN (FREXP,     "frexp",     frexp,   false)
+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 (ROUND,     "round",     1,       true)
+OTHER_BUILTIN (SCALBN,    "scalbn",    scalbn,  true)
+OTHER_BUILTIN (TRUNC,     "trunc",     1,       true)

gcc/fortran/trans-intrinsic.c

@@ -105,10 +105,10 @@ gfc_intrinsic_map_t;
     false, HAVE_COMPLEX, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, \
     NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE }
 
-#define OTHER_BUILTIN(ID, NAME, TYPE) \
+#define OTHER_BUILTIN(ID, NAME, TYPE, CONST) \
   { GFC_ISYM_NONE, BUILT_IN_ ## ID ## F, BUILT_IN_ ## ID, \
     BUILT_IN_ ## ID ## L, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
-    true, false, true, NAME, NULL_TREE, NULL_TREE, \
+    true, false, CONST, NAME, NULL_TREE, NULL_TREE, \
     NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE},
 
 static GTY(()) gfc_intrinsic_map_t gfc_intrinsic_map[] =
@@ -151,6 +151,12 @@ builtin_decl_for_precision (enum built_in_function base_built_in,
     i = m->double_built_in;
   else if (precision == TYPE_PRECISION (long_double_type_node))
     i = m->long_double_built_in;
+  else if (precision == TYPE_PRECISION (float128_type_node))
+    {
+      /* Special treatment, because it is not exactly a built-in, but
+	 a library function.  */
+      return m->real16_decl;
+    }
 
   return (i == END_BUILTINS ? NULL_TREE : built_in_decls[i]);
 }
@@ -160,6 +166,18 @@ static tree
 builtin_decl_for_float_kind (enum built_in_function double_built_in, int kind)
 {
   int i = gfc_validate_kind (BT_REAL, kind, false);
+
+  if (gfc_real_kinds[i].c_float128)
+    {
+      /* For __float128, the story is a bit different, because we return
+	 a decl to a library function rather than a built-in.  */
+      gfc_intrinsic_map_t *m; 
+      for (m = gfc_intrinsic_map; m->double_built_in != double_built_in ; m++)
+	;
+
+      return m->real16_decl;
+    }
+
   return builtin_decl_for_precision (double_built_in,
 				     gfc_real_kinds[i].mode_precision);
 }
@@ -557,6 +575,28 @@ gfc_conv_intrinsic_conjg (gfc_se * se, gfc_expr * expr)
 }
 
 
+
+static tree
+define_quad_builtin (const char *name, tree type, bool is_const)
+{
+  tree fndecl;
+  fndecl = build_decl (input_location, FUNCTION_DECL, get_identifier (name),
+		       type);
+
+  /* Mark the decl as external.  */
+  DECL_EXTERNAL (fndecl) = 1;
+  TREE_PUBLIC (fndecl) = 1;
+
+  /* Mark it __attribute__((const)).  */
+  TREE_READONLY (fndecl) = is_const;
+
+  rest_of_decl_compilation (fndecl, 1, 0);
+
+  return fndecl;
+}
+
+
+
 /* Initialize function decls for library functions.  The external functions
    are created as required.  Builtin functions are added here.  */
 
@@ -564,6 +604,62 @@ void
 gfc_build_intrinsic_lib_fndecls (void)
 {
   gfc_intrinsic_map_t *m;
+  tree quad_decls[(int) END_BUILTINS];
+
+  if (gfc_real16_is_float128)
+  {
+    /* If we have soft-float types, we create the decls for their
+       C99-like library functions.  For now, we only handle __float128
+       q-suffixed functions.  */
+
+    tree tmp, func_0, func_1, func_2, func_cabs, func_frexp;
+    tree func_lround, func_llround, func_scalbn;
+
+    memset (quad_decls, 0, sizeof(tree) * (int) END_BUILTINS);
+
+    /* type (*) (void) */
+    func_0 = build_function_type (float128_type_node, void_list_node);
+    /* type (*) (type) */
+    tmp = tree_cons (NULL_TREE, float128_type_node, void_list_node);
+    func_1 = build_function_type (float128_type_node, tmp);
+    /* long (*) (type) */
+    func_lround = build_function_type (long_integer_type_node, tmp);
+    /* long long (*) (type) */
+    func_llround = build_function_type (long_long_integer_type_node, tmp);
+    /* type (*) (type, type) */
+    tmp = tree_cons (NULL_TREE, float128_type_node, tmp);
+    func_2 = build_function_type (float128_type_node, tmp);
+    /* type (*) (type, &int) */
+    tmp = tree_cons (NULL_TREE, float128_type_node, void_list_node);
+    tmp = tree_cons (NULL_TREE, build_pointer_type (integer_type_node), tmp);
+    func_frexp = build_function_type (float128_type_node, tmp);
+    /* type (*) (type, int) */
+    tmp = tree_cons (NULL_TREE, float128_type_node, void_list_node);
+    tmp = tree_cons (NULL_TREE, integer_type_node, tmp);
+    func_scalbn = build_function_type (float128_type_node, tmp);
+    /* type (*) (complex type) */
+    tmp = tree_cons (NULL_TREE, complex_float128_type_node, void_list_node);
+    func_cabs = build_function_type (float128_type_node, tmp);
+
+#define DEFINE_MATH_BUILTIN(ID, NAME, ARGTYPE)
+#define DEFINE_MATH_BUILTIN_C(ID, NAME, ARGTYPE)
+#define LIB_FUNCTION(ID, NAME, HAVE_COMPLEX)
+
+    /* Only these built-ins are actually needed here. These are used directly
+       from the code, when calling builtin_decl_for_precision() or
+       builtin_decl_for_float_type(). The others are all constructed by
+       gfc_get_intrinsic_lib_fndecl().  */
+#define OTHER_BUILTIN(ID, NAME, TYPE, CONST) \
+  quad_decls[BUILT_IN_ ## ID] = define_quad_builtin (NAME "q", func_ ## TYPE, CONST);
+
+#include "mathbuiltins.def"
+
+#undef OTHER_BUILTIN
+#undef LIB_FUNCTION
+#undef DEFINE_MATH_BUILTIN
+#undef DEFINE_MATH_BUILTIN_C
+
+  }
 
   /* Add GCC builtin functions.  */
   for (m = gfc_intrinsic_map;
@@ -584,13 +680,27 @@ gfc_build_intrinsic_lib_fndecls (void)
       if (m->complex_long_double_built_in != END_BUILTINS)
 	m->complex10_decl = built_in_decls[m->complex_long_double_built_in];
 
-      /* For now, we assume that if real(kind=16) exists, it is long double.
-	 Later, we will deal with __float128 and break this assumption.  */
+      if (!gfc_real16_is_float128)
+	{
 	  if (m->long_double_built_in != END_BUILTINS)
 	    m->real16_decl = built_in_decls[m->long_double_built_in];
 	  if (m->complex_long_double_built_in != END_BUILTINS)
 	    m->complex16_decl = built_in_decls[m->complex_long_double_built_in];
 	}
+      else if (quad_decls[m->double_built_in] != NULL_TREE)
+        {
+	  /* Quad-precision function calls are constructed when first
+	     needed by builtin_decl_for_precision(), except for those
+	     that will be used directly (define by OTHER_BUILTIN).  */
+	  m->real16_decl = quad_decls[m->double_built_in];
+	}
+      else if (quad_decls[m->complex_double_built_in] != NULL_TREE)
+        {
+	  /* Same thing for the complex ones.  */
+	  m->complex16_decl = quad_decls[m->double_built_in];
+	  m->real16_decl = quad_decls[m->double_built_in];
+	}
+    }
 }
 
 
@@ -668,6 +778,9 @@ gfc_get_intrinsic_lib_fndecl (gfc_intrinsic_map_t * m, gfc_expr * expr)
       else if (gfc_real_kinds[n].c_long_double)
 	snprintf (name, sizeof (name), "%s%s%s",
 		  ts->type == BT_COMPLEX ? "c" : "", m->name, "l");
+      else if (gfc_real_kinds[n].c_float128)
+	snprintf (name, sizeof (name), "%s%s%s",
+		  ts->type == BT_COMPLEX ? "c" : "", m->name, "q");
       else
 	gcc_unreachable ();
     }

gcc/fortran/trans-types.c

@@ -64,6 +64,11 @@ tree pfunc_type_node;
 
 tree gfc_charlen_type_node;
 
+tree float128_type_node = NULL_TREE;
+tree complex_float128_type_node = NULL_TREE;
+
+bool gfc_real16_is_float128 = false;
+
 static GTY(()) tree gfc_desc_dim_type;
 static GTY(()) tree gfc_max_array_element_size;
 static GTY(()) tree gfc_array_descriptor_base[2 * GFC_MAX_DIMENSIONS];
@@ -403,12 +408,14 @@ gfc_init_kinds (void)
       if (!targetm.scalar_mode_supported_p ((enum machine_mode) mode))
 	continue;
 
-      /* Only let float/double/long double go through because the fortran
-	 library assumes these are the only floating point types.  */
-
+      /* Only let float, double, long double and __float128 go through.
+	 Runtime support for others is not provided, so they would be
+	 useless.  TFmode support is only enabled with option
+	 -fsoft-float. 	*/
 	if (mode != TYPE_MODE (float_type_node)
 	  && (mode != TYPE_MODE (double_type_node))
-          && (mode != TYPE_MODE (long_double_type_node)))
+          && (mode != TYPE_MODE (long_double_type_node))
+	  && (mode != TFmode))
 	continue;
 
       /* Let the kind equal the precision divided by 8, rounding up.  Again,
@@ -711,6 +718,11 @@ gfc_build_real_type (gfc_real_info *info)
     info->c_double = 1;
   if (mode_precision == LONG_DOUBLE_TYPE_SIZE)
     info->c_long_double = 1;
+  if (mode_precision != LONG_DOUBLE_TYPE_SIZE && mode_precision == 128)
+    {
+      info->c_float128 = 1;
+      gfc_real16_is_float128 = true;
+    }
 
   if (TYPE_PRECISION (float_type_node) == mode_precision)
     return float_type_node;
@@ -835,11 +847,17 @@ gfc_init_types (void)
 		gfc_real_kinds[index].kind);
       PUSH_TYPE (name_buf, type);
 
+      if (gfc_real_kinds[index].c_float128)
+	float128_type_node = type;
+
       type = gfc_build_complex_type (type);
       gfc_complex_types[index] = type;
       snprintf (name_buf, sizeof(name_buf), "complex(kind=%d)",
 		gfc_real_kinds[index].kind);
       PUSH_TYPE (name_buf, type);
+
+      if (gfc_real_kinds[index].c_float128)
+	complex_float128_type_node = type;
     }
 
   for (index = 0; gfc_character_kinds[index].kind != 0; ++index)

gcc/fortran/trans-types.h

@@ -31,6 +31,8 @@ extern GTY(()) tree ppvoid_type_node;
 extern GTY(()) tree pvoid_type_node;
 extern GTY(()) tree prvoid_type_node;
 extern GTY(()) tree pchar_type_node;
+extern GTY(()) tree float128_type_node;
+extern GTY(()) tree complex_float128_type_node;
 
 /* This is the type used to hold the lengths of character variables.
    It must be the same as the corresponding definition in gfortran.h.  */
@@ -38,6 +40,11 @@ extern GTY(()) tree pchar_type_node;
    and runtime library.  */
 extern GTY(()) tree gfc_charlen_type_node;
 
+/* The following flags give us information on the correspondance of
+   real (and complex) kinds with C floating-point types long double
+   and __float128.  */
+extern bool gfc_real16_is_float128;
+
 typedef enum {
   PACKED_NO = 0,
   PACKED_PARTIAL,

gcc/testsuite/ChangeLog

+2010-08-27  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/32049
+	* gfortran.dg/random_seed_1.f90: Adjust test.
+	* gfortran.dg/float128_1.f90: New test.
+
 2010-08-27  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/33197

gcc/testsuite/gfortran.dg/float128_1.f90

+! Check that __float128 can be used where it's supported
+!
+! { dg-do compile { target ia64-*-* i?86-*-* x86_64-*-* } }
+! { dg-options "-fdump-tree-original" }
+! { dg-final { scan-tree-dump "sqrtq" "original" } }
+! { dg-final { scan-tree-dump "cabsq" "original" } }
+! { dg-final { scan-tree-dump "cosl" "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+!
+  real(kind=16) :: x1, x2
+  complex(kind=16) :: z1, z2
+
+  real(kind=10) :: y
+
+  read (*,*) x1
+  x2 = sqrt(x1)                         ! sqrtq
+  z1 = x1 + (0._16 , 1.0_16)
+  z2 = z1 / (1._16, 2._16)
+
+  x1 = abs(z2)                          ! cabsq
+
+
+  y = 2
+  y = cos(y)                            ! cosl
+
+  print *, x1, x2, z1, z2, y
+
+end

gcc/testsuite/gfortran.dg/random_seed_1.f90

@@ -13,8 +13,17 @@
 
 PROGRAM random_seed_1
   IMPLICIT NONE
-  INTEGER, PARAMETER :: k = selected_real_kind (precision (0.0_8) + 1)
-  INTEGER, PARAMETER :: nbytes = MERGE(48, 32, k == 16)
+
+  ! Find out what the's largest kind size
+  INTEGER, PARAMETER :: k1 = kind (0.d0)
+  INTEGER, PARAMETER :: &
+    k2 = max (k1, selected_real_kind (precision (0._k1) + 1))
+  INTEGER, PARAMETER :: &
+    k3 = max (k2, selected_real_kind (precision (0._k2) + 1))
+  INTEGER, PARAMETER :: &
+    k4 = max (k3, selected_real_kind (precision (0._k3) + 1))
+
+  INTEGER, PARAMETER :: nbytes = MERGE(48, 32, k4 == 16)
 
   ! '+1' to avoid out-of-bounds warnings
   INTEGER, PARAMETER    :: n = nbytes / KIND(n) + 1