Ejemplo n.º 1
0
void
spread (gfc_array_char *ret, const gfc_array_char *source,
	const index_type *along, const index_type *pncopies)
{
  index_type type_size;

  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,
		 *along, *pncopies);
      return;

    case GFC_DTYPE_LOGICAL_2:
    case GFC_DTYPE_INTEGER_2:
      spread_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) source,
		 *along, *pncopies);
      return;

    case GFC_DTYPE_LOGICAL_4:
    case GFC_DTYPE_INTEGER_4:
      spread_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) source,
		 *along, *pncopies);
      return;

    case GFC_DTYPE_LOGICAL_8:
    case GFC_DTYPE_INTEGER_8:
      spread_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) source,
		 *along, *pncopies);
      return;

#ifdef HAVE_GFC_INTEGER_16
    case GFC_DTYPE_LOGICAL_16:
    case GFC_DTYPE_INTEGER_16:
      spread_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) source,
		 *along, *pncopies);
      return;
#endif

    case GFC_DTYPE_REAL_4:
      spread_r4 ((gfc_array_r4 *) ret, (gfc_array_r4 *) source,
		 *along, *pncopies);
      return;

    case GFC_DTYPE_REAL_8:
      spread_r8 ((gfc_array_r8 *) ret, (gfc_array_r8 *) source,
		 *along, *pncopies);
      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 GFC_HAVE_REAL_10
    case GFC_DTYPE_REAL_10:
      spread_r10 ((gfc_array_r10 *) ret, (gfc_array_r10 *) source,
		 *along, *pncopies);
      return;
# endif

# ifdef GFC_HAVE_REAL_16
    case GFC_DTYPE_REAL_16:
      spread_r16 ((gfc_array_r16 *) ret, (gfc_array_r16 *) source,
		 *along, *pncopies);
      return;
# endif
#endif

    case GFC_DTYPE_COMPLEX_4:
      spread_c4 ((gfc_array_c4 *) ret, (gfc_array_c4 *) source,
		 *along, *pncopies);
      return;

    case GFC_DTYPE_COMPLEX_8:
      spread_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) source,
		 *along, *pncopies);
      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 GFC_HAVE_COMPLEX_10
    case GFC_DTYPE_COMPLEX_10:
      spread_c10 ((gfc_array_c10 *) ret, (gfc_array_c10 *) source,
		 *along, *pncopies);
      return;
# endif

# ifdef GFC_HAVE_COMPLEX_16
    case GFC_DTYPE_COMPLEX_16:
      spread_c16 ((gfc_array_c16 *) ret, (gfc_array_c16 *) source,
		 *along, *pncopies);
      return;
# endif
#endif

    case GFC_DTYPE_DERIVED_2:
      if (GFC_UNALIGNED_2(ret->base_addr) || GFC_UNALIGNED_2(source->base_addr))
	break;
      else
	{
	  spread_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) source,
		     *along, *pncopies);
	  return;
	}

    case GFC_DTYPE_DERIVED_4:
      if (GFC_UNALIGNED_4(ret->base_addr) || GFC_UNALIGNED_4(source->base_addr))
	break;
      else
	{
	  spread_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) source,
		     *along, *pncopies);
	  return;
	}

    case GFC_DTYPE_DERIVED_8:
      if (GFC_UNALIGNED_8(ret->base_addr) || GFC_UNALIGNED_8(source->base_addr))
	break;
      else
	{
	  spread_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) source,
		     *along, *pncopies);
	  return;
	}

#ifdef HAVE_GFC_INTEGER_16
    case GFC_DTYPE_DERIVED_16:
      if (GFC_UNALIGNED_16(ret->base_addr)
	  || GFC_UNALIGNED_16(source->base_addr))
	break;
      else
	{
	  spread_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) source,
		      *along, *pncopies);
	  return;
	}
