Merge branch 'devel/power-ieee128' of git+ssh://gcc.gnu.org/git/gcc into devel/power-ieee128

7 files changed, 438 insertions, 76 deletions

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 1846ee4fd3c..e2802e5108e 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2643,7 +2643,7 @@ extern gfc_logical_info gfc_logical_kinds[];
 typedef struct
 {
   mpfr_t epsilon, huge, tiny, subnormal;
-  int kind, radix, digits, min_exponent, max_exponent;
+  int kind, abi_kind, radix, digits, min_exponent, max_exponent;
   int range, precision;
 
   /* The precision of the type as reported by GET_MODE_PRECISION.  */
@@ -3499,6 +3499,12 @@ void gfc_intrinsic_init_1 (void);
 void gfc_intrinsic_done_1 (void);
 
 char gfc_type_letter (bt, bool logical_equals_int = false);
+int gfc_type_abi_kind (bt, int);
+static inline int
+gfc_type_abi_kind (gfc_typespec *ts)
+{
+  return gfc_type_abi_kind (ts->type, ts->kind);
+}
 gfc_symbol * gfc_get_intrinsic_sub_symbol (const char *);
 gfc_symbol *gfc_get_intrinsic_function_symbol (gfc_expr *);
 gfc_symbol *gfc_find_intrinsic_symbol (gfc_expr *);
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 3682f9ae21f..5452ac810bf 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -103,6 +103,27 @@ gfc_type_letter (bt type, bool logical_equals_int)
 }
 
 
+/* Return kind that should be used for ABI purposes in libgfortran
+   APIs.  Usually the same as ts->kind, except for BT_REAL/BT_COMPLEX
+   for IEEE 754 quad format kind 16 where it returns 17.  */
+
+int
+gfc_type_abi_kind (bt type, int kind)
+{
+  switch (type)
+    {
+    case BT_REAL:
+    case BT_COMPLEX:
+      if (kind == 16)
+	for (int i = 0; gfc_real_kinds[i].kind != 0; i++)
+	  if (gfc_real_kinds[i].kind == kind)
+	    return gfc_real_kinds[i].abi_kind;
+      return kind;
+    default:
+      return kind;
+    }
+}
+
 /* Get a symbol for a resolved name. Note, if needed be, the elemental
    attribute has be added afterwards.  */
 
@@ -167,8 +188,8 @@ static const char *
 conv_name (gfc_typespec *from, gfc_typespec *to)
 {
   return gfc_get_string ("__convert_%c%d_%c%d",
-			 gfc_type_letter (from->type), from->kind,
-			 gfc_type_letter (to->type), to->kind);
+			 gfc_type_letter (from->type), gfc_type_abi_kind (from),
+			 gfc_type_letter (to->type), gfc_type_abi_kind (to));
 }
 
 
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 598c0409b66..73891554e61 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -191,7 +191,8 @@ resolve_transformational (const char *name, gfc_expr *f, gfc_expr *array,
 
   f->value.function.name
     = gfc_get_string (PREFIX ("%s%s_%c%d"), prefix, name,
-		      gfc_type_letter (array->ts.type), array->ts.kind);
+		      gfc_type_letter (array->ts.type),
+		      gfc_type_abi_kind (&array->ts));
 }
 
 
@@ -206,7 +207,8 @@ gfc_resolve_abs (gfc_expr *f, gfc_expr *a)
     f->ts.type = BT_REAL;
 
   f->value.function.name
-    = gfc_get_string ("__abs_%c%d", gfc_type_letter (a->ts.type), a->ts.kind);
+    = gfc_get_string ("__abs_%c%d", gfc_type_letter (a->ts.type),
+		      gfc_type_abi_kind (&a->ts));
 }
 
 
@@ -256,7 +258,8 @@ gfc_resolve_char_achar (gfc_expr *f, gfc_expr *x, gfc_expr *kind,
 
   f->value.function.name
     = gfc_get_string ("__%schar_%d_%c%d", is_achar ? "a" : "", f->ts.kind,
-		      gfc_type_letter (x->ts.type), x->ts.kind);
+		      gfc_type_letter (x->ts.type),
+		      gfc_type_abi_kind (&x->ts));
 }
 
 
@@ -272,7 +275,8 @@ gfc_resolve_acos (gfc_expr *f, gfc_expr *x)
 {
   f->ts = x->ts;
   f->value.function.name
-    = gfc_get_string ("__acos_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+    = gfc_get_string ("__acos_%c%d", gfc_type_letter (x->ts.type),
+		      gfc_type_abi_kind (&x->ts));
 }
 
 
@@ -282,7 +286,7 @@ gfc_resolve_acosh (gfc_expr *f, gfc_expr *x)
   f->ts = x->ts;
   f->value.function.name
     = gfc_get_string ("__acosh_%c%d", gfc_type_letter (x->ts.type),
-		      x->ts.kind);
+		      gfc_type_abi_kind (&x->ts));
 }
 
 
@@ -293,7 +297,7 @@ gfc_resolve_aimag (gfc_expr *f, gfc_expr *x)
   f->ts.kind = x->ts.kind;
   f->value.function.name
     = gfc_get_string ("__aimag_%c%d", gfc_type_letter (x->ts.type),
-		      x->ts.kind);
+		      gfc_type_abi_kind (&x->ts));
 }
 
 
@@ -312,7 +316,8 @@ gfc_resolve_and (gfc_expr *f, gfc_expr *i, gfc_expr *j)
     }
 
   f->value.function.name
-    = gfc_get_string ("__and_%c%d", gfc_type_letter (i->ts.type), f->ts.kind);
+    = gfc_get_string ("__and_%c%d", gfc_type_letter (i->ts.type),
+		      gfc_type_abi_kind (&f->ts));
 }
 
 
@@ -334,7 +339,8 @@ gfc_resolve_aint (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
   /* The resolved name is only used for specific intrinsics where
      the return kind is the same as the arg kind.  */
   f->value.function.name
-    = gfc_get_string ("__aint_%c%d", gfc_type_letter (a->ts.type), a->ts.kind);
+    = gfc_get_string ("__aint_%c%d", gfc_type_letter (a->ts.type),
+		      gfc_type_abi_kind (&a->ts));
 }
 
 
@@ -359,7 +365,7 @@ gfc_resolve_all (gfc_expr *f, gfc_expr *mask, gfc_expr *dim)
 
   f->value.function.name
     = gfc_get_string (PREFIX ("all_%c%d"), gfc_type_letter (mask->ts.type),
-		      mask->ts.kind);
+		      gfc_type_abi_kind (&mask->ts));
 }
 
 
