[thirdparty/gcc.git] / libgfortran / generated / sum_i8.c

/* Implementation of the SUM intrinsic
   Copyright (C) 2002-2018 Free Software Foundation, Inc.
   Contributed by Paul Brook <paul@nowt.org>

This file is part of the GNU Fortran 95 runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.

You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
<http://www.gnu.org/licenses/>.  */

#include "libgfortran.h"


#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)


extern void sum_i8 (gfc_array_i8 * const restrict, 
	gfc_array_i8 * const restrict, const index_type * const restrict);
export_proto(sum_i8);

void
sum_i8 (gfc_array_i8 * const restrict retarray, 
	gfc_array_i8 * const restrict array, 
	const index_type * const restrict pdim)
{
  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type sstride[GFC_MAX_DIMENSIONS];
  index_type dstride[GFC_MAX_DIMENSIONS];
  const GFC_INTEGER_8 * restrict base;
  GFC_INTEGER_8 * restrict dest;
  index_type rank;
  index_type n;
  index_type len;
  index_type delta;
  index_type dim;
  int continue_loop;

  /* Make dim zero based to avoid confusion.  */
  rank = GFC_DESCRIPTOR_RANK (array) - 1;
  dim = (*pdim) - 1;

  if (unlikely (dim < 0 || dim > rank))
    {
      runtime_error ("Dim argument incorrect in SUM intrinsic: "
 		     "is %ld, should be between 1 and %ld",
		     (long int) dim + 1, (long int) rank + 1);
    }

  len = GFC_DESCRIPTOR_EXTENT(array,dim);
  if (len < 0)
    len = 0;
  delta = GFC_DESCRIPTOR_STRIDE(array,dim);

  for (n = 0; n < dim; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);

      if (extent[n] < 0)
	extent[n] = 0;
    }
  for (n = dim; n < rank; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);

      if (extent[n] < 0)
	extent[n] = 0;
    }

  if (retarray->base_addr == NULL)
    {
      size_t alloc_size, str;

      for (n = 0; n < rank; n++)
	{
	  if (n == 0)
	    str = 1;
	  else
	    str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];

	  GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);

	}

      retarray->offset = 0;
      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;

      alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];

      retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));
      if (alloc_size == 0)
	{
	  /* Make sure we have a zero-sized array.  */
	  GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
	  return;

	}
    }
  else
    {
      if (rank != GFC_DESCRIPTOR_RANK (retarray))
	runtime_error ("rank of return array incorrect in"
		       " SUM intrinsic: is %ld, should be %ld",
		       (long int) (GFC_DESCRIPTOR_RANK (retarray)),
		       (long int) rank);

      if (unlikely (compile_options.bounds_check))
	bounds_ifunction_return ((array_t *) retarray, extent,
				 "return value", "SUM");
    }

  for (n = 0; n < rank; n++)
    {
      count[n] = 0;
      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
      if (extent[n] <= 0)
	return;
    }

  base = array->base_addr;
  dest = retarray->base_addr;

  continue_loop = 1;
  while (continue_loop)
    {
      const GFC_INTEGER_8 * restrict src;
      GFC_INTEGER_8 result;
      src = base;
      {

  result = 0;
	if (len <= 0)
	  *dest = 0;
	else
	  {
	    for (n = 0; n < len; n++, src += delta)
	      {

  result += *src;
	      }
	    
	    *dest = result;
	  }
      }
      /* Advance to the next element.  */
      count[0]++;
      base += sstride[0];
      dest += dstride[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 probably not worth it.  */
	  base -= sstride[n] * extent[n];
	  dest -= dstride[n] * extent[n];
	  n++;
	  if (n >= rank)
	    {
	      /* Break out of the loop.  */
	      continue_loop = 0;
	      break;
	    }
	  else
	    {
	      count[n]++;
	      base += sstride[n];
	      dest += dstride[n];
	    }
	}
    }
}


