+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.
--- /dev/null
+! { 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
--- /dev/null
+! { 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
+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
$(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 \
$(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= \
$(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 > $@
$(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 \
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) \
$(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 \
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 \
_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 =
$(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 \
$(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
@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@
@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
@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 > $@
--- /dev/null
+/* 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
--- /dev/null
+/* 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
--- /dev/null
+/* 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
--- /dev/null
+/* 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
--- /dev/null
+/* 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
--- /dev/null
+/* 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
--- /dev/null
+/* 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
--- /dev/null
+/* 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
--- /dev/null
+/* 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
--- /dev/null
+/* 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
--- /dev/null
+/* 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
--- /dev/null
+/* 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
--- /dev/null
+/* 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
#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)
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'");
if (arraysize == 0)
return;
+ type_size = GFC_DTYPE_TYPE_SIZE (array);
- which = which - 1;
- sstride[0] = 0;
- rstride[0] = 0;
+ 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;
- extent[0] = 1;
- count[0] = 0;
- n = 0;
+#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
- /* 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;
+ 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;
+ }
- case GFC_DTYPE_COMPLEX:
- if (size == sizeof (_Complex float))
- whichloop = 5;
- else if (size == sizeof (_Complex double))
- whichloop = 6;
+ 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;
+ rstride[0] = 0;
+
+ extent[0] = 1;
+ count[0] = 0;
+ n = 0;
/* Initialized for avoiding compiler warnings. */
roffset = size;
soffset = size;
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++)
+ {
+ memcpy (dest, src, size);
+ dest += roffset;
+ src += soffset;
+ }
+ for (src = sptr, n = 0; n < 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;
}
}
(__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
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 */
--- /dev/null
+`/* 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'
OSDN Git Service
