re PR libfortran/32972 (performance of pack/unpack)

2008-03-19  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/32972
	* Makefile.am (in_pack_c): Add in_pack_i1.c, in_pack_i2.c,
	in_pack_r4.c, in_pack_r8.c, in_pack_r10.c and in_pack_r16.c.
	(in_unpack_c): Add in_unpack_i1.c, in_unpack_i2.c,
	in_unpack_r4.c, in_unpack_r8.c, in_unpack_r10.c and
	in_unpack_r16.c.
	* Makefile.in: Regenerate.
	* libgfortran.h:  Add prototypes for internal_pack_1,
	internal_pack_2, internal_pack_16, internal_pack_r4,
	internal_pack_r8, internal_pack_r10, internal_pack_r16,
	internal_pack_c10 and internal_pack_c16.  Add prototypes for
	internal_unpack_1, internal_unpack_2, internal_unpack_16,
	internal_unpack_r4, internal_unpack_r8, internal_unpack_r10,
	internal_unpack_r16, internal_unpack_c10 and
	internal_unpack_c16.
	* runtime/in_pack_generic.c (internal_pack): Use sizeof instead
	of hardwired sizes.
	Add calls to internal_pack_1, internal_pack_2,
	internal_pack_16, internal_pack_r4, internal_pack_r8,
	internal_pack_r10, internal_pack_r16, internal_pack_c10 and
	internal_pack_c16.
	* runtime/in_unpack_generic.c (internal_unpack):  Use sizeof
	instead of hardwired sizes.
	Add calls to internal_unpack_1, internal_unpack_2,
	internal_unpack_16, internal_unpack_r4, internal_unpack_r8,
	internal_unpack_r10, internal_unpack_r16, internal_unpack_c10
	and internal_unpack_c16.
	* generated/in_pack_r4.c:  New file.
	* generated/in_pack_i2.c:  New file.
	* generated/in_unpack_i1.c:  New file.
	* generated/in_pack_r10.c:  New file.
	* generated/in_unpack_r4.c:  New file.
	* generated/in_unpack_i2.c:  New file.
	* generated/in_unpack_r16.c:  New file.
	* generated/in_pack_r8.c:  New file.
	* generated/in_unpack_r10.c:  New file.
	* generated/in_unpack_r8.c:  New file.
	* generated/in_pack_r16.c:  New file.
	* generated/in_pack_i1.c:  New file.

2008-03-19  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/32972
	* gfortran.dg/internal_pack_1.f90:  New test case.
	* gfortran.dg/internal_pack_2.f90:  New test case.
	* gfortran.dg/internal_pack_3.f90:  New test case.

From-SVN: r133344
This commit is contained in:
Thomas Koenig 2008-03-19 15:42:55 +00:00
parent cd7e0bd4b1
commit 8e1d7686de
22 changed files with 1893 additions and 22 deletions

View File

@ -1,3 +1,10 @@
2008-03-19 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/32972
* gfortran.dg/internal_pack_1.f90: New test case.
* gfortran.dg/internal_pack_2.f90: New test case.
* gfortran.dg/internal_pack_3.f90: New test case.
2008-03-19 Jan Hubicka <jh@suse.cz>
* gcc.dg/20050811-2.c: Update dumping flags.

View File

@ -0,0 +1,85 @@
! { dg-do run }
! Test that the internal pack and unpack routines work OK
! for different data types
program main
integer(kind=1), dimension(3) :: i1
integer(kind=2), dimension(3) :: i2
integer(kind=4), dimension(3) :: i4
integer(kind=8), dimension(3) :: i8
real(kind=4), dimension(3) :: r4
real(kind=8), dimension(3) :: r8
i1 = (/ -1, 1, -3 /)
call sub_i1(i1(1:3:2))
if (any(i1 /= (/ 3, 1, 2 /))) call abort
i2 = (/ -1, 1, -3 /)
call sub_i2(i2(1:3:2))
if (any(i2 /= (/ 3, 1, 2 /))) call abort
i4 = (/ -1, 1, -3 /)
call sub_i4(i4(1:3:2))
if (any(i4 /= (/ 3, 1, 2 /))) call abort
i8 = (/ -1, 1, -3 /)
call sub_i8(i8(1:3:2))
if (any(i8 /= (/ 3, 1, 2 /))) call abort
r4 = (/ -1.0, 1.0, -3.0 /)
call sub_r4(r4(1:3:2))
if (any(r4 /= (/ 3.0, 1.0, 2.0/))) call abort
r8 = (/ -1.0_8, 1.0_8, -3.0_8 /)
call sub_r8(r8(1:3:2))
if (any(r8 /= (/ 3.0_8, 1.0_8, 2.0_8/))) call abort
end program main
subroutine sub_i1(i)
integer(kind=1), dimension(2) :: i
if (i(1) /= -1) call abort
if (i(2) /= -3) call abort
i(1) = 3
i(2) = 2
end subroutine sub_i1
subroutine sub_i2(i)
integer(kind=2), dimension(2) :: i
if (i(1) /= -1) call abort
if (i(2) /= -3) call abort
i(1) = 3
i(2) = 2
end subroutine sub_i2
subroutine sub_i4(i)
integer(kind=4), dimension(2) :: i
if (i(1) /= -1) call abort
if (i(2) /= -3) call abort
i(1) = 3
i(2) = 2
end subroutine sub_i4
subroutine sub_i8(i)
integer(kind=8), dimension(2) :: i
if (i(1) /= -1) call abort
if (i(2) /= -3) call abort
i(1) = 3
i(2) = 2
end subroutine sub_i8
subroutine sub_r4(r)
real(kind=4), dimension(2) :: r
if (r(1) /= -1.) call abort
if (r(2) /= -3.) call abort
r(1) = 3.
r(2) = 2.
end subroutine sub_r4
subroutine sub_r8(r)
real(kind=8), dimension(2) :: r
if (r(1) /= -1._8) call abort
if (r(2) /= -3._8) call abort
r(1) = 3._8
r(2) = 2._8
end subroutine sub_r8

