re PR fortran/37577 ([meta-bug] change internal array descriptor format for…

re PR fortran/37577 ([meta-bug] change internal array descriptor format for better syntax, C interop TR, rank 15)

2018-01-30  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/37577
	* libgfortran.h: Remove GFC_DTYPE_DERIVED_1, GFC_DTYPE_DERIVED_2,
	GFC_DTYPE_DERIVED_4, GFC_DTYPE_DERIVED_8 and GFC_DTYPE_DERIVED_16.
	* m4/cshift1.m4: Remove GFC_DTYPE_DERIVED_1.
	* generated/cshift1_16.c: Regenerated.
	* generated/cshift1_4.c: Regenerated.
	* generated/cshift1_8.c: Regenerated.
	* intrinsics/cshift0.c: Remove GFC_DTYPE_DERIVED_1.
	* intrinsics/pack_generic.c (pack): Move handling of other types
	into separate switch statement.
	* intrinsics/spread_generic.c (spread): Likewise.
	(spread_scalar): Likewise.
	* intrinsics/unpack_generic.c (unpack1): Likewise.
	(unpack0): Likewise.
	* runtime/in_pack_generic.c (internal_pack): Likewise.
	* runtime/in_unpack_generic.c (internal_unpack): Likewise.

From-SVN: r257195

libgfortran/ChangeLog

-2018-25-01  Paul Thomas  <pault@gcc.gnu.org>
+2018-01-30  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/37577
+	* libgfortran.h: Remove GFC_DTYPE_DERIVED_1, GFC_DTYPE_DERIVED_2,
+	GFC_DTYPE_DERIVED_4, GFC_DTYPE_DERIVED_8 and GFC_DTYPE_DERIVED_16.
+	* m4/cshift1.m4: Remove GFC_DTYPE_DERIVED_1.
+	* generated/cshift1_16.c: Regenerated.
+	* generated/cshift1_4.c: Regenerated.
+	* generated/cshift1_8.c: Regenerated.
+	* intrinsics/cshift0.c: Remove GFC_DTYPE_DERIVED_1.
+	* intrinsics/pack_generic.c (pack): Move handling of other types
+	into separate switch statement.
+	* intrinsics/spread_generic.c (spread): Likewise.
+	(spread_scalar): Likewise.
+	* intrinsics/unpack_generic.c (unpack1): Likewise.
+	(unpack0): Likewise.
+	* runtime/in_pack_generic.c (internal_pack): Likewise.
+	* runtime/in_unpack_generic.c (internal_unpack): Likewise.
+
+2018-01-25  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/37577
 	* caf/single.c (_gfortran_caf_failed_images): Access the 'type'

libgfortran/generated/cshift1_16.c

@@ -120,7 +120,6 @@ cshift1 (gfc_array_char * const restrict ret,
   {
     case GFC_DTYPE_LOGICAL_1:
     case GFC_DTYPE_INTEGER_1:
-    case GFC_DTYPE_DERIVED_1:
       cshift1_16_i1 ((gfc_array_i1 *)ret, (gfc_array_i1 *) array,
       			h, pwhich);
       return;

libgfortran/generated/cshift1_4.c

@@ -120,7 +120,6 @@ cshift1 (gfc_array_char * const restrict ret,
   {
     case GFC_DTYPE_LOGICAL_1:
     case GFC_DTYPE_INTEGER_1:
-    case GFC_DTYPE_DERIVED_1:
       cshift1_4_i1 ((gfc_array_i1 *)ret, (gfc_array_i1 *) array,
       			h, pwhich);
       return;

libgfortran/generated/cshift1_8.c

@@ -120,7 +120,6 @@ cshift1 (gfc_array_char * const restrict ret,
   {
     case GFC_DTYPE_LOGICAL_1:
     case GFC_DTYPE_INTEGER_1:
-    case GFC_DTYPE_DERIVED_1:
       cshift1_8_i1 ((gfc_array_i1 *)ret, (gfc_array_i1 *) array,
       			h, pwhich);
       return;

libgfortran/intrinsics/cshift0.c

@@ -95,7 +95,6 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array,
     {
     case GFC_DTYPE_LOGICAL_1:
     case GFC_DTYPE_INTEGER_1:
-    case GFC_DTYPE_DERIVED_1:
       cshift0_i1 ((gfc_array_i1 *)ret, (gfc_array_i1 *) array, shift, which);
       return;
 

libgfortran/intrinsics/pack_generic.c

@@ -255,7 +255,6 @@ pack (gfc_array_char *ret, const gfc_array_char *array,
     {
     case GFC_DTYPE_LOGICAL_1:
     case GFC_DTYPE_INTEGER_1:
-    case GFC_DTYPE_DERIVED_1:
       pack_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) array,
 	       (gfc_array_l1 *) mask, (gfc_array_i1 *) vector);
       return;
@@ -349,12 +348,19 @@ pack (gfc_array_char *ret, const gfc_array_char *array,
       return;
 # endif
 #endif
+    }
+  
+  /* For other types, let's check the actual alignment of the data pointers.
+     If they are aligned, we can safely call the unpack functions.  */
 
-      /* For derived types, let's check the actual alignment of the
-	 data pointers.  If they are aligned, we can safely call
-	 the unpack functions.  */
+  switch (GFC_DESCRIPTOR_SIZE (array))
+    {
+    case 1:
+      pack_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) array,
+	       (gfc_array_l1 *) mask, (gfc_array_i1 *) vector);
+      return;
 
-    case GFC_DTYPE_DERIVED_2:
+    case 2:
       if (GFC_UNALIGNED_2(ret->base_addr) || GFC_UNALIGNED_2(array->base_addr)
 	  || (vector && GFC_UNALIGNED_2(vector->base_addr)))
 	break;
@@ -365,7 +371,7 @@ pack (gfc_array_char *ret, const gfc_array_char *array,
 	  return;
 	}
 	      
-    case GFC_DTYPE_DERIVED_4:
+    case 4:
       if (GFC_UNALIGNED_4(ret->base_addr) || GFC_UNALIGNED_4(array->base_addr)
 	  || (vector && GFC_UNALIGNED_4(vector->base_addr)))
 	break;
@@ -376,7 +382,7 @@ pack (gfc_array_char *ret, const gfc_array_char *array,
 	  return;
 	}
 
-    case GFC_DTYPE_DERIVED_8:
+    case 8:
       if (GFC_UNALIGNED_8(ret->base_addr) || GFC_UNALIGNED_8(array->base_addr)
 	  || (vector && GFC_UNALIGNED_8(vector->base_addr)))
 	break;
@@ -388,7 +394,7 @@ pack (gfc_array_char *ret, const gfc_array_char *array,
 	}
 
 #ifdef HAVE_GFC_INTEGER_16	      
-    case GFC_DTYPE_DERIVED_16:
+    case 16:
       if (GFC_UNALIGNED_16(ret->base_addr) || GFC_UNALIGNED_16(array->base_addr)
 	  || (vector && GFC_UNALIGNED_16(vector->base_addr)))
 	break;
@@ -399,7 +405,8 @@ pack (gfc_array_char *ret, const gfc_array_char *array,
 	  return;
 	}
 #endif
-
+    default:
+      break;
     }
 
   size = GFC_DESCRIPTOR_SIZE (array);

libgfortran/intrinsics/spread_generic.c

@@ -274,7 +274,6 @@ spread (gfc_array_char *ret, const gfc_array_char *source,
   type_size = GFC_DTYPE_TYPE_SIZE(ret);
   switch(type_size)
     {
-    case GFC_DTYPE_DERIVED_1:
     case GFC_DTYPE_LOGICAL_1:
     case GFC_DTYPE_INTEGER_1:
       spread_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) source,
@@ -371,7 +370,16 @@ spread (gfc_array_char *ret, const gfc_array_char *source,
 # endif
 #endif
 
-    case GFC_DTYPE_DERIVED_2:
+    }
+  
+  switch (GFC_DESCRIPTOR_SIZE (ret))
+    {
+    case 1:
+      spread_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) source,
+		 *along, *pncopies);
+      return;
+
+    case 2:
       if (GFC_UNALIGNED_2(ret->base_addr) || GFC_UNALIGNED_2(source->base_addr))
 	break;
       else
@@ -381,7 +389,7 @@ spread (gfc_array_char *ret, const gfc_array_char *source,
 	  return;
 	}
 
-    case GFC_DTYPE_DERIVED_4:
+    case 4:
       if (GFC_UNALIGNED_4(ret->base_addr) || GFC_UNALIGNED_4(source->base_addr))
 	break;
       else
@@ -391,7 +399,7 @@ spread (gfc_array_char *ret, const gfc_array_char *source,
 	  return;
 	}
 
-    case GFC_DTYPE_DERIVED_8:
+    case 8:
       if (GFC_UNALIGNED_8(ret->base_addr) || GFC_UNALIGNED_8(source->base_addr))
 	break;
       else
@@ -400,9 +408,8 @@ spread (gfc_array_char *ret, const gfc_array_char *source,
 		     *along, *pncopies);
 	  return;
 	}
-
 #ifdef HAVE_GFC_INTEGER_16
-    case GFC_DTYPE_DERIVED_16:
+    case 16:
       if (GFC_UNALIGNED_16(ret->base_addr)
 	  || GFC_UNALIGNED_16(source->base_addr))
 	break;
@@ -413,6 +420,7 @@ spread (gfc_array_char *ret, const gfc_array_char *source,
 	  return;
 	    }
 #endif
+
     }
 
   spread_internal (ret, source, along, pncopies);
@@ -470,7 +478,6 @@ spread_scalar (gfc_array_char *ret, const char *source,
   type_size = GFC_DTYPE_TYPE_SIZE(ret);
   switch(type_size)
     {
-    case GFC_DTYPE_DERIVED_1:
     case GFC_DTYPE_LOGICAL_1:
     case GFC_DTYPE_INTEGER_1:
       spread_scalar_i1 ((gfc_array_i1 *) ret, (GFC_INTEGER_1 *) source,
@@ -567,7 +574,16 @@ spread_scalar (gfc_array_char *ret, const char *source,
 # endif
 #endif
 
-    case GFC_DTYPE_DERIVED_2:
+    }
+
+  switch (GFC_DESCRIPTOR_SIZE(ret))
+    {
+    case 1:
+      spread_scalar_i1 ((gfc_array_i1 *) ret, (GFC_INTEGER_1 *) source,
+			*along, *pncopies);
+      return;
+
+    case 2:
       if (GFC_UNALIGNED_2(ret->base_addr) || GFC_UNALIGNED_2(source))
 	break;
       else
@@ -577,7 +593,7 @@ spread_scalar (gfc_array_char *ret, const char *source,
 	  return;
 	}
 
-    case GFC_DTYPE_DERIVED_4:
+    case 4:
       if (GFC_UNALIGNED_4(ret->base_addr) || GFC_UNALIGNED_4(source))
 	break;
       else
@@ -587,7 +603,7 @@ spread_scalar (gfc_array_char *ret, const char *source,
 	  return;
 	}
 
-    case GFC_DTYPE_DERIVED_8:
+    case 8:
       if (GFC_UNALIGNED_8(ret->base_addr) || GFC_UNALIGNED_8(source))
 	break;
       else
@@ -597,7 +613,7 @@ spread_scalar (gfc_array_char *ret, const char *source,
 	  return;
 	}
 #ifdef HAVE_GFC_INTEGER_16
-    case GFC_DTYPE_DERIVED_16:
+    case 16:
       if (GFC_UNALIGNED_16(ret->base_addr) || GFC_UNALIGNED_16(source))
 	break;
       else
@@ -607,6 +623,8 @@ spread_scalar (gfc_array_char *ret, const char *source,
 	  return;
 	}
 #endif
+    default:
+      break;
     }
 
   spread_internal_scalar (ret, source, along, pncopies);

libgfortran/intrinsics/unpack_generic.c

@@ -222,7 +222,6 @@ unpack1 (gfc_array_char *ret, const gfc_array_char *vector,
     {
     case GFC_DTYPE_LOGICAL_1:
     case GFC_DTYPE_INTEGER_1:
-    case GFC_DTYPE_DERIVED_1:
       unpack1_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) vector,
 		  mask, (gfc_array_i1 *) field);
       return;
@@ -317,7 +316,16 @@ unpack1 (gfc_array_char *ret, const gfc_array_char *vector,
 # endif
 #endif
 
-    case GFC_DTYPE_DERIVED_2:
+    }
+
+  switch (GFC_DESCRIPTOR_SIZE(ret))
+    {
+    case 1:
+      unpack1_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) vector,
+		  mask, (gfc_array_i1 *) field);
+      return;
+
+    case 2:
       if (GFC_UNALIGNED_2(ret->base_addr) || GFC_UNALIGNED_2(vector->base_addr)
 	  || GFC_UNALIGNED_2(field->base_addr))
 	break;
@@ -328,7 +336,7 @@ unpack1 (gfc_array_char *ret, const gfc_array_char *vector,
 	  return;
 	}
 
-    case GFC_DTYPE_DERIVED_4:
+    case 4:
       if (GFC_UNALIGNED_4(ret->base_addr) || GFC_UNALIGNED_4(vector->base_addr)
 	  || GFC_UNALIGNED_4(field->base_addr))
 	break;
@@ -339,7 +347,7 @@ unpack1 (gfc_array_char *ret, const gfc_array_char *vector,
 	  return;
 	}
 
-    case GFC_DTYPE_DERIVED_8:
+    case 8:
       if (GFC_UNALIGNED_8(ret->base_addr) || GFC_UNALIGNED_8(vector->base_addr)
 	  || GFC_UNALIGNED_8(field->base_addr))
 	break;
@@ -351,7 +359,7 @@ unpack1 (gfc_array_char *ret, const gfc_array_char *vector,
 	}
 
 #ifdef HAVE_GFC_INTEGER_16
-    case GFC_DTYPE_DERIVED_16:
+    case 16:
       if (GFC_UNALIGNED_16(ret->base_addr)
 	  || GFC_UNALIGNED_16(vector->base_addr)
 	  || GFC_UNALIGNED_16(field->base_addr))
@@ -363,6 +371,8 @@ unpack1 (gfc_array_char *ret, const gfc_array_char *vector,
 	  return;
 	}
 #endif
+    default:
+      break;
     }
 
   unpack_internal (ret, vector, mask, field, size);
@@ -433,7 +443,6 @@ unpack0 (gfc_array_char *ret, const gfc_array_char *vector,
     {
     case GFC_DTYPE_LOGICAL_1:
     case GFC_DTYPE_INTEGER_1:
-    case GFC_DTYPE_DERIVED_1:
       unpack0_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) vector,
 		  mask, (GFC_INTEGER_1 *) field);
       return;
@@ -528,7 +537,16 @@ unpack0 (gfc_array_char *ret, const gfc_array_char *vector,
 # endif
 #endif
 
-    case GFC_DTYPE_DERIVED_2:
+    }
+
+  switch (GFC_DESCRIPTOR_SIZE(ret))
+    {
+    case 1:
+      unpack0_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) vector,
+		  mask, (GFC_INTEGER_1 *) field);
+      return;
+
+    case 2:
       if (GFC_UNALIGNED_2(ret->base_addr) || GFC_UNALIGNED_2(vector->base_addr)
 	  || GFC_UNALIGNED_2(field))
 	break;
@@ -539,7 +557,7 @@ unpack0 (gfc_array_char *ret, const gfc_array_char *vector,
 	  return;
 	}
 
-    case GFC_DTYPE_DERIVED_4:
+    case 4:
       if (GFC_UNALIGNED_4(ret->base_addr) || GFC_UNALIGNED_4(vector->base_addr)
 	  || GFC_UNALIGNED_4(field))
 	break;
@@ -550,7 +568,7 @@ unpack0 (gfc_array_char *ret, const gfc_array_char *vector,
 	  return;
 	}
 
-    case GFC_DTYPE_DERIVED_8:
+    case 8:
       if (GFC_UNALIGNED_8(ret->base_addr) || GFC_UNALIGNED_8(vector->base_addr)
 	  || GFC_UNALIGNED_8(field))
 	break;
@@ -562,7 +580,7 @@ unpack0 (gfc_array_char *ret, const gfc_array_char *vector,
 	}
 
 #ifdef HAVE_GFC_INTEGER_16
-    case GFC_DTYPE_DERIVED_16:
+    case 16:
       if (GFC_UNALIGNED_16(ret->base_addr)
 	  || GFC_UNALIGNED_16(vector->base_addr)
 	  || GFC_UNALIGNED_16(field))
@@ -574,7 +592,6 @@ unpack0 (gfc_array_char *ret, const gfc_array_char *vector,
 	  return;
 	}
 #endif
-
     }
 
   memset (&tmp, 0, sizeof (tmp));

libgfortran/libgfortran.h

@@ -490,19 +490,6 @@ typedef gfc_array_i4 gfc_array_s4;
    | (sizeof(GFC_COMPLEX_16) << GFC_DTYPE_SIZE_SHIFT))
 #endif
 
-#define GFC_DTYPE_DERIVED_1 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_DERIVED_2 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_INTEGER_2) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_DERIVED_4 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_SHIFT))
-#define GFC_DTYPE_DERIVED_8 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_INTEGER_8) << GFC_DTYPE_SIZE_SHIFT))
-#ifdef HAVE_GFC_INTEGER_16
-#define GFC_DTYPE_DERIVED_16 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
-   | (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT))
-#endif
-
 /* Macros to determine the alignment of pointers.  */
 
 #define GFC_UNALIGNED_2(x) (((uintptr_t)(x)) & \

libgfortran/m4/cshift1.m4

@@ -121,7 +121,6 @@ cshift1 (gfc_array_char * const restrict ret,
   {
     case GFC_DTYPE_LOGICAL_1:
     case GFC_DTYPE_INTEGER_1:
-    case GFC_DTYPE_DERIVED_1:
       cshift1_'atype_kind`_i1 ((gfc_array_i1 *)ret, (gfc_array_i1 *) array,
       			h, pwhich);
       return;

libgfortran/runtime/in_pack_generic.c

@@ -55,7 +55,6 @@ internal_pack (gfc_array_char * source)
     {
     case GFC_DTYPE_INTEGER_1:
     case GFC_DTYPE_LOGICAL_1:
-    case GFC_DTYPE_DERIVED_1:
       return internal_pack_1 ((gfc_array_i1 *) source);
 
     case GFC_DTYPE_INTEGER_2:
@@ -123,32 +122,40 @@ internal_pack (gfc_array_char * source)
 # endif
 #endif
 
-    case GFC_DTYPE_DERIVED_2:
+    default:
+      break;
+    }
+
+  switch(GFC_DESCRIPTOR_SIZE (source))
+    {
+    case 1:
+      return internal_pack_1 ((gfc_array_i1 *) source);
+
+    case 2:
       if (GFC_UNALIGNED_2(source->base_addr))
 	break;
       else
 	return internal_pack_2 ((gfc_array_i2 *) source);
 
-    case GFC_DTYPE_DERIVED_4:
+    case 4:
       if (GFC_UNALIGNED_4(source->base_addr))
 	break;
       else
 	return internal_pack_4 ((gfc_array_i4 *) source);
 
-    case GFC_DTYPE_DERIVED_8:
+    case 8:
       if (GFC_UNALIGNED_8(source->base_addr))
 	break;
       else
 	return internal_pack_8 ((gfc_array_i8 *) source);
 
 #ifdef HAVE_GFC_INTEGER_16
-    case GFC_DTYPE_DERIVED_16:
+    case 16:
       if (GFC_UNALIGNED_16(source->base_addr))
 	break;
       else
 	return internal_pack_16 ((gfc_array_i16 *) source);
 #endif
-
     default:
       break;
     }

libgfortran/runtime/in_unpack_generic.c

@@ -54,7 +54,6 @@ internal_unpack (gfc_array_char * d, const void * s)
     {
     case GFC_DTYPE_INTEGER_1:
     case GFC_DTYPE_LOGICAL_1:
-    case GFC_DTYPE_DERIVED_1:
       internal_unpack_1 ((gfc_array_i1 *) d, (const GFC_INTEGER_1 *) s);
       return;
 
@@ -136,7 +135,17 @@ internal_unpack (gfc_array_char * d, const void * s)
 # endif
 #endif
 
-    case GFC_DTYPE_DERIVED_2:
+    default:
+      break;
+    }
+
+  switch (GFC_DESCRIPTOR_SIZE(d))
+    {
+    case 1:
+      internal_unpack_1 ((gfc_array_i1 *) d, (const GFC_INTEGER_1 *) s);
+      return;
+
+    case 2:
       if (GFC_UNALIGNED_2(d->base_addr) || GFC_UNALIGNED_2(s))
 	break;
       else
@@ -144,7 +153,8 @@ internal_unpack (gfc_array_char * d, const void * s)
 	  internal_unpack_2 ((gfc_array_i2 *) d, (const GFC_INTEGER_2 *) s);
 	  return;
 	}
-    case GFC_DTYPE_DERIVED_4:
+      
+    case 4:
       if (GFC_UNALIGNED_4(d->base_addr) || GFC_UNALIGNED_4(s))
 	break;
       else
@@ -153,7 +163,7 @@ internal_unpack (gfc_array_char * d, const void * s)
 	  return;
 	}
 
-    case GFC_DTYPE_DERIVED_8:
+    case 8:
       if (GFC_UNALIGNED_8(d->base_addr) || GFC_UNALIGNED_8(s))
 	break;
       else
@@ -163,7 +173,7 @@ internal_unpack (gfc_array_char * d, const void * s)
 	}
 
 #ifdef HAVE_GFC_INTEGER_16
-    case GFC_DTYPE_DERIVED_16:
+    case 16:
       if (GFC_UNALIGNED_16(d->base_addr) || GFC_UNALIGNED_16(s))
 	break;
       else
@@ -172,7 +182,6 @@ internal_unpack (gfc_array_char * d, const void * s)
 	  return;
 	}
 #endif
-
     default:
       break;
     }