自学教程：C++ GFC_DESCRIPTOR_SIZE函数代码示例

  index_type len;  index_type n;  index_type size;  index_type arraysize;  int which;  GFC_INTEGER_8 sh;  GFC_INTEGER_8 delta;  /* The compiler cannot figure out that these are set, initialize     them to avoid warnings.  */  len = 0;  soffset = 0;  roffset = 0;  arraysize = size0 ((array_t *) array);  size = GFC_DESCRIPTOR_SIZE(array);  if (pwhich)    which = *pwhich - 1;  else    which = 0;  if (ret->data == NULL)    {      int i;      ret->offset = 0;      ret->dtype = array->dtype;      for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)        {	  index_type ub, str;

  index_type dstride[GFC_MAX_DIMENSIONS];  const GFC_LOGICAL_1 * restrict base;  GFC_LOGICAL_8 * restrict dest;  index_type rank;  index_type n;  index_type len;  index_type delta;  index_type dim;  int src_kind;  int continue_loop;  /* Make dim zero based to avoid confusion.  */  dim = (*pdim) - 1;  rank = GFC_DESCRIPTOR_RANK (array) - 1;  src_kind = GFC_DESCRIPTOR_SIZE (array);  len = GFC_DESCRIPTOR_EXTENT(array,dim);  if (len < 0)    len = 0;  delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);  for (n = 0; n < dim; n++)    {      sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);      if (extent[n] < 0)	extent[n] = 0;    }

voidmminloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array,				  gfc_array_l4 * mask){  index_type count[GFC_MAX_DIMENSIONS];  index_type extent[GFC_MAX_DIMENSIONS];  index_type sstride[GFC_MAX_DIMENSIONS];  index_type mstride[GFC_MAX_DIMENSIONS];  index_type dstride;  GFC_INTEGER_16 *dest;  GFC_INTEGER_16 *base;  GFC_LOGICAL_4 *mbase;  int rank;  index_type n;  rank = GFC_DESCRIPTOR_RANK (array);  if (rank <= 0)    runtime_error ("Rank of array needs to be > 0");  if (retarray->data == NULL)    {      retarray->dim[0].lbound = 0;      retarray->dim[0].ubound = rank-1;      retarray->dim[0].stride = 1;      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;      retarray->offset = 0;      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);    }  else    {      if (GFC_DESCRIPTOR_RANK (retarray) != 1)	runtime_error ("rank of return array does not equal 1");      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)        runtime_error ("dimension of return array incorrect");      if (retarray->dim[0].stride == 0)	retarray->dim[0].stride = 1;    }  /* TODO:  It should be a front end job to correctly set the strides.  */  if (array->dim[0].stride == 0)    array->dim[0].stride = 1;  if (mask->dim[0].stride == 0)    mask->dim[0].stride = 1;  dstride = retarray->dim[0].stride;  dest = retarray->data;  for (n = 0; n < rank; n++)    {      sstride[n] = array->dim[n].stride;      mstride[n] = mask->dim[n].stride;      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;      count[n] = 0;      if (extent[n] <= 0)	{	  /* Set the return value.  */	  for (n = 0; n < rank; n++)	    dest[n * dstride] = 0;	  return;	}    }  base = array->data;  mbase = mask->data;  if (GFC_DESCRIPTOR_SIZE (mask) != 4)    {      /* This allows the same loop to be used for all logical types.  */      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);      for (n = 0; n < rank; n++)        mstride[n] <<= 1;      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));    }  /* Initialize the return value.  */  for (n = 0; n < rank; n++)    dest[n * dstride] = 0;  {  GFC_INTEGER_16 minval;  minval = GFC_INTEGER_16_HUGE;  while (base)    {      {        /* Implementation start.  */  if (*mbase && (*base < minval || !dest[0]))    {      minval = *base;      for (n = 0; n < rank; n++)        dest[n * dstride] = count[n] + 1;    }        /* Implementation end.  */      }//.........这里部分代码省略.........

static voidspread_internal (gfc_array_char *ret, const gfc_array_char *source,		 const index_type *along, const index_type *pncopies){  /* r.* indicates the return array.  */  index_type rstride[GFC_MAX_DIMENSIONS];  index_type rstride0;  index_type rdelta = 0;  index_type rrank;  index_type rs;  char *rptr;  char *dest;  /* s.* indicates the source array.  */  index_type sstride[GFC_MAX_DIMENSIONS];  index_type sstride0;  index_type srank;  const char *sptr;  index_type count[GFC_MAX_DIMENSIONS];  index_type extent[GFC_MAX_DIMENSIONS];  index_type n;  index_type dim;  index_type ncopies;  index_type size;  size = GFC_DESCRIPTOR_SIZE(source);  srank = GFC_DESCRIPTOR_RANK(source);  rrank = srank + 1;  if (rrank > GFC_MAX_DIMENSIONS)    runtime_error ("return rank too large in spread()");  if (*along > rrank)      runtime_error ("dim outside of rank in spread()");  ncopies = *pncopies;  if (ret->base_addr == NULL)    {      /* The front end has signalled that we need to populate the	 return array descriptor.  */      size_t ub, stride;      ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank;      dim = 0;      rs = 1;      for (n = 0; n < rrank; n++)	{	  stride = rs;	  if (n == *along - 1)	    {	      ub = ncopies - 1;	      rdelta = rs * size;	      rs *= ncopies;	    }	  else	    {	      count[dim] = 0;	      extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim);	      sstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(source,dim);	      rstride[dim] = rs * size;	      ub = extent[dim]-1;	      rs *= extent[dim];	      dim++;	    }	  GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride);	}      ret->offset = 0;      ret->base_addr = xmalloc (rs * size);      if (rs <= 0)	return;    }  else    {      int zero_sized;      zero_sized = 0;      dim = 0;      if (GFC_DESCRIPTOR_RANK(ret) != rrank)	runtime_error ("rank mismatch in spread()");      if (compile_options.bounds_check)	{	  for (n = 0; n < rrank; n++)	    {	      index_type ret_extent;	      ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n);	      if (n == *along - 1)		{		  rdelta = GFC_DESCRIPTOR_STRIDE_BYTES(ret,n);		  if (ret_extent != ncopies)		    runtime_error("Incorrect extent in return value of SPREAD"//.........这里部分代码省略.........

voidinternal_unpack (gfc_array_char * d, const void * s){  index_type count[GFC_MAX_DIMENSIONS];  index_type extent[GFC_MAX_DIMENSIONS];  index_type stride[GFC_MAX_DIMENSIONS];  index_type stride0;  index_type dim;  index_type dsize;  char *dest;  const char *src;  int n;  int size;  dest = d->data;  /* This check may be redundant, but do it anyway.  */  if (s == dest || !s)    return;  size = GFC_DESCRIPTOR_SIZE (d);  switch (size)    {    case 4:      internal_unpack_4 ((gfc_array_i4 *)d, (const GFC_INTEGER_4 *)s);      return;    case 8:      internal_unpack_8 ((gfc_array_i8 *)d, (const GFC_INTEGER_8 *)s);      return;    }  if (d->dim[0].stride == 0)    d->dim[0].stride = 1;  dim = GFC_DESCRIPTOR_RANK (d);  dsize = 1;  for (n = 0; n < dim; n++)    {      count[n] = 0;      stride[n] = d->dim[n].stride;      extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound;      if (extent[n] <= 0)        abort ();      if (dsize == stride[n])        dsize *= extent[n];      else        dsize = 0;    }  src = s;  if (dsize != 0)    {      memcpy (dest, src, dsize * size);      return;    }  stride0 = stride[0] * size;  while (dest)    {      /* Copy the data.  */      memcpy (dest, src, size);      /* Advance to the next element.  */      src += size;      dest += stride0;      count[0]++;      /* Advance to the next source element.  */      n = 0;      while (count[n] == extent[n])        {          /* When we get to the end of a dimension, reset it and increment             the next dimension.  */          count[n] = 0;          /* We could precalculate these products, but this is a less             frequently used path so proabably not worth it.  */          dest -= stride[n] * extent[n] * size;          n++;          if (n == dim)            {              dest = NULL;              break;            }          else            {              count[n]++;              dest += stride[n] * size;            }        }    }}

//.........这里部分代码省略.........    case GFC_DTYPE_REAL_10:      unpack0_r10 ((gfc_array_r10 *) ret, (gfc_array_r10 *) vector,		   mask, (GFC_REAL_10 *) field);      return;# endif# ifdef HAVE_GFC_REAL_16    case GFC_DTYPE_REAL_16:      unpack0_r16 ((gfc_array_r16 *) ret, (gfc_array_r16 *) vector,		   mask, (GFC_REAL_16 *) field);      return;# endif#endif    case GFC_DTYPE_COMPLEX_4:      unpack0_c4 ((gfc_array_c4 *) ret, (gfc_array_c4 *) vector,		  mask, (GFC_COMPLEX_4 *) field);      return;    case GFC_DTYPE_COMPLEX_8:      unpack0_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) vector,		  mask, (GFC_COMPLEX_8 *) field);      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:      unpack0_c10 ((gfc_array_c10 *) ret, (gfc_array_c10 *) vector,		   mask, (GFC_COMPLEX_10 *) field);      return;# endif# ifdef HAVE_GFC_COMPLEX_16    case GFC_DTYPE_COMPLEX_16:      unpack0_c16 ((gfc_array_c16 *) ret, (gfc_array_c16 *) vector,		   mask, (GFC_COMPLEX_16 *) field);      return;# endif#endif    case GFC_DTYPE_DERIVED_2:      if (GFC_UNALIGNED_2(ret->base_addr) || GFC_UNALIGNED_2(vector->base_addr)	  || GFC_UNALIGNED_2(field))	break;      else	{	  unpack0_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) vector,		      mask, (GFC_INTEGER_2 *) field);	  return;	}    case GFC_DTYPE_DERIVED_4:      if (GFC_UNALIGNED_4(ret->base_addr) || GFC_UNALIGNED_4(vector->base_addr)	  || GFC_UNALIGNED_4(field))	break;      else	{	  unpack0_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) vector,		      mask, (GFC_INTEGER_4 *) field);	  return;	}    case GFC_DTYPE_DERIVED_8:      if (GFC_UNALIGNED_8(ret->base_addr) || GFC_UNALIGNED_8(vector->base_addr)	  || GFC_UNALIGNED_8(field))	break;      else	{	  unpack0_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) vector,		      mask, (GFC_INTEGER_8 *) field);	  return;	}#ifdef HAVE_GFC_INTEGER_16    case GFC_DTYPE_DERIVED_16:      if (GFC_UNALIGNED_16(ret->base_addr)	  || GFC_UNALIGNED_16(vector->base_addr)	  || GFC_UNALIGNED_16(field))	break;      else	{	  unpack0_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) vector,		       mask, (GFC_INTEGER_16 *) field);	  return;	}#endif    }  memset (&tmp, 0, sizeof (tmp));  tmp.dtype = 0;  tmp.base_addr = field;  unpack_internal (ret, vector, mask, &tmp, GFC_DESCRIPTOR_SIZE (vector));}

//.........这里部分代码省略.........   values[7] = GFC_INTEGER_4_HUGE;#endif /* HAVE_GETTIMEOFDAY */  if (__date)    {      snprintf (date, DATE_LEN + 1, "%04d%02d%02d",		values[0], values[1], values[2]);    }  if (__time)    {      snprintf (timec, TIME_LEN + 1, "%02d%02d%02d.%03d",		values[4], values[5], values[6], values[7]);    }  if (__zone)    {      snprintf (zone, ZONE_LEN + 1, "%+03d%02d",		values[3] / 60, abs (values[3] % 60));    }#else /* if defined HAVE_NO_DATE_TIME  */  /* We really have *nothing* to return, so return blanks and HUGE(0).  */    {      int i;      memset (date, ' ', DATE_LEN);      date[DATE_LEN] = '/0';      memset (timec, ' ', TIME_LEN);      time[TIME_LEN] = '/0';      memset (zone, ' ', ZONE_LEN);      zone[ZONE_LEN] = '/0';      for (i = 0; i < VALUES_SIZE; i++)        values[i] = GFC_INTEGER_4_HUGE;    }#endif  /* HAVE_NO_DATE_TIME  */  /* Copy the values into the arguments.  */  if (__values)    {      int i;      size_t len, delta, elt_size;      elt_size = GFC_DESCRIPTOR_SIZE (__values);      len = __values->dim[0].ubound + 1 - __values->dim[0].lbound;      delta = __values->dim[0].stride;      if (delta == 0)	delta = 1;      assert (len >= VALUES_SIZE);      /* Cope with different type kinds.  */      if (elt_size == 4)        {	  GFC_INTEGER_4 *vptr4 = __values->data;	  for (i = 0; i < VALUES_SIZE; i++, vptr4 += delta)	    {	      *vptr4 = values[i];	    }	}      else if (elt_size == 8)        {	  GFC_INTEGER_8 *vptr8 = (GFC_INTEGER_8 *)__values->data;	  for (i = 0; i < VALUES_SIZE; i++, vptr8 += delta)	    {	      if (values[i] == GFC_INTEGER_4_HUGE)		*vptr8 = GFC_INTEGER_8_HUGE;	      else		*vptr8 = values[i];	    }	}      else 	abort ();    }  if (__zone)    {      assert (__zone_len >= ZONE_LEN);      fstrcpy (__zone, ZONE_LEN, zone, ZONE_LEN);    }  if (__time)    {      assert (__time_len >= TIME_LEN);      fstrcpy (__time, TIME_LEN, timec, TIME_LEN);    }  if (__date)    {      assert (__date_len >= DATE_LEN);      fstrcpy (__date, DATE_LEN, date, DATE_LEN);    }#undef DATE_LEN#undef TIME_LEN   #undef ZONE_LEN#undef VALUES_SIZE}

voidunpack1 (gfc_array_char *ret, const gfc_array_char *vector,	 const gfc_array_l4 *mask, const gfc_array_char *field){  /* r.* indicates the return array.  */  index_type rstride[GFC_MAX_DIMENSIONS];  index_type rstride0;  index_type rs;  char *rptr;  /* v.* indicates the vector array.  */  index_type vstride0;  char *vptr;  /* f.* indicates the field array.  */  index_type fstride[GFC_MAX_DIMENSIONS];  index_type fstride0;  const char *fptr;  /* m.* indicates the mask array.  */  index_type mstride[GFC_MAX_DIMENSIONS];  index_type mstride0;  const GFC_LOGICAL_4 *mptr;  index_type count[GFC_MAX_DIMENSIONS];  index_type extent[GFC_MAX_DIMENSIONS];  index_type n;  index_type dim;  index_type size;  index_type fsize;  size = GFC_DESCRIPTOR_SIZE (ret);  /* A field element size of 0 actually means this is a scalar.  */  fsize = GFC_DESCRIPTOR_SIZE (field);  if (ret->data == NULL)    {      /* The front end has signalled that we need to populate the	 return array descriptor.  */      dim = GFC_DESCRIPTOR_RANK (mask);      rs = 1;      for (n = 0; n < dim; n++)	{	  count[n] = 0;	  ret->dim[n].stride = rs;	  ret->dim[n].lbound = 0;	  ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;	  extent[n] = ret->dim[n].ubound + 1;	  rstride[n] = ret->dim[n].stride * size;	  fstride[n] = field->dim[n].stride * fsize;	  mstride[n] = mask->dim[n].stride;	  rs *= extent[n];	}      ret->base = 0;      ret->data = internal_malloc_size (rs * size);    }  else    {      dim = GFC_DESCRIPTOR_RANK (ret);      for (n = 0; n < dim; n++)	{	  count[n] = 0;	  extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;	  rstride[n] = ret->dim[n].stride * size;	  fstride[n] = field->dim[n].stride * fsize;	  mstride[n] = mask->dim[n].stride;	}      if (rstride[0] == 0)	rstride[0] = size;    }  if (fstride[0] == 0)    fstride[0] = fsize;  if (mstride[0] == 0)    mstride[0] = 1;  vstride0 = vector->dim[0].stride * size;  if (vstride0 == 0)    vstride0 = size;  rstride0 = rstride[0];  fstride0 = fstride[0];  mstride0 = mstride[0];  rptr = ret->data;  fptr = field->data;  mptr = mask->data;  vptr = vector->data;  /* Use the same loop for both logical types. */  if (GFC_DESCRIPTOR_SIZE (mask) != 4)    {      if (GFC_DESCRIPTOR_SIZE (mask) != 8)        runtime_error ("Funny sized logical array");      for (n = 0; n < dim; n++)        mstride[n] <<= 1;      mstride0 <<= 1;      mptr = GFOR_POINTER_L8_TO_L4 (mptr);    }  while (rptr)    {      if (*mptr)        {          /* From vector.  */          memcpy (rptr, vptr, size);          vptr += vstride0;//.........这里部分代码省略.........

void *internal_pack (gfc_array_char * source){  index_type count[GFC_MAX_DIMENSIONS];  index_type extent[GFC_MAX_DIMENSIONS];  index_type stride[GFC_MAX_DIMENSIONS];  index_type stride0;  index_type dim;  index_type ssize;  const char *src;  char *dest;  void *destptr;  int n;  int packed;  index_type size;  int type;  if (source->dim[0].stride == 0)    {      source->dim[0].stride = 1;      return source->data;    }  type = GFC_DESCRIPTOR_TYPE (source);  size = GFC_DESCRIPTOR_SIZE (source);  switch (type)    {    case GFC_DTYPE_INTEGER:    case GFC_DTYPE_LOGICAL:    case GFC_DTYPE_REAL:      switch (size)	{	case 4:	  return internal_pack_4 ((gfc_array_i4 *)source);	  	case 8:	  return internal_pack_8 ((gfc_array_i8 *)source);	}      break;    case GFC_DTYPE_COMPLEX:      switch (size)	{	case 8:	  return internal_pack_c4 ((gfc_array_c4 *)source);	  	case 16:	  return internal_pack_c8 ((gfc_array_c8 *)source);	}      break;    default:      break;    }  dim = GFC_DESCRIPTOR_RANK (source);  ssize = 1;  packed = 1;  for (n = 0; n < dim; n++)    {      count[n] = 0;      stride[n] = source->dim[n].stride;      extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;      if (extent[n] <= 0)        {          /* Do nothing.  */          packed = 1;          break;        }      if (ssize != stride[n])        packed = 0;      ssize *= extent[n];    }  if (packed)    return source->data;   /* Allocate storage for the destination.  */  destptr = internal_malloc_size (ssize * size);  dest = (char *)destptr;  src = source->data;  stride0 = stride[0] * size;  while (src)    {      /* Copy the data.  */      memcpy(dest, src, size);      /* Advance to the next element.  */      dest += size;      src += stride0;      count[0]++;      /* Advance to the next source element.  */      n = 0;      while (count[n] == extent[n])        {          /* When we get to the end of a dimension, reset it and increment             the next dimension.  */          count[n] = 0;//.........这里部分代码省略.........

//.........这里部分代码省略.........      if (GFC_UNALIGNED_2(d->base_addr) || GFC_UNALIGNED_2(s))	break;      else	{	  internal_unpack_2 ((gfc_array_i2 *) d, (const GFC_INTEGER_2 *) s);	  return;	}    case GFC_DTYPE_DERIVED_4:      if (GFC_UNALIGNED_4(d->base_addr) || GFC_UNALIGNED_4(s))	break;      else	{	  internal_unpack_4 ((gfc_array_i4 *) d, (const GFC_INTEGER_4 *) s);	  return;	}    case GFC_DTYPE_DERIVED_8:      if (GFC_UNALIGNED_8(d->base_addr) || GFC_UNALIGNED_8(s))	break;      else	{	  internal_unpack_8 ((gfc_array_i8 *) d, (const GFC_INTEGER_8 *) s);	  return;	}#ifdef HAVE_GFC_INTEGER_16    case GFC_DTYPE_DERIVED_16:      if (GFC_UNALIGNED_16(d->base_addr) || GFC_UNALIGNED_16(s))	break;      else	{	  internal_unpack_16 ((gfc_array_i16 *) d, (const GFC_INTEGER_16 *) s);	  return;	}#endif    default:      break;    }  size = GFC_DESCRIPTOR_SIZE (d);  dim = GFC_DESCRIPTOR_RANK (d);  dsize = 1;  for (n = 0; n < dim; n++)    {      count[n] = 0;      stride[n] = GFC_DESCRIPTOR_STRIDE(d,n);      extent[n] = GFC_DESCRIPTOR_EXTENT(d,n);      if (extent[n] <= 0)	return;      if (dsize == stride[n])	dsize *= extent[n];      else	dsize = 0;    }  src = s;  if (dsize != 0)    {      memcpy (dest, src, dsize * size);      return;    }  stride0 = stride[0] * size;  while (dest)    {      /* Copy the data.  */      memcpy (dest, src, size);      /* Advance to the next element.  */      src += size;      dest += stride0;      count[0]++;      /* Advance to the next source element.  */      n = 0;      while (count[n] == extent[n])        {          /* When we get to the end of a dimension, reset it and increment             the next dimension.  */          count[n] = 0;          /* We could precalculate these products, but this is a less             frequently used path so probably not worth it.  */          dest -= stride[n] * extent[n] * size;          n++;          if (n == dim)            {              dest = NULL;              break;            }          else            {              count[n]++;              dest += stride[n] * size;            }        }    }}

voidtranspose (gfc_array_char *ret, gfc_array_char *source){  transpose_internal (ret, source, GFC_DESCRIPTOR_SIZE (source));}

void__mmaxloc0_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array, gfc_array_l4 * mask){  index_type count[GFC_MAX_DIMENSIONS];  index_type extent[GFC_MAX_DIMENSIONS];  index_type sstride[GFC_MAX_DIMENSIONS];  index_type mstride[GFC_MAX_DIMENSIONS];  index_type dstride;  GFC_INTEGER_8 *dest;  GFC_REAL_8 *base;  GFC_LOGICAL_4 *mbase;  int rank;  index_type n;  rank = GFC_DESCRIPTOR_RANK (array);  assert (rank > 0);  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);  assert (GFC_DESCRIPTOR_RANK (mask) == rank);  if (array->dim[0].stride == 0)    array->dim[0].stride = 1;  if (retarray->dim[0].stride == 0)    retarray->dim[0].stride = 1;  if (retarray->dim[0].stride == 0)    retarray->dim[0].stride = 1;  dstride = retarray->dim[0].stride;  dest = retarray->data;  for (n = 0; n < rank; n++)    {      sstride[n] = array->dim[n].stride;      mstride[n] = mask->dim[n].stride;      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;      count[n] = 0;      if (extent[n] <= 0)	{	  /* Set the return value.  */	  for (n = 0; n < rank; n++)	    dest[n * dstride] = 0;	  return;	}    }  base = array->data;  mbase = mask->data;  if (GFC_DESCRIPTOR_SIZE (mask) != 4)    {      /* This allows the same loop to be used for all logical types.  */      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);      for (n = 0; n < rank; n++)        mstride[n] <<= 1;      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));    }  /* Initialize the return value.  */  for (n = 0; n < rank; n++)    dest[n * dstride] = 1;  {  GFC_REAL_8 maxval;  maxval = -GFC_REAL_8_HUGE;  while (base)    {      {        /* Implementation start.  */  if (*mbase && *base > maxval)    {      maxval = *base;      for (n = 0; n < rank; n++)        dest[n * dstride] = count[n] + 1;    }        /* Implementation end.  */      }      /* Advance to the next element.  */      count[0]++;      base += sstride[0];      mbase += mstride[0];      n = 0;      while (count[n] == extent[n])        {          /* When we get to the end of a dimension, reset it and increment             the next dimension.  */          count[n] = 0;          /* We could precalculate these products, but this is a less             frequently used path so proabably not worth it.  */          base -= sstride[n] * extent[n];          mbase -= mstride[n] * extent[n];          n++;          if (n == rank)            {              /* Break out of the loop.  */              base = NULL;              break;            }//.........这里部分代码省略.........

voideoshift3_4 (gfc_array_char *ret, gfc_array_char *array,		       gfc_array_i4 *h, const gfc_array_char *bound,		       GFC_INTEGER_4 *pwhich){  /* r.* indicates the return array.  */  index_type rstride[GFC_MAX_DIMENSIONS];  index_type rstride0;  index_type roffset;  char *rptr;  char *dest;  /* s.* indicates the source array.  */  index_type sstride[GFC_MAX_DIMENSIONS];  index_type sstride0;  index_type soffset;  const char *sptr;  const char *src;  /* h.* indicates the shift array.  */  index_type hstride[GFC_MAX_DIMENSIONS];  index_type hstride0;  const GFC_INTEGER_4 *hptr;  /* b.* indicates the bound array.  */  index_type bstride[GFC_MAX_DIMENSIONS];  index_type bstride0;  const char *bptr;  index_type count[GFC_MAX_DIMENSIONS];  index_type extent[GFC_MAX_DIMENSIONS];  index_type dim;  index_type size;  index_type len;  index_type n;  int which;  GFC_INTEGER_4 sh;  GFC_INTEGER_4 delta;  if (pwhich)    which = *pwhich - 1;  else    which = 0;  size = GFC_DESCRIPTOR_SIZE (ret);  if (ret->data == NULL)    {      int i;      ret->data = internal_malloc_size (size * size0 ((array_t *)array));      ret->base = 0;      ret->dtype = array->dtype;      for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)        {          ret->dim[i].lbound = 0;          ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;          if (i == 0)            ret->dim[i].stride = 1;          else            ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;        }    }  extent[0] = 1;  count[0] = 0;  size = GFC_DESCRIPTOR_SIZE (array);  n = 0;  for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)    {      if (dim == which)        {          roffset = ret->dim[dim].stride * size;          if (roffset == 0)            roffset = size;          soffset = array->dim[dim].stride * size;          if (soffset == 0)            soffset = size;          len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;        }      else        {          count[n] = 0;          extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;          rstride[n] = ret->dim[dim].stride * size;          sstride[n] = array->dim[dim].stride * size;          hstride[n] = h->dim[n].stride;          if (bound)            bstride[n] = bound->dim[n].stride * size;          else            bstride[n] = 0;          n++;        }    }  if (sstride[0] == 0)    sstride[0] = size;  if (rstride[0] == 0)    rstride[0] = size;  if (hstride[0] == 0)    hstride[0] = 1;  if (bound && bstride[0] == 0)//.........这里部分代码省略.........

voidpack (gfc_array_char *ret, const gfc_array_char *array,      const gfc_array_l1 *mask, const gfc_array_char *vector){  pack_internal (ret, array, mask, vector, GFC_DESCRIPTOR_SIZE (array));}

static voideoshift2 (gfc_array_char *ret, const gfc_array_char *array,	  int shift, const gfc_array_char *bound, int which,	  const char *filler, index_type filler_len){  /* r.* indicates the return array.  */  index_type rstride[GFC_MAX_DIMENSIONS];  index_type rstride0;  index_type roffset;  char * restrict rptr;  char *dest;  /* s.* indicates the source array.  */  index_type sstride[GFC_MAX_DIMENSIONS];  index_type sstride0;  index_type soffset;  const char *sptr;  const char *src;  /* b.* indicates the bound array.  */  index_type bstride[GFC_MAX_DIMENSIONS];  index_type bstride0;  const char *bptr;  index_type count[GFC_MAX_DIMENSIONS];  index_type extent[GFC_MAX_DIMENSIONS];  index_type dim;  index_type len;  index_type n;  index_type arraysize;  index_type size;  /* The compiler cannot figure out that these are set, initialize     them to avoid warnings.  */  len = 0;  soffset = 0;  roffset = 0;  size = GFC_DESCRIPTOR_SIZE (array);  arraysize = size0 ((array_t *) array);  if (ret->base_addr == NULL)    {      int i;      ret->offset = 0;      ret->dtype = array->dtype;      /* xmalloc allocates a single byte for zero size.  */      ret->base_addr = xmalloc (size * arraysize);      for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)        {	  index_type ub, str;          ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1;          if (i == 0)	    str = 1;          else            str = GFC_DESCRIPTOR_EXTENT(ret,i-1)	      * GFC_DESCRIPTOR_STRIDE(ret,i-1);	  GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);        }    }  else if (unlikely (compile_options.bounds_check))    {      bounds_equal_extents ((array_t *) ret, (array_t *) array,				 "return value", "EOSHIFT");    }  if (arraysize == 0)    return;  which = which - 1;  extent[0] = 1;  count[0] = 0;  sstride[0] = -1;  rstride[0] = -1;  bstride[0] = -1;  n = 0;  for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)    {      if (dim == which)        {          roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);          if (roffset == 0)            roffset = size;          soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);          if (soffset == 0)            soffset = size;          len = GFC_DESCRIPTOR_EXTENT(array,dim);        }      else        {          count[n] = 0;          extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim);          rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim);          sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim);//.........这里部分代码省略.........

void__mminval_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, index_type *pdim, gfc_array_l4 * mask){  index_type count[GFC_MAX_DIMENSIONS - 1];  index_type extent[GFC_MAX_DIMENSIONS - 1];  index_type sstride[GFC_MAX_DIMENSIONS - 1];  index_type dstride[GFC_MAX_DIMENSIONS - 1];  index_type mstride[GFC_MAX_DIMENSIONS - 1];  GFC_INTEGER_4 *dest;  GFC_INTEGER_4 *base;  GFC_LOGICAL_4 *mbase;  int rank;  int dim;  index_type n;  index_type len;  index_type delta;  index_type mdelta;  dim = (*pdim) - 1;  rank = GFC_DESCRIPTOR_RANK (array) - 1;  assert (rank == GFC_DESCRIPTOR_RANK (retarray));  if (array->dim[0].stride == 0)    array->dim[0].stride = 1;  if (retarray->dim[0].stride == 0)    retarray->dim[0].stride = 1;  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;  if (len <= 0)    return;  delta = array->dim[dim].stride;  mdelta = mask->dim[dim].stride;  for (n = 0; n < dim; n++)    {      sstride[n] = array->dim[n].stride;      mstride[n] = mask->dim[n].stride;      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;    }  for (n = dim; n < rank; n++)    {      sstride[n] = array->dim[n + 1].stride;      mstride[n] = mask->dim[n + 1].stride;      extent[n] =        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;    }  for (n = 0; n < rank; n++)    {      count[n] = 0;      dstride[n] = retarray->dim[n].stride;      if (extent[n] <= 0)        return;    }  dest = retarray->data;  base = array->data;  mbase = mask->data;  if (GFC_DESCRIPTOR_SIZE (mask) != 4)    {      /* This allows the same loop to be used for all logical types.  */      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);      for (n = 0; n < rank; n++)        mstride[n] <<= 1;      mdelta <<= 1;      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));    }  while (base)    {      GFC_INTEGER_4 *src;      GFC_LOGICAL_4 *msrc;      GFC_INTEGER_4 result;      src = base;      msrc = mbase;      {  result = GFC_INTEGER_4_HUGE;        if (len <= 0)	  *dest = GFC_INTEGER_4_HUGE;	else	  {	    for (n = 0; n < len; n++, src += delta, msrc += mdelta)	      {  if (*msrc && *src < result)    result = *src;              }	    *dest = result;	  }      }      /* Advance to the next element.  */      count[0]++;      base += sstride[0];      mbase += mstride[0];      dest += dstride[0];      n = 0;      while (count[n] == extent[n])        {          /* When we get to the end of a dimension, reset it and increment//.........这里部分代码省略.........

void *internal_pack (gfc_array_char * source){  index_type count[GFC_MAX_DIMENSIONS];  index_type extent[GFC_MAX_DIMENSIONS];  index_type stride[GFC_MAX_DIMENSIONS];  index_type stride0;  index_type dim;  index_type ssize;  const char *src;  char *dest;  void *destptr;  int n;  int packed;  index_type size;  index_type type_size;  if (source->base_addr == NULL)    return NULL;  type_size = GFC_DTYPE_TYPE_SIZE(source);  size = GFC_DESCRIPTOR_SIZE (source);  switch (type_size)    {    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:    case GFC_DTYPE_LOGICAL_2:      return internal_pack_2 ((gfc_array_i2 *) source);    case GFC_DTYPE_INTEGER_4:    case GFC_DTYPE_LOGICAL_4:      return internal_pack_4 ((gfc_array_i4 *) source);	    case GFC_DTYPE_INTEGER_8:    case GFC_DTYPE_LOGICAL_8:      return internal_pack_8 ((gfc_array_i8 *) source);#if defined(HAVE_GFC_INTEGER_16)    case GFC_DTYPE_INTEGER_16:    case GFC_DTYPE_LOGICAL_16:      return internal_pack_16 ((gfc_array_i16 *) source);#endif    case GFC_DTYPE_REAL_4:      return internal_pack_r4 ((gfc_array_r4 *) source);    case GFC_DTYPE_REAL_8:      return internal_pack_r8 ((gfc_array_r8 *) source);/* 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)# if defined (HAVE_GFC_REAL_10)    case GFC_DTYPE_REAL_10:      return internal_pack_r10 ((gfc_array_r10 *) source);# endif# if defined (HAVE_GFC_REAL_16)    case GFC_DTYPE_REAL_16:      return internal_pack_r16 ((gfc_array_r16 *) source);# endif#endif    case GFC_DTYPE_COMPLEX_4:      return internal_pack_c4 ((gfc_array_c4 *) source);	    case GFC_DTYPE_COMPLEX_8:      return internal_pack_c8 ((gfc_array_c8 *) source);/* 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)# if defined (HAVE_GFC_COMPLEX_10)    case GFC_DTYPE_COMPLEX_10:      return internal_pack_c10 ((gfc_array_c10 *) source);# endif# if defined (HAVE_GFC_COMPLEX_16)    case GFC_DTYPE_COMPLEX_16:      return internal_pack_c16 ((gfc_array_c16 *) source);# endif#endif    case GFC_DTYPE_DERIVED_2:      if (GFC_UNALIGNED_2(source->base_addr))	break;      else	return internal_pack_2 ((gfc_array_i2 *) source);//.........这里部分代码省略.........

voiddate_and_time (char *__date, char *__time, char *__zone,	       gfc_array_i4 *__values, GFC_INTEGER_4 __date_len,	       GFC_INTEGER_4 __time_len, GFC_INTEGER_4 __zone_len){  int i;  char date[DATE_LEN + 1];  char timec[TIME_LEN + 1];  char zone[ZONE_LEN + 1];  GFC_INTEGER_4 values[VALUES_SIZE];  time_t lt;  struct tm local_time;  struct tm UTC_time;  long usecs;  if (!gf_gettime (&lt, &usecs))    {      values[7] = usecs / 1000;      localtime_r (&lt, &local_time);      gmtime_r (&lt, &UTC_time);      /* All arguments can be derived from VALUES.  */      values[0] = 1900 + local_time.tm_year;      values[1] = 1 + local_time.tm_mon;      values[2] = local_time.tm_mday;      values[3] = (local_time.tm_min - UTC_time.tm_min +	           60 * (local_time.tm_hour - UTC_time.tm_hour +		     24 * (local_time.tm_yday - UTC_time.tm_yday)));      values[4] = local_time.tm_hour;      values[5] = local_time.tm_min;      values[6] = local_time.tm_sec;      if (__date)	snprintf (date, DATE_LEN + 1, "%04d%02d%02d",		  values[0], values[1], values[2]);      if (__time)	snprintf (timec, TIME_LEN + 1, "%02d%02d%02d.%03d",		  values[4], values[5], values[6], values[7]);      if (__zone)	snprintf (zone, ZONE_LEN + 1, "%+03d%02d",		  values[3] / 60, abs (values[3] % 60));    }  else    {      memset (date, ' ', DATE_LEN);      date[DATE_LEN] = '/0';      memset (timec, ' ', TIME_LEN);      timec[TIME_LEN] = '/0';      memset (zone, ' ', ZONE_LEN);      zone[ZONE_LEN] = '/0';      for (i = 0; i < VALUES_SIZE; i++)	values[i] = - GFC_INTEGER_4_HUGE;    }     /* Copy the values into the arguments.  */  if (__values)    {      index_type len, delta, elt_size;      elt_size = GFC_DESCRIPTOR_SIZE (__values);      len = GFC_DESCRIPTOR_EXTENT(__values,0);      delta = GFC_DESCRIPTOR_STRIDE(__values,0);      if (delta == 0)	delta = 1;            if (unlikely (len < VALUES_SIZE))	  runtime_error ("Incorrect extent in VALUE argument to"			 " DATE_AND_TIME intrinsic: is %ld, should"			 " be >=%ld", (long int) len, (long int) VALUES_SIZE);      /* Cope with different type kinds.  */      if (elt_size == 4)        {	  GFC_INTEGER_4 *vptr4 = __values->base_addr;	  for (i = 0; i < VALUES_SIZE; i++, vptr4 += delta)	    *vptr4 = values[i];	}      else if (elt_size == 8)        {	  GFC_INTEGER_8 *vptr8 = (GFC_INTEGER_8 *)__values->base_addr;	  for (i = 0; i < VALUES_SIZE; i++, vptr8 += delta)	    {	      if (values[i] == - GFC_INTEGER_4_HUGE)		*vptr8 = - GFC_INTEGER_8_HUGE;	      else		*vptr8 = values[i];	    }	}      else 	abort ();    }//.........这里部分代码省略.........

voidmmaxval_r10 (gfc_array_r10 * retarray, gfc_array_r10 * array,				  index_type *pdim, gfc_array_l4 * mask){  index_type count[GFC_MAX_DIMENSIONS];  index_type extent[GFC_MAX_DIMENSIONS];  index_type sstride[GFC_MAX_DIMENSIONS];  index_type dstride[GFC_MAX_DIMENSIONS];  index_type mstride[GFC_MAX_DIMENSIONS];  GFC_REAL_10 *dest;  GFC_REAL_10 *base;  GFC_LOGICAL_4 *mbase;  int rank;  int dim;  index_type n;  index_type len;  index_type delta;  index_type mdelta;  dim = (*pdim) - 1;  rank = GFC_DESCRIPTOR_RANK (array) - 1;  /* TODO:  It should be a front end job to correctly set the strides.  */  if (array->dim[0].stride == 0)    array->dim[0].stride = 1;  if (mask->dim[0].stride == 0)    mask->dim[0].stride = 1;  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;  if (len <= 0)    return;  delta = array->dim[dim].stride;  mdelta = mask->dim[dim].stride;  for (n = 0; n < dim; n++)    {      sstride[n] = array->dim[n].stride;      mstride[n] = mask->dim[n].stride;      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;    }  for (n = dim; n < rank; n++)    {      sstride[n] = array->dim[n + 1].stride;      mstride[n] = mask->dim[n + 1].stride;      extent[n] =        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;    }  if (retarray->data == NULL)    {      for (n = 0; n < rank; n++)        {          retarray->dim[n].lbound = 0;          retarray->dim[n].ubound = extent[n]-1;          if (n == 0)            retarray->dim[n].stride = 1;          else            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];        }      retarray->data	 = internal_malloc_size (sizeof (GFC_REAL_10)		 		 * retarray->dim[rank-1].stride				 * extent[rank-1]);      retarray->offset = 0;      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;    }  else    {      if (retarray->dim[0].stride == 0)	retarray->dim[0].stride = 1;      if (rank != GFC_DESCRIPTOR_RANK (retarray))	runtime_error ("rank of return array incorrect");    }  for (n = 0; n < rank; n++)    {      count[n] = 0;      dstride[n] = retarray->dim[n].stride;      if (extent[n] <= 0)        return;    }  dest = retarray->data;  base = array->data;  mbase = mask->data;  if (GFC_DESCRIPTOR_SIZE (mask) != 4)    {      /* This allows the same loop to be used for all logical types.  */      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);      for (n = 0; n < rank; n++)        mstride[n] <<= 1;      mdelta <<= 1;      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));    }//.........这里部分代码省略.........