View File

@ -0,0 +1,25 @@
! { dg-do run }
! { dg-require-effective-target fortran_large_real }
! Test that the internal pack and unpack routines work OK
! for our large real type.
program main
implicit none
integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
real(kind=k), dimension(3) :: rk
rk = (/ -1.0_k, 1.0_k, -3.0_k /)
call sub_rk(rk(1:3:2))
if (any(rk /= (/ 3.0_k, 1.0_k, 2.0_k/))) call abort
end program main
subroutine sub_rk(r)
implicit none
integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
real(kind=k), dimension(2) :: r
if (r(1) /= -1._k) call abort
if (r(2) /= -3._k) call abort
r(1) = 3._k
r(2) = 2._k
end subroutine sub_rk

View File

@ -0,0 +1,21 @@
! { dg-do run }
! { dg-require-effective-target fortran_large_int }
! Test that the internal pack and unpack routines work OK
! for our large integer type.
program main
integer,parameter :: k = selected_int_kind (range (0_8) + 1)
integer(kind=k), dimension(3) :: ik
ik = (/ -1, 1, -3 /)
call sub_ik(ik(1:3:2))
if (any(ik /= (/ 3, 1, 2 /))) call abort
end program main
subroutine sub_ik(i)
integer(kind=k), dimension(2) :: i
if (i(1) /= -1) call abort
if (i(2) /= -3) call abort
i(1) = 3
i(2) = 2
end subroutine sub_ik

View File

@ -1,3 +1,45 @@
2008-03-19 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/32972
* Makefile.am (in_pack_c): Add in_pack_i1.c, in_pack_i2.c,
in_pack_r4.c, in_pack_r8.c, in_pack_r10.c and in_pack_r16.c.
(in_unpack_c): Add in_unpack_i1.c, in_unpack_i2.c,
in_unpack_r4.c, in_unpack_r8.c, in_unpack_r10.c and
in_unpack_r16.c.
* Makefile.in: Regenerate.
* libgfortran.h: Add prototypes for internal_pack_1,
internal_pack_2, internal_pack_16, internal_pack_r4,
internal_pack_r8, internal_pack_r10, internal_pack_r16,
internal_pack_c10 and internal_pack_c16. Add prototypes for
internal_unpack_1, internal_unpack_2, internal_unpack_16,
internal_unpack_r4, internal_unpack_r8, internal_unpack_r10,
internal_unpack_r16, internal_unpack_c10 and
internal_unpack_c16.
* runtime/in_pack_generic.c (internal_pack): Use sizeof instead
of hardwired sizes.
Add calls to internal_pack_1, internal_pack_2,
internal_pack_16, internal_pack_r4, internal_pack_r8,
internal_pack_r10, internal_pack_r16, internal_pack_c10 and
internal_pack_c16.
* runtime/in_unpack_generic.c (internal_unpack): Use sizeof
instead of hardwired sizes.
Add calls to internal_unpack_1, internal_unpack_2,
internal_unpack_16, internal_unpack_r4, internal_unpack_r8,
internal_unpack_r10, internal_unpack_r16, internal_unpack_c10
and internal_unpack_c16.
* generated/in_pack_r4.c: New file.
* generated/in_pack_i2.c: New file.
* generated/in_unpack_i1.c: New file.
* generated/in_pack_r10.c: New file.
* generated/in_unpack_r4.c: New file.
* generated/in_unpack_i2.c: New file.
* generated/in_unpack_r16.c: New file.
* generated/in_pack_r8.c: New file.
* generated/in_unpack_r10.c: New file.
* generated/in_unpack_r8.c: New file.
* generated/in_pack_r16.c: New file.
* generated/in_pack_i1.c: New file.
2008-03-17 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/35617

View File

@ -380,18 +380,30 @@ $(srcdir)/generated/cshift1_8.c \
$(srcdir)/generated/cshift1_16.c
in_pack_c = \
$(srcdir)/generated/in_pack_i1.c \
$(srcdir)/generated/in_pack_i2.c \
$(srcdir)/generated/in_pack_i4.c \
$(srcdir)/generated/in_pack_i8.c \
$(srcdir)/generated/in_pack_i16.c \
$(srcdir)/generated/in_pack_r4.c \
$(srcdir)/generated/in_pack_r8.c \
$(srcdir)/generated/in_pack_r10.c \
$(srcdir)/generated/in_pack_r16.c \
$(srcdir)/generated/in_pack_c4.c \
$(srcdir)/generated/in_pack_c8.c \
$(srcdir)/generated/in_pack_c10.c \
$(srcdir)/generated/in_pack_c16.c
in_unpack_c = \
$(srcdir)/generated/in_unpack_i1.c \
$(srcdir)/generated/in_unpack_i2.c \
$(srcdir)/generated/in_unpack_i4.c \
$(srcdir)/generated/in_unpack_i8.c \
$(srcdir)/generated/in_unpack_i16.c \
$(srcdir)/generated/in_unpack_r4.c \
$(srcdir)/generated/in_unpack_r8.c \
$(srcdir)/generated/in_unpack_r10.c \
$(srcdir)/generated/in_unpack_r16.c \
$(srcdir)/generated/in_unpack_c4.c \
$(srcdir)/generated/in_unpack_c8.c \
$(srcdir)/generated/in_unpack_c10.c \

