OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2005-06-11  Thomas Koenig  <Thomas.Koenig@onlinde.de>

	PR libfortran/21333
	* Makefile.am: Add in_pack_c4.c, in_pack_c8.c, in_unpack_c4.c
	and in_unpack_c8.c.
	* Makefile.in: Regenerate.
	* libgfortran.h:  Declare internal_pack_c4, internal_pack_c8,
	internal_unpack_c4 and internal_unpack_c8.
	* m4/in_pack.m4: Use rtype_ccode insteald of rtype_kind
	in function name.
	Use sizeof (rtype_name) as size for memory allocation.
	* m4/in_unpack.m4: Use rtype_ccode insteald of rtype_kind
	in function name.
	Use sizeof (rtype_name) for calculation of sizes for memcpy.
	* runtime/in_pack_generic.c:  For real, integer and logical
	call internal_pack_4 if size==4 and internal_pack_8 if
	size==8.
	For complex, call internal_pack_c4 if size==8 and
	internal_pack_c8 if size==16.
	* runtime/in_unpack_generic.c: For real, integer and logical
        call internal_unpack_4 if size==4 and internal_unpack_8 if
        size==8.
        For complex, call internal_unpack_c4 if size==8 and
        internal_unpack_c8 if size==16.
	* generated/in_pack_i4.c:  Regenerated.
	* generated/in_pack_i8.c:  Regenerated.
	* generated/in_unpack_i4.c:  Regenerated.
	* generated/in_unpack_i8.c:  Regenerated.
	* generated/in_pack_c4.c:  New file.
	* generated/in_pack_c8.c:  New file.
	* generated/in_unpack_c4.c:  New file.
	* generated/in_unpack_c8.c:  New file.

2005-05-11  Thomas Koenig  <Thomas.Koenig@online.de>

	* gfortran.fortran-torture/execute/in-pack.f90:  New test.

From-SVN: r100842
This commit is contained in:
Thomas Koenig 2005-06-11 19:39:13 +00:00 committed by Thomas Koenig
parent 1fa5c70974
commit 3932808120
17 changed files with 675 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,7 @@
2005-05-11 Thomas Koenig <Thomas.Koenig@online.de>
* gfortran.fortran-torture/execute/in-pack.f90: New test.
2005-06-10 Dorit Nuzman <dorit@il.ibm.com>
* gfortran.dg/vect/vect-4.f90: Update comments. Only one unaligned

92
gcc/testsuite/gfortran.fortran-torture/execute/in-pack.f90 Normal file
View File