@@ -383,7 +389,7 @@ gfc_resolve_anint (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
      the return kind is the same as the arg kind.  */
   f->value.function.name
     = gfc_get_string ("__anint_%c%d", gfc_type_letter (a->ts.type),
-		      a->ts.kind);
+		      gfc_type_abi_kind (&a->ts));
 }
 
 
@@ -408,7 +414,7 @@ gfc_resolve_any (gfc_expr *f, gfc_expr *mask, gfc_expr *dim)
 
   f->value.function.name
     = gfc_get_string (PREFIX ("any_%c%d"), gfc_type_letter (mask->ts.type),
-		      mask->ts.kind);
+		      gfc_type_abi_kind (&mask->ts));
 }
 
 
@@ -417,7 +423,8 @@ gfc_resolve_asin (gfc_expr *f, gfc_expr *x)
 {
   f->ts = x->ts;
   f->value.function.name
-    = gfc_get_string ("__asin_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+    = gfc_get_string ("__asin_%c%d", gfc_type_letter (x->ts.type),
+		      gfc_type_abi_kind (&x->ts));
 }
 
 void
@@ -426,7 +433,7 @@ gfc_resolve_asinh (gfc_expr *f, gfc_expr *x)
   f->ts = x->ts;
   f->value.function.name
     = gfc_get_string ("__asinh_%c%d", gfc_type_letter (x->ts.type),
-		      x->ts.kind);
+		      gfc_type_abi_kind (&x->ts));
 }
 
 void
@@ -434,7 +441,8 @@ gfc_resolve_atan (gfc_expr *f, gfc_expr *x)
 {
   f->ts = x->ts;
   f->value.function.name
-    = gfc_get_string ("__atan_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+    = gfc_get_string ("__atan_%c%d", gfc_type_letter (x->ts.type),
+		      gfc_type_abi_kind (&x->ts));
 }
 
 void
@@ -443,7 +451,7 @@ gfc_resolve_atanh (gfc_expr *f, gfc_expr *x)
   f->ts = x->ts;
   f->value.function.name
     = gfc_get_string ("__atanh_%c%d", gfc_type_letter (x->ts.type),
-		      x->ts.kind);
+		      gfc_type_abi_kind (&x->ts));
 }
 
 void
@@ -452,7 +460,7 @@ gfc_resolve_atan2 (gfc_expr *f, gfc_expr *x, gfc_expr *y ATTRIBUTE_UNUSED)
   f->ts = x->ts;
   f->value.function.name
     = gfc_get_string ("__atan2_%c%d", gfc_type_letter (x->ts.type),
-		      x->ts.kind);
+		      gfc_type_abi_kind (&x->ts));
 }
 
 
@@ -507,10 +515,10 @@ gfc_resolve_bessel_n2 (gfc_expr *f, gfc_expr *n1, gfc_expr *n2, gfc_expr *x)
 
   if (f->value.function.isym->id == GFC_ISYM_JN2)
     f->value.function.name = gfc_get_string (PREFIX ("bessel_jn_r%d"),
-					     f->ts.kind);
+					     gfc_type_abi_kind (&f->ts));
   else
     f->value.function.name = gfc_get_string (PREFIX ("bessel_yn_r%d"),
-					     f->ts.kind);
+					     gfc_type_abi_kind (&f->ts));
 }
 
 
@@ -546,7 +554,8 @@ gfc_resolve_ceiling (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
 	     ? gfc_default_integer_kind : mpz_get_si (kind->value.integer);
   f->value.function.name
     = gfc_get_string ("__ceiling_%d_%c%d", f->ts.kind,
-		      gfc_type_letter (a->ts.type), a->ts.kind);
+		      gfc_type_letter (a->ts.type),
+		      gfc_type_abi_kind (&a->ts));
 }
 
 
@@ -618,12 +627,15 @@ gfc_resolve_cmplx (gfc_expr *f, gfc_expr *x, gfc_expr *y, gfc_expr *kind)
   if (y == NULL)
     f->value.function.name
       = gfc_get_string ("__cmplx0_%d_%c%d", f->ts.kind,
-			gfc_type_letter (x->ts.type), x->ts.kind);
+			gfc_type_letter (x->ts.type),
+			gfc_type_abi_kind (&x->ts));
   else
     f->value.function.name
       = gfc_get_string ("__cmplx1_%d_%c%d_%c%d", f->ts.kind,
-			gfc_type_letter (x->ts.type), x->ts.kind,
-			gfc_type_letter (y->ts.type), y->ts.kind);
+			gfc_type_letter (x->ts.type),
+			gfc_type_abi_kind (&x->ts),
+			gfc_type_letter (y->ts.type),
+			gfc_type_abi_kind (&y->ts));
 }
 
 
@@ -659,8 +671,10 @@ gfc_resolve_complex (gfc_expr *f, gfc_expr *x, gfc_expr *y)
   f->ts.kind = kind;
   f->value.function.name
     = gfc_get_string ("__cmplx1_%d_%c%d_%c%d", f->ts.kind,
-		      gfc_type_letter (x->ts.type), x->ts.kind,
-		      gfc_type_letter (y->ts.type), y->ts.kind);
+		      gfc_type_letter (x->ts.type),
+		      gfc_type_abi_kind (&x->ts),
+		      gfc_type_letter (y->ts.type),
+		      gfc_type_abi_kind (&y->ts));
 }
 
 
@@ -677,7 +691,8 @@ gfc_resolve_cos (gfc_expr *f, gfc_expr *x)
 {
   f->ts = x->ts;
   f->value.function.name
-    = gfc_get_string ("__cos_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+    = gfc_get_string ("__cos_%c%d", gfc_type_letter (x->ts.type),
+		      gfc_type_abi_kind (&x->ts));
 }
 
 
@@ -686,7 +701,8 @@ gfc_resolve_cosh (gfc_expr *f, gfc_expr *x)
 {
   f->ts = x->ts;
   f->value.function.name
-    = gfc_get_string ("__cosh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+    = gfc_get_string ("__cosh_%c%d", gfc_type_letter (x->ts.type),
+		      gfc_type_abi_kind (&x->ts));
 }
 
 
@@ -709,7 +725,7 @@ gfc_resolve_count (gfc_expr *f, gfc_expr *mask, gfc_expr *dim, gfc_expr *kind)
   resolve_mask_arg (mask);
 
   f->value.function.name
-    = gfc_get_string (PREFIX ("count_%d_%c"), f->ts.kind,
+    = gfc_get_string (PREFIX ("count_%d_%c"), gfc_type_abi_kind (&f->ts),
 		      gfc_type_letter (mask->ts.type));
 }
 
@@ -810,7 +826,8 @@ gfc_resolve_dble (gfc_expr *f, gfc_expr *a)
   f->ts.type = BT_REAL;
   f->ts.kind = gfc_default_double_kind;
   f->value.function.name