extern void msum_i8 (gfc_array_i8 * const restrict, 
	gfc_array_i8 * const restrict, const index_type * const restrict,
	gfc_array_l1 * const restrict);
export_proto(msum_i8);

void
msum_i8 (gfc_array_i8 * const restrict retarray, 
	gfc_array_i8 * const restrict array, 
	const index_type * const restrict pdim, 
	gfc_array_l1 * const restrict 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_INTEGER_8 * restrict dest;
  const GFC_INTEGER_8 * restrict base;
  const GFC_LOGICAL_1 * restrict mbase;
  index_type rank;
  index_type dim;
  index_type n;
  index_type len;
  index_type delta;
  index_type mdelta;
  int mask_kind;

  dim = (*pdim) - 1;
  rank = GFC_DESCRIPTOR_RANK (array) - 1;


  if (unlikely (dim < 0 || dim > rank))
    {
      runtime_error ("Dim argument incorrect in SUM intrinsic: "
 		     "is %ld, should be between 1 and %ld",
		     (long int) dim + 1, (long int) rank + 1);
    }

  len = GFC_DESCRIPTOR_EXTENT(array,dim);
  if (len <= 0)
    return;

  mbase = mask->base_addr;

  mask_kind = GFC_DESCRIPTOR_SIZE (mask);

  if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
#ifdef HAVE_GFC_LOGICAL_16
      || mask_kind == 16
#endif
      )
    mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
  else
    runtime_error ("Funny sized logical array");

  delta = GFC_DESCRIPTOR_STRIDE(array,dim);
  mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);

  for (n = 0; n < dim; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);

      if (extent[n] < 0)
	extent[n] = 0;

    }
  for (n = dim; n < rank; n++)
    {
      sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
      mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
      extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);

      if (extent[n] < 0)
	extent[n] = 0;
    }

  if (retarray->base_addr == NULL)
    {
      size_t alloc_size, str;

      for (n = 0; n < rank; n++)
	{
	  if (n == 0)
	    str = 1;
	  else
	    str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];

	  GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);

	}

      alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];

      retarray->offset = 0;
      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;

      if (alloc_size == 0)
	{
	  /* Make sure we have a zero-sized array.  */
	  GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
	  return;
	}
      else
	retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));

    }
  else
    {
      if (rank != GFC_DESCRIPTOR_RANK (retarray))
	runtime_error ("rank of return array incorrect in SUM intrinsic");

      if (unlikely (compile_options.bounds_check))
	{
	  bounds_ifunction_return ((array_t *) retarray, extent,
				   "return value", "SUM");
	  bounds_equal_extents ((array_t *) mask, (array_t *) array,
	  			"MASK argument", "SUM");
	}
    }

  for (n = 0; n < rank; n++)
    {
      count[n] = 0;
      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
      if (extent[n] <= 0)
	return;
    }

  dest = retarray->base_addr;
  base = array->base_addr;

  while (base)
    {
      const GFC_INTEGER_8 * restrict src;
      const GFC_LOGICAL_1 * restrict msrc;
      GFC_INTEGER_8 result;
      src = base;
      msrc = mbase;
      {

  result = 0;
	for (n = 0; n < len; n++, src += delta, msrc += mdelta)
	  {

  if (*msrc)
    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
	     the next dimension.  */
	  count[n] = 0;
	  /* We could precalculate these products, but this is a less
	     frequently used path so probably not worth it.  */
	  base -= sstride[n] * extent[n];
	  mbase -= mstride[n] * extent[n];
	  dest -= dstride[n] * extent[n];
	  n++;
	  if (n >= rank)
	    {
	      /* Break out of the loop.  */
	      base = NULL;
	      break;
	    }
	  else
	    {
	      count[n]++;
	      base += sstride[n];
	      mbase += mstride[n];
	      dest += dstride[n];
	    }
	}
    }
}


extern void ssum_i8 (gfc_array_i8 * const restrict, 
	gfc_array_i8 * const restrict, const index_type * const restrict,
	GFC_LOGICAL_4 *);