@ -0,0 +1,92 @@
! Check in_pack and in_unpack for integer and comlex types, with
! alignment issues thrown in for good measure.
program main
implicit none
complex(kind=4) :: a4(5),b4(5),aa4(5),bb4(5)
real(kind=4) :: r4(100)
equivalence(a4(1),r4(1)),(b4(1),r4(12))
complex(kind=8) :: a8(5),b8(5),aa8(5),bb8(5)
real(kind=8) :: r8(100)
equivalence(a8(1),r8(1)),(b8(1),r8(12))
integer(kind=4) :: i4(5),ii4(5)
integer(kind=8) :: i8(5),ii8(5)
integer :: i
a4 = (/(cmplx(i,-i,kind=4),i=1,5)/)
b4 = (/(2*cmplx(i,-i,kind=4),i=1,5)/)
call csub4(a4(5:1:-1),b4(5:1:-1),5)
aa4 = (/(cmplx(5-i+1,i-5-1,kind=4),i=1,5)/)
if (any(aa4 /= a4)) call abort
bb4 = (/(2*cmplx(5-i+1,i-5-1,kind=4),i=1,5)/)
if (any(bb4 /= b4)) call abort
a8 = (/(cmplx(i,-i,kind=8),i=1,5)/)
b8 = (/(2*cmplx(i,-i,kind=8),i=1,5)/)
call csub8(a8(5:1:-1),b8(5:1:-1),5)
aa8 = (/(cmplx(5-i+1,i-5-1,kind=8),i=1,5)/)
if (any(aa8 /= a8)) call abort
bb8 = (/(2*cmplx(5-i+1,i-5-1,kind=8),i=1,5)/)
if (any(bb8 /= b8)) call abort
i4 = (/(i, i=1,5)/)
call isub4(i4(5:1:-1),5)
ii4 = (/(5-i+1,i=1,5)/)
if (any(ii4 /= i4)) call abort
i8 = (/(i,i=1,5)/)
call isub8(i8(5:1:-1),5)
ii8 = (/(5-i+1,i=1,5)/)
if (any(ii8 /= i8)) call abort
end program main
subroutine csub4(a,b,n)
implicit none
complex(kind=4), dimension(n) :: a,b
complex(kind=4), dimension(n) :: aa, bb
integer :: n, i
aa = (/(cmplx(n-i+1,i-n-1,kind=4),i=1,n)/)
if (any(aa /= a)) call abort
bb = (/(2*cmplx(n-i+1,i-n-1,kind=4),i=1,5)/)
if (any(bb /= b)) call abort
a = (/(cmplx(i,-i,kind=4),i=1,5)/)
b = (/(2*cmplx(i,-i,kind=4),i=1,5)/)
end subroutine csub4
subroutine csub8(a,b,n)
implicit none
complex(kind=8), dimension(n) :: a,b
complex(kind=8), dimension(n) :: aa, bb
integer :: n, i
aa = (/(cmplx(n-i+1,i-n-1,kind=8),i=1,n)/)
if (any(aa /= a)) call abort
bb = (/(2*cmplx(n-i+1,i-n-1,kind=8),i=1,5)/)
if (any(bb /= b)) call abort
a = (/(cmplx(i,-i,kind=8),i=1,5)/)
b = (/(2*cmplx(i,-i,kind=8),i=1,5)/)
end subroutine csub8
subroutine isub4(a,n)
implicit none
integer(kind=4), dimension(n) :: a
integer(kind=4), dimension(n) :: aa
integer :: n, i
aa = (/(n-i+1,i=1,n)/)
if (any(aa /= a)) call abort
a = (/(i,i=1,5)/)
end subroutine isub4
subroutine isub8(a,n)
implicit none
integer(kind=8), dimension(n) :: a
integer(kind=8), dimension(n) :: aa
integer :: n, i
aa = (/(n-i+1,i=1,n)/)
if (any(aa /= a)) call abort
a = (/(i,i=1,5)/)
end subroutine isub8

8
libgfortran/Makefile.am
View File

@ -243,11 +243,15 @@ generated/cshift1_8.c
in_pack_c = \
generated/in_pack_i4.c \
generated/in_pack_i8.c
generated/in_pack_i8.c \
generated/in_pack_c4.c \
generated/in_pack_c8.c
in_unpack_c = \
generated/in_unpack_i4.c \
generated/in_unpack_i8.c
generated/in_unpack_i8.c \
generated/in_unpack_c4.c \
generated/in_unpack_c8.c
i_exponent_c = \
generated/exponent_r4.c \

26
libgfortran/Makefile.in
View File