-    = gfc_get_string ("__dble_%c%d", gfc_type_letter (a->ts.type), a->ts.kind);
+    = gfc_get_string ("__dble_%c%d", gfc_type_letter (a->ts.type),
+		      gfc_type_abi_kind (&a->ts));
 }
 
 
@@ -832,7 +849,8 @@ gfc_resolve_dim (gfc_expr *f, gfc_expr *a, gfc_expr *p)
     }
 
   f->value.function.name
-    = gfc_get_string ("__dim_%c%d", gfc_type_letter (f->ts.type), f->ts.kind);
+    = gfc_get_string ("__dim_%c%d", gfc_type_letter (f->ts.type),
+		      gfc_type_abi_kind (&f->ts));
 }
 
 
@@ -850,7 +868,8 @@ gfc_resolve_dot_product (gfc_expr *f, gfc_expr *a, gfc_expr *b)
   f->ts = temp.ts;
   f->value.function.name
     = gfc_get_string (PREFIX ("dot_product_%c%d"),
-		      gfc_type_letter (f->ts.type), f->ts.kind);
+		      gfc_type_letter (f->ts.type),
+		      gfc_type_abi_kind (&f->ts));
 }
 
 
@@ -860,7 +879,8 @@ gfc_resolve_dprod (gfc_expr *f, gfc_expr *a ATTRIBUTE_UNUSED,
 {
   f->ts.kind = gfc_default_double_kind;
   f->ts.type = BT_REAL;
-  f->value.function.name = gfc_get_string ("__dprod_r%d", f->ts.kind);
+  f->value.function.name = gfc_get_string ("__dprod_r%d",
+					   gfc_type_abi_kind (&f->ts));
 }
 
 
@@ -951,7 +971,8 @@ gfc_resolve_exp (gfc_expr *f, gfc_expr *x)
 {
   f->ts = x->ts;
   f->value.function.name
-    = gfc_get_string ("__exp_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+    = gfc_get_string ("__exp_%c%d", gfc_type_letter (x->ts.type),
+		      gfc_type_abi_kind (&x->ts));
 }
 
 
@@ -1044,7 +1065,8 @@ gfc_resolve_floor (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
 	     ? gfc_default_integer_kind : mpz_get_si (kind->value.integer);
   f->value.function.name
     = gfc_get_string ("__floor%d_%c%d", f->ts.kind,
-		      gfc_type_letter (a->ts.type), a->ts.kind);
+		      gfc_type_letter (a->ts.type),
+		      gfc_type_abi_kind (&a->ts));
 }
 
 
@@ -1135,7 +1157,8 @@ void
 gfc_resolve_hypot (gfc_expr *f, gfc_expr *x, gfc_expr *y ATTRIBUTE_UNUSED)
 {
   f->ts = x->ts;
-  f->value.function.name = gfc_get_string ("__hypot_r%d", x->ts.kind);
+  f->value.function.name = gfc_get_string ("__hypot_r%d",
+					   gfc_type_abi_kind (&x->ts));
 }
 
 
@@ -1311,7 +1334,8 @@ gfc_resolve_int (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
 	     ? gfc_default_integer_kind : mpz_get_si (kind->value.integer);
   f->value.function.name
     = gfc_get_string ("__int_%d_%c%d", f->ts.kind,
-		      gfc_type_letter (a->ts.type), a->ts.kind);
+		      gfc_type_letter (a->ts.type),
+		      gfc_type_abi_kind (&a->ts));
 }
 
 
@@ -1322,7 +1346,8 @@ gfc_resolve_int2 (gfc_expr *f, gfc_expr *a)
   f->ts.kind = 2;
   f->value.function.name
     = gfc_get_string ("__int_%d_%c%d", f->ts.kind,
-		      gfc_type_letter (a->ts.type), a->ts.kind);
+		      gfc_type_letter (a->ts.type),
+		      gfc_type_abi_kind (&a->ts));
 }
 
 
@@ -1333,7 +1358,8 @@ gfc_resolve_int8 (gfc_expr *f, gfc_expr *a)
   f->ts.kind = 8;
   f->value.function.name
     = gfc_get_string ("__int_%d_%c%d", f->ts.kind,
-		      gfc_type_letter (a->ts.type), a->ts.kind);
+		      gfc_type_letter (a->ts.type),
+		      gfc_type_abi_kind (&a->ts));
 }
 
 
@@ -1344,7 +1370,8 @@ gfc_resolve_long (gfc_expr *f, gfc_expr *a)
   f->ts.kind = 4;
   f->value.function.name
     = gfc_get_string ("__int_%d_%c%d", f->ts.kind,
-		      gfc_type_letter (a->ts.type), a->ts.kind);
+		      gfc_type_letter (a->ts.type),
+		      gfc_type_abi_kind (&a->ts));
 }
 
 
@@ -1498,7 +1525,8 @@ gfc_resolve_log (gfc_expr *f, gfc_expr *x)
 {
   f->ts = x->ts;
   f->value.function.name
-    = gfc_get_string ("__log_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+    = gfc_get_string ("__log_%c%d", gfc_type_letter (x->ts.type),
+		      gfc_type_abi_kind (&x->ts));
 }
 
 
@@ -1508,7 +1536,7 @@ gfc_resolve_log10 (gfc_expr *f, gfc_expr *x)
   f->ts = x->ts;
   f->value.function.name
     = gfc_get_string ("__log10_%c%d", gfc_type_letter (x->ts.type),
-		      x->ts.kind);
+		      gfc_type_abi_kind (&x->ts));
 }
 
 
@@ -1522,7 +1550,8 @@ gfc_resolve_logical (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
 
   f->value.function.name
     = gfc_get_string ("__logical_%d_%c%d", f->ts.kind,
-		      gfc_type_letter (a->ts.type), a->ts.kind);
+		      gfc_type_letter (a->ts.type),
+		      gfc_type_abi_kind (&a->ts));
 }
 
 
@@ -1579,7 +1608,7 @@ gfc_resolve_matmul (gfc_expr *f, gfc_expr *a, gfc_expr *b)
 
   f->value.function.name
     = gfc_get_string (PREFIX ("matmul_%c%d"), gfc_type_letter (f->ts.type),
-		      f->ts.kind);
+		      gfc_type_abi_kind (&f->ts));
 }
 
 
@@ -1605,7 +1634,8 @@ gfc_resolve_minmax (const char *name, gfc_expr *f, gfc_actual_arglist *args)
     }
 
   f->value.function.name
-    = gfc_get_string (name, gfc_type_letter (f->ts.type), f->ts.kind);
+    = gfc_get_string (name, gfc_type_letter (f->ts.type),
+		      gfc_type_abi_kind (&f->ts));
 }
 
 
