aboutsummaryrefslogtreecommitdiff
path: root/libgfortran
diff options
context:
space:
mode:
authorTobias Burnus <burnus@net-b.de>2010-09-06 07:55:10 +0200
committerTobias Burnus <burnus@gcc.gnu.org>2010-09-06 07:55:10 +0200
commit195a95c4300bd699e86aae541119b3b41b407e38 (patch)
treeb60ae679f939f761998c881713e1adbe57c96041 /libgfortran
parent1c53d72bec3e943a4f57f9b5530626a2e6882eef (diff)
downloadgcc-195a95c4300bd699e86aae541119b3b41b407e38.zip
gcc-195a95c4300bd699e86aae541119b3b41b407e38.tar.gz
gcc-195a95c4300bd699e86aae541119b3b41b407e38.tar.bz2
re PR fortran/38282 (Bit intrinsics: ILEN and IBCHNG)
2010-09-06 Tobias Burnus <burnus@net-b.de> PR fortran/38282 * intrinsic.c (add_functions): Support IALL, IANY, IPARITY. (check_specific): Special case for those intrinsics. * gfortran.h (gfc_isym_id): Add new intrinsics * intrinsic.h (gfc_check_transf_bit_intrins, gfc_simplify_iall, gfc_simplify_iany, gfc_simplify_iparity, gfc_resolve_iall, gfc_resolve_iany, gfc_resolve_iparity): New prototypes. * iresolve.c (gfc_resolve_iall, gfc_resolve_iany, gfc_resolve_iparity, resolve_transformational): New functions. (gfc_resolve_product, gfc_resolve_sum, gfc_resolve_parity): Use resolve_transformational. * check.c (gfc_check_transf_bit_intrins): New function. * simplify.c (gfc_simplify_iall, gfc_simplify_iany, gfc_simplify_iparity, do_bit_any, do_bit_ior, do_bit_xor, simplify_transformation): New functions. (gfc_simplify_all, gfc_simplify_any, gfc_simplify_parity, gfc_simplify_sum, gfc_simplify_product): Use simplify_transformation. * trans-intrinsic.c (gfc_conv_intrinsic_arith, gfc_conv_intrinsic_function, gfc_is_intrinsic_libcall): Handle IALL, IANY and IPARITY intrinsics. * intrinsic.texi (IMAGE_INDEX): Move up to fix alphabetic order. (IALL, IANY, IPARITY): Document new intrinsics. 2010-09-06 Tobias Burnus <burnus@net-b.de> PR fortran/38282 * gfortran.dg/iall_iany_iparity_1.f90: New. * gfortran.dg/iall_iany_iparity_2.f90: New. 2010-09-06 Tobias Burnus <burnus@net-b.de> PR fortran/38282 * gfortran.map: Add new iany, iall and iparity intrinsics. * Makefile.am: Ditto. * m4/iany.m4: New. * m4/iall.m4: New. * m4/iparity.m4: New. * Makefile.in: Regenerate. * generated/iall_i1.c: Generate. * generated/iall_i2.c: Generate. * generated/iall_i4.c: Generate. * generated/iall_i8.c: Generate. * generated/iall_i16.c: Generate. * generated/iany_i1.c: Generate. * generated/iany_i2.c: Generate. * generated/iany_i4.c: Generate. * generated/iany_i8.c: Generate. * generated/iany_i16.c: Generate. * generated/iparity_i1.c: Generate. * generated/iparity_i2.c: Generate. * generated/iparity_i4.c: Generate. * generated/iparity_i8.c: Generate. * generated/iparity_i16.c: Generate. From-SVN: r163898
Diffstat (limited to 'libgfortran')
-rw-r--r--libgfortran/ChangeLog25
-rw-r--r--libgfortran/Makefile.am36
-rw-r--r--libgfortran/Makefile.in233
-rw-r--r--libgfortran/generated/iall_i1.c509
-rw-r--r--libgfortran/generated/iall_i16.c509
-rw-r--r--libgfortran/generated/iall_i2.c509
-rw-r--r--libgfortran/generated/iall_i4.c509
-rw-r--r--libgfortran/generated/iall_i8.c509
-rw-r--r--libgfortran/generated/iany_i1.c509
-rw-r--r--libgfortran/generated/iany_i16.c509
-rw-r--r--libgfortran/generated/iany_i2.c509
-rw-r--r--libgfortran/generated/iany_i4.c509
-rw-r--r--libgfortran/generated/iany_i8.c509
-rw-r--r--libgfortran/generated/iparity_i1.c509
-rw-r--r--libgfortran/generated/iparity_i16.c509
-rw-r--r--libgfortran/generated/iparity_i2.c509
-rw-r--r--libgfortran/generated/iparity_i4.c509
-rw-r--r--libgfortran/generated/iparity_i8.c509
-rw-r--r--libgfortran/gfortran.map19
-rw-r--r--libgfortran/m4/iall.m446
-rw-r--r--libgfortran/m4/iany.m446
-rw-r--r--libgfortran/m4/iparity.m446
22 files changed, 8045 insertions, 41 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 4c5ffd8..e21064e 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,28 @@
+2010-09-06 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/38282
+ * gfortran.map: Add new iany, iall and iparity intrinsics.
+ * Makefile.am: Ditto.
+ * m4/iany.m4: New.
+ * m4/iall.m4: New.
+ * m4/iparity.m4: New.
+ * Makefile.in: Regenerate.
+ * generated/iall_i1.c: Generate.
+ * generated/iall_i2.c: Generate.
+ * generated/iall_i4.c: Generate.
+ * generated/iall_i8.c: Generate.
+ * generated/iall_i16.c: Generate.
+ * generated/iany_i1.c: Generate.
+ * generated/iany_i2.c: Generate.
+ * generated/iany_i4.c: Generate.
+ * generated/iany_i8.c: Generate.
+ * generated/iany_i16.c: Generate.
+ * generated/iparity_i1.c: Generate.
+ * generated/iparity_i2.c: Generate.
+ * generated/iparity_i4.c: Generate.
+ * generated/iparity_i8.c: Generate.
+ * generated/iparity_i16.c: Generate.
+
2010-09-05 Tobias Burnus <burnus@net-b.de>
* m4/bessel.m4: Fix printf warning by casting to (long int).
diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am
index b8dd9f8..2952f99 100644
--- a/libgfortran/Makefile.am
+++ b/libgfortran/Makefile.am
@@ -189,6 +189,27 @@ $(srcdir)/generated/count_4_l.c \
$(srcdir)/generated/count_8_l.c \
$(srcdir)/generated/count_16_l.c
+i_iall_c= \
+$(srcdir)/generated/iall_i1.c \
+$(srcdir)/generated/iall_i2.c \
+$(srcdir)/generated/iall_i4.c \
+$(srcdir)/generated/iall_i8.c \
+$(srcdir)/generated/iall_i16.c
+
+i_iany_c= \
+$(srcdir)/generated/iany_i1.c \
+$(srcdir)/generated/iany_i2.c \
+$(srcdir)/generated/iany_i4.c \
+$(srcdir)/generated/iany_i8.c \
+$(srcdir)/generated/iany_i16.c
+
+i_iparity_c= \
+$(srcdir)/generated/iparity_i1.c \
+$(srcdir)/generated/iparity_i2.c \
+$(srcdir)/generated/iparity_i4.c \
+$(srcdir)/generated/iparity_i8.c \
+$(srcdir)/generated/iparity_i16.c
+
i_maxloc0_c= \
$(srcdir)/generated/maxloc0_4_i1.c \
$(srcdir)/generated/maxloc0_8_i1.c \
@@ -603,11 +624,13 @@ m4_files= m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \
m4/transpose.m4 m4/eoshift1.m4 m4/eoshift3.m4 m4/exponent.m4 \
m4/fraction.m4 m4/nearest.m4 m4/set_exponent.m4 m4/pow.m4 \
m4/misc_specifics.m4 m4/rrspacing.m4 m4/spacing.m4 m4/pack.m4 \
- m4/unpack.m4 m4/spread.m4 m4/bessel.m4 m4/norm2.m4 m4/parity.m4
+ m4/unpack.m4 m4/spread.m4 m4/bessel.m4 m4/norm2.m4 m4/parity.m4 \
+ m4/iall.m4 m4/iany.m4 m4/iparity.m4
gfor_built_src= $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \
$(i_maxloc1_c) $(i_maxval_c) $(i_minloc0_c) $(i_minloc1_c) $(i_minval_c) \
- $(i_product_c) $(i_sum_c) $(i_bessel_c) $(i_norm2_c) $(i_parity_c) \
+ $(i_product_c) $(i_sum_c) $(i_bessel_c) $(i_iall_c) $(i_iany_c) \
+ $(i_iparity_c) $(i_norm2_c) $(i_parity_c) \
$(i_matmul_c) $(i_matmull_c) $(i_transpose_c) $(i_shape_c) $(i_eoshift1_c) \
$(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \
$(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \
@@ -850,6 +873,15 @@ $(i_any_c): m4/any.m4 $(I_M4_DEPS2)
$(i_count_c): m4/count.m4 $(I_M4_DEPS2)
$(M4) -Dfile=$@ -I$(srcdir)/m4 count.m4 > $@
+$(i_iall_c): m4/iall.m4 $(I_M4_DEPS)
+ $(M4) -Dfile=$@ -I$(srcdir)/m4 iall.m4 > $@
+
+$(i_iany_c): m4/iany.m4 $(I_M4_DEPS)
+ $(M4) -Dfile=$@ -I$(srcdir)/m4 iany.m4 > $@
+
+$(i_iparity_c): m4/iparity.m4 $(I_M4_DEPS)
+ $(M4) -Dfile=$@ -I$(srcdir)/m4 iparity.m4 > $@
+
$(i_maxloc0_c): m4/maxloc0.m4 $(I_M4_DEPS0)
$(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc0.m4 > $@
diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in
index fa30519..e6be1c1 100644
--- a/libgfortran/Makefile.in
+++ b/libgfortran/Makefile.in
@@ -144,43 +144,49 @@ am__objects_12 = sum_i1.lo sum_i2.lo sum_i4.lo sum_i8.lo sum_i16.lo \
sum_r4.lo sum_r8.lo sum_r10.lo sum_r16.lo sum_c4.lo sum_c8.lo \
sum_c10.lo sum_c16.lo
am__objects_13 = bessel_r4.lo bessel_r8.lo bessel_r10.lo bessel_r16.lo
-am__objects_14 = norm2_r4.lo norm2_r8.lo norm2_r10.lo norm2_r16.lo
-am__objects_15 = parity_l1.lo parity_l2.lo parity_l4.lo parity_l8.lo \
+am__objects_14 = iall_i1.lo iall_i2.lo iall_i4.lo iall_i8.lo \
+ iall_i16.lo
+am__objects_15 = iany_i1.lo iany_i2.lo iany_i4.lo iany_i8.lo \
+ iany_i16.lo
+am__objects_16 = iparity_i1.lo iparity_i2.lo iparity_i4.lo \
+ iparity_i8.lo iparity_i16.lo
+am__objects_17 = norm2_r4.lo norm2_r8.lo norm2_r10.lo norm2_r16.lo
+am__objects_18 = parity_l1.lo parity_l2.lo parity_l4.lo parity_l8.lo \
parity_l16.lo
-am__objects_16 = matmul_i1.lo matmul_i2.lo matmul_i4.lo matmul_i8.lo \
+am__objects_19 = matmul_i1.lo matmul_i2.lo matmul_i4.lo matmul_i8.lo \
matmul_i16.lo matmul_r4.lo matmul_r8.lo matmul_r10.lo \
matmul_r16.lo matmul_c4.lo matmul_c8.lo matmul_c10.lo \
matmul_c16.lo
-am__objects_17 = matmul_l4.lo matmul_l8.lo matmul_l16.lo
-am__objects_18 = transpose_i4.lo transpose_i8.lo transpose_i16.lo \
+am__objects_20 = matmul_l4.lo matmul_l8.lo matmul_l16.lo
+am__objects_21 = transpose_i4.lo transpose_i8.lo transpose_i16.lo \
transpose_r4.lo transpose_r8.lo transpose_r10.lo \
transpose_r16.lo transpose_c4.lo transpose_c8.lo \
transpose_c10.lo transpose_c16.lo
-am__objects_19 = shape_i4.lo shape_i8.lo shape_i16.lo
-am__objects_20 = eoshift1_4.lo eoshift1_8.lo eoshift1_16.lo
-am__objects_21 = eoshift3_4.lo eoshift3_8.lo eoshift3_16.lo
-am__objects_22 = cshift1_4.lo cshift1_8.lo cshift1_16.lo
-am__objects_23 = reshape_i4.lo reshape_i8.lo reshape_i16.lo \
+am__objects_22 = shape_i4.lo shape_i8.lo shape_i16.lo
+am__objects_23 = eoshift1_4.lo eoshift1_8.lo eoshift1_16.lo
+am__objects_24 = eoshift3_4.lo eoshift3_8.lo eoshift3_16.lo
+am__objects_25 = cshift1_4.lo cshift1_8.lo cshift1_16.lo
+am__objects_26 = reshape_i4.lo reshape_i8.lo reshape_i16.lo \
reshape_r4.lo reshape_r8.lo reshape_r10.lo reshape_r16.lo \
reshape_c4.lo reshape_c8.lo reshape_c10.lo reshape_c16.lo
-am__objects_24 = in_pack_i1.lo in_pack_i2.lo in_pack_i4.lo \
+am__objects_27 = in_pack_i1.lo in_pack_i2.lo in_pack_i4.lo \
in_pack_i8.lo in_pack_i16.lo in_pack_r4.lo in_pack_r8.lo \
in_pack_r10.lo in_pack_r16.lo in_pack_c4.lo in_pack_c8.lo \
in_pack_c10.lo in_pack_c16.lo
-am__objects_25 = in_unpack_i1.lo in_unpack_i2.lo in_unpack_i4.lo \
+am__objects_28 = in_unpack_i1.lo in_unpack_i2.lo in_unpack_i4.lo \
in_unpack_i8.lo in_unpack_i16.lo in_unpack_r4.lo \
in_unpack_r8.lo in_unpack_r10.lo in_unpack_r16.lo \
in_unpack_c4.lo in_unpack_c8.lo in_unpack_c10.lo \
in_unpack_c16.lo
-am__objects_26 = exponent_r4.lo exponent_r8.lo exponent_r10.lo \
+am__objects_29 = exponent_r4.lo exponent_r8.lo exponent_r10.lo \
exponent_r16.lo
-am__objects_27 = fraction_r4.lo fraction_r8.lo fraction_r10.lo \
+am__objects_30 = fraction_r4.lo fraction_r8.lo fraction_r10.lo \
fraction_r16.lo
-am__objects_28 = nearest_r4.lo nearest_r8.lo nearest_r10.lo \
+am__objects_31 = nearest_r4.lo nearest_r8.lo nearest_r10.lo \
nearest_r16.lo
-am__objects_29 = set_exponent_r4.lo set_exponent_r8.lo \
+am__objects_32 = set_exponent_r4.lo set_exponent_r8.lo \
set_exponent_r10.lo set_exponent_r16.lo
-am__objects_30 = pow_i4_i4.lo pow_i8_i4.lo pow_i16_i4.lo pow_c4_i4.lo \
+am__objects_33 = pow_i4_i4.lo pow_i8_i4.lo pow_i16_i4.lo pow_c4_i4.lo \
pow_c8_i4.lo pow_c10_i4.lo pow_c16_i4.lo pow_i4_i8.lo \
pow_i8_i8.lo pow_i16_i8.lo pow_r4_i8.lo pow_r8_i8.lo \
pow_r10_i8.lo pow_r16_i8.lo pow_c4_i8.lo pow_c8_i8.lo \
@@ -188,26 +194,26 @@ am__objects_30 = pow_i4_i4.lo pow_i8_i4.lo pow_i16_i4.lo pow_c4_i4.lo \
pow_i16_i16.lo pow_r4_i16.lo pow_r8_i16.lo pow_r10_i16.lo \
pow_r16_i16.lo pow_c4_i16.lo pow_c8_i16.lo pow_c10_i16.lo \
pow_c16_i16.lo
-am__objects_31 = rrspacing_r4.lo rrspacing_r8.lo rrspacing_r10.lo \
+am__objects_34 = rrspacing_r4.lo rrspacing_r8.lo rrspacing_r10.lo \
rrspacing_r16.lo
-am__objects_32 = spacing_r4.lo spacing_r8.lo spacing_r10.lo \
+am__objects_35 = spacing_r4.lo spacing_r8.lo spacing_r10.lo \
spacing_r16.lo
-am__objects_33 = pack_i1.lo pack_i2.lo pack_i4.lo pack_i8.lo \
+am__objects_36 = pack_i1.lo pack_i2.lo pack_i4.lo pack_i8.lo \
pack_i16.lo pack_r4.lo pack_r8.lo pack_r10.lo pack_r16.lo \
pack_c4.lo pack_c8.lo pack_c10.lo pack_c16.lo
-am__objects_34 = unpack_i1.lo unpack_i2.lo unpack_i4.lo unpack_i8.lo \
+am__objects_37 = unpack_i1.lo unpack_i2.lo unpack_i4.lo unpack_i8.lo \
unpack_i16.lo unpack_r4.lo unpack_r8.lo unpack_r10.lo \
unpack_r16.lo unpack_c4.lo unpack_c8.lo unpack_c10.lo \
unpack_c16.lo
-am__objects_35 = spread_i1.lo spread_i2.lo spread_i4.lo spread_i8.lo \
+am__objects_38 = spread_i1.lo spread_i2.lo spread_i4.lo spread_i8.lo \
spread_i16.lo spread_r4.lo spread_r8.lo spread_r10.lo \
spread_r16.lo spread_c4.lo spread_c8.lo spread_c10.lo \
spread_c16.lo
-am__objects_36 = cshift0_i1.lo cshift0_i2.lo cshift0_i4.lo \
+am__objects_39 = 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_37 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \
+am__objects_40 = $(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) \
@@ -218,11 +224,12 @@ am__objects_37 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \
$(am__objects_26) $(am__objects_27) $(am__objects_28) \
$(am__objects_29) $(am__objects_30) $(am__objects_31) \
$(am__objects_32) $(am__objects_33) $(am__objects_34) \
- $(am__objects_35) $(am__objects_36)
-am__objects_38 = close.lo file_pos.lo format.lo inquire.lo \
+ $(am__objects_35) $(am__objects_36) $(am__objects_37) \
+ $(am__objects_38) $(am__objects_39)
+am__objects_41 = 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_39 = associated.lo abort.lo access.lo args.lo \
+am__objects_42 = associated.lo abort.lo access.lo args.lo \
bit_intrinsics.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 \
@@ -237,8 +244,8 @@ am__objects_39 = associated.lo abort.lo access.lo args.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_40 =
-am__objects_41 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
+am__objects_43 =
+am__objects_44 = _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 \
@@ -262,18 +269,18 @@ am__objects_41 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
_conjg_c4.lo _conjg_c8.lo _conjg_c10.lo _conjg_c16.lo \
_aint_r4.lo _aint_r8.lo _aint_r10.lo _aint_r16.lo _anint_r4.lo \
_anint_r8.lo _anint_r10.lo _anint_r16.lo
-am__objects_42 = _sign_i4.lo _sign_i8.lo _sign_i16.lo _sign_r4.lo \
+am__objects_45 = _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_43 = misc_specifics.lo
-am__objects_44 = $(am__objects_41) $(am__objects_42) $(am__objects_43) \
+am__objects_46 = misc_specifics.lo
+am__objects_47 = $(am__objects_44) $(am__objects_45) $(am__objects_46) \
dprod_r8.lo f2c_specifics.lo
-am__objects_45 = $(am__objects_1) $(am__objects_37) $(am__objects_38) \
- $(am__objects_39) $(am__objects_40) $(am__objects_44)
-@onestep_FALSE@am_libgfortran_la_OBJECTS = $(am__objects_45)
+am__objects_48 = $(am__objects_1) $(am__objects_40) $(am__objects_41) \
+ $(am__objects_42) $(am__objects_43) $(am__objects_47)
+@onestep_FALSE@am_libgfortran_la_OBJECTS = $(am__objects_48)
@onestep_TRUE@am_libgfortran_la_OBJECTS = libgfortran_c.lo
libgfortran_la_OBJECTS = $(am_libgfortran_la_OBJECTS)
libgfortranbegin_la_LIBADD =
@@ -609,6 +616,27 @@ $(srcdir)/generated/count_4_l.c \
$(srcdir)/generated/count_8_l.c \
$(srcdir)/generated/count_16_l.c
+i_iall_c = \
+$(srcdir)/generated/iall_i1.c \
+$(srcdir)/generated/iall_i2.c \
+$(srcdir)/generated/iall_i4.c \
+$(srcdir)/generated/iall_i8.c \
+$(srcdir)/generated/iall_i16.c
+
+i_iany_c = \
+$(srcdir)/generated/iany_i1.c \
+$(srcdir)/generated/iany_i2.c \
+$(srcdir)/generated/iany_i4.c \
+$(srcdir)/generated/iany_i8.c \
+$(srcdir)/generated/iany_i16.c
+
+i_iparity_c = \
+$(srcdir)/generated/iparity_i1.c \
+$(srcdir)/generated/iparity_i2.c \
+$(srcdir)/generated/iparity_i4.c \
+$(srcdir)/generated/iparity_i8.c \
+$(srcdir)/generated/iparity_i16.c
+
i_maxloc0_c = \
$(srcdir)/generated/maxloc0_4_i1.c \
$(srcdir)/generated/maxloc0_8_i1.c \
@@ -1022,11 +1050,13 @@ m4_files = m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \
m4/transpose.m4 m4/eoshift1.m4 m4/eoshift3.m4 m4/exponent.m4 \
m4/fraction.m4 m4/nearest.m4 m4/set_exponent.m4 m4/pow.m4 \
m4/misc_specifics.m4 m4/rrspacing.m4 m4/spacing.m4 m4/pack.m4 \
- m4/unpack.m4 m4/spread.m4 m4/bessel.m4 m4/norm2.m4 m4/parity.m4
+ m4/unpack.m4 m4/spread.m4 m4/bessel.m4 m4/norm2.m4 m4/parity.m4 \
+ m4/iall.m4 m4/iany.m4 m4/iparity.m4
gfor_built_src = $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \
$(i_maxloc1_c) $(i_maxval_c) $(i_minloc0_c) $(i_minloc1_c) $(i_minval_c) \
- $(i_product_c) $(i_sum_c) $(i_bessel_c) $(i_norm2_c) $(i_parity_c) \
+ $(i_product_c) $(i_sum_c) $(i_bessel_c) $(i_iall_c) $(i_iany_c) \
+ $(i_iparity_c) $(i_norm2_c) $(i_parity_c) \
$(i_matmul_c) $(i_matmull_c) $(i_transpose_c) $(i_shape_c) $(i_eoshift1_c) \
$(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \
$(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \
@@ -1427,6 +1457,16 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getcwd.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getlog.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/hostnm.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iall_i1.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iall_i16.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iall_i2.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iall_i4.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iall_i8.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iany_i1.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iany_i16.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iany_i2.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iany_i4.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iany_i8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ierrno.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_c10.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_c16.Plo@am__quote@
@@ -1458,6 +1498,11 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_r8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/inquire.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/intrinsics.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iparity_i1.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iparity_i16.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iparity_i2.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iparity_i4.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iparity_i8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ishftc.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iso_c_binding.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iso_c_generated_procs.Plo@am__quote@
@@ -3523,6 +3568,111 @@ bessel_r16.lo: $(srcdir)/generated/bessel_r16.c
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o bessel_r16.lo `test -f '$(srcdir)/generated/bessel_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/bessel_r16.c
+iall_i1.lo: $(srcdir)/generated/iall_i1.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iall_i1.lo -MD -MP -MF $(DEPDIR)/iall_i1.Tpo -c -o iall_i1.lo `test -f '$(srcdir)/generated/iall_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i1.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iall_i1.Tpo $(DEPDIR)/iall_i1.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iall_i1.c' object='iall_i1.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iall_i1.lo `test -f '$(srcdir)/generated/iall_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i1.c
+
+iall_i2.lo: $(srcdir)/generated/iall_i2.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iall_i2.lo -MD -MP -MF $(DEPDIR)/iall_i2.Tpo -c -o iall_i2.lo `test -f '$(srcdir)/generated/iall_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i2.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iall_i2.Tpo $(DEPDIR)/iall_i2.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iall_i2.c' object='iall_i2.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iall_i2.lo `test -f '$(srcdir)/generated/iall_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i2.c
+
+iall_i4.lo: $(srcdir)/generated/iall_i4.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iall_i4.lo -MD -MP -MF $(DEPDIR)/iall_i4.Tpo -c -o iall_i4.lo `test -f '$(srcdir)/generated/iall_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i4.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iall_i4.Tpo $(DEPDIR)/iall_i4.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iall_i4.c' object='iall_i4.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iall_i4.lo `test -f '$(srcdir)/generated/iall_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i4.c
+
+iall_i8.lo: $(srcdir)/generated/iall_i8.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iall_i8.lo -MD -MP -MF $(DEPDIR)/iall_i8.Tpo -c -o iall_i8.lo `test -f '$(srcdir)/generated/iall_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i8.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iall_i8.Tpo $(DEPDIR)/iall_i8.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iall_i8.c' object='iall_i8.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iall_i8.lo `test -f '$(srcdir)/generated/iall_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i8.c
+
+iall_i16.lo: $(srcdir)/generated/iall_i16.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iall_i16.lo -MD -MP -MF $(DEPDIR)/iall_i16.Tpo -c -o iall_i16.lo `test -f '$(srcdir)/generated/iall_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i16.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iall_i16.Tpo $(DEPDIR)/iall_i16.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iall_i16.c' object='iall_i16.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iall_i16.lo `test -f '$(srcdir)/generated/iall_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i16.c
+
+iany_i1.lo: $(srcdir)/generated/iany_i1.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iany_i1.lo -MD -MP -MF $(DEPDIR)/iany_i1.Tpo -c -o iany_i1.lo `test -f '$(srcdir)/generated/iany_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i1.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iany_i1.Tpo $(DEPDIR)/iany_i1.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iany_i1.c' object='iany_i1.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iany_i1.lo `test -f '$(srcdir)/generated/iany_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i1.c
+
+iany_i2.lo: $(srcdir)/generated/iany_i2.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iany_i2.lo -MD -MP -MF $(DEPDIR)/iany_i2.Tpo -c -o iany_i2.lo `test -f '$(srcdir)/generated/iany_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i2.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iany_i2.Tpo $(DEPDIR)/iany_i2.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iany_i2.c' object='iany_i2.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iany_i2.lo `test -f '$(srcdir)/generated/iany_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i2.c
+
+iany_i4.lo: $(srcdir)/generated/iany_i4.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iany_i4.lo -MD -MP -MF $(DEPDIR)/iany_i4.Tpo -c -o iany_i4.lo `test -f '$(srcdir)/generated/iany_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i4.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iany_i4.Tpo $(DEPDIR)/iany_i4.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iany_i4.c' object='iany_i4.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iany_i4.lo `test -f '$(srcdir)/generated/iany_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i4.c
+
+iany_i8.lo: $(srcdir)/generated/iany_i8.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iany_i8.lo -MD -MP -MF $(DEPDIR)/iany_i8.Tpo -c -o iany_i8.lo `test -f '$(srcdir)/generated/iany_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i8.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iany_i8.Tpo $(DEPDIR)/iany_i8.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iany_i8.c' object='iany_i8.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iany_i8.lo `test -f '$(srcdir)/generated/iany_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i8.c
+
+iany_i16.lo: $(srcdir)/generated/iany_i16.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iany_i16.lo -MD -MP -MF $(DEPDIR)/iany_i16.Tpo -c -o iany_i16.lo `test -f '$(srcdir)/generated/iany_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i16.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iany_i16.Tpo $(DEPDIR)/iany_i16.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iany_i16.c' object='iany_i16.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iany_i16.lo `test -f '$(srcdir)/generated/iany_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i16.c
+
+iparity_i1.lo: $(srcdir)/generated/iparity_i1.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iparity_i1.lo -MD -MP -MF $(DEPDIR)/iparity_i1.Tpo -c -o iparity_i1.lo `test -f '$(srcdir)/generated/iparity_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i1.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iparity_i1.Tpo $(DEPDIR)/iparity_i1.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iparity_i1.c' object='iparity_i1.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iparity_i1.lo `test -f '$(srcdir)/generated/iparity_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i1.c
+
+iparity_i2.lo: $(srcdir)/generated/iparity_i2.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iparity_i2.lo -MD -MP -MF $(DEPDIR)/iparity_i2.Tpo -c -o iparity_i2.lo `test -f '$(srcdir)/generated/iparity_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i2.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iparity_i2.Tpo $(DEPDIR)/iparity_i2.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iparity_i2.c' object='iparity_i2.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iparity_i2.lo `test -f '$(srcdir)/generated/iparity_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i2.c
+
+iparity_i4.lo: $(srcdir)/generated/iparity_i4.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iparity_i4.lo -MD -MP -MF $(DEPDIR)/iparity_i4.Tpo -c -o iparity_i4.lo `test -f '$(srcdir)/generated/iparity_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i4.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iparity_i4.Tpo $(DEPDIR)/iparity_i4.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iparity_i4.c' object='iparity_i4.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iparity_i4.lo `test -f '$(srcdir)/generated/iparity_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i4.c
+
+iparity_i8.lo: $(srcdir)/generated/iparity_i8.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iparity_i8.lo -MD -MP -MF $(DEPDIR)/iparity_i8.Tpo -c -o iparity_i8.lo `test -f '$(srcdir)/generated/iparity_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i8.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iparity_i8.Tpo $(DEPDIR)/iparity_i8.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iparity_i8.c' object='iparity_i8.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iparity_i8.lo `test -f '$(srcdir)/generated/iparity_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i8.c
+
+iparity_i16.lo: $(srcdir)/generated/iparity_i16.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iparity_i16.lo -MD -MP -MF $(DEPDIR)/iparity_i16.Tpo -c -o iparity_i16.lo `test -f '$(srcdir)/generated/iparity_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i16.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iparity_i16.Tpo $(DEPDIR)/iparity_i16.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iparity_i16.c' object='iparity_i16.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iparity_i16.lo `test -f '$(srcdir)/generated/iparity_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i16.c
+
norm2_r4.lo: $(srcdir)/generated/norm2_r4.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT norm2_r4.lo -MD -MP -MF $(DEPDIR)/norm2_r4.Tpo -c -o norm2_r4.lo `test -f '$(srcdir)/generated/norm2_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/norm2_r4.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/norm2_r4.Tpo $(DEPDIR)/norm2_r4.Plo
@@ -5671,6 +5821,15 @@ fpu-target.h: $(srcdir)/$(FPU_HOST_HEADER)
@MAINTAINER_MODE_TRUE@$(i_count_c): m4/count.m4 $(I_M4_DEPS2)
@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 count.m4 > $@
+@MAINTAINER_MODE_TRUE@$(i_iall_c): m4/iall.m4 $(I_M4_DEPS)
+@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 iall.m4 > $@
+
+@MAINTAINER_MODE_TRUE@$(i_iany_c): m4/iany.m4 $(I_M4_DEPS)
+@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 iany.m4 > $@
+
+@MAINTAINER_MODE_TRUE@$(i_iparity_c): m4/iparity.m4 $(I_M4_DEPS)
+@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 iparity.m4 > $@
+
@MAINTAINER_MODE_TRUE@$(i_maxloc0_c): m4/maxloc0.m4 $(I_M4_DEPS0)
@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc0.m4 > $@
diff --git a/libgfortran/generated/iall_i1.c b/libgfortran/generated/iall_i1.c
new file mode 100644
index 0000000..c6bacab
--- /dev/null
+++ b/libgfortran/generated/iall_i1.c
@@ -0,0 +1,509 @@
+/* Implementation of the IALL intrinsic
+ Copyright 2010 Free Software Foundation, Inc.
+ Contributed by Tobias Burnus <burnus@net-b.de>
+
+This file is part of the GNU Fortran 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 3 of the License, or (at your option) any later version.
+
+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.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <assert.h>
+
+
+#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_1)
+
+
+extern void iall_i1 (gfc_array_i1 * const restrict,
+ gfc_array_i1 * const restrict, const index_type * const restrict);
+export_proto(iall_i1);
+
+void
+iall_i1 (gfc_array_i1 * const restrict retarray,
+ gfc_array_i1 * const restrict array,
+ const index_type * const restrict pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_INTEGER_1 * restrict base;
+ GFC_INTEGER_1 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IALL intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IALL");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ continue_loop = 1;
+ while (continue_loop)
+ {
+ const GFC_INTEGER_1 * restrict src;
+ GFC_INTEGER_1 result;
+ src = base;
+ {
+
+ result = (GFC_INTEGER_1) -1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ result &= *src;
+ }
+
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void miall_i1 (gfc_array_i1 * const restrict,
+ gfc_array_i1 * const restrict, const index_type * const restrict,
+ gfc_array_l1 * const restrict);
+export_proto(miall_i1);
+
+void
+miall_i1 (gfc_array_i1 * const restrict retarray,
+ gfc_array_i1 * const restrict array,
+ const index_type * const restrict pdim,
+ gfc_array_l1 * const restrict mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_1 * restrict dest;
+ const GFC_INTEGER_1 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ int mask_kind;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len <= 0)
+ return;
+
+ mbase = mask->data;
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+ || mask_kind == 16
+#endif
+ )
+ mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+ else
+ runtime_error ("Funny sized logical array");
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in IALL intrinsic");
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IALL");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "IALL");
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->data;
+ base = array->data;
+
+ while (base)
+ {
+ const GFC_INTEGER_1 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ GFC_INTEGER_1 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc)
+ result &= *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void siall_i1 (gfc_array_i1 * const restrict,
+ gfc_array_i1 * const restrict, const index_type * const restrict,
+ GFC_LOGICAL_4 *);
+export_proto(siall_i1);
+
+void
+siall_i1 (gfc_array_i1 * const restrict retarray,
+ gfc_array_i1 * const restrict array,
+ const index_type * const restrict pdim,
+ GFC_LOGICAL_4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_1 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type dim;
+
+
+ if (*mask)
+ {
+ iall_i1 (retarray, array, pdim);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ for (n = 0; n < dim; n++)
+ {
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ for (n = dim; n < rank; n++)
+ {
+ extent[n] =
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IALL intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " IALL intrinsic in dimension %ld:"
+ " is %ld, should be %ld", (long int) n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ }
+
+ dest = retarray->data;
+
+ while(1)
+ {
+ *dest = 0;
+ count[0]++;
+ dest += dstride[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. */
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ return;
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
diff --git a/libgfortran/generated/iall_i16.c b/libgfortran/generated/iall_i16.c
new file mode 100644
index 0000000..618f333
--- /dev/null
+++ b/libgfortran/generated/iall_i16.c
@@ -0,0 +1,509 @@
+/* Implementation of the IALL intrinsic
+ Copyright 2010 Free Software Foundation, Inc.
+ Contributed by Tobias Burnus <burnus@net-b.de>
+
+This file is part of the GNU Fortran 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 3 of the License, or (at your option) any later version.
+
+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.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <assert.h>
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void iall_i16 (gfc_array_i16 * const restrict,
+ gfc_array_i16 * const restrict, const index_type * const restrict);
+export_proto(iall_i16);
+
+void
+iall_i16 (gfc_array_i16 * const restrict retarray,
+ gfc_array_i16 * const restrict array,
+ const index_type * const restrict pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_INTEGER_16 * restrict base;
+ GFC_INTEGER_16 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IALL intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IALL");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ continue_loop = 1;
+ while (continue_loop)
+ {
+ const GFC_INTEGER_16 * restrict src;
+ GFC_INTEGER_16 result;
+ src = base;
+ {
+
+ result = (GFC_INTEGER_16) -1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ result &= *src;
+ }
+
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void miall_i16 (gfc_array_i16 * const restrict,
+ gfc_array_i16 * const restrict, const index_type * const restrict,
+ gfc_array_l1 * const restrict);
+export_proto(miall_i16);
+
+void
+miall_i16 (gfc_array_i16 * const restrict retarray,
+ gfc_array_i16 * const restrict array,
+ const index_type * const restrict pdim,
+ gfc_array_l1 * const restrict mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 * restrict dest;
+ const GFC_INTEGER_16 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ int mask_kind;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len <= 0)
+ return;
+
+ mbase = mask->data;
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+ || mask_kind == 16
+#endif
+ )
+ mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+ else
+ runtime_error ("Funny sized logical array");
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in IALL intrinsic");
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IALL");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "IALL");
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->data;
+ base = array->data;
+
+ while (base)
+ {
+ const GFC_INTEGER_16 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ GFC_INTEGER_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc)
+ result &= *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void siall_i16 (gfc_array_i16 * const restrict,
+ gfc_array_i16 * const restrict, const index_type * const restrict,
+ GFC_LOGICAL_4 *);
+export_proto(siall_i16);
+
+void
+siall_i16 (gfc_array_i16 * const restrict retarray,
+ gfc_array_i16 * const restrict array,
+ const index_type * const restrict pdim,
+ GFC_LOGICAL_4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type dim;
+
+
+ if (*mask)
+ {
+ iall_i16 (retarray, array, pdim);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ for (n = 0; n < dim; n++)
+ {
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ for (n = dim; n < rank; n++)
+ {
+ extent[n] =
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IALL intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " IALL intrinsic in dimension %ld:"
+ " is %ld, should be %ld", (long int) n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ }
+
+ dest = retarray->data;
+
+ while(1)
+ {
+ *dest = 0;
+ count[0]++;
+ dest += dstride[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. */
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ return;
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
diff --git a/libgfortran/generated/iall_i2.c b/libgfortran/generated/iall_i2.c
new file mode 100644
index 0000000..c900059
--- /dev/null
+++ b/libgfortran/generated/iall_i2.c
@@ -0,0 +1,509 @@
+/* Implementation of the IALL intrinsic
+ Copyright 2010 Free Software Foundation, Inc.
+ Contributed by Tobias Burnus <burnus@net-b.de>
+
+This file is part of the GNU Fortran 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 3 of the License, or (at your option) any later version.
+
+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.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <assert.h>
+
+
+#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_2)
+
+
+extern void iall_i2 (gfc_array_i2 * const restrict,
+ gfc_array_i2 * const restrict, const index_type * const restrict);
+export_proto(iall_i2);
+
+void
+iall_i2 (gfc_array_i2 * const restrict retarray,
+ gfc_array_i2 * const restrict array,
+ const index_type * const restrict pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_INTEGER_2 * restrict base;
+ GFC_INTEGER_2 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IALL intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IALL");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ continue_loop = 1;
+ while (continue_loop)
+ {
+ const GFC_INTEGER_2 * restrict src;
+ GFC_INTEGER_2 result;
+ src = base;
+ {
+
+ result = (GFC_INTEGER_2) -1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ result &= *src;
+ }
+
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void miall_i2 (gfc_array_i2 * const restrict,
+ gfc_array_i2 * const restrict, const index_type * const restrict,
+ gfc_array_l1 * const restrict);
+export_proto(miall_i2);
+
+void
+miall_i2 (gfc_array_i2 * const restrict retarray,
+ gfc_array_i2 * const restrict array,
+ const index_type * const restrict pdim,
+ gfc_array_l1 * const restrict mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_2 * restrict dest;
+ const GFC_INTEGER_2 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ int mask_kind;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len <= 0)
+ return;
+
+ mbase = mask->data;
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+ || mask_kind == 16
+#endif
+ )
+ mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+ else
+ runtime_error ("Funny sized logical array");
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in IALL intrinsic");
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IALL");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "IALL");
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->data;
+ base = array->data;
+
+ while (base)
+ {
+ const GFC_INTEGER_2 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ GFC_INTEGER_2 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc)
+ result &= *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void siall_i2 (gfc_array_i2 * const restrict,
+ gfc_array_i2 * const restrict, const index_type * const restrict,
+ GFC_LOGICAL_4 *);
+export_proto(siall_i2);
+
+void
+siall_i2 (gfc_array_i2 * const restrict retarray,
+ gfc_array_i2 * const restrict array,
+ const index_type * const restrict pdim,
+ GFC_LOGICAL_4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_2 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type dim;
+
+
+ if (*mask)
+ {
+ iall_i2 (retarray, array, pdim);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ for (n = 0; n < dim; n++)
+ {
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ for (n = dim; n < rank; n++)
+ {
+ extent[n] =
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IALL intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " IALL intrinsic in dimension %ld:"
+ " is %ld, should be %ld", (long int) n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ }
+
+ dest = retarray->data;
+
+ while(1)
+ {
+ *dest = 0;
+ count[0]++;
+ dest += dstride[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. */
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ return;
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
diff --git a/libgfortran/generated/iall_i4.c b/libgfortran/generated/iall_i4.c
new file mode 100644
index 0000000..d5e7dfe
--- /dev/null
+++ b/libgfortran/generated/iall_i4.c
@@ -0,0 +1,509 @@
+/* Implementation of the IALL intrinsic
+ Copyright 2010 Free Software Foundation, Inc.
+ Contributed by Tobias Burnus <burnus@net-b.de>
+
+This file is part of the GNU Fortran 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 3 of the License, or (at your option) any later version.
+
+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.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <assert.h>
+
+
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void iall_i4 (gfc_array_i4 * const restrict,
+ gfc_array_i4 * const restrict, const index_type * const restrict);
+export_proto(iall_i4);
+
+void
+iall_i4 (gfc_array_i4 * const restrict retarray,
+ gfc_array_i4 * const restrict array,
+ const index_type * const restrict pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_INTEGER_4 * restrict base;
+ GFC_INTEGER_4 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IALL intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IALL");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ continue_loop = 1;
+ while (continue_loop)
+ {
+ const GFC_INTEGER_4 * restrict src;
+ GFC_INTEGER_4 result;
+ src = base;
+ {
+
+ result = (GFC_INTEGER_4) -1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ result &= *src;
+ }
+
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void miall_i4 (gfc_array_i4 * const restrict,
+ gfc_array_i4 * const restrict, const index_type * const restrict,
+ gfc_array_l1 * const restrict);
+export_proto(miall_i4);
+
+void
+miall_i4 (gfc_array_i4 * const restrict retarray,
+ gfc_array_i4 * const restrict array,
+ const index_type * const restrict pdim,
+ gfc_array_l1 * const restrict mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_4 * restrict dest;
+ const GFC_INTEGER_4 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ int mask_kind;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len <= 0)
+ return;
+
+ mbase = mask->data;
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+ || mask_kind == 16
+#endif
+ )
+ mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+ else
+ runtime_error ("Funny sized logical array");
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in IALL intrinsic");
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IALL");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "IALL");
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->data;
+ base = array->data;
+
+ while (base)
+ {
+ const GFC_INTEGER_4 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ GFC_INTEGER_4 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc)
+ result &= *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void siall_i4 (gfc_array_i4 * const restrict,
+ gfc_array_i4 * const restrict, const index_type * const restrict,
+ GFC_LOGICAL_4 *);
+export_proto(siall_i4);
+
+void
+siall_i4 (gfc_array_i4 * const restrict retarray,
+ gfc_array_i4 * const restrict array,
+ const index_type * const restrict pdim,
+ GFC_LOGICAL_4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_4 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type dim;
+
+
+ if (*mask)
+ {
+ iall_i4 (retarray, array, pdim);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ for (n = 0; n < dim; n++)
+ {
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ for (n = dim; n < rank; n++)
+ {
+ extent[n] =
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IALL intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " IALL intrinsic in dimension %ld:"
+ " is %ld, should be %ld", (long int) n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ }
+
+ dest = retarray->data;
+
+ while(1)
+ {
+ *dest = 0;
+ count[0]++;
+ dest += dstride[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. */
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ return;
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
diff --git a/libgfortran/generated/iall_i8.c b/libgfortran/generated/iall_i8.c
new file mode 100644
index 0000000..74ae1b5
--- /dev/null
+++ b/libgfortran/generated/iall_i8.c
@@ -0,0 +1,509 @@
+/* Implementation of the IALL intrinsic
+ Copyright 2010 Free Software Foundation, Inc.
+ Contributed by Tobias Burnus <burnus@net-b.de>
+
+This file is part of the GNU Fortran 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 3 of the License, or (at your option) any later version.
+
+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.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <assert.h>
+
+
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void iall_i8 (gfc_array_i8 * const restrict,
+ gfc_array_i8 * const restrict, const index_type * const restrict);
+export_proto(iall_i8);
+
+void
+iall_i8 (gfc_array_i8 * const restrict retarray,
+ gfc_array_i8 * const restrict array,
+ const index_type * const restrict pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_INTEGER_8 * restrict base;
+ GFC_INTEGER_8 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IALL intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IALL");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ continue_loop = 1;
+ while (continue_loop)
+ {
+ const GFC_INTEGER_8 * restrict src;
+ GFC_INTEGER_8 result;
+ src = base;
+ {
+
+ result = (GFC_INTEGER_8) -1;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ result &= *src;
+ }
+
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void miall_i8 (gfc_array_i8 * const restrict,
+ gfc_array_i8 * const restrict, const index_type * const restrict,
+ gfc_array_l1 * const restrict);
+export_proto(miall_i8);
+
+void
+miall_i8 (gfc_array_i8 * const restrict retarray,
+ gfc_array_i8 * const restrict array,
+ const index_type * const restrict pdim,
+ gfc_array_l1 * const restrict mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_8 * restrict dest;
+ const GFC_INTEGER_8 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ int mask_kind;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len <= 0)
+ return;
+
+ mbase = mask->data;
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+ || mask_kind == 16
+#endif
+ )
+ mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+ else
+ runtime_error ("Funny sized logical array");
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in IALL intrinsic");
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IALL");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "IALL");
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->data;
+ base = array->data;
+
+ while (base)
+ {
+ const GFC_INTEGER_8 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ GFC_INTEGER_8 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc)
+ result &= *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void siall_i8 (gfc_array_i8 * const restrict,
+ gfc_array_i8 * const restrict, const index_type * const restrict,
+ GFC_LOGICAL_4 *);
+export_proto(siall_i8);
+
+void
+siall_i8 (gfc_array_i8 * const restrict retarray,
+ gfc_array_i8 * const restrict array,
+ const index_type * const restrict pdim,
+ GFC_LOGICAL_4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_8 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type dim;
+
+
+ if (*mask)
+ {
+ iall_i8 (retarray, array, pdim);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ for (n = 0; n < dim; n++)
+ {
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ for (n = dim; n < rank; n++)
+ {
+ extent[n] =
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IALL intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " IALL intrinsic in dimension %ld:"
+ " is %ld, should be %ld", (long int) n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ }
+
+ dest = retarray->data;
+
+ while(1)
+ {
+ *dest = 0;
+ count[0]++;
+ dest += dstride[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. */
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ return;
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
diff --git a/libgfortran/generated/iany_i1.c b/libgfortran/generated/iany_i1.c
new file mode 100644
index 0000000..e5d7855
--- /dev/null
+++ b/libgfortran/generated/iany_i1.c
@@ -0,0 +1,509 @@
+/* Implementation of the IANY intrinsic
+ Copyright 2010 Free Software Foundation, Inc.
+ Contributed by Tobias Burnus <burnus@net-b.de>
+
+This file is part of the GNU Fortran 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 3 of the License, or (at your option) any later version.
+
+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.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <assert.h>
+
+
+#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_1)
+
+
+extern void iany_i1 (gfc_array_i1 * const restrict,
+ gfc_array_i1 * const restrict, const index_type * const restrict);
+export_proto(iany_i1);
+
+void
+iany_i1 (gfc_array_i1 * const restrict retarray,
+ gfc_array_i1 * const restrict array,
+ const index_type * const restrict pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_INTEGER_1 * restrict base;
+ GFC_INTEGER_1 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IANY intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IANY");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ continue_loop = 1;
+ while (continue_loop)
+ {
+ const GFC_INTEGER_1 * restrict src;
+ GFC_INTEGER_1 result;
+ src = base;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ result |= *src;
+ }
+
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void miany_i1 (gfc_array_i1 * const restrict,
+ gfc_array_i1 * const restrict, const index_type * const restrict,
+ gfc_array_l1 * const restrict);
+export_proto(miany_i1);
+
+void
+miany_i1 (gfc_array_i1 * const restrict retarray,
+ gfc_array_i1 * const restrict array,
+ const index_type * const restrict pdim,
+ gfc_array_l1 * const restrict mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_1 * restrict dest;
+ const GFC_INTEGER_1 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ int mask_kind;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len <= 0)
+ return;
+
+ mbase = mask->data;
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+ || mask_kind == 16
+#endif
+ )
+ mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+ else
+ runtime_error ("Funny sized logical array");
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in IANY intrinsic");
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IANY");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "IANY");
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->data;
+ base = array->data;
+
+ while (base)
+ {
+ const GFC_INTEGER_1 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ GFC_INTEGER_1 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc)
+ result |= *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void siany_i1 (gfc_array_i1 * const restrict,
+ gfc_array_i1 * const restrict, const index_type * const restrict,
+ GFC_LOGICAL_4 *);
+export_proto(siany_i1);
+
+void
+siany_i1 (gfc_array_i1 * const restrict retarray,
+ gfc_array_i1 * const restrict array,
+ const index_type * const restrict pdim,
+ GFC_LOGICAL_4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_1 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type dim;
+
+
+ if (*mask)
+ {
+ iany_i1 (retarray, array, pdim);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ for (n = 0; n < dim; n++)
+ {
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ for (n = dim; n < rank; n++)
+ {
+ extent[n] =
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IANY intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " IANY intrinsic in dimension %ld:"
+ " is %ld, should be %ld", (long int) n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ }
+
+ dest = retarray->data;
+
+ while(1)
+ {
+ *dest = 0;
+ count[0]++;
+ dest += dstride[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. */
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ return;
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
diff --git a/libgfortran/generated/iany_i16.c b/libgfortran/generated/iany_i16.c
new file mode 100644
index 0000000..20d14d5
--- /dev/null
+++ b/libgfortran/generated/iany_i16.c
@@ -0,0 +1,509 @@
+/* Implementation of the IANY intrinsic
+ Copyright 2010 Free Software Foundation, Inc.
+ Contributed by Tobias Burnus <burnus@net-b.de>
+
+This file is part of the GNU Fortran 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 3 of the License, or (at your option) any later version.
+
+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.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <assert.h>
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void iany_i16 (gfc_array_i16 * const restrict,
+ gfc_array_i16 * const restrict, const index_type * const restrict);
+export_proto(iany_i16);
+
+void
+iany_i16 (gfc_array_i16 * const restrict retarray,
+ gfc_array_i16 * const restrict array,
+ const index_type * const restrict pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_INTEGER_16 * restrict base;
+ GFC_INTEGER_16 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IANY intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IANY");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ continue_loop = 1;
+ while (continue_loop)
+ {
+ const GFC_INTEGER_16 * restrict src;
+ GFC_INTEGER_16 result;
+ src = base;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ result |= *src;
+ }
+
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void miany_i16 (gfc_array_i16 * const restrict,
+ gfc_array_i16 * const restrict, const index_type * const restrict,
+ gfc_array_l1 * const restrict);
+export_proto(miany_i16);
+
+void
+miany_i16 (gfc_array_i16 * const restrict retarray,
+ gfc_array_i16 * const restrict array,
+ const index_type * const restrict pdim,
+ gfc_array_l1 * const restrict mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 * restrict dest;
+ const GFC_INTEGER_16 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ int mask_kind;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len <= 0)
+ return;
+
+ mbase = mask->data;
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+ || mask_kind == 16
+#endif
+ )
+ mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+ else
+ runtime_error ("Funny sized logical array");
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in IANY intrinsic");
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IANY");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "IANY");
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->data;
+ base = array->data;
+
+ while (base)
+ {
+ const GFC_INTEGER_16 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ GFC_INTEGER_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc)
+ result |= *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void siany_i16 (gfc_array_i16 * const restrict,
+ gfc_array_i16 * const restrict, const index_type * const restrict,
+ GFC_LOGICAL_4 *);
+export_proto(siany_i16);
+
+void
+siany_i16 (gfc_array_i16 * const restrict retarray,
+ gfc_array_i16 * const restrict array,
+ const index_type * const restrict pdim,
+ GFC_LOGICAL_4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type dim;
+
+
+ if (*mask)
+ {
+ iany_i16 (retarray, array, pdim);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ for (n = 0; n < dim; n++)
+ {
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ for (n = dim; n < rank; n++)
+ {
+ extent[n] =
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IANY intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " IANY intrinsic in dimension %ld:"
+ " is %ld, should be %ld", (long int) n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ }
+
+ dest = retarray->data;
+
+ while(1)
+ {
+ *dest = 0;
+ count[0]++;
+ dest += dstride[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. */
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ return;
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
diff --git a/libgfortran/generated/iany_i2.c b/libgfortran/generated/iany_i2.c
new file mode 100644
index 0000000..b464c5d
--- /dev/null
+++ b/libgfortran/generated/iany_i2.c
@@ -0,0 +1,509 @@
+/* Implementation of the IANY intrinsic
+ Copyright 2010 Free Software Foundation, Inc.
+ Contributed by Tobias Burnus <burnus@net-b.de>
+
+This file is part of the GNU Fortran 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 3 of the License, or (at your option) any later version.
+
+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.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <assert.h>
+
+
+#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_2)
+
+
+extern void iany_i2 (gfc_array_i2 * const restrict,
+ gfc_array_i2 * const restrict, const index_type * const restrict);
+export_proto(iany_i2);
+
+void
+iany_i2 (gfc_array_i2 * const restrict retarray,
+ gfc_array_i2 * const restrict array,
+ const index_type * const restrict pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_INTEGER_2 * restrict base;
+ GFC_INTEGER_2 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IANY intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IANY");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ continue_loop = 1;
+ while (continue_loop)
+ {
+ const GFC_INTEGER_2 * restrict src;
+ GFC_INTEGER_2 result;
+ src = base;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ result |= *src;
+ }
+
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void miany_i2 (gfc_array_i2 * const restrict,
+ gfc_array_i2 * const restrict, const index_type * const restrict,
+ gfc_array_l1 * const restrict);
+export_proto(miany_i2);
+
+void
+miany_i2 (gfc_array_i2 * const restrict retarray,
+ gfc_array_i2 * const restrict array,
+ const index_type * const restrict pdim,
+ gfc_array_l1 * const restrict mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_2 * restrict dest;
+ const GFC_INTEGER_2 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ int mask_kind;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len <= 0)
+ return;
+
+ mbase = mask->data;
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+ || mask_kind == 16
+#endif
+ )
+ mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+ else
+ runtime_error ("Funny sized logical array");
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in IANY intrinsic");
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IANY");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "IANY");
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->data;
+ base = array->data;
+
+ while (base)
+ {
+ const GFC_INTEGER_2 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ GFC_INTEGER_2 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc)
+ result |= *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void siany_i2 (gfc_array_i2 * const restrict,
+ gfc_array_i2 * const restrict, const index_type * const restrict,
+ GFC_LOGICAL_4 *);
+export_proto(siany_i2);
+
+void
+siany_i2 (gfc_array_i2 * const restrict retarray,
+ gfc_array_i2 * const restrict array,
+ const index_type * const restrict pdim,
+ GFC_LOGICAL_4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_2 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type dim;
+
+
+ if (*mask)
+ {
+ iany_i2 (retarray, array, pdim);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ for (n = 0; n < dim; n++)
+ {
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ for (n = dim; n < rank; n++)
+ {
+ extent[n] =
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IANY intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " IANY intrinsic in dimension %ld:"
+ " is %ld, should be %ld", (long int) n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ }
+
+ dest = retarray->data;
+
+ while(1)
+ {
+ *dest = 0;
+ count[0]++;
+ dest += dstride[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. */
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ return;
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
diff --git a/libgfortran/generated/iany_i4.c b/libgfortran/generated/iany_i4.c
new file mode 100644
index 0000000..3e20282
--- /dev/null
+++ b/libgfortran/generated/iany_i4.c
@@ -0,0 +1,509 @@
+/* Implementation of the IANY intrinsic
+ Copyright 2010 Free Software Foundation, Inc.
+ Contributed by Tobias Burnus <burnus@net-b.de>
+
+This file is part of the GNU Fortran 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 3 of the License, or (at your option) any later version.
+
+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.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <assert.h>
+
+
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void iany_i4 (gfc_array_i4 * const restrict,
+ gfc_array_i4 * const restrict, const index_type * const restrict);
+export_proto(iany_i4);
+
+void
+iany_i4 (gfc_array_i4 * const restrict retarray,
+ gfc_array_i4 * const restrict array,
+ const index_type * const restrict pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_INTEGER_4 * restrict base;
+ GFC_INTEGER_4 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IANY intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IANY");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ continue_loop = 1;
+ while (continue_loop)
+ {
+ const GFC_INTEGER_4 * restrict src;
+ GFC_INTEGER_4 result;
+ src = base;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ result |= *src;
+ }
+
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void miany_i4 (gfc_array_i4 * const restrict,
+ gfc_array_i4 * const restrict, const index_type * const restrict,
+ gfc_array_l1 * const restrict);
+export_proto(miany_i4);
+
+void
+miany_i4 (gfc_array_i4 * const restrict retarray,
+ gfc_array_i4 * const restrict array,
+ const index_type * const restrict pdim,
+ gfc_array_l1 * const restrict mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_4 * restrict dest;
+ const GFC_INTEGER_4 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ int mask_kind;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len <= 0)
+ return;
+
+ mbase = mask->data;
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+ || mask_kind == 16
+#endif
+ )
+ mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+ else
+ runtime_error ("Funny sized logical array");
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in IANY intrinsic");
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IANY");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "IANY");
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->data;
+ base = array->data;
+
+ while (base)
+ {
+ const GFC_INTEGER_4 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ GFC_INTEGER_4 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc)
+ result |= *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void siany_i4 (gfc_array_i4 * const restrict,
+ gfc_array_i4 * const restrict, const index_type * const restrict,
+ GFC_LOGICAL_4 *);
+export_proto(siany_i4);
+
+void
+siany_i4 (gfc_array_i4 * const restrict retarray,
+ gfc_array_i4 * const restrict array,
+ const index_type * const restrict pdim,
+ GFC_LOGICAL_4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_4 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type dim;
+
+
+ if (*mask)
+ {
+ iany_i4 (retarray, array, pdim);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ for (n = 0; n < dim; n++)
+ {
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ for (n = dim; n < rank; n++)
+ {
+ extent[n] =
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IANY intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " IANY intrinsic in dimension %ld:"
+ " is %ld, should be %ld", (long int) n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ }
+
+ dest = retarray->data;
+
+ while(1)
+ {
+ *dest = 0;
+ count[0]++;
+ dest += dstride[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. */
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ return;
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
diff --git a/libgfortran/generated/iany_i8.c b/libgfortran/generated/iany_i8.c
new file mode 100644
index 0000000..8c89e4d
--- /dev/null
+++ b/libgfortran/generated/iany_i8.c
@@ -0,0 +1,509 @@
+/* Implementation of the IANY intrinsic
+ Copyright 2010 Free Software Foundation, Inc.
+ Contributed by Tobias Burnus <burnus@net-b.de>
+
+This file is part of the GNU Fortran 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 3 of the License, or (at your option) any later version.
+
+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.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <assert.h>
+
+
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void iany_i8 (gfc_array_i8 * const restrict,
+ gfc_array_i8 * const restrict, const index_type * const restrict);
+export_proto(iany_i8);
+
+void
+iany_i8 (gfc_array_i8 * const restrict retarray,
+ gfc_array_i8 * const restrict array,
+ const index_type * const restrict pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_INTEGER_8 * restrict base;
+ GFC_INTEGER_8 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IANY intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IANY");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ continue_loop = 1;
+ while (continue_loop)
+ {
+ const GFC_INTEGER_8 * restrict src;
+ GFC_INTEGER_8 result;
+ src = base;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ result |= *src;
+ }
+
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void miany_i8 (gfc_array_i8 * const restrict,
+ gfc_array_i8 * const restrict, const index_type * const restrict,
+ gfc_array_l1 * const restrict);
+export_proto(miany_i8);
+
+void
+miany_i8 (gfc_array_i8 * const restrict retarray,
+ gfc_array_i8 * const restrict array,
+ const index_type * const restrict pdim,
+ gfc_array_l1 * const restrict mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_8 * restrict dest;
+ const GFC_INTEGER_8 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ int mask_kind;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len <= 0)
+ return;
+
+ mbase = mask->data;
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+ || mask_kind == 16
+#endif
+ )
+ mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+ else
+ runtime_error ("Funny sized logical array");
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in IANY intrinsic");
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IANY");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "IANY");
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->data;
+ base = array->data;
+
+ while (base)
+ {
+ const GFC_INTEGER_8 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ GFC_INTEGER_8 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc)
+ result |= *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void siany_i8 (gfc_array_i8 * const restrict,
+ gfc_array_i8 * const restrict, const index_type * const restrict,
+ GFC_LOGICAL_4 *);
+export_proto(siany_i8);
+
+void
+siany_i8 (gfc_array_i8 * const restrict retarray,
+ gfc_array_i8 * const restrict array,
+ const index_type * const restrict pdim,
+ GFC_LOGICAL_4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_8 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type dim;
+
+
+ if (*mask)
+ {
+ iany_i8 (retarray, array, pdim);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ for (n = 0; n < dim; n++)
+ {
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ for (n = dim; n < rank; n++)
+ {
+ extent[n] =
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IANY intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " IANY intrinsic in dimension %ld:"
+ " is %ld, should be %ld", (long int) n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ }
+
+ dest = retarray->data;
+
+ while(1)
+ {
+ *dest = 0;
+ count[0]++;
+ dest += dstride[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. */
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ return;
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
diff --git a/libgfortran/generated/iparity_i1.c b/libgfortran/generated/iparity_i1.c
new file mode 100644
index 0000000..35c51c0
--- /dev/null
+++ b/libgfortran/generated/iparity_i1.c
@@ -0,0 +1,509 @@
+/* Implementation of the IPARITY intrinsic
+ Copyright 2010 Free Software Foundation, Inc.
+ Contributed by Tobias Burnus <burnus@net-b.de>
+
+This file is part of the GNU Fortran 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 3 of the License, or (at your option) any later version.
+
+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.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <assert.h>
+
+
+#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_1)
+
+
+extern void iparity_i1 (gfc_array_i1 * const restrict,
+ gfc_array_i1 * const restrict, const index_type * const restrict);
+export_proto(iparity_i1);
+
+void
+iparity_i1 (gfc_array_i1 * const restrict retarray,
+ gfc_array_i1 * const restrict array,
+ const index_type * const restrict pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_INTEGER_1 * restrict base;
+ GFC_INTEGER_1 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IPARITY intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IPARITY");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ continue_loop = 1;
+ while (continue_loop)
+ {
+ const GFC_INTEGER_1 * restrict src;
+ GFC_INTEGER_1 result;
+ src = base;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ result ^= *src;
+ }
+
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void miparity_i1 (gfc_array_i1 * const restrict,
+ gfc_array_i1 * const restrict, const index_type * const restrict,
+ gfc_array_l1 * const restrict);
+export_proto(miparity_i1);
+
+void
+miparity_i1 (gfc_array_i1 * const restrict retarray,
+ gfc_array_i1 * const restrict array,
+ const index_type * const restrict pdim,
+ gfc_array_l1 * const restrict mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_1 * restrict dest;
+ const GFC_INTEGER_1 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ int mask_kind;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len <= 0)
+ return;
+
+ mbase = mask->data;
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+ || mask_kind == 16
+#endif
+ )
+ mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+ else
+ runtime_error ("Funny sized logical array");
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in IPARITY intrinsic");
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IPARITY");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "IPARITY");
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->data;
+ base = array->data;
+
+ while (base)
+ {
+ const GFC_INTEGER_1 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ GFC_INTEGER_1 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc)
+ result ^= *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void siparity_i1 (gfc_array_i1 * const restrict,
+ gfc_array_i1 * const restrict, const index_type * const restrict,
+ GFC_LOGICAL_4 *);
+export_proto(siparity_i1);
+
+void
+siparity_i1 (gfc_array_i1 * const restrict retarray,
+ gfc_array_i1 * const restrict array,
+ const index_type * const restrict pdim,
+ GFC_LOGICAL_4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_1 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type dim;
+
+
+ if (*mask)
+ {
+ iparity_i1 (retarray, array, pdim);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ for (n = 0; n < dim; n++)
+ {
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ for (n = dim; n < rank; n++)
+ {
+ extent[n] =
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IPARITY intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " IPARITY intrinsic in dimension %ld:"
+ " is %ld, should be %ld", (long int) n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ }
+
+ dest = retarray->data;
+
+ while(1)
+ {
+ *dest = 0;
+ count[0]++;
+ dest += dstride[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. */
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ return;
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
diff --git a/libgfortran/generated/iparity_i16.c b/libgfortran/generated/iparity_i16.c
new file mode 100644
index 0000000..608fe22
--- /dev/null
+++ b/libgfortran/generated/iparity_i16.c
@@ -0,0 +1,509 @@
+/* Implementation of the IPARITY intrinsic
+ Copyright 2010 Free Software Foundation, Inc.
+ Contributed by Tobias Burnus <burnus@net-b.de>
+
+This file is part of the GNU Fortran 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 3 of the License, or (at your option) any later version.
+
+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.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <assert.h>
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void iparity_i16 (gfc_array_i16 * const restrict,
+ gfc_array_i16 * const restrict, const index_type * const restrict);
+export_proto(iparity_i16);
+
+void
+iparity_i16 (gfc_array_i16 * const restrict retarray,
+ gfc_array_i16 * const restrict array,
+ const index_type * const restrict pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_INTEGER_16 * restrict base;
+ GFC_INTEGER_16 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IPARITY intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IPARITY");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ continue_loop = 1;
+ while (continue_loop)
+ {
+ const GFC_INTEGER_16 * restrict src;
+ GFC_INTEGER_16 result;
+ src = base;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ result ^= *src;
+ }
+
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void miparity_i16 (gfc_array_i16 * const restrict,
+ gfc_array_i16 * const restrict, const index_type * const restrict,
+ gfc_array_l1 * const restrict);
+export_proto(miparity_i16);
+
+void
+miparity_i16 (gfc_array_i16 * const restrict retarray,
+ gfc_array_i16 * const restrict array,
+ const index_type * const restrict pdim,
+ gfc_array_l1 * const restrict mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 * restrict dest;
+ const GFC_INTEGER_16 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ int mask_kind;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len <= 0)
+ return;
+
+ mbase = mask->data;
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+ || mask_kind == 16
+#endif
+ )
+ mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+ else
+ runtime_error ("Funny sized logical array");
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in IPARITY intrinsic");
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IPARITY");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "IPARITY");
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->data;
+ base = array->data;
+
+ while (base)
+ {
+ const GFC_INTEGER_16 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ GFC_INTEGER_16 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc)
+ result ^= *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void siparity_i16 (gfc_array_i16 * const restrict,
+ gfc_array_i16 * const restrict, const index_type * const restrict,
+ GFC_LOGICAL_4 *);
+export_proto(siparity_i16);
+
+void
+siparity_i16 (gfc_array_i16 * const restrict retarray,
+ gfc_array_i16 * const restrict array,
+ const index_type * const restrict pdim,
+ GFC_LOGICAL_4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_16 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type dim;
+
+
+ if (*mask)
+ {
+ iparity_i16 (retarray, array, pdim);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ for (n = 0; n < dim; n++)
+ {
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ for (n = dim; n < rank; n++)
+ {
+ extent[n] =
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IPARITY intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " IPARITY intrinsic in dimension %ld:"
+ " is %ld, should be %ld", (long int) n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ }
+
+ dest = retarray->data;
+
+ while(1)
+ {
+ *dest = 0;
+ count[0]++;
+ dest += dstride[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. */
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ return;
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
diff --git a/libgfortran/generated/iparity_i2.c b/libgfortran/generated/iparity_i2.c
new file mode 100644
index 0000000..a1e465c
--- /dev/null
+++ b/libgfortran/generated/iparity_i2.c
@@ -0,0 +1,509 @@
+/* Implementation of the IPARITY intrinsic
+ Copyright 2010 Free Software Foundation, Inc.
+ Contributed by Tobias Burnus <burnus@net-b.de>
+
+This file is part of the GNU Fortran 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 3 of the License, or (at your option) any later version.
+
+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.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <assert.h>
+
+
+#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_2)
+
+
+extern void iparity_i2 (gfc_array_i2 * const restrict,
+ gfc_array_i2 * const restrict, const index_type * const restrict);
+export_proto(iparity_i2);
+
+void
+iparity_i2 (gfc_array_i2 * const restrict retarray,
+ gfc_array_i2 * const restrict array,
+ const index_type * const restrict pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_INTEGER_2 * restrict base;
+ GFC_INTEGER_2 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IPARITY intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IPARITY");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ continue_loop = 1;
+ while (continue_loop)
+ {
+ const GFC_INTEGER_2 * restrict src;
+ GFC_INTEGER_2 result;
+ src = base;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ result ^= *src;
+ }
+
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void miparity_i2 (gfc_array_i2 * const restrict,
+ gfc_array_i2 * const restrict, const index_type * const restrict,
+ gfc_array_l1 * const restrict);
+export_proto(miparity_i2);
+
+void
+miparity_i2 (gfc_array_i2 * const restrict retarray,
+ gfc_array_i2 * const restrict array,
+ const index_type * const restrict pdim,
+ gfc_array_l1 * const restrict mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_2 * restrict dest;
+ const GFC_INTEGER_2 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ int mask_kind;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len <= 0)
+ return;
+
+ mbase = mask->data;
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+ || mask_kind == 16
+#endif
+ )
+ mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+ else
+ runtime_error ("Funny sized logical array");
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in IPARITY intrinsic");
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IPARITY");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "IPARITY");
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->data;
+ base = array->data;
+
+ while (base)
+ {
+ const GFC_INTEGER_2 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ GFC_INTEGER_2 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc)
+ result ^= *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void siparity_i2 (gfc_array_i2 * const restrict,
+ gfc_array_i2 * const restrict, const index_type * const restrict,
+ GFC_LOGICAL_4 *);
+export_proto(siparity_i2);
+
+void
+siparity_i2 (gfc_array_i2 * const restrict retarray,
+ gfc_array_i2 * const restrict array,
+ const index_type * const restrict pdim,
+ GFC_LOGICAL_4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_2 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type dim;
+
+
+ if (*mask)
+ {
+ iparity_i2 (retarray, array, pdim);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ for (n = 0; n < dim; n++)
+ {
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ for (n = dim; n < rank; n++)
+ {
+ extent[n] =
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IPARITY intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " IPARITY intrinsic in dimension %ld:"
+ " is %ld, should be %ld", (long int) n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ }
+
+ dest = retarray->data;
+
+ while(1)
+ {
+ *dest = 0;
+ count[0]++;
+ dest += dstride[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. */
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ return;
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
diff --git a/libgfortran/generated/iparity_i4.c b/libgfortran/generated/iparity_i4.c
new file mode 100644
index 0000000..e4a492cb
--- /dev/null
+++ b/libgfortran/generated/iparity_i4.c
@@ -0,0 +1,509 @@
+/* Implementation of the IPARITY intrinsic
+ Copyright 2010 Free Software Foundation, Inc.
+ Contributed by Tobias Burnus <burnus@net-b.de>
+
+This file is part of the GNU Fortran 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 3 of the License, or (at your option) any later version.
+
+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.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <assert.h>
+
+
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void iparity_i4 (gfc_array_i4 * const restrict,
+ gfc_array_i4 * const restrict, const index_type * const restrict);
+export_proto(iparity_i4);
+
+void
+iparity_i4 (gfc_array_i4 * const restrict retarray,
+ gfc_array_i4 * const restrict array,
+ const index_type * const restrict pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_INTEGER_4 * restrict base;
+ GFC_INTEGER_4 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IPARITY intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IPARITY");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ continue_loop = 1;
+ while (continue_loop)
+ {
+ const GFC_INTEGER_4 * restrict src;
+ GFC_INTEGER_4 result;
+ src = base;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ result ^= *src;
+ }
+
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void miparity_i4 (gfc_array_i4 * const restrict,
+ gfc_array_i4 * const restrict, const index_type * const restrict,
+ gfc_array_l1 * const restrict);
+export_proto(miparity_i4);
+
+void
+miparity_i4 (gfc_array_i4 * const restrict retarray,
+ gfc_array_i4 * const restrict array,
+ const index_type * const restrict pdim,
+ gfc_array_l1 * const restrict mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_4 * restrict dest;
+ const GFC_INTEGER_4 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ int mask_kind;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len <= 0)
+ return;
+
+ mbase = mask->data;
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+ || mask_kind == 16
+#endif
+ )
+ mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+ else
+ runtime_error ("Funny sized logical array");
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in IPARITY intrinsic");
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IPARITY");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "IPARITY");
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->data;
+ base = array->data;
+
+ while (base)
+ {
+ const GFC_INTEGER_4 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ GFC_INTEGER_4 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc)
+ result ^= *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void siparity_i4 (gfc_array_i4 * const restrict,
+ gfc_array_i4 * const restrict, const index_type * const restrict,
+ GFC_LOGICAL_4 *);
+export_proto(siparity_i4);
+
+void
+siparity_i4 (gfc_array_i4 * const restrict retarray,
+ gfc_array_i4 * const restrict array,
+ const index_type * const restrict pdim,
+ GFC_LOGICAL_4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_4 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type dim;
+
+
+ if (*mask)
+ {
+ iparity_i4 (retarray, array, pdim);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ for (n = 0; n < dim; n++)
+ {
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ for (n = dim; n < rank; n++)
+ {
+ extent[n] =
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IPARITY intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " IPARITY intrinsic in dimension %ld:"
+ " is %ld, should be %ld", (long int) n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ }
+
+ dest = retarray->data;
+
+ while(1)
+ {
+ *dest = 0;
+ count[0]++;
+ dest += dstride[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. */
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ return;
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
diff --git a/libgfortran/generated/iparity_i8.c b/libgfortran/generated/iparity_i8.c
new file mode 100644
index 0000000..b399751
--- /dev/null
+++ b/libgfortran/generated/iparity_i8.c
@@ -0,0 +1,509 @@
+/* Implementation of the IPARITY intrinsic
+ Copyright 2010 Free Software Foundation, Inc.
+ Contributed by Tobias Burnus <burnus@net-b.de>
+
+This file is part of the GNU Fortran 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 3 of the License, or (at your option) any later version.
+
+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.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <assert.h>
+
+
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void iparity_i8 (gfc_array_i8 * const restrict,
+ gfc_array_i8 * const restrict, const index_type * const restrict);
+export_proto(iparity_i8);
+
+void
+iparity_i8 (gfc_array_i8 * const restrict retarray,
+ gfc_array_i8 * const restrict array,
+ const index_type * const restrict pdim)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_INTEGER_8 * restrict base;
+ GFC_INTEGER_8 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type dim;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IPARITY intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IPARITY");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ len = 0;
+ }
+
+ base = array->data;
+ dest = retarray->data;
+
+ continue_loop = 1;
+ while (continue_loop)
+ {
+ const GFC_INTEGER_8 * restrict src;
+ GFC_INTEGER_8 result;
+ src = base;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta)
+ {
+
+ result ^= *src;
+ }
+
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void miparity_i8 (gfc_array_i8 * const restrict,
+ gfc_array_i8 * const restrict, const index_type * const restrict,
+ gfc_array_l1 * const restrict);
+export_proto(miparity_i8);
+
+void
+miparity_i8 (gfc_array_i8 * const restrict retarray,
+ gfc_array_i8 * const restrict array,
+ const index_type * const restrict pdim,
+ gfc_array_l1 * const restrict mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_8 * restrict dest;
+ const GFC_INTEGER_8 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ int rank;
+ int dim;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ int mask_kind;
+
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len <= 0)
+ return;
+
+ mbase = mask->data;
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
+#ifdef HAVE_GFC_LOGICAL_16
+ || mask_kind == 16
+#endif
+ )
+ mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
+ else
+ runtime_error ("Funny sized logical array");
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ for (n = 0; n < dim; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+
+ }
+ for (n = dim; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
+
+ if (extent[n] < 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in IPARITY intrinsic");
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "IPARITY");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "IPARITY");
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->data;
+ base = array->data;
+
+ while (base)
+ {
+ const GFC_INTEGER_8 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ GFC_INTEGER_8 result;
+ src = base;
+ msrc = mbase;
+ {
+
+ result = 0;
+ if (len <= 0)
+ *dest = 0;
+ else
+ {
+ for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+ {
+
+ if (*msrc)
+ result ^= *src;
+ }
+ *dest = result;
+ }
+ }
+ /* Advance to the next element. */
+ count[0]++;
+ base += sstride[0];
+ mbase += mstride[0];
+ dest += dstride[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. */
+ base -= sstride[n] * extent[n];
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ {
+ /* Break out of the look. */
+ base = NULL;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n];
+ mbase += mstride[n];
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+
+extern void siparity_i8 (gfc_array_i8 * const restrict,
+ gfc_array_i8 * const restrict, const index_type * const restrict,
+ GFC_LOGICAL_4 *);
+export_proto(siparity_i8);
+
+void
+siparity_i8 (gfc_array_i8 * const restrict retarray,
+ gfc_array_i8 * const restrict array,
+ const index_type * const restrict pdim,
+ GFC_LOGICAL_4 * mask)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ GFC_INTEGER_8 * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type dim;
+
+
+ if (*mask)
+ {
+ iparity_i8 (retarray, array, pdim);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ dim = (*pdim) - 1;
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+ for (n = 0; n < dim; n++)
+ {
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ for (n = dim; n < rank; n++)
+ {
+ extent[n] =
+ GFC_DESCRIPTOR_EXTENT(array,n + 1);
+
+ if (extent[n] <= 0)
+ extent[n] = 0;
+ }
+
+ if (retarray->data == NULL)
+ {
+ size_t alloc_size, str;
+
+ for (n = 0; n < rank; n++)
+ {
+ if (n == 0)
+ str = 1;
+ else
+ str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
+
+ GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
+
+ }
+
+ retarray->offset = 0;
+ retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+
+ alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
+ * extent[rank-1];
+
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ else
+ retarray->data = internal_malloc_size (alloc_size);
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " IPARITY intrinsic: is %ld, should be %ld",
+ (long int) (GFC_DESCRIPTOR_RANK (retarray)),
+ (long int) rank);
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " IPARITY intrinsic in dimension %ld:"
+ " is %ld, should be %ld", (long int) n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ }
+
+ dest = retarray->data;
+
+ while(1)
+ {
+ *dest = 0;
+ count[0]++;
+ dest += dstride[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. */
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n == rank)
+ return;
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+
+#endif
diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map
index 72dafa6..ea6ebfa 100644
--- a/libgfortran/gfortran.map
+++ b/libgfortran/gfortran.map
@@ -1107,8 +1107,6 @@ GFORTRAN_1.3 {
GFORTRAN_1.4 {
global:
- _gfortran_error_stop_numeric;
- _gfortran_selected_real_kind2008;
_gfortran_bessel_jn_r4;
_gfortran_bessel_jn_r8;
_gfortran_bessel_jn_r10;
@@ -1117,6 +1115,22 @@ GFORTRAN_1.4 {
_gfortran_bessel_yn_r8;
_gfortran_bessel_yn_r10;
_gfortran_bessel_yn_r16;
+ _gfortran_error_stop_numeric;
+ _gfortran_iall_i1;
+ _gfortran_iall_i2;
+ _gfortran_iall_i4;
+ _gfortran_iall_i8;
+ _gfortran_iall_i16;
+ _gfortran_iany_i1;
+ _gfortran_iany_i2;
+ _gfortran_iany_i4;
+ _gfortran_iany_i8;
+ _gfortran_iany_i16;
+ _gfortran_iparity_i1;
+ _gfortran_iparity_i2;
+ _gfortran_iparity_i4;
+ _gfortran_iparity_i8;
+ _gfortran_iparity_i16;
_gfortran_norm2_r4;
_gfortran_norm2_r8;
_gfortran_norm2_r10;
@@ -1126,6 +1140,7 @@ GFORTRAN_1.4 {
_gfortran_parity_l4;
_gfortran_parity_l8;
_gfortran_parity_l16;
+ _gfortran_selected_real_kind2008;
} GFORTRAN_1.3;
F2C_1.0 {
diff --git a/libgfortran/m4/iall.m4 b/libgfortran/m4/iall.m4
new file mode 100644
index 0000000..2e6667e
--- /dev/null
+++ b/libgfortran/m4/iall.m4
@@ -0,0 +1,46 @@
+`/* Implementation of the IALL intrinsic
+ Copyright 2010 Free Software Foundation, Inc.
+ Contributed by Tobias Burnus <burnus@net-b.de>
+
+This file is part of the GNU Fortran 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 3 of the License, or (at your option) any later version.
+
+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.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <assert.h>'
+
+include(iparm.m4)dnl
+include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
+ARRAY_FUNCTION(0,
+` result = ('rtype_name`) -1;',
+` result &= *src;')
+
+MASKED_ARRAY_FUNCTION(0,
+` result = 0;',
+` if (*msrc)
+ result &= *src;')
+
+SCALAR_ARRAY_FUNCTION(0)
+
+#endif
diff --git a/libgfortran/m4/iany.m4 b/libgfortran/m4/iany.m4
new file mode 100644
index 0000000..a17d951
--- /dev/null
+++ b/libgfortran/m4/iany.m4
@@ -0,0 +1,46 @@
+`/* Implementation of the IANY intrinsic
+ Copyright 2010 Free Software Foundation, Inc.
+ Contributed by Tobias Burnus <burnus@net-b.de>
+
+This file is part of the GNU Fortran 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 3 of the License, or (at your option) any later version.
+
+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.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <assert.h>'
+
+include(iparm.m4)dnl
+include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
+ARRAY_FUNCTION(0,
+` result = 0;',
+` result |= *src;')
+
+MASKED_ARRAY_FUNCTION(0,
+` result = 0;',
+` if (*msrc)
+ result |= *src;')
+
+SCALAR_ARRAY_FUNCTION(0)
+
+#endif
diff --git a/libgfortran/m4/iparity.m4 b/libgfortran/m4/iparity.m4
new file mode 100644
index 0000000..78dbc3d
--- /dev/null
+++ b/libgfortran/m4/iparity.m4
@@ -0,0 +1,46 @@
+`/* Implementation of the IPARITY intrinsic
+ Copyright 2010 Free Software Foundation, Inc.
+ Contributed by Tobias Burnus <burnus@net-b.de>
+
+This file is part of the GNU Fortran 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 3 of the License, or (at your option) any later version.
+
+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.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "libgfortran.h"
+#include <stdlib.h>
+#include <assert.h>'
+
+include(iparm.m4)dnl
+include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
+ARRAY_FUNCTION(0,
+` result = 0;',
+` result ^= *src;')
+
+MASKED_ARRAY_FUNCTION(0,
+` result = 0;',
+` if (*msrc)
+ result ^= *src;')
+
+SCALAR_ARRAY_FUNCTION(0)
+
+#endif