1 files changed, 87 insertions, 91 deletions

diff --git a/libgfortran/intrinsics/pack_generic.c b/libgfortran/intrinsics/pack_generic.c
index 5aea3d0e1f6..b2b79bb9069 100644
--- a/libgfortran/intrinsics/pack_generic.c
+++ b/libgfortran/intrinsics/pack_generic.c
@@ -101,7 +101,7 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array,
   /* Use the same loop for all logical types, by using GFC_LOGICAL_1
      and using shifting to address size and endian issues.  */
 
-  mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+  mask_kind = GFC_DESCRIPTOR_ELEM_LEN (mask);
 
   if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
 #ifdef HAVE_GFC_LOGICAL_16
@@ -120,8 +120,10 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array,
     {
       count[n] = 0;
       extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
-      sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);
-      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+      sstride[n] = GFC_DESCRIPTOR_SM(array,n);
+      mstride[n] = GFC_DESCRIPTOR_SM(mask,n);
+      if (extent[n] <= 0)
+	mptr = NULL;
     }
   if (sstride[0] == 0)
     sstride[0] = size;
@@ -149,7 +151,7 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array,
       if (ret->base_addr == NULL)
 	{
 	  /* Setup the array descriptor.  */
-	  GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1);
+	  GFC_DIMENSION_SET (ret->dim[0], 0, total, size);
 
 	  ret->offset = 0;
 	  /* xmallocarray allocates a single byte for zero size.  */
@@ -171,7 +173,7 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array,
 	}
     }
 
-  rstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(ret,0);
+  rstride0 = GFC_DESCRIPTOR_SM(ret,0);
   if (rstride0 == 0)
     rstride0 = size;
   sstride0 = sstride[0];
@@ -224,7 +226,7 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array,
       nelem = ((rptr - ret->base_addr) / rstride0);
       if (n > nelem)
         {
-          sstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(vector,0);
+          sstride0 = GFC_DESCRIPTOR_SM(vector,0);
           if (sstride0 == 0)
             sstride0 = size;
 
@@ -248,163 +250,157 @@ void
 pack (gfc_array_char *ret, const gfc_array_char *array,
       const gfc_array_l1 *mask, const gfc_array_char *vector)
 {
-  index_type type_size;
+  CFI_type_t type;
   index_type size;
 
-  type_size = GFC_DTYPE_TYPE_SIZE(array);
+  type = GFC_DESCRIPTOR_TYPE (array);
+  if ((type == CFI_type_struct || type == CFI_type_other)
+      && GFC_DESCRIPTOR_ELEM_LEN (array) == 1)
+    type = CFI_type_Integer1;
 
-  switch(type_size)
+  switch(type)
     {
-    case GFC_DTYPE_LOGICAL_1:
-    case GFC_DTYPE_INTEGER_1:
-    case GFC_DTYPE_DERIVED_1:
+    case CFI_type_Integer1:
+    case CFI_type_Logical1:
       pack_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) array,
 	       (gfc_array_l1 *) mask, (gfc_array_i1 *) vector);
       return;
 
-    case GFC_DTYPE_LOGICAL_2:
-    case GFC_DTYPE_INTEGER_2:
+    case CFI_type_Integer2:
+    case CFI_type_Logical2:
       pack_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) array,
 	       (gfc_array_l1 *) mask, (gfc_array_i2 *) vector);
       return;
 
-    case GFC_DTYPE_LOGICAL_4:
-    case GFC_DTYPE_INTEGER_4:
+    case CFI_type_Integer4:
+    case CFI_type_Logical4:
       pack_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) array,
 	       (gfc_array_l1 *) mask, (gfc_array_i4 *) vector);
       return;
 
-    case GFC_DTYPE_LOGICAL_8:
-    case GFC_DTYPE_INTEGER_8:
+    case CFI_type_Integer8:
+    case CFI_type_Logical8:
       pack_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) array,
 	       (gfc_array_l1 *) mask, (gfc_array_i8 *) vector);
       return;
 
 #ifdef HAVE_GFC_INTEGER_16
-    case GFC_DTYPE_LOGICAL_16:
-    case GFC_DTYPE_INTEGER_16:
+    case CFI_type_Integer16:
+    case CFI_type_Logical16:
       pack_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) array,
 		(gfc_array_l1 *) mask, (gfc_array_i16 *) vector);
       return;
 #endif
 