View File

@ -285,16 +285,28 @@ am__libgfortran_la_SOURCES_DIST = runtime/backtrace.c \
$(srcdir)/generated/reshape_c8.c \
$(srcdir)/generated/reshape_c10.c \
$(srcdir)/generated/reshape_c16.c \
$(srcdir)/generated/in_pack_i1.c \
$(srcdir)/generated/in_pack_i2.c \
$(srcdir)/generated/in_pack_i4.c \
$(srcdir)/generated/in_pack_i8.c \
$(srcdir)/generated/in_pack_i16.c \
$(srcdir)/generated/in_pack_r4.c \
$(srcdir)/generated/in_pack_r8.c \
$(srcdir)/generated/in_pack_r10.c \
$(srcdir)/generated/in_pack_r16.c \
$(srcdir)/generated/in_pack_c4.c \
$(srcdir)/generated/in_pack_c8.c \
$(srcdir)/generated/in_pack_c10.c \
$(srcdir)/generated/in_pack_c16.c \
$(srcdir)/generated/in_unpack_i1.c \
$(srcdir)/generated/in_unpack_i2.c \
$(srcdir)/generated/in_unpack_i4.c \
$(srcdir)/generated/in_unpack_i8.c \
$(srcdir)/generated/in_unpack_i16.c \
$(srcdir)/generated/in_unpack_r4.c \
$(srcdir)/generated/in_unpack_r8.c \
$(srcdir)/generated/in_unpack_r10.c \
$(srcdir)/generated/in_unpack_r16.c \
$(srcdir)/generated/in_unpack_c4.c \
$(srcdir)/generated/in_unpack_c8.c \
$(srcdir)/generated/in_unpack_c10.c \
@ -592,9 +604,13 @@ am__objects_19 = cshift1_4.lo cshift1_8.lo cshift1_16.lo
am__objects_20 = reshape_i4.lo reshape_i8.lo reshape_i16.lo \
reshape_r4.lo reshape_r8.lo reshape_r10.lo reshape_r16.lo \
reshape_c4.lo reshape_c8.lo reshape_c10.lo reshape_c16.lo
am__objects_21 = in_pack_i4.lo in_pack_i8.lo in_pack_i16.lo \
in_pack_c4.lo in_pack_c8.lo in_pack_c10.lo in_pack_c16.lo
am__objects_22 = in_unpack_i4.lo in_unpack_i8.lo in_unpack_i16.lo \
am__objects_21 = in_pack_i1.lo in_pack_i2.lo in_pack_i4.lo \
in_pack_i8.lo in_pack_i16.lo in_pack_r4.lo in_pack_r8.lo \
in_pack_r10.lo in_pack_r16.lo in_pack_c4.lo in_pack_c8.lo \
in_pack_c10.lo in_pack_c16.lo
am__objects_22 = in_unpack_i1.lo in_unpack_i2.lo in_unpack_i4.lo \
in_unpack_i8.lo in_unpack_i16.lo in_unpack_r4.lo \
in_unpack_r8.lo in_unpack_r10.lo in_unpack_r16.lo \
in_unpack_c4.lo in_unpack_c8.lo in_unpack_c10.lo \
in_unpack_c16.lo
am__objects_23 = exponent_r4.lo exponent_r8.lo exponent_r10.lo \
@ -1218,18 +1234,30 @@ $(srcdir)/generated/cshift1_8.c \
$(srcdir)/generated/cshift1_16.c
in_pack_c = \
$(srcdir)/generated/in_pack_i1.c \
$(srcdir)/generated/in_pack_i2.c \
$(srcdir)/generated/in_pack_i4.c \
$(srcdir)/generated/in_pack_i8.c \
$(srcdir)/generated/in_pack_i16.c \
$(srcdir)/generated/in_pack_r4.c \
$(srcdir)/generated/in_pack_r8.c \
$(srcdir)/generated/in_pack_r10.c \
$(srcdir)/generated/in_pack_r16.c \
$(srcdir)/generated/in_pack_c4.c \
$(srcdir)/generated/in_pack_c8.c \
$(srcdir)/generated/in_pack_c10.c \
$(srcdir)/generated/in_pack_c16.c
in_unpack_c = \
$(srcdir)/generated/in_unpack_i1.c \
$(srcdir)/generated/in_unpack_i2.c \
$(srcdir)/generated/in_unpack_i4.c \
$(srcdir)/generated/in_unpack_i8.c \
$(srcdir)/generated/in_unpack_i16.c \
$(srcdir)/generated/in_unpack_r4.c \
$(srcdir)/generated/in_unpack_r8.c \
$(srcdir)/generated/in_unpack_r10.c \
$(srcdir)/generated/in_unpack_r16.c \
$(srcdir)/generated/in_unpack_c4.c \
$(srcdir)/generated/in_unpack_c8.c \
$(srcdir)/generated/in_unpack_c10.c \
@ -1689,17 +1717,29 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_c4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_c8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_generic.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_i1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_i16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_i2.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_i4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_i8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_r10.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_r16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_r4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_r8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_c10.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_c16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_c4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_c8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_generic.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_i1.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_i16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_i2.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_i4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_i8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_r10.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_r16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_r4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_r8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/inquire.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/intrinsics.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ishftc.Plo@am__quote@
@ -4026,6 +4066,20 @@ reshape_c16.lo: $(srcdir)/generated/reshape_c16.c
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_c16.lo `test -f '$(srcdir)/generated/reshape_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/reshape_c16.c
in_pack_i1.lo: $(srcdir)/generated/in_pack_i1.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_i1.lo -MD -MP -MF "$(DEPDIR)/in_pack_i1.Tpo" -c -o in_pack_i1.lo `test -f '$(srcdir)/generated/in_pack_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_i1.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_pack_i1.Tpo" "$(DEPDIR)/in_pack_i1.Plo"; else rm -f "$(DEPDIR)/in_pack_i1.Tpo"; exit 1; fi
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_pack_i1.c' object='in_pack_i1.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_i1.lo `test -f '$(srcdir)/generated/in_pack_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_i1.c
in_pack_i2.lo: $(srcdir)/generated/in_pack_i2.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_i2.lo -MD -MP -MF "$(DEPDIR)/in_pack_i2.Tpo" -c -o in_pack_i2.lo `test -f '$(srcdir)/generated/in_pack_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_i2.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_pack_i2.Tpo" "$(DEPDIR)/in_pack_i2.Plo"; else rm -f "$(DEPDIR)/in_pack_i2.Tpo"; exit 1; fi
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_pack_i2.c' object='in_pack_i2.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_i2.lo `test -f '$(srcdir)/generated/in_pack_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_i2.c
in_pack_i4.lo: $(srcdir)/generated/in_pack_i4.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_i4.lo -MD -MP -MF "$(DEPDIR)/in_pack_i4.Tpo" -c -o in_pack_i4.lo `test -f '$(srcdir)/generated/in_pack_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_i4.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_pack_i4.Tpo" "$(DEPDIR)/in_pack_i4.Plo"; else rm -f "$(DEPDIR)/in_pack_i4.Tpo"; exit 1; fi
@ -4047,6 +4101,34 @@ in_pack_i16.lo: $(srcdir)/generated/in_pack_i16.c
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_i16.lo `test -f '$(srcdir)/generated/in_pack_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_i16.c
in_pack_r4.lo: $(srcdir)/generated/in_pack_r4.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_r4.lo -MD -MP -MF "$(DEPDIR)/in_pack_r4.Tpo" -c -o in_pack_r4.lo `test -f '$(srcdir)/generated/in_pack_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_r4.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_pack_r4.Tpo" "$(DEPDIR)/in_pack_r4.Plo"; else rm -f "$(DEPDIR)/in_pack_r4.Tpo"; exit 1; fi
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_pack_r4.c' object='in_pack_r4.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_r4.lo `test -f '$(srcdir)/generated/in_pack_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_r4.c
in_pack_r8.lo: $(srcdir)/generated/in_pack_r8.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_r8.lo -MD -MP -MF "$(DEPDIR)/in_pack_r8.Tpo" -c -o in_pack_r8.lo `test -f '$(srcdir)/generated/in_pack_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_r8.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_pack_r8.Tpo" "$(DEPDIR)/in_pack_r8.Plo"; else rm -f "$(DEPDIR)/in_pack_r8.Tpo"; exit 1; fi
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_pack_r8.c' object='in_pack_r8.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_r8.lo `test -f '$(srcdir)/generated/in_pack_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_r8.c
in_pack_r10.lo: $(srcdir)/generated/in_pack_r10.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_r10.lo -MD -MP -MF "$(DEPDIR)/in_pack_r10.Tpo" -c -o in_pack_r10.lo `test -f '$(srcdir)/generated/in_pack_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_r10.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_pack_r10.Tpo" "$(DEPDIR)/in_pack_r10.Plo"; else rm -f "$(DEPDIR)/in_pack_r10.Tpo"; exit 1; fi
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_pack_r10.c' object='in_pack_r10.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_r10.lo `test -f '$(srcdir)/generated/in_pack_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_r10.c
in_pack_r16.lo: $(srcdir)/generated/in_pack_r16.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_r16.lo -MD -MP -MF "$(DEPDIR)/in_pack_r16.Tpo" -c -o in_pack_r16.lo `test -f '$(srcdir)/generated/in_pack_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_r16.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_pack_r16.Tpo" "$(DEPDIR)/in_pack_r16.Plo"; else rm -f "$(DEPDIR)/in_pack_r16.Tpo"; exit 1; fi
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_pack_r16.c' object='in_pack_r16.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_r16.lo `test -f '$(srcdir)/generated/in_pack_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_r16.c
in_pack_c4.lo: $(srcdir)/generated/in_pack_c4.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_c4.lo -MD -MP -MF "$(DEPDIR)/in_pack_c4.Tpo" -c -o in_pack_c4.lo `test -f '$(srcdir)/generated/in_pack_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_c4.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_pack_c4.Tpo" "$(DEPDIR)/in_pack_c4.Plo"; else rm -f "$(DEPDIR)/in_pack_c4.Tpo"; exit 1; fi
@ -4075,6 +4157,20 @@ in_pack_c16.lo: $(srcdir)/generated/in_pack_c16.c
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c16.lo `test -f '$(srcdir)/generated/in_pack_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_c16.c
in_unpack_i1.lo: $(srcdir)/generated/in_unpack_i1.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_i1.lo -MD -MP -MF "$(DEPDIR)/in_unpack_i1.Tpo" -c -o in_unpack_i1.lo `test -f '$(srcdir)/generated/in_unpack_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_i1.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_unpack_i1.Tpo" "$(DEPDIR)/in_unpack_i1.Plo"; else rm -f "$(DEPDIR)/in_unpack_i1.Tpo"; exit 1; fi
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_unpack_i1.c' object='in_unpack_i1.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i1.lo `test -f '$(srcdir)/generated/in_unpack_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_i1.c
in_unpack_i2.lo: $(srcdir)/generated/in_unpack_i2.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_i2.lo -MD -MP -MF "$(DEPDIR)/in_unpack_i2.Tpo" -c -o in_unpack_i2.lo `test -f '$(srcdir)/generated/in_unpack_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_i2.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_unpack_i2.Tpo" "$(DEPDIR)/in_unpack_i2.Plo"; else rm -f "$(DEPDIR)/in_unpack_i2.Tpo"; exit 1; fi
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_unpack_i2.c' object='in_unpack_i2.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i2.lo `test -f '$(srcdir)/generated/in_unpack_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_i2.c
in_unpack_i4.lo: $(srcdir)/generated/in_unpack_i4.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_i4.lo -MD -MP -MF "$(DEPDIR)/in_unpack_i4.Tpo" -c -o in_unpack_i4.lo `test -f '$(srcdir)/generated/in_unpack_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_i4.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_unpack_i4.Tpo" "$(DEPDIR)/in_unpack_i4.Plo"; else rm -f "$(DEPDIR)/in_unpack_i4.Tpo"; exit 1; fi
@ -4096,6 +4192,34 @@ in_unpack_i16.lo: $(srcdir)/generated/in_unpack_i16.c
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i16.lo `test -f '$(srcdir)/generated/in_unpack_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_i16.c
in_unpack_r4.lo: $(srcdir)/generated/in_unpack_r4.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_r4.lo -MD -MP -MF "$(DEPDIR)/in_unpack_r4.Tpo" -c -o in_unpack_r4.lo `test -f '$(srcdir)/generated/in_unpack_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_r4.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_unpack_r4.Tpo" "$(DEPDIR)/in_unpack_r4.Plo"; else rm -f "$(DEPDIR)/in_unpack_r4.Tpo"; exit 1; fi
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_unpack_r4.c' object='in_unpack_r4.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_r4.lo `test -f '$(srcdir)/generated/in_unpack_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_r4.c
in_unpack_r8.lo: $(srcdir)/generated/in_unpack_r8.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_r8.lo -MD -MP -MF "$(DEPDIR)/in_unpack_r8.Tpo" -c -o in_unpack_r8.lo `test -f '$(srcdir)/generated/in_unpack_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_r8.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_unpack_r8.Tpo" "$(DEPDIR)/in_unpack_r8.Plo"; else rm -f "$(DEPDIR)/in_unpack_r8.Tpo"; exit 1; fi
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_unpack_r8.c' object='in_unpack_r8.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_r8.lo `test -f '$(srcdir)/generated/in_unpack_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_r8.c
in_unpack_r10.lo: $(srcdir)/generated/in_unpack_r10.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_r10.lo -MD -MP -MF "$(DEPDIR)/in_unpack_r10.Tpo" -c -o in_unpack_r10.lo `test -f '$(srcdir)/generated/in_unpack_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_r10.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_unpack_r10.Tpo" "$(DEPDIR)/in_unpack_r10.Plo"; else rm -f "$(DEPDIR)/in_unpack_r10.Tpo"; exit 1; fi
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_unpack_r10.c' object='in_unpack_r10.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_r10.lo `test -f '$(srcdir)/generated/in_unpack_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_r10.c
in_unpack_r16.lo: $(srcdir)/generated/in_unpack_r16.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_r16.lo -MD -MP -MF "$(DEPDIR)/in_unpack_r16.Tpo" -c -o in_unpack_r16.lo `test -f '$(srcdir)/generated/in_unpack_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_r16.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_unpack_r16.Tpo" "$(DEPDIR)/in_unpack_r16.Plo"; else rm -f "$(DEPDIR)/in_unpack_r16.Tpo"; exit 1; fi
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_unpack_r16.c' object='in_unpack_r16.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_r16.lo `test -f '$(srcdir)/generated/in_unpack_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_r16.c
in_unpack_c4.lo: $(srcdir)/generated/in_unpack_c4.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_c4.lo -MD -MP -MF "$(DEPDIR)/in_unpack_c4.Tpo" -c -o in_unpack_c4.lo `test -f '$(srcdir)/generated/in_unpack_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_c4.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/in_unpack_c4.Tpo" "$(DEPDIR)/in_unpack_c4.Plo"; else rm -f "$(DEPDIR)/in_unpack_c4.Tpo"; exit 1; fi

