in_unpack_c8.c 2.78 KB
Newer Older
Thomas Koenig committed
1
/* Helper function for repacking arrays.
Jakub Jelinek committed
2
   Copyright (C) 2003-2015 Free Software Foundation, Inc.
Thomas Koenig committed
3 4
   Contributed by Paul Brook <paul@nowt.org>

5
This file is part of the GNU Fortran runtime library (libgfortran).
Thomas Koenig committed
6 7 8 9

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
10
version 3 of the License, or (at your option) any later version.
Thomas Koenig committed
11 12 13 14 15 16

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.

17 18 19 20 21 22 23 24
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/>.  */
Thomas Koenig committed
25

26
#include "libgfortran.h"
Thomas Koenig committed
27 28 29
#include <stdlib.h>
#include <assert.h>
#include <string.h>
30

Thomas Koenig committed
31

32 33
#if defined (HAVE_GFC_COMPLEX_8)

Thomas Koenig committed
34 35 36 37 38 39 40 41 42
void
internal_unpack_c8 (gfc_array_c8 * d, const GFC_COMPLEX_8 * src)
{
  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;
43
  GFC_COMPLEX_8 * restrict dest;
Thomas Koenig committed
44 45
  int n;

46
  dest = d->base_addr;
Thomas Koenig committed
47 48 49 50 51 52 53 54
  if (src == dest || !src)
    return;

  dim = GFC_DESCRIPTOR_RANK (d);
  dsize = 1;
  for (n = 0; n < dim; n++)
    {
      count[n] = 0;
55 56
      stride[n] = GFC_DESCRIPTOR_STRIDE(d,n);
      extent[n] = GFC_DESCRIPTOR_EXTENT(d,n);
Thomas Koenig committed
57
      if (extent[n] <= 0)
58
	return;
Thomas Koenig committed
59 60

      if (dsize == stride[n])
61
	dsize *= extent[n];
Thomas Koenig committed
62
      else
63
	dsize = 0;
Thomas Koenig committed
64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88
    }

  if (dsize != 0)
    {
      memcpy (dest, src, dsize * sizeof (GFC_COMPLEX_8));
      return;
    }

  stride0 = stride[0];

  while (dest)
    {
      /* Copy the data.  */
      *dest = *(src++);
      /* Advance to the next element.  */
      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
89
             frequently used path so probably not worth it.  */
Thomas Koenig committed
90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105
          dest -= stride[n] * extent[n];
          n++;
          if (n == dim)
            {
              dest = NULL;
              break;
            }
          else
            {
              count[n]++;
              dest += stride[n];
            }
        }
    }
}

106
#endif
107