index_type count_0 (const gfc_array_l1 * array){  const GFC_LOGICAL_1 * restrict base;  index_type rank;  int kind;  int continue_loop;  index_type count[GFC_MAX_DIMENSIONS];  index_type extent[GFC_MAX_DIMENSIONS];  index_type sstride[GFC_MAX_DIMENSIONS];  index_type result;  index_type n;  rank = GFC_DESCRIPTOR_RANK (array);  kind = GFC_DESCRIPTOR_SIZE (array);  base = array->base_addr;  if (kind == 1 || kind == 2 || kind == 4 || kind == 8#ifdef HAVE_GFC_LOGICAL_16      || kind == 16#endif    )    {      if (base)	base = GFOR_POINTER_TO_L1 (base, kind);    }  else    internal_error (NULL, "Funny sized logical array in count_0");  for (n = 0; n < rank; n++)    {      sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);      count[n] = 0;      if (extent[n] <= 0)	return 0;    }  result = 0;  continue_loop = 1;  while (continue_loop)    {      if (*base)	result ++;      count[0]++;      base += sstride[0];      n = 0;      while (count[n] == extent[n])	{	  count[n] = 0;	  base -= sstride[n] * extent[n];	  n++;	  if (n == rank)	    {	      continue_loop = 0;	      break;	    }	  else	    {	      count[n]++;	      base += sstride[n];	    }	}    }  return result;}

//.........这里部分代码省略.........#ifdef HAVE_GFC_INTEGER_16    case GFC_DTYPE_LOGICAL_16:    case GFC_DTYPE_INTEGER_16:      spread_scalar_i16 ((gfc_array_i16 *) ret, (GFC_INTEGER_16 *) source,			*along, *pncopies);      return;#endif    case GFC_DTYPE_REAL_4:      spread_scalar_r4 ((gfc_array_r4 *) ret, (GFC_REAL_4 *) source,			*along, *pncopies);      return;    case GFC_DTYPE_REAL_8:      spread_scalar_r8 ((gfc_array_r8 *) ret, (GFC_REAL_8 *) source,			*along, *pncopies);      return;#ifdef HAVE_GFC_REAL_10    case GFC_DTYPE_REAL_10:      spread_scalar_r10 ((gfc_array_r10 *) ret, (GFC_REAL_10 *) source,			*along, *pncopies);      return;#endif#ifdef HAVE_GFC_REAL_16    case GFC_DTYPE_REAL_16:      spread_scalar_r16 ((gfc_array_r16 *) ret, (GFC_REAL_16 *) source,			*along, *pncopies);      return;#endif    case GFC_DTYPE_COMPLEX_4:      spread_scalar_c4 ((gfc_array_c4 *) ret, (GFC_COMPLEX_4 *) source,			*along, *pncopies);      return;    case GFC_DTYPE_COMPLEX_8:      spread_scalar_c8 ((gfc_array_c8 *) ret, (GFC_COMPLEX_8 *) source,			*along, *pncopies);      return;#ifdef HAVE_GFC_COMPLEX_10    case GFC_DTYPE_COMPLEX_10:      spread_scalar_c10 ((gfc_array_c10 *) ret, (GFC_COMPLEX_10 *) source,			*along, *pncopies);      return;#endif#ifdef HAVE_GFC_COMPLEX_16    case GFC_DTYPE_COMPLEX_16:      spread_scalar_c16 ((gfc_array_c16 *) ret, (GFC_COMPLEX_16 *) source,			*along, *pncopies);      return;#endif    case GFC_DTYPE_DERIVED_2:      if (GFC_UNALIGNED_2(ret->data) || GFC_UNALIGNED_2(source))	break;      else	{	  spread_scalar_i2 ((gfc_array_i2 *) ret, (GFC_INTEGER_2 *) source,			    *along, *pncopies);	  return;	}    case GFC_DTYPE_DERIVED_4:      if (GFC_UNALIGNED_4(ret->data) || GFC_UNALIGNED_4(source))	break;      else	{	  spread_scalar_i4 ((gfc_array_i4 *) ret, (GFC_INTEGER_4 *) source,			    *along, *pncopies);	  return;	}    case GFC_DTYPE_DERIVED_8:      if (GFC_UNALIGNED_8(ret->data) || GFC_UNALIGNED_8(source))	break;      else	{	  spread_scalar_i8 ((gfc_array_i8 *) ret, (GFC_INTEGER_8 *) source,			    *along, *pncopies);	  return;	}#ifdef HAVE_GFC_INTEGER_16    case GFC_DTYPE_DERIVED_16:      if (GFC_UNALIGNED_16(ret->data) || GFC_UNALIGNED_16(source))	break;      else	{	  spread_scalar_i16 ((gfc_array_i16 *) ret, (GFC_INTEGER_16 *) source,			     *along, *pncopies);	  return;	}#endif    }  spread_internal_scalar (ret, source, along, pncopies, GFC_DESCRIPTOR_SIZE (ret));}