View File

@ -0,0 +1,124 @@
/* Helper function for repacking arrays.
Copyright 2003, 2006, 2007 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., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>
#if defined (HAVE_GFC_INTEGER_1)
/* Allocates a block of memory with internal_malloc if the array needs
repacking. */
GFC_INTEGER_1 *
internal_pack_1 (gfc_array_i1 * 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_INTEGER_1 *src;
GFC_INTEGER_1 *dest;
GFC_INTEGER_1 *destptr;
int n;
int packed;
/* TODO: Investigate how we can figure out if this is a temporary
since the stride=0 thing has been removed from the frontend. */
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_INTEGER_1 *)internal_malloc_size (ssize * sizeof (GFC_INTEGER_1));
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 probably not worth it. */
src -= stride[n] * extent[n];
n++;
if (n == dim)
{
src = NULL;
break;
}
else
{
count[n]++;
src += stride[n];
}
}
}
return destptr;
}
#endif

View File

@ -0,0 +1,124 @@
/* Helper function for repacking arrays.
Copyright 2003, 2006, 2007 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., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>
#if defined (HAVE_GFC_INTEGER_2)
/* Allocates a block of memory with internal_malloc if the array needs
repacking. */
GFC_INTEGER_2 *
internal_pack_2 (gfc_array_i2 * 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_INTEGER_2 *src;
GFC_INTEGER_2 *dest;
GFC_INTEGER_2 *destptr;
int n;
int packed;
/* TODO: Investigate how we can figure out if this is a temporary
since the stride=0 thing has been removed from the frontend. */
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_INTEGER_2 *)internal_malloc_size (ssize * sizeof (GFC_INTEGER_2));
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 probably not worth it. */
src -= stride[n] * extent[n];
n++;
if (n == dim)
{
src = NULL;
break;
}
else
{
count[n]++;
src += stride[n];
}
}
}
return destptr;
}
#endif