#endif
    }

  spread_internal (ret, source, along, pncopies);
}
void
spread (gfc_array_char *ret, const gfc_array_char *source,
	const index_type *along, const index_type *pncopies)
{
  index_type type_size;

  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,
		 *along, *pncopies);
      return;

    case GFC_DTYPE_LOGICAL_2:
    case GFC_DTYPE_INTEGER_2:
      spread_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) source,
		 *along, *pncopies);
      return;

    case GFC_DTYPE_LOGICAL_4:
    case GFC_DTYPE_INTEGER_4:
      spread_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) source,
		 *along, *pncopies);
      return;

    case GFC_DTYPE_LOGICAL_8:
    case GFC_DTYPE_INTEGER_8:
      spread_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) source,
		 *along, *pncopies);
      return;

#ifdef HAVE_GFC_INTEGER_16
    case GFC_DTYPE_LOGICAL_16:
    case GFC_DTYPE_INTEGER_16:
      spread_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) source,
		 *along, *pncopies);
      return;
#endif

    case GFC_DTYPE_REAL_4:
      spread_r4 ((gfc_array_r4 *) ret, (gfc_array_r4 *) source,
		 *along, *pncopies);
      return;

    case GFC_DTYPE_REAL_8:
      spread_r8 ((gfc_array_r8 *) ret, (gfc_array_r8 *) source,
		 *along, *pncopies);
      return;

#ifdef GFC_HAVE_REAL_10
    case GFC_DTYPE_REAL_10:
      spread_r10 ((gfc_array_r10 *) ret, (gfc_array_r10 *) source,
		 *along, *pncopies);
      return;
#endif

#ifdef GFC_HAVE_REAL_16
    case GFC_DTYPE_REAL_16:
      spread_r16 ((gfc_array_r16 *) ret, (gfc_array_r16 *) source,
		 *along, *pncopies);
      return;
#endif

    case GFC_DTYPE_COMPLEX_4:
      spread_c4 ((gfc_array_c4 *) ret, (gfc_array_c4 *) source,
		 *along, *pncopies);
      return;

    case GFC_DTYPE_COMPLEX_8:
      spread_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) source,
		 *along, *pncopies);
      return;

#ifdef GFC_HAVE_COMPLEX_10
    case GFC_DTYPE_COMPLEX_10:
      spread_c10 ((gfc_array_c10 *) ret, (gfc_array_c10 *) source,
		 *along, *pncopies);
      return;
#endif

#ifdef GFC_HAVE_COMPLEX_16
    case GFC_DTYPE_COMPLEX_16:
      spread_c16 ((gfc_array_c16 *) ret, (gfc_array_c16 *) source,
		 *along, *pncopies);
      return;
#endif

    case GFC_DTYPE_DERIVED_2:
      if (GFC_UNALIGNED_2(ret->data) || GFC_UNALIGNED_2(source->data))
	break;
      else
	{
	  spread_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) source,
		     *along, *pncopies);
	  return;
	}

    case GFC_DTYPE_DERIVED_4:
      if (GFC_UNALIGNED_4(ret->data) || GFC_UNALIGNED_4(source->data))
	break;
      else
	{
	  spread_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) source,
		     *along, *pncopies);
	  return;
	}

    case GFC_DTYPE_DERIVED_8:
      if (GFC_UNALIGNED_8(ret->data) || GFC_UNALIGNED_8(source->data))
	break;
      else
	{
	  spread_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) source,
		     *along, *pncopies);
	  return;
	}

#ifdef HAVE_GFC_INTEGER_16
    case GFC_DTYPE_DERIVED_16:
      if (GFC_UNALIGNED_16(ret->data) || GFC_UNALIGNED_16(source->data))
	break;
      else
	{
	  spread_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) source,
		      *along, *pncopies);
	  return;
	}
#endif
    }

  spread_internal (ret, source, along, pncopies, GFC_DESCRIPTOR_SIZE (source));
}