-    case GFC_DTYPE_REAL_4:
+    case CFI_type_Real4:
       pack_r4 ((gfc_array_r4 *) ret, (gfc_array_r4 *) array,
 	       (gfc_array_l1 *) mask, (gfc_array_r4 *) vector);
       return;
 
-    case GFC_DTYPE_REAL_8:
+    case CFI_type_Real8:
       pack_r8 ((gfc_array_r8 *) ret, (gfc_array_r8 *) array,
 	       (gfc_array_l1 *) mask, (gfc_array_r8 *) vector);
       return;
 
-/* FIXME: This here is a hack, which will have to be removed when
-   the array descriptor is reworked.  Currently, we don't store the
-   kind value for the type, but only the size.  Because on targets with
-   __float128, we have sizeof(logn double) == sizeof(__float128),
-   we cannot discriminate here and have to fall back to the generic
-   handling (which is suboptimal).  */
-#if !defined(GFC_REAL_16_IS_FLOAT128)
 # ifdef HAVE_GFC_REAL_10
-    case GFC_DTYPE_REAL_10:
+    case CFI_type_Real10:
       pack_r10 ((gfc_array_r10 *) ret, (gfc_array_r10 *) array,
 		(gfc_array_l1 *) mask, (gfc_array_r10 *) vector);
       return;
 # endif
 
 # ifdef HAVE_GFC_REAL_16
-    case GFC_DTYPE_REAL_16:
+    case CFI_type_Real16:
       pack_r16 ((gfc_array_r16 *) ret, (gfc_array_r16 *) array,
 		(gfc_array_l1 *) mask, (gfc_array_r16 *) vector);
       return;
 # endif
-#endif
 
-    case GFC_DTYPE_COMPLEX_4:
+    case CFI_type_Complex4:
       pack_c4 ((gfc_array_c4 *) ret, (gfc_array_c4 *) array,
 	       (gfc_array_l1 *) mask, (gfc_array_c4 *) vector);
       return;
 
-    case GFC_DTYPE_COMPLEX_8:
+    case CFI_type_Complex8:
       pack_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) array,
 	       (gfc_array_l1 *) mask, (gfc_array_c8 *) vector);
       return;
 
-/* FIXME: This here is a hack, which will have to be removed when
-   the array descriptor is reworked.  Currently, we don't store the
-   kind value for the type, but only the size.  Because on targets with
-   __float128, we have sizeof(logn double) == sizeof(__float128),
-   we cannot discriminate here and have to fall back to the generic
-   handling (which is suboptimal).  */
-#if !defined(GFC_REAL_16_IS_FLOAT128)
 # ifdef HAVE_GFC_COMPLEX_10
-    case GFC_DTYPE_COMPLEX_10:
+    case CFI_type_Complex10:
       pack_c10 ((gfc_array_c10 *) ret, (gfc_array_c10 *) array,
 		(gfc_array_l1 *) mask, (gfc_array_c10 *) vector);
       return;
 # endif
 
 # ifdef HAVE_GFC_COMPLEX_16
-    case GFC_DTYPE_COMPLEX_16:
+    case CFI_type_Complex16:
       pack_c16 ((gfc_array_c16 *) ret, (gfc_array_c16 *) array,
 		(gfc_array_l1 *) mask, (gfc_array_c16 *) vector);
       return;
 # endif
-#endif
 
       /* For derived types, let's check the actual alignment of the
 	 data pointers.  If they are aligned, we can safely call
 	 the unpack functions.  */
 
-    case GFC_DTYPE_DERIVED_2:
-      if (GFC_UNALIGNED_2(ret->base_addr) || GFC_UNALIGNED_2(array->base_addr)
-	  || (vector && GFC_UNALIGNED_2(vector->base_addr)))
-	break;
-      else
-	{
-	  pack_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) array,
-		   (gfc_array_l1 *) mask, (gfc_array_i2 *) vector);
-	  return;
-	}
+    case CFI_type_struct:
+    case CFI_type_other:
+      switch (GFC_DESCRIPTOR_ELEM_LEN(array))
+        {
+	case 2:
+	  if (GFC_UNALIGNED_2(ret->base_addr)
+	      || GFC_UNALIGNED_2(array->base_addr)
+	      || (vector && GFC_UNALIGNED_2(vector->base_addr)))
+	    break;
+	  else
+	    {
+	      pack_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) array,
+		       (gfc_array_l1 *) mask, (gfc_array_i2 *) vector);
+	      return;
+	    }
 