View File

@ -0,0 +1,124 @@
/* Helper function for repacking arrays.
Copyright 2003, 2006, 2007 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., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>
#if defined (HAVE_GFC_REAL_10)
/* Allocates a block of memory with internal_malloc if the array needs
repacking. */
GFC_REAL_10 *
internal_pack_r10 (gfc_array_r10 * 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_REAL_10 *src;
GFC_REAL_10 *dest;
GFC_REAL_10 *destptr;
int n;
int packed;
/* TODO: Investigate how we can figure out if this is a temporary
since the stride=0 thing has been removed from the frontend. */
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_REAL_10 *)internal_malloc_size (ssize * sizeof (GFC_REAL_10));
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 probably not worth it. */
src -= stride[n] * extent[n];
n++;
if (n == dim)
{
src = NULL;
break;
}
else
{
count[n]++;
src += stride[n];
}
}
}
return destptr;
}
#endif

View File

@ -0,0 +1,124 @@
/* Helper function for repacking arrays.
Copyright 2003, 2006, 2007 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., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>
#if defined (HAVE_GFC_REAL_16)
/* Allocates a block of memory with internal_malloc if the array needs
repacking. */
GFC_REAL_16 *
internal_pack_r16 (gfc_array_r16 * 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_REAL_16 *src;
GFC_REAL_16 *dest;
GFC_REAL_16 *destptr;
int n;
int packed;
/* TODO: Investigate how we can figure out if this is a temporary
since the stride=0 thing has been removed from the frontend. */
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_REAL_16 *)internal_malloc_size (ssize * sizeof (GFC_REAL_16));
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 probably not worth it. */
src -= stride[n] * extent[n];
n++;
if (n == dim)
{
src = NULL;
break;
}
else
{
count[n]++;
src += stride[n];
}
}
}
return destptr;
}
#endif