@ -104,8 +104,10 @@ am__objects_21 = eoshift3_4.lo eoshift3_8.lo
am__objects_22 = cshift1_4.lo cshift1_8.lo
am__objects_23 = reshape_i4.lo reshape_i8.lo reshape_c4.lo \
reshape_c8.lo
am__objects_24 = in_pack_i4.lo in_pack_i8.lo
am__objects_25 = in_unpack_i4.lo in_unpack_i8.lo
am__objects_24 = in_pack_i4.lo in_pack_i8.lo in_pack_c4.lo \
in_pack_c8.lo
am__objects_25 = in_unpack_i4.lo in_unpack_i8.lo in_unpack_c4.lo \
in_unpack_c8.lo
am__objects_26 = exponent_r4.lo exponent_r8.lo
am__objects_27 = fraction_r4.lo fraction_r8.lo
am__objects_28 = nearest_r4.lo nearest_r8.lo
@ -533,11 +535,15 @@ generated/cshift1_8.c
in_pack_c = \
generated/in_pack_i4.c \
generated/in_pack_i8.c
generated/in_pack_i8.c \
generated/in_pack_c4.c \
generated/in_pack_c8.c
in_unpack_c = \
generated/in_unpack_i4.c \
generated/in_unpack_i8.c
generated/in_unpack_i8.c \
generated/in_unpack_c4.c \
generated/in_unpack_c8.c
i_exponent_c = \
generated/exponent_r4.c \
@ -1129,12 +1135,24 @@ in_pack_i4.lo: generated/in_pack_i4.c
in_pack_i8.lo: generated/in_pack_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_i8.lo `test -f 'generated/in_pack_i8.c' || echo '$(srcdir)/'`generated/in_pack_i8.c
in_pack_c4.lo: generated/in_pack_c4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c4.lo `test -f 'generated/in_pack_c4.c' || echo '$(srcdir)/'`generated/in_pack_c4.c
in_pack_c8.lo: generated/in_pack_c8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c8.lo `test -f 'generated/in_pack_c8.c' || echo '$(srcdir)/'`generated/in_pack_c8.c
in_unpack_i4.lo: generated/in_unpack_i4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i4.lo `test -f 'generated/in_unpack_i4.c' || echo '$(srcdir)/'`generated/in_unpack_i4.c
in_unpack_i8.lo: generated/in_unpack_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i8.lo `test -f 'generated/in_unpack_i8.c' || echo '$(srcdir)/'`generated/in_unpack_i8.c
in_unpack_c4.lo: generated/in_unpack_c4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_c4.lo `test -f 'generated/in_unpack_c4.c' || echo '$(srcdir)/'`generated/in_unpack_c4.c
in_unpack_c8.lo: generated/in_unpack_c8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_c8.lo `test -f 'generated/in_unpack_c8.c' || echo '$(srcdir)/'`generated/in_unpack_c8.c
exponent_r4.lo: generated/exponent_r4.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exponent_r4.lo `test -f 'generated/exponent_r4.c' || echo '$(srcdir)/'`generated/exponent_r4.c

123
libgfortran/generated/in_pack_c4.c Normal file
View File

@ -0,0 +1,123 @@
/* Helper function for repacking arrays.
Copyright 2003 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 2 of the License, or (at your option) any later version.
In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file. (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)
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.
You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#include "config.h"
#include <stdlib.h>
#include <assert.h>
#include "libgfortran.h"
/* Allocates a block of memory with internal_malloc if the array needs
repacking. */
GFC_COMPLEX_4 *
internal_pack_c4 (gfc_array_c4 * 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 GFC_COMPLEX_4 *src;
GFC_COMPLEX_4 *dest;
GFC_COMPLEX_4 *destptr;
int n;
int packed;
if (source->dim[0].stride == 0)
{
source->dim[0].stride = 1;
return source->data;
}
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 = (GFC_COMPLEX_4 *)internal_malloc_size (ssize * sizeof (GFC_COMPLEX_4));
dest = destptr;
src = source->data;
stride0 = stride[0];
while (src)
{
/* Copy the data. */
*(dest++) = *src;
/* Advance to the next element. */
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;
/* We could precalculate these products, but this is a less
frequently used path so proabably not worth it. */
src -= stride[n] * extent[n];
n++;
if (n == dim)
{
src = NULL;
break;
}
else
{
count[n]++;
src += stride[n];
}
}
}
return destptr;
}

123
libgfortran/generated/in_pack_c8.c Normal file
View File

@ -0,0 +1,123 @@
/* Helper function for repacking arrays.
Copyright 2003 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 2 of the License, or (at your option) any later version.
In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file. (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)
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.
You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#include "config.h"
#include <stdlib.h>
#include <assert.h>
#include "libgfortran.h"
/* Allocates a block of memory with internal_malloc if the array needs
repacking. */
GFC_COMPLEX_8 *
internal_pack_c8 (gfc_array_c8 * 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 GFC_COMPLEX_8 *src;
GFC_COMPLEX_8 *dest;
GFC_COMPLEX_8 *destptr;
int n;
int packed;
if (source->dim[0].stride == 0)
{
source->dim[0].stride = 1;
return source->data;
}
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 = (GFC_COMPLEX_8 *)internal_malloc_size (ssize * sizeof (GFC_COMPLEX_8));
dest = destptr;
src = source->data;
stride0 = stride[0];
while (src)
{
/* Copy the data. */
*(dest++) = *src;
/* Advance to the next element. */
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;
/* We could precalculate these products, but this is a less
frequently used path so proabably not worth it. */
src -= stride[n] * extent[n];
n++;
if (n == dim)
{
src = NULL;
break;
}
else
{
count[n]++;
src += stride[n];
}
}
}
return destptr;
}

