re PR libfortran/36886 (misaligment for cshift of character)
2008-08-14 Thomas Koenig <tkoenig@gcc.gnu.org> PR libfortran/36886 * Makefile.am: Added $(i_cshift0_c). Added $(i_cshift0_c) to gfor_built_specific_src. Add rule to build from cshift0.m4. * Makefile.in: Regenerated. * libgfortran.h: Addedd prototypes for cshift0_i1, cshift0_i2, cshift0_i4, cshift0_i8, cshift0_i16, cshift0_r4, cshift0_r8, cshift0_r10, cshift0_r16, cshift0_c4, cshift0_c8, cshift0_c10, cshift0_c16. Define Macros GFC_UNALIGNED_C4 and GFC_UNALIGNED_C8. * intrinsics/cshift0.c: Remove helper functions for the innter shift loop. (cshift0): Call specific functions depending on type of array argument. Only call specific functions for correct alignment for other types. * m4/cshift0.m4: New file. * generated/cshift0_i1.c: New file. * generated/cshift0_i2.c: New file. * generated/cshift0_i4.c: New file. * generated/cshift0_i8:.c New file. * generated/cshift0_i16.c: New file. * generated/cshift0_r4.c: New file. * generated/cshift0_r8.c: New file. * generated/cshift0_r10.c: New file. * generated/cshift0_r16.c: New file. * generated/cshift0_c4.c: New file. * generated/cshift0_c8.c: New file. * generated/cshift0_c10.c: New file. * generated/cshift0_c16.c: New file. 2008-08-14 Thomas Koenig <tkoenig@gcc.gnu.org> PR libfortran/36886 * gfortran.dg/cshift_char_3.f90: New test case. * gfortran.dg/cshift_nan_1.f90: New test case. From-SVN: r139111
This commit is contained in:
Thomas Koenig
parent
6eefb96d46
commit
c2b00cdcaa
|
|
@ -1,3 +1,9 @@
|
|||
2008-08-14 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR libfortran/36886
|
||||
* gfortran.dg/cshift_char_3.f90: New test case.
|
||||
* gfortran.dg/cshift_nan_1.f90: New test case.
|
||||
|
||||
2008-08-14 Rafael Avila de Espindola <espindola@google.com>
|
||||
|
||||
* gcc.dg/visibility-14.c: New test.
|
||||
|
|
|
|||
|
|
@ -0,0 +1,13 @@
|
|||
! { dg-do run }
|
||||
! PR 36886 - misalignment of characters for cshift could cause
|
||||
! problems on some architectures.
|
||||
program main
|
||||
character(len=2) :: c2
|
||||
character(len=4), dimension(2,2) :: a, b, c, d
|
||||
! Force misalignment of a or b
|
||||
common /foo/ a, c, c2, b, d
|
||||
a = 'aa'
|
||||
b = 'bb'
|
||||
d = cshift(b,1)
|
||||
c = cshift(a,1)
|
||||
end program main
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
! { dg-do run }
|
||||
! Test cshift where the values are eight bytes,
|
||||
! but are aligned on a four-byte boundary. The
|
||||
! integers correspond to NaN values.
|
||||
program main
|
||||
implicit none
|
||||
integer :: i
|
||||
type t
|
||||
sequence
|
||||
integer :: a,b
|
||||
end type t
|
||||
type(t), dimension(4) :: u,v
|
||||
common /foo/ u, i, v
|
||||
|
||||
u(1)%a = 2142240768
|
||||
u(2)%a = 2144337920
|
||||
u(3)%a = -5242880
|
||||
u(4)%a = -3145728
|
||||
u%b = (/(i,i=-1,-4,-1)/)
|
||||
v(1:3:2) = cshift(u(1:3:2),1)
|
||||
v(2:4:2) = cshift(u(2:4:2),-1)
|
||||
if (any(v%a /= (/-5242880, -3145728, 2142240768, 2144337920 /))) call abort
|
||||
if (any(v%b /= (/-3, -4, -1, -2/))) call abort
|
||||
end program main
|
||||
|
|
@ -1,3 +1,35 @@
|
|||
2008-08-14 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR libfortran/36886
|
||||
* Makefile.am: Added $(i_cshift0_c).
|
||||
Added $(i_cshift0_c) to gfor_built_specific_src.
|
||||
Add rule to build from cshift0.m4.
|
||||
* Makefile.in: Regenerated.
|
||||
* libgfortran.h: Addedd prototypes for cshift0_i1,
|
||||
cshift0_i2, cshift0_i4, cshift0_i8, cshift0_i16,
|
||||
cshift0_r4, cshift0_r8, cshift0_r10, cshift0_r16,
|
||||
cshift0_c4, cshift0_c8, cshift0_c10, cshift0_c16.
|
||||
Define Macros GFC_UNALIGNED_C4 and GFC_UNALIGNED_C8.
|
||||
* intrinsics/cshift0.c: Remove helper functions for
|
||||
the innter shift loop.
|
||||
(cshift0): Call specific functions depending on type
|
||||
of array argument. Only call specific functions for
|
||||
correct alignment for other types.
|
||||
* m4/cshift0.m4: New file.
|
||||
* generated/cshift0_i1.c: New file.
|
||||
* generated/cshift0_i2.c: New file.
|
||||
* generated/cshift0_i4.c: New file.
|
||||
* generated/cshift0_i8:.c New file.
|
||||
* generated/cshift0_i16.c: New file.
|
||||
* generated/cshift0_r4.c: New file.
|
||||
* generated/cshift0_r8.c: New file.
|
||||
* generated/cshift0_r10.c: New file.
|
||||
* generated/cshift0_r16.c: New file.
|
||||
* generated/cshift0_c4.c: New file.
|
||||
* generated/cshift0_c8.c: New file.
|
||||
* generated/cshift0_c10.c: New file.
|
||||
* generated/cshift0_c16.c: New file.
|
||||
|
||||
2008-07-27 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/36132
|
||||
|
|
|
|||
|
|
@ -379,6 +379,22 @@ $(srcdir)/generated/eoshift3_4.c \
|
|||
$(srcdir)/generated/eoshift3_8.c \
|
||||
$(srcdir)/generated/eoshift3_16.c
|
||||
|
||||
i_cshift0_c= \
|
||||
$(srcdir)/generated/cshift0_i1.c \
|
||||
$(srcdir)/generated/cshift0_i2.c \
|
||||
$(srcdir)/generated/cshift0_i4.c \
|
||||
$(srcdir)/generated/cshift0_i8.c \
|
||||
$(srcdir)/generated/cshift0_i16.c \
|
||||
$(srcdir)/generated/cshift0_r4.c \
|
||||
$(srcdir)/generated/cshift0_r8.c \
|
||||
$(srcdir)/generated/cshift0_r10.c \
|
||||
$(srcdir)/generated/cshift0_r16.c \
|
||||
$(srcdir)/generated/cshift0_c4.c \
|
||||
$(srcdir)/generated/cshift0_c8.c \
|
||||
$(srcdir)/generated/cshift0_c10.c \
|
||||
$(srcdir)/generated/cshift0_c16.c
|
||||
|
||||
|
||||
i_cshift1_c= \
|
||||
$(srcdir)/generated/cshift1_4.c \
|
||||
$(srcdir)/generated/cshift1_8.c \
|
||||
|
|
@ -545,7 +561,7 @@ gfor_built_src= $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \
|
|||
$(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \
|
||||
$(i_pow_c) $(i_rrspacing_c) $(i_spacing_c) $(i_pack_c) $(i_unpack_c) \
|
||||
$(i_spread_c) selected_int_kind.inc selected_real_kind.inc kinds.h \
|
||||
kinds.inc c99_protos.inc fpu-target.h
|
||||
$(i_cshift0_c) kinds.inc c99_protos.inc fpu-target.h
|
||||
|
||||
# Machine generated specifics
|
||||
gfor_built_specific_src= \
|
||||
|
|
@ -829,6 +845,9 @@ $(i_eoshift1_c): m4/eoshift1.m4 $(I_M4_DEPS)
|
|||
$(i_eoshift3_c): m4/eoshift3.m4 $(I_M4_DEPS)
|
||||
$(M4) -Dfile=$@ -I$(srcdir)/m4 eoshift3.m4 > $@
|
||||
|
||||
$(i_cshift0_c): m4/cshift0.m4 $(I_M4_DEPS)
|
||||
$(M4) -Dfile=$@ -I$(srcdir)/m4 cshift0.m4 > $@
|
||||
|
||||
$(i_cshift1_c): m4/cshift1.m4 $(I_M4_DEPS)
|
||||
$(M4) -Dfile=$@ -I$(srcdir)/m4 cshift1.m4 > $@
|
||||
|
||||
|
|
|
|||
|
|
@ -397,7 +397,20 @@ am__libgfortran_la_SOURCES_DIST = runtime/backtrace.c \
|
|||
$(srcdir)/generated/spread_c8.c \
|
||||
$(srcdir)/generated/spread_c10.c \
|
||||
$(srcdir)/generated/spread_c16.c selected_int_kind.inc \
|
||||
selected_real_kind.inc kinds.h kinds.inc c99_protos.inc \
|
||||
selected_real_kind.inc kinds.h \
|
||||
$(srcdir)/generated/cshift0_i1.c \
|
||||
$(srcdir)/generated/cshift0_i2.c \
|
||||
$(srcdir)/generated/cshift0_i4.c \
|
||||
$(srcdir)/generated/cshift0_i8.c \
|
||||
$(srcdir)/generated/cshift0_i16.c \
|
||||
$(srcdir)/generated/cshift0_r4.c \
|
||||
$(srcdir)/generated/cshift0_r8.c \
|
||||
$(srcdir)/generated/cshift0_r10.c \
|
||||
$(srcdir)/generated/cshift0_r16.c \
|
||||
$(srcdir)/generated/cshift0_c4.c \
|
||||
$(srcdir)/generated/cshift0_c8.c \
|
||||
$(srcdir)/generated/cshift0_c10.c \
|
||||
$(srcdir)/generated/cshift0_c16.c kinds.inc c99_protos.inc \
|
||||
fpu-target.h io/close.c io/file_pos.c io/format.c io/inquire.c \
|
||||
io/intrinsics.c io/list_read.c io/lock.c io/open.c io/read.c \
|
||||
io/size_from_kind.c io/transfer.c io/unit.c io/unix.c \
|
||||
|
|
@ -679,7 +692,11 @@ am__objects_32 = spread_i1.lo spread_i2.lo spread_i4.lo spread_i8.lo \
|
|||
spread_i16.lo spread_r4.lo spread_r8.lo spread_r10.lo \
|
||||
spread_r16.lo spread_c4.lo spread_c8.lo spread_c10.lo \
|
||||
spread_c16.lo
|
||||
am__objects_33 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \
|
||||
am__objects_33 = cshift0_i1.lo cshift0_i2.lo cshift0_i4.lo \
|
||||
cshift0_i8.lo cshift0_i16.lo cshift0_r4.lo cshift0_r8.lo \
|
||||
cshift0_r10.lo cshift0_r16.lo cshift0_c4.lo cshift0_c8.lo \
|
||||
cshift0_c10.lo cshift0_c16.lo
|
||||
am__objects_34 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \
|
||||
$(am__objects_5) $(am__objects_6) $(am__objects_7) \
|
||||
$(am__objects_8) $(am__objects_9) $(am__objects_10) \
|
||||
$(am__objects_11) $(am__objects_12) $(am__objects_13) \
|
||||
|
|
@ -689,11 +706,11 @@ am__objects_33 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \
|
|||
$(am__objects_23) $(am__objects_24) $(am__objects_25) \
|
||||
$(am__objects_26) $(am__objects_27) $(am__objects_28) \
|
||||
$(am__objects_29) $(am__objects_30) $(am__objects_31) \
|
||||
$(am__objects_32)
|
||||
am__objects_34 = close.lo file_pos.lo format.lo inquire.lo \
|
||||
$(am__objects_32) $(am__objects_33)
|
||||
am__objects_35 = close.lo file_pos.lo format.lo inquire.lo \
|
||||
intrinsics.lo list_read.lo lock.lo open.lo read.lo \
|
||||
size_from_kind.lo transfer.lo unit.lo unix.lo write.lo fbuf.lo
|
||||
am__objects_35 = associated.lo abort.lo access.lo args.lo \
|
||||
am__objects_36 = associated.lo abort.lo access.lo args.lo \
|
||||
c99_functions.lo chdir.lo chmod.lo clock.lo cpu_time.lo \
|
||||
cshift0.lo ctime.lo date_and_time.lo dtime.lo env.lo \
|
||||
eoshift0.lo eoshift2.lo erfc_scaled.lo etime.lo exit.lo \
|
||||
|
|
@ -707,8 +724,8 @@ am__objects_35 = associated.lo abort.lo access.lo args.lo \
|
|||
stat.lo symlnk.lo system_clock.lo time.lo transpose_generic.lo \
|
||||
umask.lo unlink.lo unpack_generic.lo in_pack_generic.lo \
|
||||
in_unpack_generic.lo
|
||||
am__objects_36 =
|
||||
am__objects_37 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
|
||||
am__objects_37 =
|
||||
am__objects_38 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
|
||||
_abs_i4.lo _abs_i8.lo _abs_i16.lo _abs_r4.lo _abs_r8.lo \
|
||||
_abs_r10.lo _abs_r16.lo _aimag_c4.lo _aimag_c8.lo \
|
||||
_aimag_c10.lo _aimag_c16.lo _exp_r4.lo _exp_r8.lo _exp_r10.lo \
|
||||
|
|
@ -732,18 +749,18 @@ am__objects_37 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
|
|||
_conjg_c4.lo _conjg_c8.lo _conjg_c10.lo _conjg_c16.lo \
|
||||
_aint_r4.lo _aint_r8.lo _aint_r10.lo _aint_r16.lo _anint_r4.lo \
|
||||
_anint_r8.lo _anint_r10.lo _anint_r16.lo
|
||||
am__objects_38 = _sign_i4.lo _sign_i8.lo _sign_i16.lo _sign_r4.lo \
|
||||
am__objects_39 = _sign_i4.lo _sign_i8.lo _sign_i16.lo _sign_r4.lo \
|
||||
_sign_r8.lo _sign_r10.lo _sign_r16.lo _dim_i4.lo _dim_i8.lo \
|
||||
_dim_i16.lo _dim_r4.lo _dim_r8.lo _dim_r10.lo _dim_r16.lo \
|
||||
_atan2_r4.lo _atan2_r8.lo _atan2_r10.lo _atan2_r16.lo \
|
||||
_mod_i4.lo _mod_i8.lo _mod_i16.lo _mod_r4.lo _mod_r8.lo \
|
||||
_mod_r10.lo _mod_r16.lo
|
||||
am__objects_39 = misc_specifics.lo
|
||||
am__objects_40 = $(am__objects_37) $(am__objects_38) $(am__objects_39) \
|
||||
am__objects_40 = misc_specifics.lo
|
||||
am__objects_41 = $(am__objects_38) $(am__objects_39) $(am__objects_40) \
|
||||
dprod_r8.lo f2c_specifics.lo
|
||||
am__objects_41 = $(am__objects_1) $(am__objects_33) $(am__objects_34) \
|
||||
$(am__objects_35) $(am__objects_36) $(am__objects_40)
|
||||
@onestep_FALSE@am_libgfortran_la_OBJECTS = $(am__objects_41)
|
||||
am__objects_42 = $(am__objects_1) $(am__objects_34) $(am__objects_35) \
|
||||
$(am__objects_36) $(am__objects_37) $(am__objects_41)
|
||||
@onestep_FALSE@am_libgfortran_la_OBJECTS = $(am__objects_42)
|
||||
@onestep_TRUE@am_libgfortran_la_OBJECTS = libgfortran_c.lo
|
||||
libgfortran_la_OBJECTS = $(am_libgfortran_la_OBJECTS)
|
||||
libgfortranbegin_la_LIBADD =
|
||||
|
|
@ -1279,6 +1296,21 @@ $(srcdir)/generated/eoshift3_4.c \
|
|||
$(srcdir)/generated/eoshift3_8.c \
|
||||
$(srcdir)/generated/eoshift3_16.c
|
||||
|
||||
i_cshift0_c = \
|
||||
$(srcdir)/generated/cshift0_i1.c \
|
||||
$(srcdir)/generated/cshift0_i2.c \
|
||||
$(srcdir)/generated/cshift0_i4.c \
|
||||
$(srcdir)/generated/cshift0_i8.c \
|
||||
$(srcdir)/generated/cshift0_i16.c \
|
||||
$(srcdir)/generated/cshift0_r4.c \
|
||||
$(srcdir)/generated/cshift0_r8.c \
|
||||
$(srcdir)/generated/cshift0_r10.c \
|
||||
$(srcdir)/generated/cshift0_r16.c \
|
||||
$(srcdir)/generated/cshift0_c4.c \
|
||||
$(srcdir)/generated/cshift0_c8.c \
|
||||
$(srcdir)/generated/cshift0_c10.c \
|
||||
$(srcdir)/generated/cshift0_c16.c
|
||||
|
||||
i_cshift1_c = \
|
||||
$(srcdir)/generated/cshift1_4.c \
|
||||
$(srcdir)/generated/cshift1_8.c \
|
||||
|
|
@ -1445,7 +1477,7 @@ gfor_built_src = $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \
|
|||
$(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \
|
||||
$(i_pow_c) $(i_rrspacing_c) $(i_spacing_c) $(i_pack_c) $(i_unpack_c) \
|
||||
$(i_spread_c) selected_int_kind.inc selected_real_kind.inc kinds.h \
|
||||
kinds.inc c99_protos.inc fpu-target.h
|
||||
$(i_cshift0_c) kinds.inc c99_protos.inc fpu-target.h
|
||||
|
||||
|
||||
# Machine generated specifics
|
||||
|
|
@ -1771,6 +1803,19 @@ distclean-compile:
|
|||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_8_l.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cpu_time.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_c10.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_c16.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_c4.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_c8.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_i1.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_i16.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_i2.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_i4.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_i8.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_r10.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_r16.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_r4.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_r8.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift1_16.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift1_4.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift1_8.Plo@am__quote@
|
||||
|
|
@ -5038,6 +5083,97 @@ spread_c16.lo: $(srcdir)/generated/spread_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 spread_c16.lo `test -f '$(srcdir)/generated/spread_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_c16.c
|
||||
|
||||
cshift0_i1.lo: $(srcdir)/generated/cshift0_i1.c
|
||||
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_i1.lo -MD -MP -MF "$(DEPDIR)/cshift0_i1.Tpo" -c -o cshift0_i1.lo `test -f '$(srcdir)/generated/cshift0_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i1.c; \
|
||||
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_i1.Tpo" "$(DEPDIR)/cshift0_i1.Plo"; else rm -f "$(DEPDIR)/cshift0_i1.Tpo"; exit 1; fi
|
||||
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_i1.c' object='cshift0_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 cshift0_i1.lo `test -f '$(srcdir)/generated/cshift0_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i1.c
|
||||
|
||||
cshift0_i2.lo: $(srcdir)/generated/cshift0_i2.c
|
||||
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_i2.lo -MD -MP -MF "$(DEPDIR)/cshift0_i2.Tpo" -c -o cshift0_i2.lo `test -f '$(srcdir)/generated/cshift0_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i2.c; \
|
||||
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_i2.Tpo" "$(DEPDIR)/cshift0_i2.Plo"; else rm -f "$(DEPDIR)/cshift0_i2.Tpo"; exit 1; fi
|
||||
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_i2.c' object='cshift0_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 cshift0_i2.lo `test -f '$(srcdir)/generated/cshift0_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i2.c
|
||||
|
||||
cshift0_i4.lo: $(srcdir)/generated/cshift0_i4.c
|
||||
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_i4.lo -MD -MP -MF "$(DEPDIR)/cshift0_i4.Tpo" -c -o cshift0_i4.lo `test -f '$(srcdir)/generated/cshift0_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i4.c; \
|
||||
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_i4.Tpo" "$(DEPDIR)/cshift0_i4.Plo"; else rm -f "$(DEPDIR)/cshift0_i4.Tpo"; exit 1; fi
|
||||
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_i4.c' object='cshift0_i4.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 cshift0_i4.lo `test -f '$(srcdir)/generated/cshift0_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i4.c
|
||||
|
||||
cshift0_i8.lo: $(srcdir)/generated/cshift0_i8.c
|
||||
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_i8.lo -MD -MP -MF "$(DEPDIR)/cshift0_i8.Tpo" -c -o cshift0_i8.lo `test -f '$(srcdir)/generated/cshift0_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i8.c; \
|
||||
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_i8.Tpo" "$(DEPDIR)/cshift0_i8.Plo"; else rm -f "$(DEPDIR)/cshift0_i8.Tpo"; exit 1; fi
|
||||
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_i8.c' object='cshift0_i8.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 cshift0_i8.lo `test -f '$(srcdir)/generated/cshift0_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i8.c
|
||||
|
||||
cshift0_i16.lo: $(srcdir)/generated/cshift0_i16.c
|
||||
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_i16.lo -MD -MP -MF "$(DEPDIR)/cshift0_i16.Tpo" -c -o cshift0_i16.lo `test -f '$(srcdir)/generated/cshift0_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i16.c; \
|
||||
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_i16.Tpo" "$(DEPDIR)/cshift0_i16.Plo"; else rm -f "$(DEPDIR)/cshift0_i16.Tpo"; exit 1; fi
|
||||
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_i16.c' object='cshift0_i16.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 cshift0_i16.lo `test -f '$(srcdir)/generated/cshift0_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i16.c
|
||||
|
||||
cshift0_r4.lo: $(srcdir)/generated/cshift0_r4.c
|
||||
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_r4.lo -MD -MP -MF "$(DEPDIR)/cshift0_r4.Tpo" -c -o cshift0_r4.lo `test -f '$(srcdir)/generated/cshift0_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_r4.c; \
|
||||
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_r4.Tpo" "$(DEPDIR)/cshift0_r4.Plo"; else rm -f "$(DEPDIR)/cshift0_r4.Tpo"; exit 1; fi
|
||||
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_r4.c' object='cshift0_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 cshift0_r4.lo `test -f '$(srcdir)/generated/cshift0_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_r4.c
|
||||
|
||||
cshift0_r8.lo: $(srcdir)/generated/cshift0_r8.c
|
||||
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_r8.lo -MD -MP -MF "$(DEPDIR)/cshift0_r8.Tpo" -c -o cshift0_r8.lo `test -f '$(srcdir)/generated/cshift0_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_r8.c; \
|
||||
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_r8.Tpo" "$(DEPDIR)/cshift0_r8.Plo"; else rm -f "$(DEPDIR)/cshift0_r8.Tpo"; exit 1; fi
|
||||
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_r8.c' object='cshift0_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 cshift0_r8.lo `test -f '$(srcdir)/generated/cshift0_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_r8.c
|
||||
|
||||
cshift0_r10.lo: $(srcdir)/generated/cshift0_r10.c
|
||||
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_r10.lo -MD -MP -MF "$(DEPDIR)/cshift0_r10.Tpo" -c -o cshift0_r10.lo `test -f '$(srcdir)/generated/cshift0_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_r10.c; \
|
||||
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_r10.Tpo" "$(DEPDIR)/cshift0_r10.Plo"; else rm -f "$(DEPDIR)/cshift0_r10.Tpo"; exit 1; fi
|
||||
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_r10.c' object='cshift0_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 cshift0_r10.lo `test -f '$(srcdir)/generated/cshift0_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_r10.c
|
||||
|
||||
cshift0_r16.lo: $(srcdir)/generated/cshift0_r16.c
|
||||
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_r16.lo -MD -MP -MF "$(DEPDIR)/cshift0_r16.Tpo" -c -o cshift0_r16.lo `test -f '$(srcdir)/generated/cshift0_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_r16.c; \
|
||||
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_r16.Tpo" "$(DEPDIR)/cshift0_r16.Plo"; else rm -f "$(DEPDIR)/cshift0_r16.Tpo"; exit 1; fi
|
||||
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_r16.c' object='cshift0_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 cshift0_r16.lo `test -f '$(srcdir)/generated/cshift0_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_r16.c
|
||||
|
||||
cshift0_c4.lo: $(srcdir)/generated/cshift0_c4.c
|
||||
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_c4.lo -MD -MP -MF "$(DEPDIR)/cshift0_c4.Tpo" -c -o cshift0_c4.lo `test -f '$(srcdir)/generated/cshift0_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_c4.c; \
|
||||
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_c4.Tpo" "$(DEPDIR)/cshift0_c4.Plo"; else rm -f "$(DEPDIR)/cshift0_c4.Tpo"; exit 1; fi
|
||||
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_c4.c' object='cshift0_c4.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 cshift0_c4.lo `test -f '$(srcdir)/generated/cshift0_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_c4.c
|
||||
|
||||
cshift0_c8.lo: $(srcdir)/generated/cshift0_c8.c
|
||||
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_c8.lo -MD -MP -MF "$(DEPDIR)/cshift0_c8.Tpo" -c -o cshift0_c8.lo `test -f '$(srcdir)/generated/cshift0_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_c8.c; \
|
||||
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_c8.Tpo" "$(DEPDIR)/cshift0_c8.Plo"; else rm -f "$(DEPDIR)/cshift0_c8.Tpo"; exit 1; fi
|
||||
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_c8.c' object='cshift0_c8.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 cshift0_c8.lo `test -f '$(srcdir)/generated/cshift0_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_c8.c
|
||||
|
||||
cshift0_c10.lo: $(srcdir)/generated/cshift0_c10.c
|
||||
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_c10.lo -MD -MP -MF "$(DEPDIR)/cshift0_c10.Tpo" -c -o cshift0_c10.lo `test -f '$(srcdir)/generated/cshift0_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_c10.c; \
|
||||
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_c10.Tpo" "$(DEPDIR)/cshift0_c10.Plo"; else rm -f "$(DEPDIR)/cshift0_c10.Tpo"; exit 1; fi
|
||||
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_c10.c' object='cshift0_c10.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 cshift0_c10.lo `test -f '$(srcdir)/generated/cshift0_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_c10.c
|
||||
|
||||
cshift0_c16.lo: $(srcdir)/generated/cshift0_c16.c
|
||||
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_c16.lo -MD -MP -MF "$(DEPDIR)/cshift0_c16.Tpo" -c -o cshift0_c16.lo `test -f '$(srcdir)/generated/cshift0_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_c16.c; \
|
||||
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/cshift0_c16.Tpo" "$(DEPDIR)/cshift0_c16.Plo"; else rm -f "$(DEPDIR)/cshift0_c16.Tpo"; exit 1; fi
|
||||
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_c16.c' object='cshift0_c16.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 cshift0_c16.lo `test -f '$(srcdir)/generated/cshift0_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_c16.c
|
||||
|
||||
close.lo: io/close.c
|
||||
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT close.lo -MD -MP -MF "$(DEPDIR)/close.Tpo" -c -o close.lo `test -f 'io/close.c' || echo '$(srcdir)/'`io/close.c; \
|
||||
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/close.Tpo" "$(DEPDIR)/close.Plo"; else rm -f "$(DEPDIR)/close.Tpo"; exit 1; fi
|
||||
|
|
@ -5973,6 +6109,9 @@ fpu-target.h: $(srcdir)/$(FPU_HOST_HEADER)
|
|||
@MAINTAINER_MODE_TRUE@$(i_eoshift3_c): m4/eoshift3.m4 $(I_M4_DEPS)
|
||||
@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 eoshift3.m4 > $@
|
||||
|
||||
@MAINTAINER_MODE_TRUE@$(i_cshift0_c): m4/cshift0.m4 $(I_M4_DEPS)
|
||||
@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 cshift0.m4 > $@
|
||||
|
||||
@MAINTAINER_MODE_TRUE@$(i_cshift1_c): m4/cshift1.m4 $(I_M4_DEPS)
|
||||
@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 cshift1.m4 > $@
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,176 @@
|
|||
/* Helper function for cshift functions.
|
||||
Copyright 2008 Free Software Foundation, Inc.
|
||||
Contributed by Thomas Koenig <tkoenig@gcc.gnu.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_COMPLEX_10)
|
||||
|
||||
void
|
||||
cshift0_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array, ssize_t shift,
|
||||
int which)
|
||||
{
|
||||
/* r.* indicates the return array. */
|
||||
index_type rstride[GFC_MAX_DIMENSIONS];
|
||||
index_type rstride0;
|
||||
index_type roffset;
|
||||
GFC_COMPLEX_10 *rptr;
|
||||
|
||||
/* s.* indicates the source array. */
|
||||
index_type sstride[GFC_MAX_DIMENSIONS];
|
||||
index_type sstride0;
|
||||
index_type soffset;
|
||||
const GFC_COMPLEX_10 *sptr;
|
||||
|
||||
index_type count[GFC_MAX_DIMENSIONS];
|
||||
index_type extent[GFC_MAX_DIMENSIONS];
|
||||
index_type dim;
|
||||
index_type len;
|
||||
index_type n;
|
||||
|
||||
which = which - 1;
|
||||
sstride[0] = 0;
|
||||
rstride[0] = 0;
|
||||
|
||||
extent[0] = 1;
|
||||
count[0] = 0;
|
||||
n = 0;
|
||||
/* Initialized for avoiding compiler warnings. */
|
||||
roffset = 1;
|
||||
soffset = 1;
|
||||
len = 0;
|
||||
|
||||
for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
|
||||
{
|
||||
if (dim == which)
|
||||
{
|
||||
roffset = ret->dim[dim].stride;
|
||||
if (roffset == 0)
|
||||
roffset = 1;
|
||||
soffset = array->dim[dim].stride;
|
||||
if (soffset == 0)
|
||||
soffset = 1;
|
||||
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n] = 0;
|
||||
extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
rstride[n] = ret->dim[dim].stride;
|
||||
sstride[n] = array->dim[dim].stride;
|
||||
n++;
|
||||
}
|
||||
}
|
||||
if (sstride[0] == 0)
|
||||
sstride[0] = 1;
|
||||
if (rstride[0] == 0)
|
||||
rstride[0] = 1;
|
||||
|
||||
dim = GFC_DESCRIPTOR_RANK (array);
|
||||
rstride0 = rstride[0];
|
||||
sstride0 = sstride[0];
|
||||
rptr = ret->data;
|
||||
sptr = array->data;
|
||||
|
||||
shift = len == 0 ? 0 : shift % (ssize_t)len;
|
||||
if (shift < 0)
|
||||
shift += len;
|
||||
|
||||
while (rptr)
|
||||
{
|
||||
/* Do the shift for this dimension. */
|
||||
|
||||
/* If elements are contiguous, perform the operation
|
||||
in two block moves. */
|
||||
if (soffset == 1 && roffset == 1)
|
||||
{
|
||||
size_t len1 = shift * sizeof (GFC_COMPLEX_10);
|
||||
size_t len2 = (len - shift) * sizeof (GFC_COMPLEX_10);
|
||||
memcpy (rptr, sptr + shift, len2);
|
||||
memcpy (rptr + (len - shift), sptr, len1);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Otherwise, we will have to perform the copy one element at
|
||||
a time. */
|
||||
GFC_COMPLEX_10 *dest = rptr;
|
||||
const GFC_COMPLEX_10 *src = &sptr[shift * soffset];
|
||||
|
||||
for (n = 0; n < len - shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
for (src = sptr, n = 0; n < shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
}
|
||||
|
||||
/* Advance to the next section. */
|
||||
rptr += rstride0;
|
||||
sptr += sstride0;
|
||||
count[0]++;
|
||||
n = 0;
|
||||
while (count[n] == extent[n])
|
||||
{
|
||||
/* When we get to the end of a dimension, reset it and increment
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
rptr -= rstride[n] * extent[n];
|
||||
sptr -= sstride[n] * extent[n];
|
||||
n++;
|
||||
if (n >= dim - 1)
|
||||
{
|
||||
/* Break out of the loop. */
|
||||
rptr = NULL;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
rptr += rstride[n];
|
||||
sptr += sstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
|
@ -0,0 +1,176 @@
|
|||
/* Helper function for cshift functions.
|
||||
Copyright 2008 Free Software Foundation, Inc.
|
||||
Contributed by Thomas Koenig <tkoenig@gcc.gnu.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_COMPLEX_16)
|
||||
|
||||
void
|
||||
cshift0_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array, ssize_t shift,
|
||||
int which)
|
||||
{
|
||||
/* r.* indicates the return array. */
|
||||
index_type rstride[GFC_MAX_DIMENSIONS];
|
||||
index_type rstride0;
|
||||
index_type roffset;
|
||||
GFC_COMPLEX_16 *rptr;
|
||||
|
||||
/* s.* indicates the source array. */
|
||||
index_type sstride[GFC_MAX_DIMENSIONS];
|
||||
index_type sstride0;
|
||||
index_type soffset;
|
||||
const GFC_COMPLEX_16 *sptr;
|
||||
|
||||
index_type count[GFC_MAX_DIMENSIONS];
|
||||
index_type extent[GFC_MAX_DIMENSIONS];
|
||||
index_type dim;
|
||||
index_type len;
|
||||
index_type n;
|
||||
|
||||
which = which - 1;
|
||||
sstride[0] = 0;
|
||||
rstride[0] = 0;
|
||||
|
||||
extent[0] = 1;
|
||||
count[0] = 0;
|
||||
n = 0;
|
||||
/* Initialized for avoiding compiler warnings. */
|
||||
roffset = 1;
|
||||
soffset = 1;
|
||||
len = 0;
|
||||
|
||||
for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
|
||||
{
|
||||
if (dim == which)
|
||||
{
|
||||
roffset = ret->dim[dim].stride;
|
||||
if (roffset == 0)
|
||||
roffset = 1;
|
||||
soffset = array->dim[dim].stride;
|
||||
if (soffset == 0)
|
||||
soffset = 1;
|
||||
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n] = 0;
|
||||
extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
rstride[n] = ret->dim[dim].stride;
|
||||
sstride[n] = array->dim[dim].stride;
|
||||
n++;
|
||||
}
|
||||
}
|
||||
if (sstride[0] == 0)
|
||||
sstride[0] = 1;
|
||||
if (rstride[0] == 0)
|
||||
rstride[0] = 1;
|
||||
|
||||
dim = GFC_DESCRIPTOR_RANK (array);
|
||||
rstride0 = rstride[0];
|
||||
sstride0 = sstride[0];
|
||||
rptr = ret->data;
|
||||
sptr = array->data;
|
||||
|
||||
shift = len == 0 ? 0 : shift % (ssize_t)len;
|
||||
if (shift < 0)
|
||||
shift += len;
|
||||
|
||||
while (rptr)
|
||||
{
|
||||
/* Do the shift for this dimension. */
|
||||
|
||||
/* If elements are contiguous, perform the operation
|
||||
in two block moves. */
|
||||
if (soffset == 1 && roffset == 1)
|
||||
{
|
||||
size_t len1 = shift * sizeof (GFC_COMPLEX_16);
|
||||
size_t len2 = (len - shift) * sizeof (GFC_COMPLEX_16);
|
||||
memcpy (rptr, sptr + shift, len2);
|
||||
memcpy (rptr + (len - shift), sptr, len1);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Otherwise, we will have to perform the copy one element at
|
||||
a time. */
|
||||
GFC_COMPLEX_16 *dest = rptr;
|
||||
const GFC_COMPLEX_16 *src = &sptr[shift * soffset];
|
||||
|
||||
for (n = 0; n < len - shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
for (src = sptr, n = 0; n < shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
}
|
||||
|
||||
/* Advance to the next section. */
|
||||
rptr += rstride0;
|
||||
sptr += sstride0;
|
||||
count[0]++;
|
||||
n = 0;
|
||||
while (count[n] == extent[n])
|
||||
{
|
||||
/* When we get to the end of a dimension, reset it and increment
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
rptr -= rstride[n] * extent[n];
|
||||
sptr -= sstride[n] * extent[n];
|
||||
n++;
|
||||
if (n >= dim - 1)
|
||||
{
|
||||
/* Break out of the loop. */
|
||||
rptr = NULL;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
rptr += rstride[n];
|
||||
sptr += sstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
|
@ -0,0 +1,176 @@
|
|||
/* Helper function for cshift functions.
|
||||
Copyright 2008 Free Software Foundation, Inc.
|
||||
Contributed by Thomas Koenig <tkoenig@gcc.gnu.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_COMPLEX_4)
|
||||
|
||||
void
|
||||
cshift0_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array, ssize_t shift,
|
||||
int which)
|
||||
{
|
||||
/* r.* indicates the return array. */
|
||||
index_type rstride[GFC_MAX_DIMENSIONS];
|
||||
index_type rstride0;
|
||||
index_type roffset;
|
||||
GFC_COMPLEX_4 *rptr;
|
||||
|
||||
/* s.* indicates the source array. */
|
||||
index_type sstride[GFC_MAX_DIMENSIONS];
|
||||
index_type sstride0;
|
||||
index_type soffset;
|
||||
const GFC_COMPLEX_4 *sptr;
|
||||
|
||||
index_type count[GFC_MAX_DIMENSIONS];
|
||||
index_type extent[GFC_MAX_DIMENSIONS];
|
||||
index_type dim;
|
||||
index_type len;
|
||||
index_type n;
|
||||
|
||||
which = which - 1;
|
||||
sstride[0] = 0;
|
||||
rstride[0] = 0;
|
||||
|
||||
extent[0] = 1;
|
||||
count[0] = 0;
|
||||
n = 0;
|
||||
/* Initialized for avoiding compiler warnings. */
|
||||
roffset = 1;
|
||||
soffset = 1;
|
||||
len = 0;
|
||||
|
||||
for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
|
||||
{
|
||||
if (dim == which)
|
||||
{
|
||||
roffset = ret->dim[dim].stride;
|
||||
if (roffset == 0)
|
||||
roffset = 1;
|
||||
soffset = array->dim[dim].stride;
|
||||
if (soffset == 0)
|
||||
soffset = 1;
|
||||
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n] = 0;
|
||||
extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
rstride[n] = ret->dim[dim].stride;
|
||||
sstride[n] = array->dim[dim].stride;
|
||||
n++;
|
||||
}
|
||||
}
|
||||
if (sstride[0] == 0)
|
||||
sstride[0] = 1;
|
||||
if (rstride[0] == 0)
|
||||
rstride[0] = 1;
|
||||
|
||||
dim = GFC_DESCRIPTOR_RANK (array);
|
||||
rstride0 = rstride[0];
|
||||
sstride0 = sstride[0];
|
||||
rptr = ret->data;
|
||||
sptr = array->data;
|
||||
|
||||
shift = len == 0 ? 0 : shift % (ssize_t)len;
|
||||
if (shift < 0)
|
||||
shift += len;
|
||||
|
||||
while (rptr)
|
||||
{
|
||||
/* Do the shift for this dimension. */
|
||||
|
||||
/* If elements are contiguous, perform the operation
|
||||
in two block moves. */
|
||||
if (soffset == 1 && roffset == 1)
|
||||
{
|
||||
size_t len1 = shift * sizeof (GFC_COMPLEX_4);
|
||||
size_t len2 = (len - shift) * sizeof (GFC_COMPLEX_4);
|
||||
memcpy (rptr, sptr + shift, len2);
|
||||
memcpy (rptr + (len - shift), sptr, len1);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Otherwise, we will have to perform the copy one element at
|
||||
a time. */
|
||||
GFC_COMPLEX_4 *dest = rptr;
|
||||
const GFC_COMPLEX_4 *src = &sptr[shift * soffset];
|
||||
|
||||
for (n = 0; n < len - shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
for (src = sptr, n = 0; n < shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
}
|
||||
|
||||
/* Advance to the next section. */
|
||||
rptr += rstride0;
|
||||
sptr += sstride0;
|
||||
count[0]++;
|
||||
n = 0;
|
||||
while (count[n] == extent[n])
|
||||
{
|
||||
/* When we get to the end of a dimension, reset it and increment
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
rptr -= rstride[n] * extent[n];
|
||||
sptr -= sstride[n] * extent[n];
|
||||
n++;
|
||||
if (n >= dim - 1)
|
||||
{
|
||||
/* Break out of the loop. */
|
||||
rptr = NULL;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
rptr += rstride[n];
|
||||
sptr += sstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
|
@ -0,0 +1,176 @@
|
|||
/* Helper function for cshift functions.
|
||||
Copyright 2008 Free Software Foundation, Inc.
|
||||
Contributed by Thomas Koenig <tkoenig@gcc.gnu.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_COMPLEX_8)
|
||||
|
||||
void
|
||||
cshift0_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, ssize_t shift,
|
||||
int which)
|
||||
{
|
||||
/* r.* indicates the return array. */
|
||||
index_type rstride[GFC_MAX_DIMENSIONS];
|
||||
index_type rstride0;
|
||||
index_type roffset;
|
||||
GFC_COMPLEX_8 *rptr;
|
||||
|
||||
/* s.* indicates the source array. */
|
||||
index_type sstride[GFC_MAX_DIMENSIONS];
|
||||
index_type sstride0;
|
||||
index_type soffset;
|
||||
const GFC_COMPLEX_8 *sptr;
|
||||
|
||||
index_type count[GFC_MAX_DIMENSIONS];
|
||||
index_type extent[GFC_MAX_DIMENSIONS];
|
||||
index_type dim;
|
||||
index_type len;
|
||||
index_type n;
|
||||
|
||||
which = which - 1;
|
||||
sstride[0] = 0;
|
||||
rstride[0] = 0;
|
||||
|
||||
extent[0] = 1;
|
||||
count[0] = 0;
|
||||
n = 0;
|
||||
/* Initialized for avoiding compiler warnings. */
|
||||
roffset = 1;
|
||||
soffset = 1;
|
||||
len = 0;
|
||||
|
||||
for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
|
||||
{
|
||||
if (dim == which)
|
||||
{
|
||||
roffset = ret->dim[dim].stride;
|
||||
if (roffset == 0)
|
||||
roffset = 1;
|
||||
soffset = array->dim[dim].stride;
|
||||
if (soffset == 0)
|
||||
soffset = 1;
|
||||
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n] = 0;
|
||||
extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
rstride[n] = ret->dim[dim].stride;
|
||||
sstride[n] = array->dim[dim].stride;
|
||||
n++;
|
||||
}
|
||||
}
|
||||
if (sstride[0] == 0)
|
||||
sstride[0] = 1;
|
||||
if (rstride[0] == 0)
|
||||
rstride[0] = 1;
|
||||
|
||||
dim = GFC_DESCRIPTOR_RANK (array);
|
||||
rstride0 = rstride[0];
|
||||
sstride0 = sstride[0];
|
||||
rptr = ret->data;
|
||||
sptr = array->data;
|
||||
|
||||
shift = len == 0 ? 0 : shift % (ssize_t)len;
|
||||
if (shift < 0)
|
||||
shift += len;
|
||||
|
||||
while (rptr)
|
||||
{
|
||||
/* Do the shift for this dimension. */
|
||||
|
||||
/* If elements are contiguous, perform the operation
|
||||
in two block moves. */
|
||||
if (soffset == 1 && roffset == 1)
|
||||
{
|
||||
size_t len1 = shift * sizeof (GFC_COMPLEX_8);
|
||||
size_t len2 = (len - shift) * sizeof (GFC_COMPLEX_8);
|
||||
memcpy (rptr, sptr + shift, len2);
|
||||
memcpy (rptr + (len - shift), sptr, len1);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Otherwise, we will have to perform the copy one element at
|
||||
a time. */
|
||||
GFC_COMPLEX_8 *dest = rptr;
|
||||
const GFC_COMPLEX_8 *src = &sptr[shift * soffset];
|
||||
|
||||
for (n = 0; n < len - shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
for (src = sptr, n = 0; n < shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
}
|
||||
|
||||
/* Advance to the next section. */
|
||||
rptr += rstride0;
|
||||
sptr += sstride0;
|
||||
count[0]++;
|
||||
n = 0;
|
||||
while (count[n] == extent[n])
|
||||
{
|
||||
/* When we get to the end of a dimension, reset it and increment
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
rptr -= rstride[n] * extent[n];
|
||||
sptr -= sstride[n] * extent[n];
|
||||
n++;
|
||||
if (n >= dim - 1)
|
||||
{
|
||||
/* Break out of the loop. */
|
||||
rptr = NULL;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
rptr += rstride[n];
|
||||
sptr += sstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
|
@ -0,0 +1,176 @@
|
|||
/* Helper function for cshift functions.
|
||||
Copyright 2008 Free Software Foundation, Inc.
|
||||
Contributed by Thomas Koenig <tkoenig@gcc.gnu.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
|
||||
cshift0_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array, ssize_t shift,
|
||||
int which)
|
||||
{
|
||||
/* r.* indicates the return array. */
|
||||
index_type rstride[GFC_MAX_DIMENSIONS];
|
||||
index_type rstride0;
|
||||
index_type roffset;
|
||||
GFC_INTEGER_1 *rptr;
|
||||
|
||||
/* s.* indicates the source array. */
|
||||
index_type sstride[GFC_MAX_DIMENSIONS];
|
||||
index_type sstride0;
|
||||
index_type soffset;
|
||||
const GFC_INTEGER_1 *sptr;
|
||||
|
||||
index_type count[GFC_MAX_DIMENSIONS];
|
||||
index_type extent[GFC_MAX_DIMENSIONS];
|
||||
index_type dim;
|
||||
index_type len;
|
||||
index_type n;
|
||||
|
||||
which = which - 1;
|
||||
sstride[0] = 0;
|
||||
rstride[0] = 0;
|
||||
|
||||
extent[0] = 1;
|
||||
count[0] = 0;
|
||||
n = 0;
|
||||
/* Initialized for avoiding compiler warnings. */
|
||||
roffset = 1;
|
||||
soffset = 1;
|
||||
len = 0;
|
||||
|
||||
for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
|
||||
{
|
||||
if (dim == which)
|
||||
{
|
||||
roffset = ret->dim[dim].stride;
|
||||
if (roffset == 0)
|
||||
roffset = 1;
|
||||
soffset = array->dim[dim].stride;
|
||||
if (soffset == 0)
|
||||
soffset = 1;
|
||||
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n] = 0;
|
||||
extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
rstride[n] = ret->dim[dim].stride;
|
||||
sstride[n] = array->dim[dim].stride;
|
||||
n++;
|
||||
}
|
||||
}
|
||||
if (sstride[0] == 0)
|
||||
sstride[0] = 1;
|
||||
if (rstride[0] == 0)
|
||||
rstride[0] = 1;
|
||||
|
||||
dim = GFC_DESCRIPTOR_RANK (array);
|
||||
rstride0 = rstride[0];
|
||||
sstride0 = sstride[0];
|
||||
rptr = ret->data;
|
||||
sptr = array->data;
|
||||
|
||||
shift = len == 0 ? 0 : shift % (ssize_t)len;
|
||||
if (shift < 0)
|
||||
shift += len;
|
||||
|
||||
while (rptr)
|
||||
{
|
||||
/* Do the shift for this dimension. */
|
||||
|
||||
/* If elements are contiguous, perform the operation
|
||||
in two block moves. */
|
||||
if (soffset == 1 && roffset == 1)
|
||||
{
|
||||
size_t len1 = shift * sizeof (GFC_INTEGER_1);
|
||||
size_t len2 = (len - shift) * sizeof (GFC_INTEGER_1);
|
||||
memcpy (rptr, sptr + shift, len2);
|
||||
memcpy (rptr + (len - shift), sptr, len1);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Otherwise, we will have to perform the copy one element at
|
||||
a time. */
|
||||
GFC_INTEGER_1 *dest = rptr;
|
||||
const GFC_INTEGER_1 *src = &sptr[shift * soffset];
|
||||
|
||||
for (n = 0; n < len - shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
for (src = sptr, n = 0; n < shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
}
|
||||
|
||||
/* Advance to the next section. */
|
||||
rptr += rstride0;
|
||||
sptr += sstride0;
|
||||
count[0]++;
|
||||
n = 0;
|
||||
while (count[n] == extent[n])
|
||||
{
|
||||
/* When we get to the end of a dimension, reset it and increment
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
rptr -= rstride[n] * extent[n];
|
||||
sptr -= sstride[n] * extent[n];
|
||||
n++;
|
||||
if (n >= dim - 1)
|
||||
{
|
||||
/* Break out of the loop. */
|
||||
rptr = NULL;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
rptr += rstride[n];
|
||||
sptr += sstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
|
@ -0,0 +1,176 @@
|
|||
/* Helper function for cshift functions.
|
||||
Copyright 2008 Free Software Foundation, Inc.
|
||||
Contributed by Thomas Koenig <tkoenig@gcc.gnu.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_16)
|
||||
|
||||
void
|
||||
cshift0_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array, ssize_t shift,
|
||||
int which)
|
||||
{
|
||||
/* r.* indicates the return array. */
|
||||
index_type rstride[GFC_MAX_DIMENSIONS];
|
||||
index_type rstride0;
|
||||
index_type roffset;
|
||||
GFC_INTEGER_16 *rptr;
|
||||
|
||||
/* s.* indicates the source array. */
|
||||
index_type sstride[GFC_MAX_DIMENSIONS];
|
||||
index_type sstride0;
|
||||
index_type soffset;
|
||||
const GFC_INTEGER_16 *sptr;
|
||||
|
||||
index_type count[GFC_MAX_DIMENSIONS];
|
||||
index_type extent[GFC_MAX_DIMENSIONS];
|
||||
index_type dim;
|
||||
index_type len;
|
||||
index_type n;
|
||||
|
||||
which = which - 1;
|
||||
sstride[0] = 0;
|
||||
rstride[0] = 0;
|
||||
|
||||
extent[0] = 1;
|
||||
count[0] = 0;
|
||||
n = 0;
|
||||
/* Initialized for avoiding compiler warnings. */
|
||||
roffset = 1;
|
||||
soffset = 1;
|
||||
len = 0;
|
||||
|
||||
for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
|
||||
{
|
||||
if (dim == which)
|
||||
{
|
||||
roffset = ret->dim[dim].stride;
|
||||
if (roffset == 0)
|
||||
roffset = 1;
|
||||
soffset = array->dim[dim].stride;
|
||||
if (soffset == 0)
|
||||
soffset = 1;
|
||||
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n] = 0;
|
||||
extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
rstride[n] = ret->dim[dim].stride;
|
||||
sstride[n] = array->dim[dim].stride;
|
||||
n++;
|
||||
}
|
||||
}
|
||||
if (sstride[0] == 0)
|
||||
sstride[0] = 1;
|
||||
if (rstride[0] == 0)
|
||||
rstride[0] = 1;
|
||||
|
||||
dim = GFC_DESCRIPTOR_RANK (array);
|
||||
rstride0 = rstride[0];
|
||||
sstride0 = sstride[0];
|
||||
rptr = ret->data;
|
||||
sptr = array->data;
|
||||
|
||||
shift = len == 0 ? 0 : shift % (ssize_t)len;
|
||||
if (shift < 0)
|
||||
shift += len;
|
||||
|
||||
while (rptr)
|
||||
{
|
||||
/* Do the shift for this dimension. */
|
||||
|
||||
/* If elements are contiguous, perform the operation
|
||||
in two block moves. */
|
||||
if (soffset == 1 && roffset == 1)
|
||||
{
|
||||
size_t len1 = shift * sizeof (GFC_INTEGER_16);
|
||||
size_t len2 = (len - shift) * sizeof (GFC_INTEGER_16);
|
||||
memcpy (rptr, sptr + shift, len2);
|
||||
memcpy (rptr + (len - shift), sptr, len1);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Otherwise, we will have to perform the copy one element at
|
||||
a time. */
|
||||
GFC_INTEGER_16 *dest = rptr;
|
||||
const GFC_INTEGER_16 *src = &sptr[shift * soffset];
|
||||
|
||||
for (n = 0; n < len - shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
for (src = sptr, n = 0; n < shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
}
|
||||
|
||||
/* Advance to the next section. */
|
||||
rptr += rstride0;
|
||||
sptr += sstride0;
|
||||
count[0]++;
|
||||
n = 0;
|
||||
while (count[n] == extent[n])
|
||||
{
|
||||
/* When we get to the end of a dimension, reset it and increment
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
rptr -= rstride[n] * extent[n];
|
||||
sptr -= sstride[n] * extent[n];
|
||||
n++;
|
||||
if (n >= dim - 1)
|
||||
{
|
||||
/* Break out of the loop. */
|
||||
rptr = NULL;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
rptr += rstride[n];
|
||||
sptr += sstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
|
@ -0,0 +1,176 @@
|
|||
/* Helper function for cshift functions.
|
||||
Copyright 2008 Free Software Foundation, Inc.
|
||||
Contributed by Thomas Koenig <tkoenig@gcc.gnu.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
|
||||
cshift0_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array, ssize_t shift,
|
||||
int which)
|
||||
{
|
||||
/* r.* indicates the return array. */
|
||||
index_type rstride[GFC_MAX_DIMENSIONS];
|
||||
index_type rstride0;
|
||||
index_type roffset;
|
||||
GFC_INTEGER_2 *rptr;
|
||||
|
||||
/* s.* indicates the source array. */
|
||||
index_type sstride[GFC_MAX_DIMENSIONS];
|
||||
index_type sstride0;
|
||||
index_type soffset;
|
||||
const GFC_INTEGER_2 *sptr;
|
||||
|
||||
index_type count[GFC_MAX_DIMENSIONS];
|
||||
index_type extent[GFC_MAX_DIMENSIONS];
|
||||
index_type dim;
|
||||
index_type len;
|
||||
index_type n;
|
||||
|
||||
which = which - 1;
|
||||
sstride[0] = 0;
|
||||
rstride[0] = 0;
|
||||
|
||||
extent[0] = 1;
|
||||
count[0] = 0;
|
||||
n = 0;
|
||||
/* Initialized for avoiding compiler warnings. */
|
||||
roffset = 1;
|
||||
soffset = 1;
|
||||
len = 0;
|
||||
|
||||
for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
|
||||
{
|
||||
if (dim == which)
|
||||
{
|
||||
roffset = ret->dim[dim].stride;
|
||||
if (roffset == 0)
|
||||
roffset = 1;
|
||||
soffset = array->dim[dim].stride;
|
||||
if (soffset == 0)
|
||||
soffset = 1;
|
||||
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n] = 0;
|
||||
extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
rstride[n] = ret->dim[dim].stride;
|
||||
sstride[n] = array->dim[dim].stride;
|
||||
n++;
|
||||
}
|
||||
}
|
||||
if (sstride[0] == 0)
|
||||
sstride[0] = 1;
|
||||
if (rstride[0] == 0)
|
||||
rstride[0] = 1;
|
||||
|
||||
dim = GFC_DESCRIPTOR_RANK (array);
|
||||
rstride0 = rstride[0];
|
||||
sstride0 = sstride[0];
|
||||
rptr = ret->data;
|
||||
sptr = array->data;
|
||||
|
||||
shift = len == 0 ? 0 : shift % (ssize_t)len;
|
||||
if (shift < 0)
|
||||
shift += len;
|
||||
|
||||
while (rptr)
|
||||
{
|
||||
/* Do the shift for this dimension. */
|
||||
|
||||
/* If elements are contiguous, perform the operation
|
||||
in two block moves. */
|
||||
if (soffset == 1 && roffset == 1)
|
||||
{
|
||||
size_t len1 = shift * sizeof (GFC_INTEGER_2);
|
||||
size_t len2 = (len - shift) * sizeof (GFC_INTEGER_2);
|
||||
memcpy (rptr, sptr + shift, len2);
|
||||
memcpy (rptr + (len - shift), sptr, len1);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Otherwise, we will have to perform the copy one element at
|
||||
a time. */
|
||||
GFC_INTEGER_2 *dest = rptr;
|
||||
const GFC_INTEGER_2 *src = &sptr[shift * soffset];
|
||||
|
||||
for (n = 0; n < len - shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
for (src = sptr, n = 0; n < shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
}
|
||||
|
||||
/* Advance to the next section. */
|
||||
rptr += rstride0;
|
||||
sptr += sstride0;
|
||||
count[0]++;
|
||||
n = 0;
|
||||
while (count[n] == extent[n])
|
||||
{
|
||||
/* When we get to the end of a dimension, reset it and increment
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
rptr -= rstride[n] * extent[n];
|
||||
sptr -= sstride[n] * extent[n];
|
||||
n++;
|
||||
if (n >= dim - 1)
|
||||
{
|
||||
/* Break out of the loop. */
|
||||
rptr = NULL;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
rptr += rstride[n];
|
||||
sptr += sstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
|
@ -0,0 +1,176 @@
|
|||
/* Helper function for cshift functions.
|
||||
Copyright 2008 Free Software Foundation, Inc.
|
||||
Contributed by Thomas Koenig <tkoenig@gcc.gnu.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_4)
|
||||
|
||||
void
|
||||
cshift0_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array, ssize_t shift,
|
||||
int which)
|
||||
{
|
||||
/* r.* indicates the return array. */
|
||||
index_type rstride[GFC_MAX_DIMENSIONS];
|
||||
index_type rstride0;
|
||||
index_type roffset;
|
||||
GFC_INTEGER_4 *rptr;
|
||||
|
||||
/* s.* indicates the source array. */
|
||||
index_type sstride[GFC_MAX_DIMENSIONS];
|
||||
index_type sstride0;
|
||||
index_type soffset;
|
||||
const GFC_INTEGER_4 *sptr;
|
||||
|
||||
index_type count[GFC_MAX_DIMENSIONS];
|
||||
index_type extent[GFC_MAX_DIMENSIONS];
|
||||
index_type dim;
|
||||
index_type len;
|
||||
index_type n;
|
||||
|
||||
which = which - 1;
|
||||
sstride[0] = 0;
|
||||
rstride[0] = 0;
|
||||
|
||||
extent[0] = 1;
|
||||
count[0] = 0;
|
||||
n = 0;
|
||||
/* Initialized for avoiding compiler warnings. */
|
||||
roffset = 1;
|
||||
soffset = 1;
|
||||
len = 0;
|
||||
|
||||
for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
|
||||
{
|
||||
if (dim == which)
|
||||
{
|
||||
roffset = ret->dim[dim].stride;
|
||||
if (roffset == 0)
|
||||
roffset = 1;
|
||||
soffset = array->dim[dim].stride;
|
||||
if (soffset == 0)
|
||||
soffset = 1;
|
||||
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n] = 0;
|
||||
extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
rstride[n] = ret->dim[dim].stride;
|
||||
sstride[n] = array->dim[dim].stride;
|
||||
n++;
|
||||
}
|
||||
}
|
||||
if (sstride[0] == 0)
|
||||
sstride[0] = 1;
|
||||
if (rstride[0] == 0)
|
||||
rstride[0] = 1;
|
||||
|
||||
dim = GFC_DESCRIPTOR_RANK (array);
|
||||
rstride0 = rstride[0];
|
||||
sstride0 = sstride[0];
|
||||
rptr = ret->data;
|
||||
sptr = array->data;
|
||||
|
||||
shift = len == 0 ? 0 : shift % (ssize_t)len;
|
||||
if (shift < 0)
|
||||
shift += len;
|
||||
|
||||
while (rptr)
|
||||
{
|
||||
/* Do the shift for this dimension. */
|
||||
|
||||
/* If elements are contiguous, perform the operation
|
||||
in two block moves. */
|
||||
if (soffset == 1 && roffset == 1)
|
||||
{
|
||||
size_t len1 = shift * sizeof (GFC_INTEGER_4);
|
||||
size_t len2 = (len - shift) * sizeof (GFC_INTEGER_4);
|
||||
memcpy (rptr, sptr + shift, len2);
|
||||
memcpy (rptr + (len - shift), sptr, len1);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Otherwise, we will have to perform the copy one element at
|
||||
a time. */
|
||||
GFC_INTEGER_4 *dest = rptr;
|
||||
const GFC_INTEGER_4 *src = &sptr[shift * soffset];
|
||||
|
||||
for (n = 0; n < len - shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
for (src = sptr, n = 0; n < shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
}
|
||||
|
||||
/* Advance to the next section. */
|
||||
rptr += rstride0;
|
||||
sptr += sstride0;
|
||||
count[0]++;
|
||||
n = 0;
|
||||
while (count[n] == extent[n])
|
||||
{
|
||||
/* When we get to the end of a dimension, reset it and increment
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
rptr -= rstride[n] * extent[n];
|
||||
sptr -= sstride[n] * extent[n];
|
||||
n++;
|
||||
if (n >= dim - 1)
|
||||
{
|
||||
/* Break out of the loop. */
|
||||
rptr = NULL;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
rptr += rstride[n];
|
||||
sptr += sstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
|
@ -0,0 +1,176 @@
|
|||
/* Helper function for cshift functions.
|
||||
Copyright 2008 Free Software Foundation, Inc.
|
||||
Contributed by Thomas Koenig <tkoenig@gcc.gnu.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_8)
|
||||
|
||||
void
|
||||
cshift0_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array, ssize_t shift,
|
||||
int which)
|
||||
{
|
||||
/* r.* indicates the return array. */
|
||||
index_type rstride[GFC_MAX_DIMENSIONS];
|
||||
index_type rstride0;
|
||||
index_type roffset;
|
||||
GFC_INTEGER_8 *rptr;
|
||||
|
||||
/* s.* indicates the source array. */
|
||||
index_type sstride[GFC_MAX_DIMENSIONS];
|
||||
index_type sstride0;
|
||||
index_type soffset;
|
||||
const GFC_INTEGER_8 *sptr;
|
||||
|
||||
index_type count[GFC_MAX_DIMENSIONS];
|
||||
index_type extent[GFC_MAX_DIMENSIONS];
|
||||
index_type dim;
|
||||
index_type len;
|
||||
index_type n;
|
||||
|
||||
which = which - 1;
|
||||
sstride[0] = 0;
|
||||
rstride[0] = 0;
|
||||
|
||||
extent[0] = 1;
|
||||
count[0] = 0;
|
||||
n = 0;
|
||||
/* Initialized for avoiding compiler warnings. */
|
||||
roffset = 1;
|
||||
soffset = 1;
|
||||
len = 0;
|
||||
|
||||
for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
|
||||
{
|
||||
if (dim == which)
|
||||
{
|
||||
roffset = ret->dim[dim].stride;
|
||||
if (roffset == 0)
|
||||
roffset = 1;
|
||||
soffset = array->dim[dim].stride;
|
||||
if (soffset == 0)
|
||||
soffset = 1;
|
||||
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n] = 0;
|
||||
extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
rstride[n] = ret->dim[dim].stride;
|
||||
sstride[n] = array->dim[dim].stride;
|
||||
n++;
|
||||
}
|
||||
}
|
||||
if (sstride[0] == 0)
|
||||
sstride[0] = 1;
|
||||
if (rstride[0] == 0)
|
||||
rstride[0] = 1;
|
||||
|
||||
dim = GFC_DESCRIPTOR_RANK (array);
|
||||
rstride0 = rstride[0];
|
||||
sstride0 = sstride[0];
|
||||
rptr = ret->data;
|
||||
sptr = array->data;
|
||||
|
||||
shift = len == 0 ? 0 : shift % (ssize_t)len;
|
||||
if (shift < 0)
|
||||
shift += len;
|
||||
|
||||
while (rptr)
|
||||
{
|
||||
/* Do the shift for this dimension. */
|
||||
|
||||
/* If elements are contiguous, perform the operation
|
||||
in two block moves. */
|
||||
if (soffset == 1 && roffset == 1)
|
||||
{
|
||||
size_t len1 = shift * sizeof (GFC_INTEGER_8);
|
||||
size_t len2 = (len - shift) * sizeof (GFC_INTEGER_8);
|
||||
memcpy (rptr, sptr + shift, len2);
|
||||
memcpy (rptr + (len - shift), sptr, len1);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Otherwise, we will have to perform the copy one element at
|
||||
a time. */
|
||||
GFC_INTEGER_8 *dest = rptr;
|
||||
const GFC_INTEGER_8 *src = &sptr[shift * soffset];
|
||||
|
||||
for (n = 0; n < len - shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
for (src = sptr, n = 0; n < shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
}
|
||||
|
||||
/* Advance to the next section. */
|
||||
rptr += rstride0;
|
||||
sptr += sstride0;
|
||||
count[0]++;
|
||||
n = 0;
|
||||
while (count[n] == extent[n])
|
||||
{
|
||||
/* When we get to the end of a dimension, reset it and increment
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
rptr -= rstride[n] * extent[n];
|
||||
sptr -= sstride[n] * extent[n];
|
||||
n++;
|
||||
if (n >= dim - 1)
|
||||
{
|
||||
/* Break out of the loop. */
|
||||
rptr = NULL;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
rptr += rstride[n];
|
||||
sptr += sstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
|
@ -0,0 +1,176 @@
|
|||
/* Helper function for cshift functions.
|
||||
Copyright 2008 Free Software Foundation, Inc.
|
||||
Contributed by Thomas Koenig <tkoenig@gcc.gnu.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
|
||||
cshift0_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array, ssize_t shift,
|
||||
int which)
|
||||
{
|
||||
/* r.* indicates the return array. */
|
||||
index_type rstride[GFC_MAX_DIMENSIONS];
|
||||
index_type rstride0;
|
||||
index_type roffset;
|
||||
GFC_REAL_10 *rptr;
|
||||
|
||||
/* s.* indicates the source array. */
|
||||
index_type sstride[GFC_MAX_DIMENSIONS];
|
||||
index_type sstride0;
|
||||
index_type soffset;
|
||||
const GFC_REAL_10 *sptr;
|
||||
|
||||
index_type count[GFC_MAX_DIMENSIONS];
|
||||
index_type extent[GFC_MAX_DIMENSIONS];
|
||||
index_type dim;
|
||||
index_type len;
|
||||
index_type n;
|
||||
|
||||
which = which - 1;
|
||||
sstride[0] = 0;
|
||||
rstride[0] = 0;
|
||||
|
||||
extent[0] = 1;
|
||||
count[0] = 0;
|
||||
n = 0;
|
||||
/* Initialized for avoiding compiler warnings. */
|
||||
roffset = 1;
|
||||
soffset = 1;
|
||||
len = 0;
|
||||
|
||||
for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
|
||||
{
|
||||
if (dim == which)
|
||||
{
|
||||
roffset = ret->dim[dim].stride;
|
||||
if (roffset == 0)
|
||||
roffset = 1;
|
||||
soffset = array->dim[dim].stride;
|
||||
if (soffset == 0)
|
||||
soffset = 1;
|
||||
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n] = 0;
|
||||
extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
rstride[n] = ret->dim[dim].stride;
|
||||
sstride[n] = array->dim[dim].stride;
|
||||
n++;
|
||||
}
|
||||
}
|
||||
if (sstride[0] == 0)
|
||||
sstride[0] = 1;
|
||||
if (rstride[0] == 0)
|
||||
rstride[0] = 1;
|
||||
|
||||
dim = GFC_DESCRIPTOR_RANK (array);
|
||||
rstride0 = rstride[0];
|
||||
sstride0 = sstride[0];
|
||||
rptr = ret->data;
|
||||
sptr = array->data;
|
||||
|
||||
shift = len == 0 ? 0 : shift % (ssize_t)len;
|
||||
if (shift < 0)
|
||||
shift += len;
|
||||
|
||||
while (rptr)
|
||||
{
|
||||
/* Do the shift for this dimension. */
|
||||
|
||||
/* If elements are contiguous, perform the operation
|
||||
in two block moves. */
|
||||
if (soffset == 1 && roffset == 1)
|
||||
{
|
||||
size_t len1 = shift * sizeof (GFC_REAL_10);
|
||||
size_t len2 = (len - shift) * sizeof (GFC_REAL_10);
|
||||
memcpy (rptr, sptr + shift, len2);
|
||||
memcpy (rptr + (len - shift), sptr, len1);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Otherwise, we will have to perform the copy one element at
|
||||
a time. */
|
||||
GFC_REAL_10 *dest = rptr;
|
||||
const GFC_REAL_10 *src = &sptr[shift * soffset];
|
||||
|
||||
for (n = 0; n < len - shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
for (src = sptr, n = 0; n < shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
}
|
||||
|
||||
/* Advance to the next section. */
|
||||
rptr += rstride0;
|
||||
sptr += sstride0;
|
||||
count[0]++;
|
||||
n = 0;
|
||||
while (count[n] == extent[n])
|
||||
{
|
||||
/* When we get to the end of a dimension, reset it and increment
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
rptr -= rstride[n] * extent[n];
|
||||
sptr -= sstride[n] * extent[n];
|
||||
n++;
|
||||
if (n >= dim - 1)
|
||||
{
|
||||
/* Break out of the loop. */
|
||||
rptr = NULL;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
rptr += rstride[n];
|
||||
sptr += sstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
|
@ -0,0 +1,176 @@
|
|||
/* Helper function for cshift functions.
|
||||
Copyright 2008 Free Software Foundation, Inc.
|
||||
Contributed by Thomas Koenig <tkoenig@gcc.gnu.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
|
||||
cshift0_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array, ssize_t shift,
|
||||
int which)
|
||||
{
|
||||
/* r.* indicates the return array. */
|
||||
index_type rstride[GFC_MAX_DIMENSIONS];
|
||||
index_type rstride0;
|
||||
index_type roffset;
|
||||
GFC_REAL_16 *rptr;
|
||||
|
||||
/* s.* indicates the source array. */
|
||||
index_type sstride[GFC_MAX_DIMENSIONS];
|
||||
index_type sstride0;
|
||||
index_type soffset;
|
||||
const GFC_REAL_16 *sptr;
|
||||
|
||||
index_type count[GFC_MAX_DIMENSIONS];
|
||||
index_type extent[GFC_MAX_DIMENSIONS];
|
||||
index_type dim;
|
||||
index_type len;
|
||||
index_type n;
|
||||
|
||||
which = which - 1;
|
||||
sstride[0] = 0;
|
||||
rstride[0] = 0;
|
||||
|
||||
extent[0] = 1;
|
||||
count[0] = 0;
|
||||
n = 0;
|
||||
/* Initialized for avoiding compiler warnings. */
|
||||
roffset = 1;
|
||||
soffset = 1;
|
||||
len = 0;
|
||||
|
||||
for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
|
||||
{
|
||||
if (dim == which)
|
||||
{
|
||||
roffset = ret->dim[dim].stride;
|
||||
if (roffset == 0)
|
||||
roffset = 1;
|
||||
soffset = array->dim[dim].stride;
|
||||
if (soffset == 0)
|
||||
soffset = 1;
|
||||
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n] = 0;
|
||||
extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
rstride[n] = ret->dim[dim].stride;
|
||||
sstride[n] = array->dim[dim].stride;
|
||||
n++;
|
||||
}
|
||||
}
|
||||
if (sstride[0] == 0)
|
||||
sstride[0] = 1;
|
||||
if (rstride[0] == 0)
|
||||
rstride[0] = 1;
|
||||
|
||||
dim = GFC_DESCRIPTOR_RANK (array);
|
||||
rstride0 = rstride[0];
|
||||
sstride0 = sstride[0];
|
||||
rptr = ret->data;
|
||||
sptr = array->data;
|
||||
|
||||
shift = len == 0 ? 0 : shift % (ssize_t)len;
|
||||
if (shift < 0)
|
||||
shift += len;
|
||||
|
||||
while (rptr)
|
||||
{
|
||||
/* Do the shift for this dimension. */
|
||||
|
||||
/* If elements are contiguous, perform the operation
|
||||
in two block moves. */
|
||||
if (soffset == 1 && roffset == 1)
|
||||
{
|
||||
size_t len1 = shift * sizeof (GFC_REAL_16);
|
||||
size_t len2 = (len - shift) * sizeof (GFC_REAL_16);
|
||||
memcpy (rptr, sptr + shift, len2);
|
||||
memcpy (rptr + (len - shift), sptr, len1);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Otherwise, we will have to perform the copy one element at
|
||||
a time. */
|
||||
GFC_REAL_16 *dest = rptr;
|
||||
const GFC_REAL_16 *src = &sptr[shift * soffset];
|
||||
|
||||
for (n = 0; n < len - shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
for (src = sptr, n = 0; n < shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
}
|
||||
|
||||
/* Advance to the next section. */
|
||||
rptr += rstride0;
|
||||
sptr += sstride0;
|
||||
count[0]++;
|
||||
n = 0;
|
||||
while (count[n] == extent[n])
|
||||
{
|
||||
/* When we get to the end of a dimension, reset it and increment
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
rptr -= rstride[n] * extent[n];
|
||||
sptr -= sstride[n] * extent[n];
|
||||
n++;
|
||||
if (n >= dim - 1)
|
||||
{
|
||||
/* Break out of the loop. */
|
||||
rptr = NULL;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
rptr += rstride[n];
|
||||
sptr += sstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
|
@ -0,0 +1,176 @@
|
|||
/* Helper function for cshift functions.
|
||||
Copyright 2008 Free Software Foundation, Inc.
|
||||
Contributed by Thomas Koenig <tkoenig@gcc.gnu.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
|
||||
cshift0_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array, ssize_t shift,
|
||||
int which)
|
||||
{
|
||||
/* r.* indicates the return array. */
|
||||
index_type rstride[GFC_MAX_DIMENSIONS];
|
||||
index_type rstride0;
|
||||
index_type roffset;
|
||||
GFC_REAL_4 *rptr;
|
||||
|
||||
/* s.* indicates the source array. */
|
||||
index_type sstride[GFC_MAX_DIMENSIONS];
|
||||
index_type sstride0;
|
||||
index_type soffset;
|
||||
const GFC_REAL_4 *sptr;
|
||||
|
||||
index_type count[GFC_MAX_DIMENSIONS];
|
||||
index_type extent[GFC_MAX_DIMENSIONS];
|
||||
index_type dim;
|
||||
index_type len;
|
||||
index_type n;
|
||||
|
||||
which = which - 1;
|
||||
sstride[0] = 0;
|
||||
rstride[0] = 0;
|
||||
|
||||
extent[0] = 1;
|
||||
count[0] = 0;
|
||||
n = 0;
|
||||
/* Initialized for avoiding compiler warnings. */
|
||||
roffset = 1;
|
||||
soffset = 1;
|
||||
len = 0;
|
||||
|
||||
for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
|
||||
{
|
||||
if (dim == which)
|
||||
{
|
||||
roffset = ret->dim[dim].stride;
|
||||
if (roffset == 0)
|
||||
roffset = 1;
|
||||
soffset = array->dim[dim].stride;
|
||||
if (soffset == 0)
|
||||
soffset = 1;
|
||||
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n] = 0;
|
||||
extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
rstride[n] = ret->dim[dim].stride;
|
||||
sstride[n] = array->dim[dim].stride;
|
||||
n++;
|
||||
}
|
||||
}
|
||||
if (sstride[0] == 0)
|
||||
sstride[0] = 1;
|
||||
if (rstride[0] == 0)
|
||||
rstride[0] = 1;
|
||||
|
||||
dim = GFC_DESCRIPTOR_RANK (array);
|
||||
rstride0 = rstride[0];
|
||||
sstride0 = sstride[0];
|
||||
rptr = ret->data;
|
||||
sptr = array->data;
|
||||
|
||||
shift = len == 0 ? 0 : shift % (ssize_t)len;
|
||||
if (shift < 0)
|
||||
shift += len;
|
||||
|
||||
while (rptr)
|
||||
{
|
||||
/* Do the shift for this dimension. */
|
||||
|
||||
/* If elements are contiguous, perform the operation
|
||||
in two block moves. */
|
||||
if (soffset == 1 && roffset == 1)
|
||||
{
|
||||
size_t len1 = shift * sizeof (GFC_REAL_4);
|
||||
size_t len2 = (len - shift) * sizeof (GFC_REAL_4);
|
||||
memcpy (rptr, sptr + shift, len2);
|
||||
memcpy (rptr + (len - shift), sptr, len1);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Otherwise, we will have to perform the copy one element at
|
||||
a time. */
|
||||
GFC_REAL_4 *dest = rptr;
|
||||
const GFC_REAL_4 *src = &sptr[shift * soffset];
|
||||
|
||||
for (n = 0; n < len - shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
for (src = sptr, n = 0; n < shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
}
|
||||
|
||||
/* Advance to the next section. */
|
||||
rptr += rstride0;
|
||||
sptr += sstride0;
|
||||
count[0]++;
|
||||
n = 0;
|
||||
while (count[n] == extent[n])
|
||||
{
|
||||
/* When we get to the end of a dimension, reset it and increment
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
rptr -= rstride[n] * extent[n];
|
||||
sptr -= sstride[n] * extent[n];
|
||||
n++;
|
||||
if (n >= dim - 1)
|
||||
{
|
||||
/* Break out of the loop. */
|
||||
rptr = NULL;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
rptr += rstride[n];
|
||||
sptr += sstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
|
@ -0,0 +1,176 @@
|
|||
/* Helper function for cshift functions.
|
||||
Copyright 2008 Free Software Foundation, Inc.
|
||||
Contributed by Thomas Koenig <tkoenig@gcc.gnu.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
|
||||
cshift0_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array, ssize_t shift,
|
||||
int which)
|
||||
{
|
||||
/* r.* indicates the return array. */
|
||||
index_type rstride[GFC_MAX_DIMENSIONS];
|
||||
index_type rstride0;
|
||||
index_type roffset;
|
||||
GFC_REAL_8 *rptr;
|
||||
|
||||
/* s.* indicates the source array. */
|
||||
index_type sstride[GFC_MAX_DIMENSIONS];
|
||||
index_type sstride0;
|
||||
index_type soffset;
|
||||
const GFC_REAL_8 *sptr;
|
||||
|
||||
index_type count[GFC_MAX_DIMENSIONS];
|
||||
index_type extent[GFC_MAX_DIMENSIONS];
|
||||
index_type dim;
|
||||
index_type len;
|
||||
index_type n;
|
||||
|
||||
which = which - 1;
|
||||
sstride[0] = 0;
|
||||
rstride[0] = 0;
|
||||
|
||||
extent[0] = 1;
|
||||
count[0] = 0;
|
||||
n = 0;
|
||||
/* Initialized for avoiding compiler warnings. */
|
||||
roffset = 1;
|
||||
soffset = 1;
|
||||
len = 0;
|
||||
|
||||
for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
|
||||
{
|
||||
if (dim == which)
|
||||
{
|
||||
roffset = ret->dim[dim].stride;
|
||||
if (roffset == 0)
|
||||
roffset = 1;
|
||||
soffset = array->dim[dim].stride;
|
||||
if (soffset == 0)
|
||||
soffset = 1;
|
||||
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n] = 0;
|
||||
extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
rstride[n] = ret->dim[dim].stride;
|
||||
sstride[n] = array->dim[dim].stride;
|
||||
n++;
|
||||
}
|
||||
}
|
||||
if (sstride[0] == 0)
|
||||
sstride[0] = 1;
|
||||
if (rstride[0] == 0)
|
||||
rstride[0] = 1;
|
||||
|
||||
dim = GFC_DESCRIPTOR_RANK (array);
|
||||
rstride0 = rstride[0];
|
||||
sstride0 = sstride[0];
|
||||
rptr = ret->data;
|
||||
sptr = array->data;
|
||||
|
||||
shift = len == 0 ? 0 : shift % (ssize_t)len;
|
||||
if (shift < 0)
|
||||
shift += len;
|
||||
|
||||
while (rptr)
|
||||
{
|
||||
/* Do the shift for this dimension. */
|
||||
|
||||
/* If elements are contiguous, perform the operation
|
||||
in two block moves. */
|
||||
if (soffset == 1 && roffset == 1)
|
||||
{
|
||||
size_t len1 = shift * sizeof (GFC_REAL_8);
|
||||
size_t len2 = (len - shift) * sizeof (GFC_REAL_8);
|
||||
memcpy (rptr, sptr + shift, len2);
|
||||
memcpy (rptr + (len - shift), sptr, len1);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Otherwise, we will have to perform the copy one element at
|
||||
a time. */
|
||||
GFC_REAL_8 *dest = rptr;
|
||||
const GFC_REAL_8 *src = &sptr[shift * soffset];
|
||||
|
||||
for (n = 0; n < len - shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
for (src = sptr, n = 0; n < shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
}
|
||||
|
||||
/* Advance to the next section. */
|
||||
rptr += rstride0;
|
||||
sptr += sstride0;
|
||||
count[0]++;
|
||||
n = 0;
|
||||
while (count[n] == extent[n])
|
||||
{
|
||||
/* When we get to the end of a dimension, reset it and increment
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
rptr -= rstride[n] * extent[n];
|
||||
sptr -= sstride[n] * extent[n];
|
||||
n++;
|
||||
if (n >= dim - 1)
|
||||
{
|
||||
/* Break out of the loop. */
|
||||
rptr = NULL;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
rptr += rstride[n];
|
||||
sptr += sstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
|
@ -33,48 +33,6 @@ Boston, MA 02110-1301, USA. */
|
|||
#include <assert.h>
|
||||
#include <string.h>
|
||||
|
||||
|
||||
/* "Templatized" helper function for the inner shift loop. */
|
||||
|
||||
#define DEF_COPY_LOOP(NAME, TYPE) \
|
||||
static inline void \
|
||||
copy_loop_##NAME (void *xdest, const void *xsrc, \
|
||||
size_t roff, size_t soff, \
|
||||
index_type len, index_type shift) \
|
||||
{ \
|
||||
TYPE *dest = xdest; \
|
||||
const TYPE *src; \
|
||||
index_type i; \
|
||||
\
|
||||
roff /= sizeof (TYPE); \
|
||||
soff /= sizeof (TYPE); \
|
||||
\
|
||||
src = xsrc; \
|
||||
src += shift * soff; \
|
||||
for (i = 0; i < len - shift; ++i) \
|
||||
{ \
|
||||
*dest = *src; \
|
||||
dest += roff; \
|
||||
src += soff; \
|
||||
} \
|
||||
\
|
||||
src = xsrc; \
|
||||
for (i = 0; i < shift; ++i) \
|
||||
{ \
|
||||
*dest = *src; \
|
||||
dest += roff; \
|
||||
src += soff; \
|
||||
} \
|
||||
}
|
||||
|
||||
DEF_COPY_LOOP(int, int)
|
||||
DEF_COPY_LOOP(long, long)
|
||||
DEF_COPY_LOOP(double, double)
|
||||
DEF_COPY_LOOP(ldouble, long double)
|
||||
DEF_COPY_LOOP(cfloat, _Complex float)
|
||||
DEF_COPY_LOOP(cdouble, _Complex double)
|
||||
|
||||
|
||||
static void
|
||||
cshift0 (gfc_array_char * ret, const gfc_array_char * array,
|
||||
ssize_t shift, int which, index_type size)
|
||||
|
|
@ -96,9 +54,10 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array,
|
|||
index_type dim;
|
||||
index_type len;
|
||||
index_type n;
|
||||
int whichloop;
|
||||
index_type arraysize;
|
||||
|
||||
index_type type_size;
|
||||
|
||||
if (which < 1 || which > GFC_DESCRIPTOR_RANK (array))
|
||||
runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'");
|
||||
|
||||
|
|
@ -133,6 +92,180 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array,
|
|||
|
||||
if (arraysize == 0)
|
||||
return;
|
||||
type_size = GFC_DTYPE_TYPE_SIZE (array);
|
||||
|
||||
switch(type_size)
|
||||
{
|
||||
case GFC_DTYPE_LOGICAL_1:
|
||||
case GFC_DTYPE_INTEGER_1:
|
||||
case GFC_DTYPE_DERIVED_1:
|
||||
cshift0_i1 ((gfc_array_i1 *)ret, (gfc_array_i1 *) array, shift, which);
|
||||
return;
|
||||
|
||||
case GFC_DTYPE_LOGICAL_2:
|
||||
case GFC_DTYPE_INTEGER_2:
|
||||
cshift0_i2 ((gfc_array_i2 *)ret, (gfc_array_i2 *) array, shift, which);
|
||||
return;
|
||||
|
||||
case GFC_DTYPE_LOGICAL_4:
|
||||
case GFC_DTYPE_INTEGER_4:
|
||||
cshift0_i4 ((gfc_array_i4 *)ret, (gfc_array_i4 *) array, shift, which);
|
||||
return;
|
||||
|
||||
case GFC_DTYPE_LOGICAL_8:
|
||||
case GFC_DTYPE_INTEGER_8:
|
||||
cshift0_i8 ((gfc_array_i8 *)ret, (gfc_array_i8 *) array, shift, which);
|
||||
return;
|
||||
|
||||
#ifdef HAVE_GFC_INTEGER_16
|
||||
case GFC_DTYPE_LOGICAL_16:
|
||||
case GFC_DTYPE_INTEGER_16:
|
||||
cshift0_i16 ((gfc_array_i8 *)ret, (gfc_array_i16 *) array, shift,
|
||||
which);
|
||||
return;
|
||||
#endif
|
||||
|
||||
case GFC_DTYPE_REAL_4:
|
||||
cshift0_r4 ((gfc_array_r4 *)ret, (gfc_array_r4 *) array, shift, which);
|
||||
return;
|
||||
|
||||
case GFC_DTYPE_REAL_8:
|
||||
cshift0_r8 ((gfc_array_r8 *)ret, (gfc_array_r8 *) array, shift, which);
|
||||
return;
|
||||
|
||||
#ifdef HAVE_GFC_REAL_10
|
||||
case GFC_DTYPE_REAL_10:
|
||||
cshift0_r10 ((gfc_array_r10 *)ret, (gfc_array_r10 *) array, shift,
|
||||
which);
|
||||
return;
|
||||
#endif
|
||||
|
||||
#ifdef HAVE_GFC_REAL_16
|
||||
case GFC_DTYPE_REAL_16:
|
||||
cshift0_r16 ((gfc_array_r16 *)ret, (gfc_array_r16 *) array, shift,
|
||||
which);
|
||||
return;
|
||||
#endif
|
||||
|
||||
case GFC_DTYPE_COMPLEX_4:
|
||||
cshift0_c4 ((gfc_array_c4 *)ret, (gfc_array_c4 *) array, shift, which);
|
||||
return;
|
||||
|
||||
case GFC_DTYPE_COMPLEX_8:
|
||||
cshift0_c8 ((gfc_array_c8 *)ret, (gfc_array_c8 *) array, shift, which);
|
||||
return;
|
||||
|
||||
#ifdef HAVE_GFC_COMPLEX_10
|
||||
case GFC_DTYPE_COMPLEX_10:
|
||||
cshift0_c10 ((gfc_array_c10 *)ret, (gfc_array_c10 *) array, shift,
|
||||
which);
|
||||
return;
|
||||
#endif
|
||||
|
||||
#ifdef HAVE_GFC_COMPLEX_16
|
||||
case GFC_DTYPE_COMPLEX_16:
|
||||
cshift0_c16 ((gfc_array_c16 *)ret, (gfc_array_c16 *) array, shift,
|
||||
which);
|
||||
return;
|
||||
#endif
|
||||
|
||||
default:
|
||||
break;
|
||||
}
|
||||
|
||||
switch (size)
|
||||
{
|
||||
/* Let's check the actual alignment of the data pointers. If they
|
||||
are suitably aligned, we can safely call the unpack functions. */
|
||||
|
||||
case sizeof (GFC_INTEGER_1):
|
||||
cshift0_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) array, shift,
|
||||
which);
|
||||
break;
|
||||
|
||||
case sizeof (GFC_INTEGER_2):
|
||||
if (GFC_UNALIGNED_2(ret->data) || GFC_UNALIGNED_2(array->data))
|
||||
break;
|
||||
else
|
||||
{
|
||||
cshift0_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) array, shift,
|
||||
which);
|
||||
return;
|
||||
}
|
||||
|
||||
case sizeof (GFC_INTEGER_4):
|
||||
if (GFC_UNALIGNED_4(ret->data) || GFC_UNALIGNED_4(array->data))
|
||||
break;
|
||||
else
|
||||
{
|
||||
cshift0_i4 ((gfc_array_i4 *)ret, (gfc_array_i4 *) array, shift,
|
||||
which);
|
||||
return;
|
||||
}
|
||||
|
||||
case sizeof (GFC_INTEGER_8):
|
||||
if (GFC_UNALIGNED_8(ret->data) || GFC_UNALIGNED_8(array->data))
|
||||
{
|
||||
/* Let's try to use the complex routines. First, a sanity
|
||||
check that the sizes match; this should be optimized to
|
||||
a no-op. */
|
||||
if (sizeof(GFC_INTEGER_8) != sizeof(GFC_COMPLEX_4))
|
||||
break;
|
||||
|
||||
if (GFC_UNALIGNED_C4(ret->data) || GFC_UNALIGNED_C4(array->data))
|
||||
break;
|
||||
|
||||
cshift0_c4 ((gfc_array_c4 *) ret, (gfc_array_c4 *) array, shift,
|
||||
which);
|
||||
return;
|
||||
}
|
||||
else
|
||||
{
|
||||
cshift0_i8 ((gfc_array_i8 *)ret, (gfc_array_i8 *) array, shift,
|
||||
which);
|
||||
return;
|
||||
}
|
||||
|
||||
#ifdef HAVE_GFC_INTEGER_16
|
||||
case sizeof (GFC_INTEGER_16):
|
||||
if (GFC_UNALIGNED_16(ret->data) || GFC_UNALIGNED_16(array->data))
|
||||
{
|
||||
/* Let's try to use the complex routines. First, a sanity
|
||||
check that the sizes match; this should be optimized to
|
||||
a no-op. */
|
||||
if (sizeof(GFC_INTGER_16) != sizeof(GFC_COMPLEX_8))
|
||||
break;
|
||||
|
||||
if (GFC_UNALIGNED_C8(ret->data) || GFC_UNALIGNED_C8(array->data))
|
||||
break;
|
||||
|
||||
cshift0_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) array, shift,
|
||||
which);
|
||||
return;
|
||||
}
|
||||
else
|
||||
{
|
||||
cshift0_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) array,
|
||||
shift, which);
|
||||
return;
|
||||
}
|
||||
#else
|
||||
case sizeof (GFC_COMPLEX_8):
|
||||
|
||||
if (GFC_UNALIGNED_C8(ret->data) || GFC_UNALIGNED_C8(array->data))
|
||||
break;
|
||||
else
|
||||
{
|
||||
cshift0_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) array, shift,
|
||||
which);
|
||||
return;
|
||||
}
|
||||
#endif
|
||||
|
||||
default:
|
||||
break;
|
||||
}
|
||||
|
||||
|
||||
which = which - 1;
|
||||
sstride[0] = 0;
|
||||
|
|
@ -141,35 +274,6 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array,
|
|||
extent[0] = 1;
|
||||
count[0] = 0;
|
||||
n = 0;
|
||||
|
||||
/* The values assigned here must match the cases in the inner loop. */
|
||||
whichloop = 0;
|
||||
switch (GFC_DESCRIPTOR_TYPE (array))
|
||||
{
|
||||
case GFC_DTYPE_LOGICAL:
|
||||
case GFC_DTYPE_INTEGER:
|
||||
case GFC_DTYPE_REAL:
|
||||
if (size == sizeof (int))
|
||||
whichloop = 1;
|
||||
else if (size == sizeof (long))
|
||||
whichloop = 2;
|
||||
else if (size == sizeof (double))
|
||||
whichloop = 3;
|
||||
else if (size == sizeof (long double))
|
||||
whichloop = 4;
|
||||
break;
|
||||
|
||||
case GFC_DTYPE_COMPLEX:
|
||||
if (size == sizeof (_Complex float))
|
||||
whichloop = 5;
|
||||
else if (size == sizeof (_Complex double))
|
||||
whichloop = 6;
|
||||
break;
|
||||
|
||||
default:
|
||||
break;
|
||||
}
|
||||
|
||||
/* Initialized for avoiding compiler warnings. */
|
||||
roffset = size;
|
||||
soffset = size;
|
||||
|
|
@ -227,56 +331,21 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array,
|
|||
else
|
||||
{
|
||||
/* Otherwise, we'll have to perform the copy one element at
|
||||
a time. We can speed this up a tad for common cases of
|
||||
fundamental types. */
|
||||
switch (whichloop)
|
||||
a time. */
|
||||
char *dest = rptr;
|
||||
const char *src = &sptr[shift * soffset];
|
||||
|
||||
for (n = 0; n < len - shift; n++)
|
||||
{
|
||||
case 0:
|
||||
{
|
||||
char *dest = rptr;
|
||||
const char *src = &sptr[shift * soffset];
|
||||
|
||||
for (n = 0; n < len - shift; n++)
|
||||
{
|
||||
memcpy (dest, src, size);
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
for (src = sptr, n = 0; n < shift; n++)
|
||||
{
|
||||
memcpy (dest, src, size);
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
}
|
||||
break;
|
||||
|
||||
case 1:
|
||||
copy_loop_int (rptr, sptr, roffset, soffset, len, shift);
|
||||
break;
|
||||
|
||||
case 2:
|
||||
copy_loop_long (rptr, sptr, roffset, soffset, len, shift);
|
||||
break;
|
||||
|
||||
case 3:
|
||||
copy_loop_double (rptr, sptr, roffset, soffset, len, shift);
|
||||
break;
|
||||
|
||||
case 4:
|
||||
copy_loop_ldouble (rptr, sptr, roffset, soffset, len, shift);
|
||||
break;
|
||||
|
||||
case 5:
|
||||
copy_loop_cfloat (rptr, sptr, roffset, soffset, len, shift);
|
||||
break;
|
||||
|
||||
case 6:
|
||||
copy_loop_cdouble (rptr, sptr, roffset, soffset, len, shift);
|
||||
break;
|
||||
|
||||
default:
|
||||
abort ();
|
||||
memcpy (dest, src, size);
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
for (src = sptr, n = 0; n < shift; n++)
|
||||
{
|
||||
memcpy (dest, src, size);
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -437,6 +437,12 @@ typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_16) gfc_array_l16;
|
|||
(__alignof__(GFC_INTEGER_16) - 1))
|
||||
#endif
|
||||
|
||||
#define GFC_UNALIGNED_C4(x) (((uintptr_t)(x)) & \
|
||||
(__alignof__(GFC_COMPLEX_4) - 1))
|
||||
|
||||
#define GFC_UNALIGNED_C8(x) (((uintptr_t)(x)) & \
|
||||
(__alignof__(GFC_COMPLEX_8) - 1))
|
||||
|
||||
/* Runtime library include. */
|
||||
#define stringize(x) expand_macro(x)
|
||||
#define expand_macro(x) # x
|
||||
|
|
@ -1210,4 +1216,55 @@ typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, void) array_t;
|
|||
extern index_type size0 (const array_t * array);
|
||||
iexport_proto(size0);
|
||||
|
||||
/* Internal auxiliary functions for cshift */
|
||||
|
||||
void cshift0_i1 (gfc_array_i1 *, const gfc_array_i1 *, ssize_t, int);
|
||||
internal_proto(cshift0_i1);
|
||||
|
||||
void cshift0_i2 (gfc_array_i2 *, const gfc_array_i2 *, ssize_t, int);
|
||||
internal_proto(cshift0_i2);
|
||||
|
||||
void cshift0_i4 (gfc_array_i4 *, const gfc_array_i4 *, ssize_t, int);
|
||||
internal_proto(cshift0_i4);
|
||||
|
||||
void cshift0_i8 (gfc_array_i8 *, const gfc_array_i8 *, ssize_t, int);
|
||||
internal_proto(cshift0_i8);
|
||||
|
||||
#ifdef HAVE_GFC_INTEGER_16
|
||||
void cshift0_i16 (gfc_array_i16 *, const gfc_array_i16 *, ssize_t, int);
|
||||
internal_proto(cshift0_i16);
|
||||
#endif
|
||||
|
||||
void cshift0_r4 (gfc_array_r4 *, const gfc_array_r4 *, ssize_t, int);
|
||||
internal_proto(cshift0_r4);
|
||||
|
||||
void cshift0_r8 (gfc_array_r8 *, const gfc_array_r8 *, ssize_t, int);
|
||||
internal_proto(cshift0_r8);
|
||||
|
||||
#ifdef HAVE_GFC_REAL_10
|
||||
void cshift0_r10 (gfc_array_r10 *, const gfc_array_r10 *, ssize_t, int);
|
||||
internal_proto(cshift0_r10);
|
||||
#endif
|
||||
|
||||
#ifdef HAVE_GFC_REAL_16
|
||||
void cshift0_r16 (gfc_array_r16 *, const gfc_array_r16 *, ssize_t, int);
|
||||
internal_proto(cshift0_r16);
|
||||
#endif
|
||||
|
||||
void cshift0_c4 (gfc_array_c4 *, const gfc_array_c4 *, ssize_t, int);
|
||||
internal_proto(cshift0_c4);
|
||||
|
||||
void cshift0_c8 (gfc_array_c8 *, const gfc_array_c8 *, ssize_t, int);
|
||||
internal_proto(cshift0_c8);
|
||||
|
||||
#ifdef HAVE_GFC_COMPLEX_10
|
||||
void cshift0_c10 (gfc_array_c10 *, const gfc_array_c10 *, ssize_t, int);
|
||||
internal_proto(cshift0_c10);
|
||||
#endif
|
||||
|
||||
#ifdef HAVE_GFC_COMPLEX_16
|
||||
void cshift0_c16 (gfc_array_c16 *, const gfc_array_c16 *, ssize_t, int);
|
||||
internal_proto(cshift0_c16);
|
||||
#endif
|
||||
|
||||
#endif /* LIBGFOR_H */
|
||||
|
|
|
|||
|
|
@ -0,0 +1,177 @@
|
|||
`/* Helper function for cshift functions.
|
||||
Copyright 2008 Free Software Foundation, Inc.
|
||||
Contributed by Thomas Koenig <tkoenig@gcc.gnu.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>'
|
||||
|
||||
include(iparm.m4)dnl
|
||||
|
||||
`#if defined (HAVE_'rtype_name`)
|
||||
|
||||
void
|
||||
cshift0_'rtype_code` ('rtype` *ret, const 'rtype` *array, ssize_t shift,
|
||||
int which)
|
||||
{
|
||||
/* r.* indicates the return array. */
|
||||
index_type rstride[GFC_MAX_DIMENSIONS];
|
||||
index_type rstride0;
|
||||
index_type roffset;
|
||||
'rtype_name` *rptr;
|
||||
|
||||
/* s.* indicates the source array. */
|
||||
index_type sstride[GFC_MAX_DIMENSIONS];
|
||||
index_type sstride0;
|
||||
index_type soffset;
|
||||
const 'rtype_name` *sptr;
|
||||
|
||||
index_type count[GFC_MAX_DIMENSIONS];
|
||||
index_type extent[GFC_MAX_DIMENSIONS];
|
||||
index_type dim;
|
||||
index_type len;
|
||||
index_type n;
|
||||
|
||||
which = which - 1;
|
||||
sstride[0] = 0;
|
||||
rstride[0] = 0;
|
||||
|
||||
extent[0] = 1;
|
||||
count[0] = 0;
|
||||
n = 0;
|
||||
/* Initialized for avoiding compiler warnings. */
|
||||
roffset = 1;
|
||||
soffset = 1;
|
||||
len = 0;
|
||||
|
||||
for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
|
||||
{
|
||||
if (dim == which)
|
||||
{
|
||||
roffset = ret->dim[dim].stride;
|
||||
if (roffset == 0)
|
||||
roffset = 1;
|
||||
soffset = array->dim[dim].stride;
|
||||
if (soffset == 0)
|
||||
soffset = 1;
|
||||
len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n] = 0;
|
||||
extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
|
||||
rstride[n] = ret->dim[dim].stride;
|
||||
sstride[n] = array->dim[dim].stride;
|
||||
n++;
|
||||
}
|
||||
}
|
||||
if (sstride[0] == 0)
|
||||
sstride[0] = 1;
|
||||
if (rstride[0] == 0)
|
||||
rstride[0] = 1;
|
||||
|
||||
dim = GFC_DESCRIPTOR_RANK (array);
|
||||
rstride0 = rstride[0];
|
||||
sstride0 = sstride[0];
|
||||
rptr = ret->data;
|
||||
sptr = array->data;
|
||||
|
||||
shift = len == 0 ? 0 : shift % (ssize_t)len;
|
||||
if (shift < 0)
|
||||
shift += len;
|
||||
|
||||
while (rptr)
|
||||
{
|
||||
/* Do the shift for this dimension. */
|
||||
|
||||
/* If elements are contiguous, perform the operation
|
||||
in two block moves. */
|
||||
if (soffset == 1 && roffset == 1)
|
||||
{
|
||||
size_t len1 = shift * sizeof ('rtype_name`);
|
||||
size_t len2 = (len - shift) * sizeof ('rtype_name`);
|
||||
memcpy (rptr, sptr + shift, len2);
|
||||
memcpy (rptr + (len - shift), sptr, len1);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Otherwise, we will have to perform the copy one element at
|
||||
a time. */
|
||||
'rtype_name` *dest = rptr;
|
||||
const 'rtype_name` *src = &sptr[shift * soffset];
|
||||
|
||||
for (n = 0; n < len - shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
for (src = sptr, n = 0; n < shift; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += roffset;
|
||||
src += soffset;
|
||||
}
|
||||
}
|
||||
|
||||
/* Advance to the next section. */
|
||||
rptr += rstride0;
|
||||
sptr += sstride0;
|
||||
count[0]++;
|
||||
n = 0;
|
||||
while (count[n] == extent[n])
|
||||
{
|
||||
/* When we get to the end of a dimension, reset it and increment
|
||||
the next dimension. */
|
||||
count[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so probably not worth it. */
|
||||
rptr -= rstride[n] * extent[n];
|
||||
sptr -= sstride[n] * extent[n];
|
||||
n++;
|
||||
if (n >= dim - 1)
|
||||
{
|
||||
/* Break out of the loop. */
|
||||
rptr = NULL;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
rptr += rstride[n];
|
||||
sptr += sstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#endif'
|
||||
Loading…
Reference in New Issue