View File

@ -0,0 +1,124 @@
/* Helper function for repacking arrays.
Copyright 2003, 2006, 2007 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., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>
#if defined (HAVE_GFC_REAL_4)
/* Allocates a block of memory with internal_malloc if the array needs
repacking. */
GFC_REAL_4 *
internal_pack_r4 (gfc_array_r4 * 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_REAL_4 *src;
GFC_REAL_4 *dest;
GFC_REAL_4 *destptr;
int n;
int packed;
/* TODO: Investigate how we can figure out if this is a temporary
since the stride=0 thing has been removed from the frontend. */
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_REAL_4 *)internal_malloc_size (ssize * sizeof (GFC_REAL_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 probably not worth it. */
src -= stride[n] * extent[n];
n++;
if (n == dim)
{
src = NULL;
break;
}
else
{
count[n]++;
src += stride[n];
}
}
}
return destptr;
}
#endif

View File

@ -0,0 +1,124 @@
/* Helper function for repacking arrays.
Copyright 2003, 2006, 2007 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., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>
#if defined (HAVE_GFC_REAL_8)
/* Allocates a block of memory with internal_malloc if the array needs
repacking. */
GFC_REAL_8 *
internal_pack_r8 (gfc_array_r8 * 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_REAL_8 *src;
GFC_REAL_8 *dest;
GFC_REAL_8 *destptr;
int n;
int packed;
/* TODO: Investigate how we can figure out if this is a temporary
since the stride=0 thing has been removed from the frontend. */
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_REAL_8 *)internal_malloc_size (ssize * sizeof (GFC_REAL_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 probably not worth it. */
src -= stride[n] * extent[n];
n++;
if (n == dim)
{
src = NULL;
break;
}
else
{
count[n]++;
src += stride[n];
}
}
}
return destptr;
}
#endif

View File

@ -0,0 +1,112 @@
/* Helper function for repacking arrays.
Copyright 2003, 2006, 2007 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., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>
#include <string.h>
#if defined (HAVE_GFC_INTEGER_1)
void
internal_unpack_1 (gfc_array_i1 * d, const GFC_INTEGER_1 * 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_INTEGER_1 *dest;
int n;
dest = d->data;
if (src == dest || !src)
return;
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_INTEGER_1));
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 probably not worth it. */
dest -= stride[n] * extent[n];
n++;
if (n == dim)
{
dest = NULL;
break;
}
else
{
count[n]++;
dest += stride[n];
}
}
}
}
#endif

View File

@ -0,0 +1,112 @@
/* Helper function for repacking arrays.
Copyright 2003, 2006, 2007 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., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>
#include <string.h>
#if defined (HAVE_GFC_INTEGER_2)
void
internal_unpack_2 (gfc_array_i2 * d, const GFC_INTEGER_2 * 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_INTEGER_2 *dest;
int n;
dest = d->data;
if (src == dest || !src)
return;
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_INTEGER_2));
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 probably not worth it. */
dest -= stride[n] * extent[n];
n++;
if (n == dim)
{
dest = NULL;
break;
}
else
{
count[n]++;
dest += stride[n];
}
}
}
}
#endif

