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

4 files changed, 77 insertions, 36 deletions

diff --git a/libgfortran/intrinsics/cshift0.c b/libgfortran/intrinsics/cshift0.c
index b07da9c..f9db484 100644
--- a/libgfortran/intrinsics/cshift0.c
+++ b/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;
 
diff --git a/libgfortran/intrinsics/pack_generic.c b/libgfortran/intrinsics/pack_generic.c
index f4a7da9..7de1e82 100644
--- a/libgfortran/intrinsics/pack_generic.c
+++ b/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;
@@ -364,8 +370,8 @@ pack (gfc_array_char *ret, const gfc_array_char *array,
 		   (gfc_array_l1 *) mask, (gfc_array_i2 *) vector);
 	  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;
@@ -387,19 +393,20 @@ pack (gfc_array_char *ret, const gfc_array_char *array,
 	  return;
 	}
 
-#ifdef HAVE_GFC_INTEGER_16
-    case GFC_DTYPE_DERIVED_16:
+#ifdef HAVE_GFC_INTEGER_16	      
+    case 16:
       if (GFC_UNALIGNED_16(ret->base_addr) || GFC_UNALIGNED_16(array->base_addr)
 	  || (vector && GFC_UNALIGNED_16(vector->base_addr)))
 	break;
       else
 	{
 	  pack_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) array,
-		   (gfc_array_l1 *) mask, (gfc_array_i16 *) vector);
+		    (gfc_array_l1 *) mask, (gfc_array_i16 *) vector);
 	  return;
 	}
 #endif
-
+    default:
+      break;
     }
 
   size = GFC_DESCRIPTOR_SIZE (array);
diff --git a/libgfortran/intrinsics/spread_generic.c b/libgfortran/intrinsics/spread_generic.c
index 83ecc1d..5c86aba 100644
--- a/libgfortran/intrinsics/spread_generic.c
+++ b/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;
@@ -411,8 +418,9 @@ spread (gfc_array_char *ret, const gfc_array_char *source,
 	  spread_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) source,
 		      *along, *pncopies);
 	  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);
diff --git a/libgfortran/intrinsics/unpack_generic.c b/libgfortran/intrinsics/unpack_generic.c
index 86e1253..c5b9ecb 100644
--- a/libgfortran/intrinsics/unpack_generic.c
+++ b/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));