re PR libfortran/32972 (performance of pack/unpack)

2008-03-28  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/32972
	PR libfortran/32512
	* Makefile.am:  Add new variable, i_spread_c, containing
	pack_i1.c, pack_i2.c, pack_i4.c, pack_i8.c, spread_i16.c,
	spread_r4.c, spread_r8.c, spread_r10.c, spread_r16.c,
	spread_c4.c, spread_c8.c, spread_c10.c, spread_c16.c.
	* Makefile.in:  Regenerated.
	* libgfortran.h:  Add prototypes for spread_i1, spread_i2,
	spread_i4, spread_i8, spread_i16, spread_r4, spread_r8,
	spread_c4, spread_c8, spread_c10, spread_c16,
	spread_scalar_i1, spread_scalar_i2, spread_scalar_i4,
	spread_scalar_i8, spread_scalar_i16, spread_scalar_r4
	spread_scalar_r8, spread_scalar_c4, spread_scalar_c8,
	spread_scalar_c10 and spread_scalar_c16.
	Add macros to isolate both type and size information
	from array descriptors with a single mask operation.
	* intrinsics/spread_generic.c:  Add calls to specific
	spread functions.
	* m4/spread.m4:  New file.
	* generated/spread_i1.c:  New file.
	* generated/spread_i2.c:  New file.
	* generated/spread_i4.c:  New file.
	* generated/spread_i8.c:  New file.
	* generated/spread_i16.c:  New file.
	* generated/spread_r4.c:  New file.
	* generated/spread_r8.c:  New file.
	* generated/spread_r10.c:  New file.
	* generated/spread_r16.c:  New file.
	* generated/spread_c4.c:  New file.
	* generated/spread_c8.c:  New file.
	* generated/spread_c10.c:  New file.
	* generated/spread_c16.c:  New file.

2008-03-28  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/32972
	PR libfortran/32512
	* intrinsic_spread_1.f90:  New file.
	* intrinsic_spread_2.f90:  New file.
	* intrinsic_spread_3.f90:  New file.

From-SVN: r133702

1 files changed, 196 insertions, 0 deletions

diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 9a1f643..b5cad85 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -308,6 +308,66 @@ typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_16) gfc_array_l16;
 #define GFC_DESCRIPTOR_DATA(desc) ((desc)->data)
 #define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->dtype)
 