2
libgfortran/generated/in_pack_i4.c
View File

@ -82,7 +82,7 @@ internal_pack_4 (gfc_array_i4 * source)
return source->data;
/* Allocate storage for the destination. */
destptr = (GFC_INTEGER_4 *)internal_malloc_size (ssize * 4);
destptr = (GFC_INTEGER_4 *)internal_malloc_size (ssize * sizeof (GFC_INTEGER_4));
dest = destptr;
src = source->data;
stride0 = stride[0];

2
libgfortran/generated/in_pack_i8.c
View File

@ -82,7 +82,7 @@ internal_pack_8 (gfc_array_i8 * source)
return source->data;
/* Allocate storage for the destination. */
destptr = (GFC_INTEGER_8 *)internal_malloc_size (ssize * 8);
destptr = (GFC_INTEGER_8 *)internal_malloc_size (ssize * sizeof (GFC_INTEGER_8));
dest = destptr;
src = source->data;
stride0 = stride[0];

111
libgfortran/generated/in_unpack_c4.c Normal file
View File

@ -0,0 +1,111 @@
/* Helper function for repacking arrays.
Copyright 2003 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 2 of the License, or (at your option) any later version.
In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file. (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)
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.
You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#include "config.h"
#include <stdlib.h>
#include <assert.h>
#include <string.h>
#include "libgfortran.h"
void
internal_unpack_c4 (gfc_array_c4 * d, const GFC_COMPLEX_4 * 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;
GFC_COMPLEX_4 *dest;
int n;
dest = d->data;
if (src == dest || !src)
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;
}
if (dsize != 0)
{
memcpy (dest, src, dsize * sizeof (GFC_COMPLEX_4));
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
frequently used path so proabably not worth it. */
dest -= stride[n] * extent[n];
n++;
if (n == dim)
{
dest = NULL;
break;
}
else
{
count[n]++;
dest += stride[n];
}
}
}
}

111
libgfortran/generated/in_unpack_c8.c Normal file
View File

@ -0,0 +1,111 @@
/* Helper function for repacking arrays.
Copyright 2003 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 2 of the License, or (at your option) any later version.
In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file. (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)
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.
You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING. If not,
write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#include "config.h"
#include <stdlib.h>
#include <assert.h>
#include <string.h>
#include "libgfortran.h"
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;
GFC_COMPLEX_8 *dest;
int n;
dest = d->data;
if (src == dest || !src)
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;
}
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
frequently used path so proabably not worth it. */
dest -= stride[n] * extent[n];
n++;
if (n == dim)
{
dest = NULL;
break;
}
else
{
count[n]++;
dest += stride[n];
}
}
}
}

2
libgfortran/generated/in_unpack_i4.c
View File

@ -71,7 +71,7 @@ internal_unpack_4 (gfc_array_i4 * d, const GFC_INTEGER_4 * src)
if (dsize != 0)
{
memcpy (dest, src, dsize * 4);
memcpy (dest, src, dsize * sizeof (GFC_INTEGER_4));
return;
}

2
libgfortran/generated/in_unpack_i8.c
View File

@ -71,7 +71,7 @@ internal_unpack_8 (gfc_array_i8 * d, const GFC_INTEGER_8 * src)
if (dsize != 0)
{
memcpy (dest, src, dsize * 8);
memcpy (dest, src, dsize * sizeof (GFC_INTEGER_8));
return;
}

14
libgfortran/libgfortran.h
View File