export_proto(ssum_i8);

void
ssum_i8 (gfc_array_i8 * const restrict retarray, 
	gfc_array_i8 * const restrict array, 
	const index_type * const restrict pdim, 
	GFC_LOGICAL_4 * mask)
{
  index_type count[GFC_MAX_DIMENSIONS];
  index_type extent[GFC_MAX_DIMENSIONS];
  index_type dstride[GFC_MAX_DIMENSIONS];
  GFC_INTEGER_8 * restrict dest;
  index_type rank;
  index_type n;
  index_type dim;


  if (*mask)
    {
      sum_i8 (retarray, array, pdim);
      return;
    }
  /* Make dim zero based to avoid confusion.  */
  dim = (*pdim) - 1;
  rank = GFC_DESCRIPTOR_RANK (array) - 1;

  if (unlikely (dim < 0 || dim > rank))
    {
      runtime_error ("Dim argument incorrect in SUM intrinsic: "
 		     "is %ld, should be between 1 and %ld",
		     (long int) dim + 1, (long int) rank + 1);
    }

  for (n = 0; n < dim; n++)
    {
      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);

      if (extent[n] <= 0)
	extent[n] = 0;
    }

  for (n = dim; n < rank; n++)
    {
      extent[n] =
	GFC_DESCRIPTOR_EXTENT(array,n + 1);

      if (extent[n] <= 0)
	extent[n] = 0;
    }

  if (retarray->base_addr == NULL)
    {
      size_t alloc_size, str;

      for (n = 0; n < rank; n++)
	{
	  if (n == 0)
	    str = 1;
	  else
	    str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];

	  GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);

	}

      retarray->offset = 0;
      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;

      alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];

      if (alloc_size == 0)
	{
	  /* Make sure we have a zero-sized array.  */
	  GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
	  return;
	}
      else
	retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));
    }
  else
    {
      if (rank != GFC_DESCRIPTOR_RANK (retarray))
	runtime_error ("rank of return array incorrect in"
		       " SUM intrinsic: is %ld, should be %ld",
		       (long int) (GFC_DESCRIPTOR_RANK (retarray)),
		       (long int) rank);

      if (unlikely (compile_options.bounds_check))
	{
	  for (n=0; n < rank; n++)
	    {
	      index_type ret_extent;

	      ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
	      if (extent[n] != ret_extent)
		runtime_error ("Incorrect extent in return value of"
			       " SUM intrinsic in dimension %ld:"
			       " is %ld, should be %ld", (long int) n + 1,
			       (long int) ret_extent, (long int) extent[n]);
	    }
	}
    }

  for (n = 0; n < rank; n++)
    {
      count[n] = 0;
      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
    }

  dest = retarray->base_addr;

  while(1)
    {
      *dest = 0;
      count[0]++;
      dest += dstride[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 probably not worth it.  */
	  dest -= dstride[n] * extent[n];
	  n++;
	  if (n >= rank)
	    return;
	  else
	    {
	      count[n]++;
	      dest += dstride[n];
	    }
      	}
    }
}

#endif
Commit	Line	Data
6de9cd9a	1	/* Implementation of the SUM intrinsic
85ec4feb	2	Copyright (C) 2002-2018 Free Software Foundation, Inc.
6de9cd9a DN	3	Contributed by Paul Brook <paul@nowt.org>
6de9cd9a DN	4
57dea9f6	5	This file is part of the GNU Fortran 95 runtime library (libgfortran).
6de9cd9a DN	6
6de9cd9a DN	7	Libgfortran is free software; you can redistribute it and/or
57dea9f6	8	modify it under the terms of the GNU General Public
6de9cd9a	9	License as published by the Free Software Foundation; either
748086b7	10	version 3 of the License, or (at your option) any later version.
6de9cd9a DN	11
	12	Libgfortran is distributed in the hope that it will be useful,
	13	but WITHOUT ANY WARRANTY; without even the implied warranty of
	14	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
57dea9f6	15	GNU General Public License for more details.
6de9cd9a	16
748086b7 JJ	17	Under Section 7 of GPL version 3, you are granted additional
	18	permissions described in the GCC Runtime Library Exception, version
	19	3.1, as published by the Free Software Foundation.
	20
	21	You should have received a copy of the GNU General Public License and
	22	a copy of the GCC Runtime Library Exception along with this program;
	23	see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
	24	<http://www.gnu.org/licenses/>. */