+/* Macros to get both the size and the type with a single masking operation  */
+
+#define GFC_DTYPE_SIZE_MASK \
+  ((~((index_type) 0) >> GFC_DTYPE_SIZE_SHIFT) << GFC_DTYPE_SIZE_SHIFT)
+#define GFC_DTYPE_TYPE_SIZE_MASK (GFC_DTYPE_SIZE_MASK | GFC_DTYPE_TYPE_MASK)
+
+#define GFC_DTYPE_TYPE_SIZE(desc) ((desc)->dtype & GFC_DTYPE_TYPE_SIZE_MASK)
+
+#define GFC_DTYPE_INTEGER_1 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
+   | (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT))
+#define GFC_DTYPE_INTEGER_2 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
+   | (sizeof(GFC_INTEGER_2) << GFC_DTYPE_SIZE_SHIFT))
+#define GFC_DTYPE_INTEGER_4 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
+   | (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_SHIFT))
+#define GFC_DTYPE_INTEGER_8 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
+   | (sizeof(GFC_INTEGER_8) << GFC_DTYPE_SIZE_SHIFT))
+#ifdef HAVE_GFC_INTEGER_16
+#define GFC_DTYPE_INTEGER_16 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
+   | (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT))
+#endif
+
+#define GFC_DTYPE_LOGICAL_1 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
+   | (sizeof(GFC_LOGICAL_1) << GFC_DTYPE_SIZE_SHIFT))
+#define GFC_DTYPE_LOGICAL_2 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
+   | (sizeof(GFC_LOGICAL_2) << GFC_DTYPE_SIZE_SHIFT))
+#define GFC_DTYPE_LOGICAL_4 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
+   | (sizeof(GFC_LOGICAL_4) << GFC_DTYPE_SIZE_SHIFT))
+#define GFC_DTYPE_LOGICAL_8 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
+   | (sizeof(GFC_LOGICAL_8) << GFC_DTYPE_SIZE_SHIFT))
+#ifdef HAVE_GFC_LOGICAL_16
+#define GFC_DTYPE_LOGICAL_16 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
+   | (sizeof(GFC_LOGICAL_16) << GFC_DTYPE_SIZE_SHIFT))
+#endif
+
+#define GFC_DTYPE_REAL_4 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \
+   | (sizeof(GFC_REAL_4) << GFC_DTYPE_SIZE_SHIFT))
+#define GFC_DTYPE_REAL_8 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \
+   | (sizeof(GFC_REAL_8) << GFC_DTYPE_SIZE_SHIFT))
+#ifdef HAVE_GFC_REAL_10
+#define GFC_DTYPE_REAL_10  ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \
+   | (sizeof(GFC_REAL_10) << GFC_DTYPE_SIZE_SHIFT))
+#endif
+#ifdef HAVE_GFC_REAL_16
+#define GFC_DTYPE_REAL_16 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \
+   | (sizeof(GFC_REAL_16) << GFC_DTYPE_SIZE_SHIFT))
+#endif
+
+#define GFC_DTYPE_COMPLEX_4 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
+   | (sizeof(GFC_COMPLEX_4) << GFC_DTYPE_SIZE_SHIFT))
+#define GFC_DTYPE_COMPLEX_8 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
+   | (sizeof(GFC_COMPLEX_8) << GFC_DTYPE_SIZE_SHIFT))
+#ifdef HAVE_GFC_COMPLEX_10
+#define GFC_DTYPE_COMPLEX_10 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
+   | (sizeof(GFC_COMPLEX_10) << GFC_DTYPE_SIZE_SHIFT))
+#endif
+#ifdef HAVE_GFC_COMPLEX_16
+#define GFC_DTYPE_COMPLEX_16 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
+   | (sizeof(GFC_COMPLEX_16) << GFC_DTYPE_SIZE_SHIFT))
+#endif
+
 /* Runtime library include.  */
 #define stringize(x) expand_macro(x)
 #define expand_macro(x) # x