@ -482,7 +482,7 @@ internal_proto(reshape_packed);
/* Repacking functions. */
/* ??? These four aren't currently used by the compiler, though we
/* ??? These eight aren't currently used by the compiler, though we
certainly could do so. */
GFC_INTEGER_4 *internal_pack_4 (gfc_array_i4 *);
internal_proto(internal_pack_4);
@ -490,12 +490,24 @@ internal_proto(internal_pack_4);
GFC_INTEGER_8 *internal_pack_8 (gfc_array_i8 *);
internal_proto(internal_pack_8);
GFC_COMPLEX_4 *internal_pack_c4 (gfc_array_c4 *);
internal_proto(internal_pack_c4);
GFC_COMPLEX_8 *internal_pack_c8 (gfc_array_c8 *);
internal_proto(internal_pack_c8);
extern void internal_unpack_4 (gfc_array_i4 *, const GFC_INTEGER_4 *);
internal_proto(internal_unpack_4);
extern void internal_unpack_8 (gfc_array_i8 *, const GFC_INTEGER_8 *);
internal_proto(internal_unpack_8);
extern void internal_unpack_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *);
internal_proto(internal_unpack_c4);
extern void internal_unpack_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *);
internal_proto(internal_unpack_c8);
/* string_intrinsics.c */
extern GFC_INTEGER_4 compare_string (GFC_INTEGER_4, const char *,

7
libgfortran/m4/in_pack.m4
View File

@ -37,9 +37,10 @@ include(iparm.m4)dnl
/* Allocates a block of memory with internal_malloc if the array needs
repacking. */
dnl Only the kind (ie size) is used to name the function.
dnl The kind (ie size) is used to name the function for logicals, integers
dnl and reals. For complex, it's c4 or c8.
rtype_name *
`internal_pack_'rtype_kind (rtype * source)
`internal_pack_'rtype_ccode (rtype * source)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
@ -84,7 +85,7 @@ rtype_name *
return source->data;
/* Allocate storage for the destination. */
destptr = (rtype_name *)internal_malloc_size (ssize * rtype_kind);
destptr = (rtype_name *)internal_malloc_size (ssize * sizeof (rtype_name));
dest = destptr;
src = source->data;
stride0 = stride[0];

7
libgfortran/m4/in_unpack.m4
View File

@ -35,9 +35,10 @@ Boston, MA 02111-1307, USA. */
#include "libgfortran.h"'
include(iparm.m4)dnl
dnl Only the kind (ie size) is used to name the function.
dnl Only the kind (ie size) is used to name the function for integers,
dnl reals and logicals. For complex, it's c4 and c8.
void
`internal_unpack_'rtype_kind (rtype * d, const rtype_name * src)
`internal_unpack_'rtype_ccode (rtype * d, const rtype_name * src)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
@ -73,7 +74,7 @@ void
if (dsize != 0)
{
memcpy (dest, src, dsize * rtype_kind);
memcpy (dest, src, dsize * sizeof (rtype_name));
return;
}

23
libgfortran/runtime/in_pack_generic.c
View File

@ -52,6 +52,7 @@ internal_pack (gfc_array_char * source)
int n;
int packed;
index_type size;
int type;
if (source->dim[0].stride == 0)
{
@ -59,7 +60,13 @@ internal_pack (gfc_array_char * source)
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:
@ -68,6 +75,22 @@ internal_pack (gfc_array_char * 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;

23
libgfortran/runtime/in_unpack_generic.c
View File

@ -50,13 +50,20 @@ internal_unpack (gfc_array_char * d, const void * s)
const char *src;
int n;
int size;
int type;
dest = d->data;
/* This check may be redundant, but do it anyway. */
if (s == dest || !s)
return;
type = GFC_DESCRIPTOR_TYPE (d);
size = GFC_DESCRIPTOR_SIZE (d);
switch (type)
{
case GFC_DTYPE_INTEGER:
case GFC_DTYPE_LOGICAL:
case GFC_DTYPE_REAL:
switch (size)
{
case 4:
@ -67,6 +74,22 @@ internal_unpack (gfc_array_char * d, const void * s)
internal_unpack_8 ((gfc_array_i8 *)d, (const GFC_INTEGER_8 *)s);
return;
}
break;
case GFC_DTYPE_COMPLEX:
switch (size)
{
case 8:
internal_unpack_c4 ((gfc_array_c4 *)d, (const GFC_COMPLEX_4 *)s);
return;
case 16:
internal_unpack_c8 ((gfc_array_c8 *)d, (const GFC_COMPLEX_8 *)s);
return;
}
default:
break;
}
if (d->dim[0].stride == 0)
d->dim[0].stride = 1;