6de9cd9a	25
36ae8a61	26	#include "libgfortran.h"
6de9cd9a	27
7d7b8bfe	28
644cb69f FXC	29	#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
	30
	31
64acfd99 JB	32	extern void sum_i8 (gfc_array_i8 * const restrict,
64acfd99 JB	33	gfc_array_i8 * const restrict, const index_type * const restrict);
7f68c75f	34	export_proto(sum_i8);
7d7b8bfe	35
6de9cd9a	36	void
64acfd99 JB	37	sum_i8 (gfc_array_i8 * const restrict retarray,
	38	gfc_array_i8 * const restrict array,
	39	const index_type * const restrict pdim)
6de9cd9a	40	{
e33e218b TK	41	index_type count[GFC_MAX_DIMENSIONS];
	42	index_type extent[GFC_MAX_DIMENSIONS];
	43	index_type sstride[GFC_MAX_DIMENSIONS];
	44	index_type dstride[GFC_MAX_DIMENSIONS];
64acfd99 JB	45	const GFC_INTEGER_8 * restrict base;
64acfd99 JB	46	GFC_INTEGER_8 * restrict dest;
6de9cd9a DN	47	index_type rank;
	48	index_type n;
	49	index_type len;
	50	index_type delta;
	51	index_type dim;
da96f5ab	52	int continue_loop;
6de9cd9a DN	53
6de9cd9a DN	54	/* Make dim zero based to avoid confusion. */
6de9cd9a	55	rank = GFC_DESCRIPTOR_RANK (array) - 1;
cfdf6ff6 TK	56	dim = (*pdim) - 1;
	57
	58	if (unlikely (dim < 0 \|\| dim > rank))
	59	{
	60	runtime_error ("Dim argument incorrect in SUM intrinsic: "
	61	"is %ld, should be between 1 and %ld",
	62	(long int) dim + 1, (long int) rank + 1);
	63	}
e33e218b	64
dfb55fdc	65	len = GFC_DESCRIPTOR_EXTENT(array,dim);
da96f5ab TK	66	if (len < 0)
da96f5ab TK	67	len = 0;
dfb55fdc	68	delta = GFC_DESCRIPTOR_STRIDE(array,dim);
6de9cd9a DN	69
	70	for (n = 0; n < dim; n++)
	71	{
dfb55fdc TK	72	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
dfb55fdc TK	73	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
80ee04b9 TK	74
	75	if (extent[n] < 0)
	76	extent[n] = 0;
6de9cd9a DN	77	}
	78	for (n = dim; n < rank; n++)
	79	{
dfb55fdc TK	80	sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
dfb55fdc TK	81	extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
80ee04b9 TK	82
	83	if (extent[n] < 0)
	84	extent[n] = 0;
6de9cd9a DN	85	}
6de9cd9a DN	86
21d1335b	87	if (retarray->base_addr == NULL)
6c167c45	88	{
dfb55fdc	89	size_t alloc_size, str;
80ee04b9	90
6c167c45	91	for (n = 0; n < rank; n++)
80927a56 JJ	92	{
80927a56 JJ	93	if (n == 0)
dfb55fdc	94	str = 1;
80927a56 JJ	95	else
80927a56 JJ	96	str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
dfb55fdc TK	97
	98	GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
	99
80927a56	100	}
6c167c45	101
efd4dc1a	102	retarray->offset = 0;
50dd63a9	103	retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) \| rank;
80ee04b9	104
92e6f3a4	105	alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
80ee04b9	106
92e6f3a4	107	retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));
80ee04b9 TK	108	if (alloc_size == 0)
	109	{
	110	/* Make sure we have a zero-sized array. */
dfb55fdc	111	GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
80ee04b9	112	return;
dfb55fdc	113
80ee04b9	114	}
6c167c45	115	}
50dd63a9 TK	116	else
50dd63a9 TK	117	{
50dd63a9	118	if (rank != GFC_DESCRIPTOR_RANK (retarray))
fd6590f8	119	runtime_error ("rank of return array incorrect in"
ccacefc7 TK	120	" SUM intrinsic: is %ld, should be %ld",
	121	(long int) (GFC_DESCRIPTOR_RANK (retarray)),
	122	(long int) rank);
fd6590f8	123
9731c4a3	124	if (unlikely (compile_options.bounds_check))
16bff921 TK	125	bounds_ifunction_return ((array_t *) retarray, extent,
16bff921 TK	126	"return value", "SUM");
50dd63a9 TK	127	}
50dd63a9 TK	128
6de9cd9a DN	129	for (n = 0; n < rank; n++)
	130	{
	131	count[n] = 0;
dfb55fdc	132	dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
6de9cd9a	133	if (extent[n] <= 0)
facc1285	134	return;
6de9cd9a DN	135	}
6de9cd9a DN	136
21d1335b TB	137	base = array->base_addr;
21d1335b TB	138	dest = retarray->base_addr;
6de9cd9a	139
da96f5ab TK	140	continue_loop = 1;
da96f5ab TK	141	while (continue_loop)
6de9cd9a	142	{
64acfd99	143	const GFC_INTEGER_8 * restrict src;
6de9cd9a DN	144	GFC_INTEGER_8 result;
	145	src = base;
	146	{
	147
	148	result = 0;
80927a56	149	if (len <= 0)
6de9cd9a DN	150	*dest = 0;
	151	else
	152	{
	153	for (n = 0; n < len; n++, src += delta)
	154	{
	155
	156	result += *src;
80927a56	157	}
0cd0559e	158
6de9cd9a DN	159	*dest = result;
	160	}
	161	}
	162	/* Advance to the next element. */
	163	count[0]++;
	164	base += sstride[0];
	165	dest += dstride[0];
	166	n = 0;
	167	while (count[n] == extent[n])
80927a56 JJ	168	{
	169	/* When we get to the end of a dimension, reset it and increment
	170	the next dimension. */
	171	count[n] = 0;
	172	/* We could precalculate these products, but this is a less
	173	frequently used path so probably not worth it. */
	174	base -= sstride[n] * extent[n];
	175	dest -= dstride[n] * extent[n];
	176	n++;
80dd631f	177	if (n >= rank)
80927a56	178	{
80dd631f	179	/* Break out of the loop. */
da96f5ab TK	180	continue_loop = 0;
da96f5ab TK	181	break;
80927a56 JJ	182	}
	183	else
	184	{
	185	count[n]++;
	186	base += sstride[n];
	187	dest += dstride[n];
	188	}
	189	}
6de9cd9a DN	190	}
	191	}
	192