@@ -1689,7 +1719,8 @@ gfc_resolve_maxloc (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
 
   f->value.function.name
     = gfc_get_string (PREFIX ("%s%d_%d_%c%d"), name, d_num, f->ts.kind,
-		      gfc_type_letter (array->ts.type), array->ts.kind);
+		      gfc_type_letter (array->ts.type),
+		      gfc_type_abi_kind (&array->ts));
 
   if (kind)
     fkind = mpz_get_si (kind->value.integer);
@@ -1806,7 +1837,8 @@ gfc_resolve_findloc (gfc_expr *f, gfc_expr *array, gfc_expr *value,
 
   f->value.function.name
     = gfc_get_string (PREFIX ("%s%d_%c%d"), name, d_num,
-		      gfc_type_letter (array->ts.type, true), array->ts.kind);
+		      gfc_type_letter (array->ts.type, true),
+		      gfc_type_abi_kind (&array->ts));
 
   /* We only have a single library function, so we need to convert
      here.  If the function is resolved from within a convert
@@ -1868,11 +1900,13 @@ gfc_resolve_maxval (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
   if (array->ts.type != BT_CHARACTER)
     f->value.function.name
       = gfc_get_string (PREFIX ("%s_%c%d"), name,
-			gfc_type_letter (array->ts.type), array->ts.kind);
+			gfc_type_letter (array->ts.type),
+			gfc_type_abi_kind (&array->ts));
   else
     f->value.function.name
       = gfc_get_string (PREFIX ("%s%d_%c%d"), name, f->rank != 0,
-			gfc_type_letter (array->ts.type), array->ts.kind);     
+			gfc_type_letter (array->ts.type),
+			gfc_type_abi_kind (&array->ts));
 }
 
 
@@ -1926,7 +1960,7 @@ gfc_resolve_merge (gfc_expr *f, gfc_expr *tsource,
   f->ts = tsource->ts;
   f->value.function.name
     = gfc_get_string ("__merge_%c%d", gfc_type_letter (tsource->ts.type),
-		      tsource->ts.kind);
+		      gfc_type_abi_kind (&tsource->ts));
 }
 
 
@@ -2017,7 +2051,8 @@ gfc_resolve_minloc (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
 
   f->value.function.name
     = gfc_get_string (PREFIX ("%s%d_%d_%c%d"), name, d_num, f->ts.kind,
-		      gfc_type_letter (array->ts.type), array->ts.kind);
+		      gfc_type_letter (array->ts.type),
+		      gfc_type_abi_kind (&array->ts));
 
   if (fkind != f->ts.kind)
     {
@@ -2082,11 +2117,13 @@ gfc_resolve_minval (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
   if (array->ts.type != BT_CHARACTER)
     f->value.function.name
       = gfc_get_string (PREFIX ("%s_%c%d"), name,
-			gfc_type_letter (array->ts.type), array->ts.kind);
+			gfc_type_letter (array->ts.type),
+			gfc_type_abi_kind (&array->ts));
   else
     f->value.function.name
       = gfc_get_string (PREFIX ("%s%d_%c%d"), name, f->rank != 0,
-			gfc_type_letter (array->ts.type), array->ts.kind);     
+			gfc_type_letter (array->ts.type),
+			gfc_type_abi_kind (&array->ts));
 }
 
 
@@ -2108,7 +2145,8 @@ gfc_resolve_mod (gfc_expr *f, gfc_expr *a, gfc_expr *p)
     }
 
   f->value.function.name
-    = gfc_get_string ("__mod_%c%d", gfc_type_letter (f->ts.type), f->ts.kind);
+    = gfc_get_string ("__mod_%c%d", gfc_type_letter (f->ts.type),
+		      gfc_type_abi_kind (&f->ts));
 }
 
 
@@ -2131,7 +2169,7 @@ gfc_resolve_modulo (gfc_expr *f, gfc_expr *a, gfc_expr *p)
 
   f->value.function.name
     = gfc_get_string ("__modulo_%c%d", gfc_type_letter (f->ts.type),
-		      f->ts.kind);
+		      gfc_type_abi_kind (&f->ts));
 }
 
 void
@@ -2143,7 +2181,7 @@ gfc_resolve_nearest (gfc_expr *f, gfc_expr *a, gfc_expr *p)
   f->ts = a->ts;
   f->value.function.name
     = gfc_get_string ("__nearest_%c%d", gfc_type_letter (a->ts.type),
-		      a->ts.kind);
+		      gfc_type_abi_kind (&a->ts));
 }
 
 void
@@ -2187,7 +2225,8 @@ gfc_resolve_or (gfc_expr *f, gfc_expr *i, gfc_expr *j)
     }
 
   f->value.function.name
-    = gfc_get_string ("__or_%c%d", gfc_type_letter (i->ts.type), f->ts.kind);
+    = gfc_get_string ("__or_%c%d", gfc_type_letter (i->ts.type),
+		      gfc_type_abi_kind (&f->ts));
 }
 
 
@@ -2265,7 +2304,8 @@ gfc_resolve_real (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
 
   f->value.function.name
     = gfc_get_string ("__real_%d_%c%d", f->ts.kind,
-		      gfc_type_letter (a->ts.type), a->ts.kind);
+		      gfc_type_letter (a->ts.type),
+		      gfc_type_abi_kind (&a->ts));
 }
 
 
@@ -2276,7 +2316,8 @@ gfc_resolve_realpart (gfc_expr *f, gfc_expr *a)
   f->ts.kind = a->ts.kind;
   f->value.function.name
     = gfc_get_string ("__real_%d_%c%d", f->ts.kind,
-		      gfc_type_letter (a->ts.type), a->ts.kind);
+		      gfc_type_letter (a->ts.type),
+		      gfc_type_abi_kind (&a->ts));
 }
 
 
@@ -2361,7 +2402,7 @@ gfc_resolve_reshape (gfc_expr *f, gfc_expr *source, gfc_expr *shape,
 	f->value.function.name
 	  = gfc_get_string (PREFIX ("reshape_%c%d"),
 			    gfc_type_letter (source->ts.type),
-			    source->ts.kind);
+			    gfc_type_abi_kind (&source->ts));
       else if (source->ts.type == BT_CHARACTER)
 	f->value.function.name = gfc_get_string (PREFIX ("reshape_char%d"),
 						 kind);
@@ -2506,7 +2547,8 @@ gfc_resolve_sign (gfc_expr *f, gfc_expr *a, gfc_expr *b ATTRIBUTE_UNUSED)
 {
   f->ts = a->ts;
   f->value.function.name
-    = gfc_get_string ("__sign_%c%d", gfc_type_letter (a->ts.type), a->ts.kind);
+    = gfc_get_string ("__sign_%c%d", gfc_type_letter (a->ts.type),
+		      gfc_type_abi_kind (&a->ts));
 }
 
 
@@ -2536,7 +2578,8 @@ gfc_resolve_sin (gfc_expr *f, gfc_expr *x)
 {
   f->ts = x->ts;
   f->value.function.name
-    = gfc_get_string ("__sin_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+    = gfc_get_string ("__sin_%c%d", gfc_type_letter (x->ts.type),
+		      gfc_type_abi_kind (&x->ts));
 }
 
 
@@ -2545,7 +2588,8 @@ gfc_resolve_sinh (gfc_expr *f, gfc_expr *x)
 {
   f->ts = x->ts;
   f->value.function.name
-    = gfc_get_string ("__sinh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+    = gfc_get_string ("__sinh_%c%d", gfc_type_letter (x->ts.type),
+		      gfc_type_abi_kind (&x->ts));
 }
 
 
@@ -2639,7 +2683,8 @@ gfc_resolve_sqrt (gfc_expr *f, gfc_expr *x)
 {
   f->ts = x->ts;
   f->value.function.name
-    = gfc_get_string ("__sqrt_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+    = gfc_get_string ("__sqrt_%c%d", gfc_type_letter (x->ts.type),
+		      gfc_type_abi_kind (&x->ts));
 }
 
 
@@ -2803,7 +2848,8 @@ gfc_resolve_tan (gfc_expr *f, gfc_expr *x)
 {
   f->ts = x->ts;
   f->value.function.name
-    = gfc_get_string ("__tan_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+    = gfc_get_string ("__tan_%c%d", gfc_type_letter (x->ts.type),
+		      gfc_type_abi_kind (&x->ts));
 }
 
 
@@ -2812,7 +2858,8 @@ gfc_resolve_tanh (gfc_expr *f, gfc_expr *x)
 {
   f->ts = x->ts;
   f->value.function.name
-    = gfc_get_string ("__tanh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+    = gfc_get_string ("__tanh_%c%d", gfc_type_letter (x->ts.type),
+		      gfc_type_abi_kind (&x->ts));
 }
 
 
@@ -3012,7 +3059,7 @@ gfc_resolve_transpose (gfc_expr *f, gfc_expr *matrix)
 	  f->value.function.name
 	    = gfc_get_string (PREFIX ("transpose_%c%d"),
 			      gfc_type_letter (matrix->ts.type),
-			      matrix->ts.kind);
+			      gfc_type_abi_kind (&matrix->ts));
 	  break;
 
 	case BT_INTEGER:
@@ -3060,7 +3107,8 @@ gfc_resolve_trigd (gfc_expr *f, gfc_expr *x)
   f->ts = x->ts;
   f->value.function.name
     = gfc_get_string (PREFIX ("%s_%c%d"), f->value.function.isym->name,
-		      gfc_type_letter (x->ts.type), x->ts.kind);
+		      gfc_type_letter (x->ts.type),
+		      gfc_type_abi_kind (&x->ts));
 }
 
 
@@ -3188,7 +3236,8 @@ gfc_resolve_xor (gfc_expr *f, gfc_expr *i, gfc_expr *j)
     }
 
   f->value.function.name
-    = gfc_get_string ("__xor_%c%d", gfc_type_letter (i->ts.type), f->ts.kind);
+    = gfc_get_string ("__xor_%c%d", gfc_type_letter (i->ts.type),
+		      gfc_type_abi_kind (&f->ts));
 }
 
 
@@ -3326,7 +3375,7 @@ gfc_resolve_random_number (gfc_code *c)
   const char *name;
   int kind;
 
-  kind = c->ext.actual->expr->ts.kind;
+  kind = gfc_type_abi_kind (&c->ext.actual->expr->ts);
   if (c->ext.actual->expr->rank == 0)
     name = gfc_get_string (PREFIX ("random_r%d"), kind);
   else
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index cb7f684d52c..ba34ec611f9 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -3602,8 +3602,9 @@ gfc_build_intrinsic_function_decls (void)
 	    rtype = gfc_get_real_type (rkinds[rkind]);
 	    if (rtype && itype)
 	      {
-		sprintf (name, PREFIX("pow_r%d_i%d"), rkinds[rkind],
-			ikinds[ikind]);
+		sprintf (name, PREFIX("pow_r%d_i%d"),
+			 gfc_type_abi_kind (BT_REAL, rkinds[rkind]),
+			 ikinds[ikind]);
 		gfor_fndecl_math_powi[rkind][ikind].real =
 		  gfc_build_library_function_decl (get_identifier (name),
 		    rtype, 2, rtype, itype);
@@ -3614,8 +3615,9 @@ gfc_build_intrinsic_function_decls (void)
 	    ctype = gfc_get_complex_type (rkinds[rkind]);
 	    if (ctype && itype)
 	      {
-		sprintf (name, PREFIX("pow_c%d_i%d"), rkinds[rkind],
-			ikinds[ikind]);
+		sprintf (name, PREFIX("pow_c%d_i%d"),
+			 gfc_type_abi_kind (BT_REAL, rkinds[rkind]),
+			 ikinds[ikind]);
 		gfor_fndecl_math_powi[rkind][ikind].cmplx =
 		  gfc_build_library_function_decl (get_identifier (name),
 		    ctype, 2,ctype, itype);
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index e5d36d5a58f..12b74207c99 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -363,6 +363,8 @@ gfc_init_kinds (void)
   int i_index, r_index, kind;
   bool saw_i4 = false, saw_i8 = false;
   bool saw_r4 = false, saw_r8 = false, saw_r10 = false, saw_r16 = false;
+  scalar_mode r16_mode = QImode;
+  scalar_mode composite_mode = QImode;
 
   i_index = 0;
   FOR_EACH_MODE_IN_CLASS (int_mode_iter, MODE_INT)
@@ -428,6 +430,10 @@ gfc_init_kinds (void)
       if (!targetm.scalar_mode_supported_p (mode))
 	continue;
 
+      if (MODE_COMPOSITE_P (mode)
+	  && (GET_MODE_PRECISION (mode) + 7) / 8 == 16)
+	composite_mode = mode;
+
       /* Only let float, double, long double and TFmode go through.
 	 Runtime support for others is not provided, so they would be
 	 useless.  */