View File

@ -0,0 +1,112 @@
/* Helper function for repacking arrays.
Copyright 2003, 2006, 2007 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., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>
#include <string.h>
#if defined (HAVE_GFC_REAL_10)
void
internal_unpack_r10 (gfc_array_r10 * d, const GFC_REAL_10 * 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_REAL_10 *dest;
int n;
dest = d->data;
if (src == dest || !src)
return;
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_REAL_10));
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 probably not worth it. */
dest -= stride[n] * extent[n];
n++;
if (n == dim)
{
dest = NULL;
break;
}
else
{
count[n]++;
dest += stride[n];
}
}
}
}
#endif

View File

@ -0,0 +1,112 @@
/* Helper function for repacking arrays.
Copyright 2003, 2006, 2007 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., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>
#include <string.h>
#if defined (HAVE_GFC_REAL_16)
void
internal_unpack_r16 (gfc_array_r16 * d, const GFC_REAL_16 * 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_REAL_16 *dest;
int n;
dest = d->data;
if (src == dest || !src)
return;
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_REAL_16));
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 probably not worth it. */
dest -= stride[n] * extent[n];
n++;
if (n == dim)
{
dest = NULL;
break;
}
else
{
count[n]++;
dest += stride[n];
}
}
}
}
#endif

View File

@ -0,0 +1,112 @@
/* Helper function for repacking arrays.
Copyright 2003, 2006, 2007 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., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>
#include <string.h>
#if defined (HAVE_GFC_REAL_4)
void
internal_unpack_r4 (gfc_array_r4 * d, const GFC_REAL_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_REAL_4 *dest;
int n;
dest = d->data;
if (src == dest || !src)
return;
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_REAL_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 probably not worth it. */
dest -= stride[n] * extent[n];
n++;
if (n == dim)
{
dest = NULL;
break;
}
else
{
count[n]++;
dest += stride[n];
}
}
}
}
#endif

View File

@ -0,0 +1,112 @@
/* Helper function for repacking arrays.
Copyright 2003, 2006, 2007 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., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
#include "libgfortran.h"
#include <stdlib.h>
#include <assert.h>
#include <string.h>
#if defined (HAVE_GFC_REAL_8)
void
internal_unpack_r8 (gfc_array_r8 * d, const GFC_REAL_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_REAL_8 *dest;
int n;
dest = d->data;
if (src == dest || !src)
return;
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_REAL_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 probably not worth it. */
dest -= stride[n] * extent[n];
n++;
if (n == dim)
{
dest = NULL;
break;
}
else
{
count[n]++;
dest += stride[n];
}
}
}
}
#endif

View File