7d7b8bfe	193
64acfd99 JB	194	extern void msum_i8 (gfc_array_i8 * const restrict,
64acfd99 JB	195	gfc_array_i8 * const restrict, const index_type * const restrict,
28dc6b33	196	gfc_array_l1 * const restrict);
7f68c75f	197	export_proto(msum_i8);
7d7b8bfe	198
6de9cd9a	199	void
64acfd99 JB	200	msum_i8 (gfc_array_i8 * const restrict retarray,
	201	gfc_array_i8 * const restrict array,
	202	const index_type * const restrict pdim,
28dc6b33	203	gfc_array_l1 * const restrict mask)
6de9cd9a	204	{
e33e218b TK	205	index_type count[GFC_MAX_DIMENSIONS];
	206	index_type extent[GFC_MAX_DIMENSIONS];
	207	index_type sstride[GFC_MAX_DIMENSIONS];
	208	index_type dstride[GFC_MAX_DIMENSIONS];
	209	index_type mstride[GFC_MAX_DIMENSIONS];
64acfd99 JB	210	GFC_INTEGER_8 * restrict dest;
64acfd99 JB	211	const GFC_INTEGER_8 * restrict base;
28dc6b33	212	const GFC_LOGICAL_1 * restrict mbase;
cfdf6ff6 TK	213	index_type rank;
cfdf6ff6 TK	214	index_type dim;
6de9cd9a DN	215	index_type n;
	216	index_type len;
	217	index_type delta;
	218	index_type mdelta;
28dc6b33	219	int mask_kind;
6de9cd9a DN	220
	221	dim = (*pdim) - 1;
	222	rank = GFC_DESCRIPTOR_RANK (array) - 1;
e33e218b	223
cfdf6ff6 TK	224
	225	if (unlikely (dim < 0 \|\| dim > rank))
	226	{
	227	runtime_error ("Dim argument incorrect in SUM intrinsic: "
	228	"is %ld, should be between 1 and %ld",
	229	(long int) dim + 1, (long int) rank + 1);
	230	}
	231
dfb55fdc	232	len = GFC_DESCRIPTOR_EXTENT(array,dim);
6de9cd9a DN	233	if (len <= 0)
6de9cd9a DN	234	return;
28dc6b33	235
21d1335b	236	mbase = mask->base_addr;
28dc6b33 TK	237
	238	mask_kind = GFC_DESCRIPTOR_SIZE (mask);
	239
	240	if (mask_kind == 1 \|\| mask_kind == 2 \|\| mask_kind == 4 \|\| mask_kind == 8
	241	#ifdef HAVE_GFC_LOGICAL_16
	242	\|\| mask_kind == 16
	243	#endif
	244	)
	245	mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
	246	else
	247	runtime_error ("Funny sized logical array");
	248
dfb55fdc TK	249	delta = GFC_DESCRIPTOR_STRIDE(array,dim);
dfb55fdc TK	250	mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
6de9cd9a DN	251
	252	for (n = 0; n < dim; n++)
	253	{
dfb55fdc TK	254	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
	255	mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
	256	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
80ee04b9 TK	257
	258	if (extent[n] < 0)
	259	extent[n] = 0;
	260
6de9cd9a DN	261	}
	262	for (n = dim; n < rank; n++)
	263	{
dfb55fdc TK	264	sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
	265	mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
	266	extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
80ee04b9 TK	267
	268	if (extent[n] < 0)
	269	extent[n] = 0;
6de9cd9a DN	270	}
6de9cd9a DN	271
21d1335b	272	if (retarray->base_addr == NULL)
50dd63a9	273	{
dfb55fdc	274	size_t alloc_size, str;
80ee04b9	275
50dd63a9	276	for (n = 0; n < rank; n++)
80927a56 JJ	277	{
	278	if (n == 0)
	279	str = 1;
	280	else
	281	str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
dfb55fdc TK	282
	283	GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
	284
80927a56	285	}
50dd63a9	286
92e6f3a4	287	alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
80ee04b9	288
efd4dc1a	289	retarray->offset = 0;
50dd63a9	290	retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) \| rank;
80ee04b9 TK	291
	292	if (alloc_size == 0)
	293	{
	294	/* Make sure we have a zero-sized array. */
dfb55fdc	295	GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
80ee04b9 TK	296	return;
	297	}
	298	else
92e6f3a4	299	retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));
80ee04b9	300
50dd63a9 TK	301	}
	302	else
	303	{
50dd63a9	304	if (rank != GFC_DESCRIPTOR_RANK (retarray))
fd6590f8 TK	305	runtime_error ("rank of return array incorrect in SUM intrinsic");
fd6590f8 TK	306
9731c4a3	307	if (unlikely (compile_options.bounds_check))
fd6590f8	308	{
16bff921 TK	309	bounds_ifunction_return ((array_t *) retarray, extent,
	310	"return value", "SUM");
	311	bounds_equal_extents ((array_t ) mask, (array_t ) array,
	312	"MASK argument", "SUM");
fd6590f8	313	}
50dd63a9 TK	314	}
50dd63a9 TK	315
6de9cd9a DN	316	for (n = 0; n < rank; n++)
	317	{
	318	count[n] = 0;
dfb55fdc	319	dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
6de9cd9a	320	if (extent[n] <= 0)
80927a56	321	return;
6de9cd9a DN	322	}
6de9cd9a DN	323
21d1335b TB	324	dest = retarray->base_addr;
21d1335b TB	325	base = array->base_addr;
6de9cd9a DN	326
	327	while (base)
	328	{
64acfd99	329	const GFC_INTEGER_8 * restrict src;
28dc6b33	330	const GFC_LOGICAL_1 * restrict msrc;
6de9cd9a DN	331	GFC_INTEGER_8 result;
	332	src = base;
	333	msrc = mbase;
	334	{
	335
	336	result = 0;
036e1775	337	for (n = 0; n < len; n++, src += delta, msrc += mdelta)
6de9cd9a	338	{
6de9cd9a DN	339
	340	if (*msrc)
	341	result += *src;
6de9cd9a	342	}
036e1775	343	*dest = result;
6de9cd9a DN	344	}
	345	/* Advance to the next element. */
	346	count[0]++;
	347	base += sstride[0];
	348	mbase += mstride[0];
	349	dest += dstride[0];
	350	n = 0;
	351	while (count[n] == extent[n])
80927a56 JJ	352	{
	353	/* When we get to the end of a dimension, reset it and increment
	354	the next dimension. */
	355	count[n] = 0;
	356	/* We could precalculate these products, but this is a less
	357	frequently used path so probably not worth it. */
	358	base -= sstride[n] * extent[n];
	359	mbase -= mstride[n] * extent[n];
	360	dest -= dstride[n] * extent[n];
	361	n++;
80dd631f	362	if (n >= rank)
80927a56	363	{
80dd631f	364	/* Break out of the loop. */
80927a56 JJ	365	base = NULL;
	366	break;
	367	}
	368	else
	369	{
	370	count[n]++;
	371	base += sstride[n];
	372	mbase += mstride[n];
	373	dest += dstride[n];
	374	}
	375	}
6de9cd9a DN	376	}
6de9cd9a DN	377	}
644cb69f	378
97a62038 TK	379
	380	extern void ssum_i8 (gfc_array_i8 * const restrict,
	381	gfc_array_i8 * const restrict, const index_type * const restrict,
	382	GFC_LOGICAL_4 *);
	383	export_proto(ssum_i8);
	384
	385	void
	386	ssum_i8 (gfc_array_i8 * const restrict retarray,
	387	gfc_array_i8 * const restrict array,
	388	const index_type * const restrict pdim,
	389	GFC_LOGICAL_4 * mask)
	390	{
802367d7 TK	391	index_type count[GFC_MAX_DIMENSIONS];
802367d7 TK	392	index_type extent[GFC_MAX_DIMENSIONS];
802367d7 TK	393	index_type dstride[GFC_MAX_DIMENSIONS];
802367d7 TK	394	GFC_INTEGER_8 * restrict dest;
97a62038 TK	395	index_type rank;
97a62038 TK	396	index_type n;
802367d7 TK	397	index_type dim;
802367d7 TK	398
97a62038 TK	399
	400	if (*mask)
	401	{
	402	sum_i8 (retarray, array, pdim);
	403	return;
	404	}
802367d7 TK	405	/* Make dim zero based to avoid confusion. */
	406	dim = (*pdim) - 1;
	407	rank = GFC_DESCRIPTOR_RANK (array) - 1;
	408
cfdf6ff6 TK	409	if (unlikely (dim < 0 \|\| dim > rank))
	410	{
	411	runtime_error ("Dim argument incorrect in SUM intrinsic: "
	412	"is %ld, should be between 1 and %ld",
	413	(long int) dim + 1, (long int) rank + 1);
	414	}
	415
802367d7 TK	416	for (n = 0; n < dim; n++)
802367d7 TK	417	{
dfb55fdc	418	extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
802367d7 TK	419
	420	if (extent[n] <= 0)
	421	extent[n] = 0;
	422	}
	423
	424	for (n = dim; n < rank; n++)
	425	{
802367d7	426	extent[n] =
80927a56	427	GFC_DESCRIPTOR_EXTENT(array,n + 1);
802367d7 TK	428
802367d7 TK	429	if (extent[n] <= 0)
80927a56	430	extent[n] = 0;
802367d7	431	}
97a62038	432
21d1335b	433	if (retarray->base_addr == NULL)
97a62038	434	{
dfb55fdc	435	size_t alloc_size, str;
802367d7 TK	436
802367d7 TK	437	for (n = 0; n < rank; n++)
80927a56 JJ	438	{
	439	if (n == 0)
	440	str = 1;
	441	else
	442	str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
dfb55fdc TK	443
	444	GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
	445
80927a56	446	}
802367d7	447
97a62038	448	retarray->offset = 0;
802367d7 TK	449	retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) \| rank;
802367d7 TK	450
92e6f3a4	451	alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
802367d7 TK	452
	453	if (alloc_size == 0)
	454	{
	455	/* Make sure we have a zero-sized array. */
dfb55fdc	456	GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
802367d7 TK	457	return;
	458	}
	459	else
92e6f3a4	460	retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8));
97a62038 TK	461	}
	462	else
	463	{
802367d7 TK	464	if (rank != GFC_DESCRIPTOR_RANK (retarray))
	465	runtime_error ("rank of return array incorrect in"
	466	" SUM intrinsic: is %ld, should be %ld",
	467	(long int) (GFC_DESCRIPTOR_RANK (retarray)),
	468	(long int) rank);
	469
9731c4a3	470	if (unlikely (compile_options.bounds_check))
fd6590f8	471	{
802367d7 TK	472	for (n=0; n < rank; n++)
	473	{
	474	index_type ret_extent;
97a62038	475
dfb55fdc	476	ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
802367d7 TK	477	if (extent[n] != ret_extent)
	478	runtime_error ("Incorrect extent in return value of"
	479	" SUM intrinsic in dimension %ld:"
	480	" is %ld, should be %ld", (long int) n + 1,
	481	(long int) ret_extent, (long int) extent[n]);
	482	}
fd6590f8 TK	483	}
fd6590f8 TK	484	}
97a62038	485
802367d7 TK	486	for (n = 0; n < rank; n++)
	487	{
	488	count[n] = 0;
dfb55fdc	489	dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
802367d7 TK	490	}
802367d7 TK	491
21d1335b	492	dest = retarray->base_addr;
802367d7 TK	493
	494	while(1)
	495	{
	496	*dest = 0;
	497	count[0]++;
	498	dest += dstride[0];
	499	n = 0;
	500	while (count[n] == extent[n])
80927a56	501	{
802367d7	502	/* When we get to the end of a dimension, reset it and increment
80927a56 JJ	503	the next dimension. */
	504	count[n] = 0;
	505	/* We could precalculate these products, but this is a less
	506	frequently used path so probably not worth it. */
	507	dest -= dstride[n] * extent[n];
	508	n++;
80dd631f	509	if (n >= rank)
802367d7	510	return;
80927a56 JJ	511	else
	512	{
	513	count[n]++;
	514	dest += dstride[n];
	515	}
802367d7 TK	516	}
802367d7 TK	517	}
97a62038 TK	518	}
97a62038 TK	519
644cb69f	520	#endif