@@ -471,7 +477,10 @@ gfc_init_kinds (void)
       if (kind == 10)
 	saw_r10 = true;
       if (kind == 16)
-	saw_r16 = true;
+	{
+	  saw_r16 = true;
+	  r16_mode = mode;
+	}
 
       /* Careful we don't stumble a weird internal mode.  */
       gcc_assert (r_index <= 0 || gfc_real_kinds[r_index-1].kind != kind);
@@ -479,6 +488,7 @@ gfc_init_kinds (void)
       gcc_assert (r_index != MAX_REAL_KINDS);
 
       gfc_real_kinds[r_index].kind = kind;
+      gfc_real_kinds[r_index].abi_kind = kind;
       gfc_real_kinds[r_index].radix = fmt->b;
       gfc_real_kinds[r_index].digits = fmt->p;
       gfc_real_kinds[r_index].min_exponent = fmt->emin;
@@ -496,6 +506,19 @@ gfc_init_kinds (void)
       r_index += 1;
     }
 
+  /* Detect the powerpc64le-linux case with -mabi=ieeelongdouble, where
+     the long double type is non-MODE_COMPOSITE_P TFmode but one can use
+     -mabi=ibmlongdouble too and get MODE_COMPOSITE_P TFmode with the same
+     precision.  For libgfortran calls pretend the IEEE 754 quad TFmode has
+     kind 17 rather than 16 and use kind 16 for the IBM extended format
+     TFmode.  */
+  if (composite_mode != QImode && saw_r16 && !MODE_COMPOSITE_P (r16_mode))
+    {
+      for (int i = 0; i < r_index; ++i)
+	if (gfc_real_kinds[i].kind == 16)
+	  gfc_real_kinds[i].abi_kind = 17;
+    }
+
   /* Choose the default integer kind.  We choose 4 unless the user directs us
      otherwise.  Even if the user specified that the default integer kind is 8,
      the numeric storage size is not 64 bits.  In this case, a warning will be
diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map
index 32579831a65..8937b4a2903 100644
--- a/libgfortran/gfortran.map
+++ b/libgfortran/gfortran.map
@@ -1633,4 +1633,119 @@ GFORTRAN_10.2 {
 GFORTRAN_12 {
   global:
   _gfortran_caf_random_init;
+  _gfortran_arandom_r17;
+  _gfortran_bessel_jn_r17;
+  _gfortran_bessel_yn_r17;
+  _gfortran_cosd_r17;
+  _gfortran_erfc_scaled_r17;
+  _gfortran_findloc0_r17;
+  _gfortran_findloc1_r17;
+  _gfortran_matmul_r17;
+  _gfortran_maxloc0_16_r17;
+  _gfortran_maxloc0_4_r17;
+  _gfortran_maxloc0_8_r17;
+  _gfortran_maxloc1_16_r17;
+  _gfortran_maxloc1_4_r17;
+  _gfortran_maxloc1_8_r17;
+  _gfortran_maxval_r17;
+  _gfortran_mfindloc0_r17;
+  _gfortran_mfindloc1_r17;
+  _gfortran_minloc0_16_r17;
+  _gfortran_minloc0_4_r17;
+  _gfortran_minloc0_8_r17;
+  _gfortran_minloc1_16_r17;
+  _gfortran_minloc1_4_r17;
+  _gfortran_minloc1_8_r17;
+  _gfortran_minval_r17;
+  _gfortran_mmaxloc0_16_r17;
+  _gfortran_mmaxloc0_4_r17;
+  _gfortran_mmaxloc0_8_r17;
+  _gfortran_mmaxloc1_16_r17;
+  _gfortran_mmaxloc1_4_r17;
+  _gfortran_mmaxloc1_8_r17;
+  _gfortran_mmaxval_r17;
+  _gfortran_mminloc0_16_r17;
+  _gfortran_mminloc0_4_r17;
+  _gfortran_mminloc0_8_r17;
+  _gfortran_mminloc1_16_r17;
+  _gfortran_mminloc1_4_r17;
+  _gfortran_mminloc1_8_r17;
+  _gfortran_mminval_r17;
+  _gfortran_mproduct_r17;
+  _gfortran_msum_r17;
+  _gfortran_norm2_r17;
+  _gfortran_pow_r17_i16;
+  _gfortran_pow_r17_i4;
+  _gfortran_pow_r17_i8;
+  _gfortran_product_r17;
+  _gfortran_random_r17;
+  _gfortran_reshape_r17;
+  _gfortran_sfindloc0_r17;
+  _gfortran_sfindloc1_r17;
+  _gfortran_sind_r17;
+  _gfortran_smaxloc0_16_r17;
+  _gfortran_smaxloc0_4_r17;
+  _gfortran_smaxloc0_8_r17;
+  _gfortran_smaxloc1_16_r17;
+  _gfortran_smaxloc1_4_r17;
+  _gfortran_smaxloc1_8_r17;
+  _gfortran_smaxval_r17;
+  _gfortran_sminloc0_16_r17;
+  _gfortran_sminloc0_4_r17;
+  _gfortran_sminloc0_8_r17;
+  _gfortran_sminloc1_16_r17;
+  _gfortran_sminloc1_4_r17;
+  _gfortran_sminloc1_8_r17;
+  _gfortran_sminval_r17;
+  _gfortran_specific__abs_r17;
+  _gfortran_specific__acosh_r17;
+  _gfortran_specific__acos_r17;
+  _gfortran_specific__aint_r17;
+  _gfortran_specific__anint_r17;
+  _gfortran_specific__asinh_r17;
+  _gfortran_specific__asin_r17;
+  _gfortran_specific__atan2_r17;
+  _gfortran_specific__atanh_r17;
+  _gfortran_specific__atan_r17;
+  _gfortran_specific__cosh_r17;
+  _gfortran_specific__cos_r17;
+  _gfortran_specific__dim_r17;
+  _gfortran_specific__exp_r17;
+  _gfortran_specific__log10_r17;
+  _gfortran_specific__log_r17;
+  _gfortran_specific__mod_r17;
+  _gfortran_specific__sign_r17;
+  _gfortran_specific__sinh_r17;
+  _gfortran_specific__sin_r17;
+  _gfortran_specific__sqrt_r17;
+  _gfortran_specific__tanh_r17;
+  _gfortran_specific__tan_r17;
+  _gfortran_sproduct_r17;
+  _gfortran_ssum_r17;
+  _gfortran_sum_r17;
+  _gfortran_tand_r17;
+  _gfortran_findloc0_c17;
+  _gfortran_findloc1_c17;
+  _gfortran_matmul_c17;
+  _gfortran_mfindloc0_c17;
+  _gfortran_mfindloc1_c17;
+  _gfortran_mproduct_c17;
+  _gfortran_msum_c17;
+  _gfortran_pow_c17_i16;
+  _gfortran_pow_c17_i4;
+  _gfortran_pow_c17_i8;
+  _gfortran_product_c17;
+  _gfortran_reshape_c17;
+  _gfortran_sfindloc0_c17;
+  _gfortran_sfindloc1_c17;
+  _gfortran_specific__abs_c17;
+  _gfortran_specific__aimag_c17;
+  _gfortran_specific__cos_c17;
+  _gfortran_specific__exp_c17;
+  _gfortran_specific__log_c17;
+  _gfortran_specific__sin_c17;
+  _gfortran_specific__sqrt_c17;
+  _gfortran_sproduct_c17;
+  _gfortran_ssum_c17;
+  _gfortran_sum_c17;
 } GFORTRAN_10.2;
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 61ebf2fdd60..1264292247c 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -968,6 +968,11 @@ GFC_REAL_16 *internal_pack_r16 (gfc_array_r16 *);
 internal_proto(internal_pack_r16);
 #endif
 
+#if defined HAVE_GFC_REAL_17
+GFC_REAL_17 *internal_pack_r17 (gfc_array_r17 *);
+internal_proto(internal_pack_r17);
+#endif
+
 GFC_COMPLEX_4 *internal_pack_c4 (gfc_array_c4 *);
 internal_proto(internal_pack_c4);
 
@@ -984,6 +989,11 @@ GFC_COMPLEX_16 *internal_pack_c16 (gfc_array_c16 *);
 internal_proto(internal_pack_c16);
 #endif
 
+#if defined HAVE_GFC_COMPLEX_17
+GFC_COMPLEX_17 *internal_pack_c17 (gfc_array_c17 *);
+internal_proto(internal_pack_c17);
+#endif
+
 extern void internal_unpack_1 (gfc_array_i1 *, const GFC_INTEGER_1 *);
 internal_proto(internal_unpack_1);
 
@@ -1017,6 +1027,11 @@ extern void internal_unpack_r16 (gfc_array_r16 *, const GFC_REAL_16 *);
 internal_proto(internal_unpack_r16);
 #endif
 
+#if defined HAVE_GFC_REAL_17
+extern void internal_unpack_r17 (gfc_array_r17 *, const GFC_REAL_17 *);
+internal_proto(internal_unpack_r17);
+#endif
+
 extern void internal_unpack_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *);
 internal_proto(internal_unpack_c4);
 
@@ -1033,6 +1048,11 @@ extern void internal_unpack_c16 (gfc_array_c16 *, const GFC_COMPLEX_16 *);
 internal_proto(internal_unpack_c16);
 #endif
 
+#if defined HAVE_GFC_COMPLEX_17
+extern void internal_unpack_c17 (gfc_array_c17 *, const GFC_COMPLEX_17 *);
+internal_proto(internal_unpack_c17);
+#endif
+
 /* Internal auxiliary functions for the pack intrinsic.  */
 
 extern void pack_i1 (gfc_array_i1 *, const gfc_array_i1 *,
@@ -1077,6 +1097,12 @@ extern void pack_r16 (gfc_array_r16 *, const gfc_array_r16 *,
 internal_proto(pack_r16);
 #endif
 
+#ifdef HAVE_GFC_REAL_17
+extern void pack_r17 (gfc_array_r17 *, const gfc_array_r17 *,
+		     const gfc_array_l1 *, const gfc_array_r17 *);
+internal_proto(pack_r17);
+#endif
+
 extern void pack_c4 (gfc_array_c4 *, const gfc_array_c4 *,
 		     const gfc_array_l1 *, const gfc_array_c4 *);
 internal_proto(pack_c4);
@@ -1097,6 +1123,12 @@ extern void pack_c16 (gfc_array_c16 *, const gfc_array_c16 *,
 internal_proto(pack_c16);
 #endif
 
+#ifdef HAVE_GFC_REAL_17
+extern void pack_c17 (gfc_array_c17 *, const gfc_array_c17 *,
+		     const gfc_array_l1 *, const gfc_array_c17 *);
+internal_proto(pack_c17);
+#endif
+
 /* Internal auxiliary functions for the unpack intrinsic.  */
 
 extern void unpack0_i1 (gfc_array_i1 *, const gfc_array_i1 *,
@@ -1147,6 +1179,14 @@ internal_proto(unpack0_r16);
 
 #endif
 
+#ifdef HAVE_GFC_REAL_17
+
+extern void unpack0_r17 (gfc_array_r17 *, const gfc_array_r17 *,
+			 const gfc_array_l1 *, const GFC_REAL_17 *);
+internal_proto(unpack0_r17);
+
+#endif
+
 extern void unpack0_c4 (gfc_array_c4 *, const gfc_array_c4 *,
 			const gfc_array_l1 *, const GFC_COMPLEX_4 *);
 internal_proto(unpack0_c4);
@@ -1171,6 +1211,14 @@ internal_proto(unpack0_c16);
 
 #endif
 
+#ifdef HAVE_GFC_COMPLEX_17
+
+extern void unpack0_c17 (gfc_array_c17 *, const gfc_array_c17 *,
+			 const gfc_array_l1 *, const GFC_COMPLEX_17 *);
+internal_proto(unpack0_c17);
+
+#endif
+
 extern void unpack1_i1 (gfc_array_i1 *, const gfc_array_i1 *,
 			const gfc_array_l1 *, const gfc_array_i1 *);
 internal_proto(unpack1_i1);
@@ -1213,6 +1261,12 @@ extern void unpack1_r16 (gfc_array_r16 *, const gfc_array_r16 *,
 internal_proto(unpack1_r16);
 #endif
 
+#ifdef HAVE_GFC_REAL_17
+extern void unpack1_r17 (gfc_array_r17 *, const gfc_array_r17 *,
+			 const gfc_array_l1 *, const gfc_array_r17 *);
+internal_proto(unpack1_r17);
+#endif
+
 extern void unpack1_c4 (gfc_array_c4 *, const gfc_array_c4 *,
 			const gfc_array_l1 *, const gfc_array_c4 *);
 internal_proto(unpack1_c4);
@@ -1233,6 +1287,12 @@ extern void unpack1_c16 (gfc_array_c16 *, const gfc_array_c16 *,
 internal_proto(unpack1_c16);
 #endif
 
+#ifdef HAVE_GFC_COMPLEX_17
+extern void unpack1_c17 (gfc_array_c17 *, const gfc_array_c17 *,
+			 const gfc_array_l1 *, const gfc_array_c17 *);
+internal_proto(unpack1_c17);
+#endif
+
 /* Helper functions for spread.  */
 
 extern void spread_i1 (gfc_array_i1 *, const gfc_array_i1 *,
@@ -1280,6 +1340,13 @@ internal_proto(spread_r16);
 
 #endif
 
+#ifdef HAVE_GFC_REAL_17
+extern void spread_r17 (gfc_array_r17 *, const gfc_array_r17 *,
+		       const index_type, const index_type);
+internal_proto(spread_r17);
+
+#endif
+
 extern void spread_c4 (gfc_array_c4 *, const gfc_array_c4 *,
 		       const index_type, const index_type);
 internal_proto(spread_c4);
@@ -1302,6 +1369,13 @@ internal_proto(spread_c16);
 
 #endif
 
+#ifdef HAVE_GFC_COMPLEX_17
+extern void spread_c17 (gfc_array_c17 *, const gfc_array_c17 *,
+		       const index_type, const index_type);
+internal_proto(spread_c17);
+
+#endif
+
 extern void spread_scalar_i1 (gfc_array_i1 *, const GFC_INTEGER_1 *,
 			      const index_type, const index_type);
 internal_proto(spread_scalar_i1);
@@ -1347,6 +1421,13 @@ internal_proto(spread_scalar_r16);
 
 #endif
 
+#ifdef HAVE_GFC_REAL_17
+extern void spread_scalar_r17 (gfc_array_r17 *, const GFC_REAL_17 *,
+			       const index_type, const index_type);
+internal_proto(spread_scalar_r17);
+
+#endif
+
 extern void spread_scalar_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *,
 			      const index_type, const index_type);
 internal_proto(spread_scalar_c4);
@@ -1369,6 +1450,13 @@ internal_proto(spread_scalar_c16);
 
 #endif
 
+#ifdef HAVE_GFC_COMPLEX_17
+extern void spread_scalar_c17 (gfc_array_c17 *, const GFC_COMPLEX_17 *,
+			       const index_type, const index_type);
+internal_proto(spread_scalar_c17);
+
+#endif
+
 /* string_intrinsics.c */
 
 extern int compare_string (gfc_charlen_type, const char *,
@@ -1460,6 +1548,11 @@ void cshift0_r16 (gfc_array_r16 *, const gfc_array_r16 *, ptrdiff_t, int);
 internal_proto(cshift0_r16);
 #endif
 
+#ifdef HAVE_GFC_REAL_17
+void cshift0_r17 (gfc_array_r17 *, const gfc_array_r17 *, ptrdiff_t, int);
+internal_proto(cshift0_r17);
+#endif
+
 void cshift0_c4 (gfc_array_c4 *, const gfc_array_c4 *, ptrdiff_t, int);
 internal_proto(cshift0_c4);
 
@@ -1476,6 +1569,11 @@ void cshift0_c16 (gfc_array_c16 *, const gfc_array_c16 *, ptrdiff_t, int);
 internal_proto(cshift0_c16);
 #endif
 
+#ifdef HAVE_GFC_COMPLEX_17
+void cshift0_c17 (gfc_array_c17 *, const gfc_array_c17 *, ptrdiff_t, int);
+internal_proto(cshift0_c17);
+#endif
+
 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_1)
 void cshift1_4_i1 (gfc_array_i1 * const restrict,
 	const gfc_array_i1 * const restrict,
@@ -1628,6 +1726,14 @@ void cshift1_4_r16 (gfc_array_r16 * const restrict,
 internal_proto(cshift1_4_r16);
 #endif
 
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_REAL_17)
+void cshift1_4_r17 (gfc_array_r17 * const restrict,
+        const gfc_array_r17 * const restrict,
+        const gfc_array_i4 * const restrict,
+        const GFC_INTEGER_4 * const restrict);
+internal_proto(cshift1_4_r17);
+#endif
+
 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_REAL_4)
 void cshift1_8_r4 (gfc_array_r4 * const restrict,
         const gfc_array_r4 * const restrict,
@@ -1660,6 +1766,14 @@ void cshift1_8_r16 (gfc_array_r16 * const restrict,
 internal_proto(cshift1_8_r16);
 #endif
 
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_REAL_17)
+void cshift1_8_r17 (gfc_array_r17 * const restrict,
+        const gfc_array_r17 * const restrict,
+        const gfc_array_i8 * const restrict,
+        const GFC_INTEGER_8 * const restrict);
+internal_proto(cshift1_8_r17);
+#endif
+
 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_REAL_4)
 void cshift1_16_r4 (gfc_array_r4 * const restrict,
         const gfc_array_r4 * const restrict,
@@ -1692,6 +1806,14 @@ void cshift1_16_r16 (gfc_array_r16 * const restrict,
 internal_proto(cshift1_16_r16);
 #endif
 
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_REAL_17)
+void cshift1_16_r17 (gfc_array_r17 * const restrict,
+        const gfc_array_r17 * const restrict,
+        const gfc_array_i16 * const restrict,
+        const GFC_INTEGER_16 * const restrict);
+internal_proto(cshift1_16_r17);
+#endif
+
 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_COMPLEX_4)
 void cshift1_4_c4 (gfc_array_c4 * const restrict,
         const gfc_array_c4 * const restrict,
@@ -1724,6 +1846,14 @@ void cshift1_4_c16 (gfc_array_c16 * const restrict,
 internal_proto(cshift1_4_c16);
 #endif
 
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_COMPLEX_17)
+void cshift1_4_c17 (gfc_array_c17 * const restrict,
+        const gfc_array_c17 * const restrict,
+        const gfc_array_i4 * const restrict,
+        const GFC_INTEGER_4 * const restrict);
+internal_proto(cshift1_4_c17);
+#endif
+
 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_COMPLEX_4)
 void cshift1_8_c4 (gfc_array_c4 * const restrict,
         const gfc_array_c4 * const restrict,
@@ -1756,6 +1886,14 @@ void cshift1_8_c16 (gfc_array_c16 * const restrict,
 internal_proto(cshift1_8_c16);
 #endif
 
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_COMPLEX_17)
+void cshift1_8_c17 (gfc_array_c17 * const restrict,
+        const gfc_array_c17 * const restrict,
+        const gfc_array_i8 * const restrict,
+        const GFC_INTEGER_8 * const restrict);
+internal_proto(cshift1_8_c17);
+#endif
+
 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_COMPLEX_4)
 void cshift1_16_c4 (gfc_array_c4 * const restrict,
         const gfc_array_c4 * const restrict,
@@ -1788,6 +1926,14 @@ void cshift1_16_c16 (gfc_array_c16 * const restrict,
 internal_proto(cshift1_16_c16);
 #endif
 
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_COMPLEX_17)
+void cshift1_16_c17 (gfc_array_c17 * const restrict,
+        const gfc_array_c17 * const restrict,
+        const gfc_array_i16 * const restrict,
+        const GFC_INTEGER_16 * const restrict);
+internal_proto(cshift1_16_c17);
+#endif
+
 /* Prototypes for the POWER __ieee128 functions.  */
 #ifdef POWER_IEEE128
 extern __float128 __acoshieee128 (__float128) __attribute__ ((__nothrow__, __leaf__));