@ -609,10 +609,15 @@ extern void reshape_packed (char *, index_type, const char *, index_type,
const char *, index_type);
internal_proto(reshape_packed);
/* Repacking functions. */
/* Repacking functions. These are called internally by internal_pack
and internal_unpack. */
GFC_INTEGER_1 *internal_pack_1 (gfc_array_i1 *);
internal_proto(internal_pack_1);
GFC_INTEGER_2 *internal_pack_2 (gfc_array_i2 *);
internal_proto(internal_pack_2);
/* ??? These 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);
@ -624,6 +629,22 @@ GFC_INTEGER_16 *internal_pack_16 (gfc_array_i16 *);
internal_proto(internal_pack_16);
#endif
GFC_REAL_4 *internal_pack_r4 (gfc_array_r4 *);
internal_proto(internal_pack_r4);
GFC_REAL_8 *internal_pack_r8 (gfc_array_r8 *);
internal_proto(internal_pack_r8);
#if defined HAVE_GFC_REAL_10
GFC_REAL_10 *internal_pack_r10 (gfc_array_r10 *);
internal_proto(internal_pack_r10);
#endif
#if defined HAVE_GFC_REAL_16
GFC_REAL_16 *internal_pack_r16 (gfc_array_r16 *);
internal_proto(internal_pack_r16);
#endif
GFC_COMPLEX_4 *internal_pack_c4 (gfc_array_c4 *);
internal_proto(internal_pack_c4);
@ -635,6 +656,17 @@ GFC_COMPLEX_10 *internal_pack_c10 (gfc_array_c10 *);
internal_proto(internal_pack_c10);
#endif
#if defined HAVE_GFC_COMPLEX_16
GFC_COMPLEX_16 *internal_pack_c16 (gfc_array_c16 *);
internal_proto(internal_pack_c16);
#endif
extern void internal_unpack_1 (gfc_array_i1 *, const GFC_INTEGER_1 *);
internal_proto(internal_unpack_1);
extern void internal_unpack_2 (gfc_array_i2 *, const GFC_INTEGER_2 *);
internal_proto(internal_unpack_2);
extern void internal_unpack_4 (gfc_array_i4 *, const GFC_INTEGER_4 *);
internal_proto(internal_unpack_4);
@ -646,6 +678,22 @@ extern void internal_unpack_16 (gfc_array_i16 *, const GFC_INTEGER_16 *);
internal_proto(internal_unpack_16);
#endif
extern void internal_unpack_r4 (gfc_array_r4 *, const GFC_REAL_4 *);
internal_proto(internal_unpack_r4);
extern void internal_unpack_r8 (gfc_array_r8 *, const GFC_REAL_8 *);
internal_proto(internal_unpack_r8);
#if defined HAVE_GFC_REAL_10
extern void internal_unpack_r10 (gfc_array_r10 *, const GFC_REAL_10 *);
internal_proto(internal_unpack_r10);
#endif
#if defined HAVE_GFC_REAL_16
extern void internal_unpack_r16 (gfc_array_r16 *, const GFC_REAL_16 *);
internal_proto(internal_unpack_r16);
#endif
extern void internal_unpack_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *);
internal_proto(internal_unpack_c4);

View File

@ -65,25 +65,65 @@ internal_pack (gfc_array_char * source)
{
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 sizeof (GFC_INTEGER_1):
return internal_pack_1 ((gfc_array_i1 *) source);
case sizeof (GFC_INTEGER_2):
return internal_pack_2 ((gfc_array_i2 *) source);
case sizeof (GFC_INTEGER_4):
return internal_pack_4 ((gfc_array_i4 *) source);
case 8:
return internal_pack_8 ((gfc_array_i8 *)source);
case sizeof (GFC_INTEGER_8):
return internal_pack_8 ((gfc_array_i8 *) source);
#if defined(HAVE_GFC_INTEGER_16)
case sizeof (GFC_INTEGER_16):
return internal_pack_16 (gfc_array_i16 *) source);
#endif
}
break;
case GFC_DTYPE_REAL:
switch (size)
{
case sizeof (GFC_REAL_4):
return internal_pack_r4 ((gfc_array_r4 *) source);
case sizeof (GFC_REAL_8):
return internal_pack_r8 ((gfc_array_r8 *) source);
#if defined (HAVE_GFC_REAL_10)
case sizeof (GFC_REAL_10):
return internal_pack_r10 ((gfc_array_r10 *) source);
#endif
#if defined (HAVE_GFC_REAL_16)
case sizeof (GFC_REAL_16):
return internal_pack_r16 ((gfc_array_r16 *) source);
#endif
}
case GFC_DTYPE_COMPLEX:
switch (size)
{
case 8:
return internal_pack_c4 ((gfc_array_c4 *)source);
case sizeof (GFC_COMPLEX_4):
return internal_pack_c4 ((gfc_array_c4 *) source);
case 16:
return internal_pack_c8 ((gfc_array_c8 *)source);
case sizeof (GFC_COMPLEX_8):
return internal_pack_c8 ((gfc_array_c8 *) source);
#if defined (HAVE_GFC_COMPLEX_10)
case sizeof (GFC_COMPLEX_10):
return internal_pack_c10 ((gfc_array_c10 *) source);
#endif
#if defined (HAVE_GFC_COMPLEX_16)
case sizeof (GFC_COMPLEX_16):
return internal_pack_c16 ((gfc_array_c16 *) source);
#endif
}
break;

View File

@ -62,29 +62,80 @@ internal_unpack (gfc_array_char * d, const void * s)
{
case GFC_DTYPE_INTEGER:
case GFC_DTYPE_LOGICAL:
switch (size)
{
case sizeof (GFC_INTEGER_1):
internal_unpack_1 ((gfc_array_i1 *) d, (const GFC_INTEGER_1 *) s);
return;
case sizeof (GFC_INTEGER_2):
internal_unpack_2 ((gfc_array_i2 *) d, (const GFC_INTEGER_2 *) s);
return;
case sizeof (GFC_INTEGER_4):
internal_unpack_4 ((gfc_array_i4 *) d, (const GFC_INTEGER_4 *) s);
return;
case sizeof (GFC_INTEGER_8):
internal_unpack_8 ((gfc_array_i8 *) d, (const GFC_INTEGER_8 *) s);
return;
#if defined (HAVE_GFC_INTEGER_16)
case sizeof (GFC_INTEGER_16):
internal_unpack_16 ((gfc_array_i16 *) d, (const GFC_INTEGER_16 *) s);
return;
#endif
}
break;
case GFC_DTYPE_REAL:
switch (size)
{
case 4:
internal_unpack_4 ((gfc_array_i4 *)d, (const GFC_INTEGER_4 *)s);
case sizeof (GFC_REAL_4):
internal_unpack_r4 ((gfc_array_r4 *) d, (const GFC_REAL_4 *) s);
return;
case 8:
internal_unpack_8 ((gfc_array_i8 *)d, (const GFC_INTEGER_8 *)s);
case sizeof (GFC_REAL_8):
internal_unpack_r8 ((gfc_array_r8 *) d, (const GFC_REAL_8 *) s);
return;
#if defined(HAVE_GFC_REAL_10)
case sizeof (GFC_REAL_10):
internal_unpack_r10 ((gfc_array_r10 *) d, (const GFC_REAL_10 *) s);
return;
#endif
#if defined(HAVE_GFC_REAL_16)
case sizeof (GFC_REAL_16):
internal_unpack_r16 ((gfc_array_r16 *) d, (const GFC_REAL_16 *) s);
return;
#endif
}
break;
case GFC_DTYPE_COMPLEX:
switch (size)
{
case 8:
case sizeof (GFC_COMPLEX_4):
internal_unpack_c4 ((gfc_array_c4 *)d, (const GFC_COMPLEX_4 *)s);
return;
case 16:
case sizeof (GFC_COMPLEX_8):
internal_unpack_c8 ((gfc_array_c8 *)d, (const GFC_COMPLEX_8 *)s);
return;
#if defined(HAVE_GFC_COMPLEX_10)
case sizeof (GFC_COMPLEX_10):
internal_unpack_c10 ((gfc_array_c10 *) d, (const GFC_COMPLEX_10 *) s);
return;
#endif
#if defined(HAVE_GFC_COMPLEX_16)
case sizeof (GFC_COMPLEX_16):
internal_unpack_c16 ((gfc_array_c16 *) d, (const GFC_COMPLEX_16 *) s);
return;
#endif
}
default:
break;