@@ -910,6 +970,142 @@ extern void unpack1_c16 (gfc_array_c16 *, const gfc_array_c16 *,
 internal_proto(unpack1_c16);
 #endif
 
+/* Helper functions for spread.  */
+
+extern void spread_i1 (gfc_array_i1 *, const gfc_array_i1 *,
+		       const index_type, const index_type);
+internal_proto(spread_i1);
+
+extern void spread_i2 (gfc_array_i2 *, const gfc_array_i2 *,
+		       const index_type, const index_type);
+internal_proto(spread_i2);
+
+extern void spread_i4 (gfc_array_i4 *, const gfc_array_i4 *,
+		       const index_type, const index_type);
+internal_proto(spread_i4);
+
+extern void spread_i8 (gfc_array_i8 *, const gfc_array_i8 *,
+		       const index_type, const index_type);
+internal_proto(spread_i8);
+
+#ifdef HAVE_GFC_INTEGER_16
+extern void spread_i16 (gfc_array_i16 *, const gfc_array_i16 *,
+		       const index_type, const index_type);
+internal_proto(spread_i16);
+
+#endif
+
+extern void spread_r4 (gfc_array_r4 *, const gfc_array_r4 *,
+		       const index_type, const index_type);
+internal_proto(spread_r4);
+
+extern void spread_r8 (gfc_array_r8 *, const gfc_array_r8 *,
+		       const index_type, const index_type);
+internal_proto(spread_r8);
+
+#ifdef HAVE_GFC_REAL_10
+extern void spread_r10 (gfc_array_r10 *, const gfc_array_r10 *,
+		       const index_type, const index_type);
+internal_proto(spread_r10);
+
+#endif
+
+#ifdef HAVE_GFC_REAL_16
+extern void spread_r16 (gfc_array_r16 *, const gfc_array_r16 *,
+		       const index_type, const index_type);
+internal_proto(spread_r16);
+
+#endif
+
+extern void spread_c4 (gfc_array_c4 *, const gfc_array_c4 *,
+		       const index_type, const index_type);
+internal_proto(spread_c4);
+
+extern void spread_c8 (gfc_array_c8 *, const gfc_array_c8 *,
+		       const index_type, const index_type);
+internal_proto(spread_c8);
+
+#ifdef HAVE_GFC_COMPLEX_10
+extern void spread_c10 (gfc_array_c10 *, const gfc_array_c10 *,
+		       const index_type, const index_type);
+internal_proto(spread_c10);
+
+#endif
+
+#ifdef HAVE_GFC_COMPLEX_16
+extern void spread_c16 (gfc_array_c16 *, const gfc_array_c16 *,
+		       const index_type, const index_type);
+internal_proto(spread_c16);
+
+#endif
+
+extern void spread_scalar_i1 (gfc_array_i1 *, const GFC_INTEGER_1 *,
+			      const index_type, const index_type);
+internal_proto(spread_scalar_i1);
+
+extern void spread_scalar_i2 (gfc_array_i2 *, const GFC_INTEGER_2 *,
+			      const index_type, const index_type);
+internal_proto(spread_scalar_i2);
+
+extern void spread_scalar_i4 (gfc_array_i4 *, const GFC_INTEGER_4 *,
+			      const index_type, const index_type);
+internal_proto(spread_scalar_i4);
+
+extern void spread_scalar_i8 (gfc_array_i8 *, const GFC_INTEGER_8 *,
+			      const index_type, const index_type);
+internal_proto(spread_scalar_i8);
+
+#ifdef HAVE_GFC_INTEGER_16
+extern void spread_scalar_i16 (gfc_array_i16 *, const GFC_INTEGER_16 *,
+			       const index_type, const index_type);
+internal_proto(spread_scalar_i16);
+
+#endif
+
+extern void spread_scalar_r4 (gfc_array_r4 *, const GFC_REAL_4 *,
+			      const index_type, const index_type);
+internal_proto(spread_scalar_r4);
+
+extern void spread_scalar_r8 (gfc_array_r8 *, const GFC_REAL_8 *,
+			      const index_type, const index_type);
+internal_proto(spread_scalar_r8);
+
+#ifdef HAVE_GFC_REAL_10
+extern void spread_scalar_r10 (gfc_array_r10 *, const GFC_REAL_10 *,
+			       const index_type, const index_type);
+internal_proto(spread_scalar_r10);
+
+#endif
+
+#ifdef HAVE_GFC_REAL_16
+extern void spread_scalar_r16 (gfc_array_r16 *, const GFC_REAL_16 *,
+			       const index_type, const index_type);
+internal_proto(spread_scalar_r16);
+
+#endif
+
+extern void spread_scalar_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *,
+			      const index_type, const index_type);
+internal_proto(spread_scalar_c4);
+
+extern void spread_scalar_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *,
+			      const index_type, const index_type);
+internal_proto(spread_scalar_c8);
+
+#ifdef HAVE_GFC_COMPLEX_10
+extern void spread_scalar_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *,
+			       const index_type, const index_type);
+internal_proto(spread_scalar_c10);
+
+#endif
+
+#ifdef HAVE_GFC_COMPLEX_16
+extern void spread_scalar_c16 (gfc_array_c16 *, const GFC_COMPLEX_16 *,
+			       const index_type, const index_type);
+internal_proto(spread_scalar_c16);
+
+#endif
+
 /* string_intrinsics.c */
 
 extern int compare_string (GFC_INTEGER_4, const char *,