-    case GFC_DTYPE_DERIVED_4:
-      if (GFC_UNALIGNED_4(ret->base_addr) || GFC_UNALIGNED_4(array->base_addr)
-	  || (vector && GFC_UNALIGNED_4(vector->base_addr)))
-	break;
-      else
-	{
-	  pack_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) array,
-		   (gfc_array_l1 *) mask, (gfc_array_i4 *) vector);
-	  return;
-	}
+	case 4:
+	  if (GFC_UNALIGNED_4(ret->base_addr)
+	      || GFC_UNALIGNED_4(array->base_addr)
+	      || (vector && GFC_UNALIGNED_4(vector->base_addr)))
+	    break;
+	  else
+	    {
+	      pack_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) array,
+		       (gfc_array_l1 *) mask, (gfc_array_i4 *) vector);
+	      return;
+	    }
 
-    case GFC_DTYPE_DERIVED_8:
-      if (GFC_UNALIGNED_8(ret->base_addr) || GFC_UNALIGNED_8(array->base_addr)
-	  || (vector && GFC_UNALIGNED_8(vector->base_addr)))
-	break;
-      else
-	{
-	  pack_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) array,
-		   (gfc_array_l1 *) mask, (gfc_array_i8 *) vector);
-	  return;
-	}
+	case 8:
+	  if (GFC_UNALIGNED_8(ret->base_addr)
+	      || GFC_UNALIGNED_8(array->base_addr)
+	      || (vector && GFC_UNALIGNED_8(vector->base_addr)))
+	    break;
+	  else
+	    {
+	      pack_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) array,
+		       (gfc_array_l1 *) mask, (gfc_array_i8 *) vector);
+	      return;
+	    }
 
 #ifdef HAVE_GFC_INTEGER_16
-    case GFC_DTYPE_DERIVED_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);
-	  return;
-	}
+	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);
+	      return;
+	    }
 #endif
-
+      }
     }
 
-  size = GFC_DESCRIPTOR_SIZE (array);
+  size = GFC_DESCRIPTOR_ELEM_LEN (array);
   pack_internal (ret, array, mask, vector, size);
 }
 
@@ -474,7 +470,7 @@ pack_s_internal (gfc_array_char *ret, const gfc_array_char *array,
       if (extent[n] < 0)
 	extent[n] = 0;
 
-      sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);
+      sstride[n] = GFC_DESCRIPTOR_SM(array,n);
       ssize *= extent[n];
     }
   if (sstride[0] == 0)
@@ -518,7 +514,7 @@ pack_s_internal (gfc_array_char *ret, const gfc_array_char *array,
 	}
 
       /* Setup the array descriptor.  */
-      GFC_DIMENSION_SET(ret->dim[0],0,total-1,1);
+      GFC_DIMENSION_SET (ret->dim[0], 0, total, size);
 
       ret->offset = 0;
 
@@ -528,7 +524,7 @@ pack_s_internal (gfc_array_char *ret, const gfc_array_char *array,
 	return;
     }
 
-  rstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(ret,0);
+  rstride0 = GFC_DESCRIPTOR_SM(ret,0);
   if (rstride0 == 0)
     rstride0 = size;
   rptr = ret->base_addr;
@@ -582,7 +578,7 @@ pack_s_internal (gfc_array_char *ret, const gfc_array_char *array,
       nelem = ((rptr - ret->base_addr) / rstride0);
       if (n > nelem)
         {
-          sstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(vector,0);
+          sstride0 = GFC_DESCRIPTOR_SM(vector,0);
           if (sstride0 == 0)
             sstride0 = size;
 
@@ -606,7 +602,7 @@ void
 pack_s (gfc_array_char *ret, const gfc_array_char *array,
 	const GFC_LOGICAL_4 *mask, const gfc_array_char *vector)
 {
-  pack_s_internal (ret, array, mask, vector, GFC_DESCRIPTOR_SIZE (array));
+  pack_s_internal (ret, array, mask, vector, GFC_DESCRIPTOR_ELEM_LEN (array));
 }