aboutsummaryrefslogtreecommitdiff
path: root/libgfortran
diff options
context:
space:
mode:
authorThomas Koenig <tkoenig@gcc.gnu.org>2018-10-28 11:05:05 +0000
committerThomas Koenig <tkoenig@gcc.gnu.org>2018-10-28 11:05:05 +0000
commit01ce9e31a02c8039d88e90f983735104417bf034 (patch)
tree186e264d66218f12fbd3d71ace05c275c82f7518 /libgfortran
parentb10fb07830939a34f822008d61ed104be40123e0 (diff)
downloadgcc-01ce9e31a02c8039d88e90f983735104417bf034.zip
gcc-01ce9e31a02c8039d88e90f983735104417bf034.tar.gz
gcc-01ce9e31a02c8039d88e90f983735104417bf034.tar.bz2
re PR fortran/54613 ([F08] Add FINDLOC plus support MAXLOC/MINLOC with KIND=/BACK=)
2017-10-28 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/54613 * gfortran.h (gfc_isym_id): Add GFC_ISYM_FINDLOC. (gfc_check_f): Add f6fl field. (gfc_simplify_f): Add f6 field. (gfc_resolve_f): Likewise. (gfc_type_letter): Add optional logical_equas_int flag. * check.c (intrinsic_type_check): New function. (gfc_check_findloc): New function. * intrinsics.c (gfc_type_letter): If logical_equals_int is set, act accordingly. (add_sym_5ml): Reformat comment. (add_sym_6fl): New function. (add_functions): Add findloc. (check_arglist): Add sixth argument, handle it. (resolve_intrinsic): Likewise. (check_specific): Handle findloc. * intrinsic.h (gfc_check_findloc): Add prototype. (gfc_simplify_findloc): Likewise. (gfc_resolve_findloc): Likewise. (MAX_INTRINSIC_ARGS): Adjust. * iresolve.c (gfc_resolve_findloc): New function. * simplify.c (gfc_simplify_minmaxloc): Make static. (simplify_findloc_to_scalar): New function. (simplify_findloc_nodim): New function. (simplify_findloc_to_array): New function. (gfc_simplify_findloc): New function. (gfc_conv_intrinsic_findloc): New function. (gfc_conv_intrinsic_function): Handle GFC_ISYM_FINDLOC. (gfc_is_intrinsic_libcall): Likewise. 2017-10-28 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/54613 * Makefile.am: Add files for findloc. * Makefile.in: Regenerated. * libgfortran.h (gfc_array_index_type): Add. (gfc_array_s1): Add using GFC_UINTEGER_1. (gfc_array_s4): Likewise. Replace unnecessary comment. (HAVE_GFC_UINTEGER_1): Define. (HAVE_GFC_UINTEGER_4): Define. * m4/findloc0.m4: New file. * m4/findloc0s.m4: New file. * m4/findloc1.m4: New file. * m4/findloc1s.m4: New file. * m4/findloc2s.m4: New file. * m4/ifindloc0.m4: New file. * m4/ifindloc1.m4: New file. * m4/ifindloc2.m4: New file. * m4/iparm.m4: Use unsigned integer for characters. * generated/findloc0_c16.c: New file. * generated/findloc0_c4.c: New file. * generated/findloc0_c8.c: New file. * generated/findloc0_i1.c: New file. * generated/findloc0_i16.c: New file. * generated/findloc0_i2.c: New file. * generated/findloc0_i4.c: New file. * generated/findloc0_i8.c: New file. * generated/findloc0_r16.c: New file. * generated/findloc0_r4.c: New file. * generated/findloc0_r8.c: New file. * generated/findloc0_s1.c: New file. * generated/findloc0_s4.c: New file. * generated/findloc1_c16.c: New file. * generated/findloc1_c4.c: New file. * generated/findloc1_c8.c: New file. * generated/findloc1_i1.c: New file. * generated/findloc1_i16.c: New file. * generated/findloc1_i2.c: New file. * generated/findloc1_i4.c: New file. * generated/findloc1_i8.c: New file. * generated/findloc1_r16.c: New file. * generated/findloc1_r4.c: New file. * generated/findloc1_r8.c: New file. * generated/findloc1_s1.c: New file. * generated/findloc1_s4.c: New file. * generated/findloc2_s1.c: New file. * generated/findloc2_s4.c: New file. * generated/maxloc0_16_s1.c: Regenerated. * generated/maxloc0_16_s4.c: Regenerated. * generated/maxloc0_4_s1.c: Regenerated. * generated/maxloc0_4_s4.c: Regenerated. * generated/maxloc0_8_s1.c: Regenerated. * generated/maxloc0_8_s4.c: Regenerated. * generated/maxloc1_16_s1.c: Regenerated. * generated/maxloc1_16_s4.c: Regenerated. * generated/maxloc1_4_s1.c: Regenerated. * generated/maxloc1_4_s4.c: Regenerated. * generated/maxloc1_8_s1.c: Regenerated. * generated/maxloc1_8_s4.c: Regenerated. * generated/maxloc2_16_s1.c: Regenerated. * generated/maxloc2_16_s4.c: Regenerated. * generated/maxloc2_4_s1.c: Regenerated. * generated/maxloc2_4_s4.c: Regenerated. * generated/maxloc2_8_s1.c: Regenerated. * generated/maxloc2_8_s4.c: Regenerated. * generated/maxval0_s1.c: Regenerated. * generated/maxval0_s4.c: Regenerated. * generated/maxval1_s1.c: Regenerated. * generated/maxval1_s4.c: Regenerated. * generated/minloc0_16_s1.c: Regenerated. * generated/minloc0_16_s4.c: Regenerated. * generated/minloc0_4_s1.c: Regenerated. * generated/minloc0_4_s4.c: Regenerated. * generated/minloc0_8_s1.c: Regenerated. * generated/minloc0_8_s4.c: Regenerated. * generated/minloc1_16_s1.c: Regenerated. * generated/minloc1_16_s4.c: Regenerated. * generated/minloc1_4_s1.c: Regenerated. * generated/minloc1_4_s4.c: Regenerated. * generated/minloc1_8_s1.c: Regenerated. * generated/minloc1_8_s4.c: Regenerated. * generated/minloc2_16_s1.c: Regenerated. * generated/minloc2_16_s4.c: Regenerated. * generated/minloc2_4_s1.c: Regenerated. * generated/minloc2_4_s4.c: Regenerated. * generated/minloc2_8_s1.c: Regenerated. * generated/minloc2_8_s4.c: Regenerated. * generated/minval0_s1.c: Regenerated. * generated/minval0_s4.c: Regenerated. * generated/minval1_s1.c: Regenerated. * generated/minval1_s4.c: Regenerated. 2017-10-28 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/54613 * gfortran.dg/findloc_1.f90: New test. * gfortran.dg/findloc_2.f90: New test. * gfortran.dg/findloc_3.f90: New test. * gfortran.dg/findloc_4.f90: New test. * gfortran.dg/findloc_5.f90: New test. * gfortran.dg/findloc_6.f90: New test. From-SVN: r265570
Diffstat (limited to 'libgfortran')
-rw-r--r--libgfortran/ChangeLog93
-rw-r--r--libgfortran/Makefile.am64
-rw-r--r--libgfortran/Makefile.in334
-rw-r--r--libgfortran/generated/findloc0_c16.c375
-rw-r--r--libgfortran/generated/findloc0_c4.c375
-rw-r--r--libgfortran/generated/findloc0_c8.c375
-rw-r--r--libgfortran/generated/findloc0_i1.c375
-rw-r--r--libgfortran/generated/findloc0_i16.c375
-rw-r--r--libgfortran/generated/findloc0_i2.c375
-rw-r--r--libgfortran/generated/findloc0_i4.c375
-rw-r--r--libgfortran/generated/findloc0_i8.c375
-rw-r--r--libgfortran/generated/findloc0_r16.c375
-rw-r--r--libgfortran/generated/findloc0_r4.c375
-rw-r--r--libgfortran/generated/findloc0_r8.c375
-rw-r--r--libgfortran/generated/findloc0_s1.c383
-rw-r--r--libgfortran/generated/findloc0_s4.c383
-rw-r--r--libgfortran/generated/findloc1_c16.c523
-rw-r--r--libgfortran/generated/findloc1_c4.c523
-rw-r--r--libgfortran/generated/findloc1_c8.c523
-rw-r--r--libgfortran/generated/findloc1_i1.c523
-rw-r--r--libgfortran/generated/findloc1_i16.c523
-rw-r--r--libgfortran/generated/findloc1_i2.c523
-rw-r--r--libgfortran/generated/findloc1_i4.c523
-rw-r--r--libgfortran/generated/findloc1_i8.c523
-rw-r--r--libgfortran/generated/findloc1_r16.c523
-rw-r--r--libgfortran/generated/findloc1_r4.c523
-rw-r--r--libgfortran/generated/findloc1_r8.c523
-rw-r--r--libgfortran/generated/findloc1_s1.c525
-rw-r--r--libgfortran/generated/findloc1_s4.c525
-rw-r--r--libgfortran/generated/findloc2_s1.c154
-rw-r--r--libgfortran/generated/findloc2_s4.c154
-rw-r--r--libgfortran/generated/maxloc0_16_s1.c14
-rw-r--r--libgfortran/generated/maxloc0_16_s4.c14
-rw-r--r--libgfortran/generated/maxloc0_4_s1.c14
-rw-r--r--libgfortran/generated/maxloc0_4_s4.c14
-rw-r--r--libgfortran/generated/maxloc0_8_s1.c14
-rw-r--r--libgfortran/generated/maxloc0_8_s4.c14
-rw-r--r--libgfortran/generated/maxloc1_16_s1.c18
-rw-r--r--libgfortran/generated/maxloc1_16_s4.c18
-rw-r--r--libgfortran/generated/maxloc1_4_s1.c18
-rw-r--r--libgfortran/generated/maxloc1_4_s4.c18
-rw-r--r--libgfortran/generated/maxloc1_8_s1.c18
-rw-r--r--libgfortran/generated/maxloc1_8_s4.c18
-rw-r--r--libgfortran/generated/maxloc2_16_s1.c14
-rw-r--r--libgfortran/generated/maxloc2_16_s4.c14
-rw-r--r--libgfortran/generated/maxloc2_4_s1.c14
-rw-r--r--libgfortran/generated/maxloc2_4_s4.c14
-rw-r--r--libgfortran/generated/maxloc2_8_s1.c14
-rw-r--r--libgfortran/generated/maxloc2_8_s4.c14
-rw-r--r--libgfortran/generated/maxval0_s1.c26
-rw-r--r--libgfortran/generated/maxval0_s4.c26
-rw-r--r--libgfortran/generated/maxval1_s1.c30
-rw-r--r--libgfortran/generated/maxval1_s4.c30
-rw-r--r--libgfortran/generated/minloc0_16_s1.c14
-rw-r--r--libgfortran/generated/minloc0_16_s4.c14
-rw-r--r--libgfortran/generated/minloc0_4_s1.c14
-rw-r--r--libgfortran/generated/minloc0_4_s4.c14
-rw-r--r--libgfortran/generated/minloc0_8_s1.c14
-rw-r--r--libgfortran/generated/minloc0_8_s4.c14
-rw-r--r--libgfortran/generated/minloc1_16_s1.c18
-rw-r--r--libgfortran/generated/minloc1_16_s4.c18
-rw-r--r--libgfortran/generated/minloc1_4_s1.c18
-rw-r--r--libgfortran/generated/minloc1_4_s4.c18
-rw-r--r--libgfortran/generated/minloc1_8_s1.c18
-rw-r--r--libgfortran/generated/minloc1_8_s4.c18
-rw-r--r--libgfortran/generated/minloc2_16_s1.c14
-rw-r--r--libgfortran/generated/minloc2_16_s4.c14
-rw-r--r--libgfortran/generated/minloc2_4_s1.c14
-rw-r--r--libgfortran/generated/minloc2_4_s4.c14
-rw-r--r--libgfortran/generated/minloc2_8_s1.c14
-rw-r--r--libgfortran/generated/minloc2_8_s4.c14
-rw-r--r--libgfortran/generated/minval0_s1.c26
-rw-r--r--libgfortran/generated/minval0_s4.c26
-rw-r--r--libgfortran/generated/minval1_s1.c30
-rw-r--r--libgfortran/generated/minval1_s4.c30
-rw-r--r--libgfortran/gfortran.map86
-rw-r--r--libgfortran/libgfortran.h12
-rw-r--r--libgfortran/m4/findloc0.m438
-rw-r--r--libgfortran/m4/findloc0s.m448
-rw-r--r--libgfortran/m4/findloc1.m440
-rw-r--r--libgfortran/m4/findloc1s.m444
-rw-r--r--libgfortran/m4/findloc2s.m444
-rw-r--r--libgfortran/m4/ifindloc0.m4350
-rw-r--r--libgfortran/m4/ifindloc1.m4495
-rw-r--r--libgfortran/m4/ifindloc2.m4126
-rw-r--r--libgfortran/m4/iparm.m42
86 files changed, 14139 insertions, 415 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index bd5e037..9242b7a 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,96 @@
+2017-10-28 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ PR fortran/54613
+ * Makefile.am: Add files for findloc.
+ * Makefile.in: Regenerated.
+ * libgfortran.h (gfc_array_index_type): Add.
+ (gfc_array_s1): Add using GFC_UINTEGER_1.
+ (gfc_array_s4): Likewise.
+ Replace unnecessary comment.
+ (HAVE_GFC_UINTEGER_1): Define.
+ (HAVE_GFC_UINTEGER_4): Define.
+ * m4/findloc0.m4: New file.
+ * m4/findloc0s.m4: New file.
+ * m4/findloc1.m4: New file.
+ * m4/findloc1s.m4: New file.
+ * m4/findloc2s.m4: New file.
+ * m4/ifindloc0.m4: New file.
+ * m4/ifindloc1.m4: New file.
+ * m4/ifindloc2.m4: New file.
+ * m4/iparm.m4: Use unsigned integer for characters.
+ * generated/findloc0_c16.c: New file.
+ * generated/findloc0_c4.c: New file.
+ * generated/findloc0_c8.c: New file.
+ * generated/findloc0_i1.c: New file.
+ * generated/findloc0_i16.c: New file.
+ * generated/findloc0_i2.c: New file.
+ * generated/findloc0_i4.c: New file.
+ * generated/findloc0_i8.c: New file.
+ * generated/findloc0_r16.c: New file.
+ * generated/findloc0_r4.c: New file.
+ * generated/findloc0_r8.c: New file.
+ * generated/findloc0_s1.c: New file.
+ * generated/findloc0_s4.c: New file.
+ * generated/findloc1_c16.c: New file.
+ * generated/findloc1_c4.c: New file.
+ * generated/findloc1_c8.c: New file.
+ * generated/findloc1_i1.c: New file.
+ * generated/findloc1_i16.c: New file.
+ * generated/findloc1_i2.c: New file.
+ * generated/findloc1_i4.c: New file.
+ * generated/findloc1_i8.c: New file.
+ * generated/findloc1_r16.c: New file.
+ * generated/findloc1_r4.c: New file.
+ * generated/findloc1_r8.c: New file.
+ * generated/findloc1_s1.c: New file.
+ * generated/findloc1_s4.c: New file.
+ * generated/findloc2_s1.c: New file.
+ * generated/findloc2_s4.c: New file.
+ * generated/maxloc0_16_s1.c: Regenerated.
+ * generated/maxloc0_16_s4.c: Regenerated.
+ * generated/maxloc0_4_s1.c: Regenerated.
+ * generated/maxloc0_4_s4.c: Regenerated.
+ * generated/maxloc0_8_s1.c: Regenerated.
+ * generated/maxloc0_8_s4.c: Regenerated.
+ * generated/maxloc1_16_s1.c: Regenerated.
+ * generated/maxloc1_16_s4.c: Regenerated.
+ * generated/maxloc1_4_s1.c: Regenerated.
+ * generated/maxloc1_4_s4.c: Regenerated.
+ * generated/maxloc1_8_s1.c: Regenerated.
+ * generated/maxloc1_8_s4.c: Regenerated.
+ * generated/maxloc2_16_s1.c: Regenerated.
+ * generated/maxloc2_16_s4.c: Regenerated.
+ * generated/maxloc2_4_s1.c: Regenerated.
+ * generated/maxloc2_4_s4.c: Regenerated.
+ * generated/maxloc2_8_s1.c: Regenerated.
+ * generated/maxloc2_8_s4.c: Regenerated.
+ * generated/maxval0_s1.c: Regenerated.
+ * generated/maxval0_s4.c: Regenerated.
+ * generated/maxval1_s1.c: Regenerated.
+ * generated/maxval1_s4.c: Regenerated.
+ * generated/minloc0_16_s1.c: Regenerated.
+ * generated/minloc0_16_s4.c: Regenerated.
+ * generated/minloc0_4_s1.c: Regenerated.
+ * generated/minloc0_4_s4.c: Regenerated.
+ * generated/minloc0_8_s1.c: Regenerated.
+ * generated/minloc0_8_s4.c: Regenerated.
+ * generated/minloc1_16_s1.c: Regenerated.
+ * generated/minloc1_16_s4.c: Regenerated.
+ * generated/minloc1_4_s1.c: Regenerated.
+ * generated/minloc1_4_s4.c: Regenerated.
+ * generated/minloc1_8_s1.c: Regenerated.
+ * generated/minloc1_8_s4.c: Regenerated.
+ * generated/minloc2_16_s1.c: Regenerated.
+ * generated/minloc2_16_s4.c: Regenerated.
+ * generated/minloc2_4_s1.c: Regenerated.
+ * generated/minloc2_4_s4.c: Regenerated.
+ * generated/minloc2_8_s1.c: Regenerated.
+ * generated/minloc2_8_s4.c: Regenerated.
+ * generated/minval0_s1.c: Regenerated.
+ * generated/minval0_s4.c: Regenerated.
+ * generated/minval1_s1.c: Regenerated.
+ * generated/minval1_s4.c: Regenerated.
+
2018-10-06 Janne Blomqvist <jb@gcc.gnu.org>
* io/unix.c (compare_file_filename): Use gfc_charlen_type instead
diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am
index 4ffc6ce..7ade1bb 100644
--- a/libgfortran/Makefile.am
+++ b/libgfortran/Makefile.am
@@ -266,6 +266,44 @@ $(srcdir)/generated/iparity_i4.c \
$(srcdir)/generated/iparity_i8.c \
$(srcdir)/generated/iparity_i16.c
+i_findloc0_c= \
+$(srcdir)/generated/findloc0_i1.c \
+$(srcdir)/generated/findloc0_i2.c \
+$(srcdir)/generated/findloc0_i4.c \
+$(srcdir)/generated/findloc0_i8.c \
+$(srcdir)/generated/findloc0_i16.c \
+$(srcdir)/generated/findloc0_r4.c \
+$(srcdir)/generated/findloc0_r8.c \
+$(srcdir)/generated/findloc0_r16.c \
+$(srcdir)/generated/findloc0_c4.c \
+$(srcdir)/generated/findloc0_c8.c \
+$(srcdir)/generated/findloc0_c16.c
+
+i_findloc0s_c= \
+$(srcdir)/generated/findloc0_s1.c \
+$(srcdir)/generated/findloc0_s4.c
+
+i_findloc1_c= \
+$(srcdir)/generated/findloc1_i1.c \
+$(srcdir)/generated/findloc1_i2.c \
+$(srcdir)/generated/findloc1_i4.c \
+$(srcdir)/generated/findloc1_i8.c \
+$(srcdir)/generated/findloc1_i16.c \
+$(srcdir)/generated/findloc1_r4.c \
+$(srcdir)/generated/findloc1_r8.c \
+$(srcdir)/generated/findloc1_r16.c \
+$(srcdir)/generated/findloc1_c4.c \
+$(srcdir)/generated/findloc1_c8.c \
+$(srcdir)/generated/findloc1_c16.c
+
+i_findloc1s_c= \
+$(srcdir)/generated/findloc1_s1.c \
+$(srcdir)/generated/findloc1_s4.c
+
+i_findloc2s_c= \
+$(srcdir)/generated/findloc2_s1.c \
+$(srcdir)/generated/findloc2_s4.c
+
i_maxloc0_c= \
$(srcdir)/generated/maxloc0_4_i1.c \
$(srcdir)/generated/maxloc0_8_i1.c \
@@ -754,7 +792,9 @@ m4_files= m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \
m4/pow.m4 \
m4/misc_specifics.m4 m4/pack.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 m4/iforeach-s.m4
+ m4/iall.m4 m4/iany.m4 m4/iparity.m4 m4/iforeach-s.m4 m4/findloc0.m4 \
+ m4/findloc0s.m4 m4/ifindloc0.m4 m4/findloc1.m4 m4/ifindloc1.m4 \
+ m4/findloc2s.m4 m4/ifindloc2.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) \
@@ -767,7 +807,9 @@ gfor_built_src= $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \
$(i_cshift0_c) kinds.inc c99_protos.inc fpu-target.h fpu-target.inc \
$(i_cshift1a_c) $(i_maxloc0s_c) $(i_minloc0s_c) $(i_maxloc1s_c) \
$(i_minloc1s_c) $(i_maxloc2s_c) $(i_minloc2s_c) $(i_maxvals_c) \
- $(i_maxval0s_c) $(i_minval0s_c) $(i_maxval1s_c) $(i_minval1s_c)
+ $(i_maxval0s_c) $(i_minval0s_c) $(i_maxval1s_c) $(i_minval1s_c) \
+ $(i_findloc0_c) $(i_findloc0s_c) $(i_findloc1_c) $(i_findloc1s_c) \
+ $(i_findloc2s_c)
# Machine generated specifics
gfor_built_specific_src= \
@@ -995,6 +1037,9 @@ I_M4_DEPS3=$(I_M4_DEPS) m4/iforeach-s.m4
I_M4_DEPS4=$(I_M4_DEPS) m4/ifunction-s.m4
I_M4_DEPS5=$(I_M4_DEPS) m4/iforeach-s2.m4
I_M4_DEPS6=$(I_M4_DEPS) m4/ifunction-s2.m4
+I_M4_DEPS7=$(I_M4_DEPS) m4/ifindloc0.m4
+I_M4_DEPS8=$(I_M4_DEPS) m4/ifindloc1.m4
+I_M4_DEPS9=$(I_M4_DEPS) m4/ifindloc2.m4
kinds.h: $(srcdir)/mk-kinds-h.sh
$(SHELL) $(srcdir)/mk-kinds-h.sh '$(FCCOMPILE)' > $@ || rm $@
@@ -1034,6 +1079,21 @@ $(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_findloc0_c): m4/findloc0.m4 $(I_M4_DEPS7)
+ $(M4) -Dfile=$@ -I$(srcdir)/m4 findloc0.m4 > $@
+
+$(i_findloc0s_c): m4/findloc0s.m4 $(I_M4_DEPS7)
+ $(M4) -Dfile=$@ -I$(srcdir)/m4 findloc0s.m4 > $@
+
+$(i_findloc1_c): m4/findloc1.m4 $(I_M4_DEPS8)
+ $(M4) -Dfile=$@ -I$(srcdir)/m4 findloc1.m4 > $@
+
+$(i_findloc1s_c): m4/findloc1s.m4 $(I_M4_DEPS8)
+ $(M4) -Dfile=$@ -I$(srcdir)/m4 findloc1s.m4 > $@
+
+$(i_findloc2s_c): m4/findloc2s.m4 $(I_M4_DEPS9)
+ $(M4) -Dfile=$@ -I$(srcdir)/m4 findloc2s.m4 > $@
+
$(i_iall_c): m4/iall.m4 $(I_M4_DEPS1)
$(M4) -Dfile=$@ -I$(srcdir)/m4 iall.m4 > $@
diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in
index 94c3524..da04593 100644
--- a/libgfortran/Makefile.in
+++ b/libgfortran/Makefile.in
@@ -334,7 +334,16 @@ am__objects_43 = maxval0_s1.lo maxval0_s4.lo
am__objects_44 = minval0_s1.lo minval0_s4.lo
am__objects_45 = maxval1_s1.lo maxval1_s4.lo
am__objects_46 = minval1_s1.lo minval1_s4.lo
-am__objects_47 = $(am__objects_4) $(am__objects_5) $(am__objects_6) \
+am__objects_47 = findloc0_i1.lo findloc0_i2.lo findloc0_i4.lo \
+ findloc0_i8.lo findloc0_i16.lo findloc0_r4.lo findloc0_r8.lo \
+ findloc0_r16.lo findloc0_c4.lo findloc0_c8.lo findloc0_c16.lo
+am__objects_48 = findloc0_s1.lo findloc0_s4.lo
+am__objects_49 = findloc1_i1.lo findloc1_i2.lo findloc1_i4.lo \
+ findloc1_i8.lo findloc1_i16.lo findloc1_r4.lo findloc1_r8.lo \
+ findloc1_r16.lo findloc1_c4.lo findloc1_c8.lo findloc1_c16.lo
+am__objects_50 = findloc1_s1.lo findloc1_s4.lo
+am__objects_51 = findloc2_s1.lo findloc2_s4.lo
+am__objects_52 = $(am__objects_4) $(am__objects_5) $(am__objects_6) \
$(am__objects_7) $(am__objects_8) $(am__objects_9) \
$(am__objects_10) $(am__objects_11) $(am__objects_12) \
$(am__objects_13) $(am__objects_14) $(am__objects_15) \
@@ -348,14 +357,15 @@ am__objects_47 = $(am__objects_4) $(am__objects_5) $(am__objects_6) \
$(am__objects_37) $(am__objects_38) $(am__objects_39) \
$(am__objects_40) $(am__objects_41) $(am__objects_42) \
$(am__objects_43) $(am__objects_44) $(am__objects_45) \
- $(am__objects_46)
-@LIBGFOR_MINIMAL_FALSE@am__objects_48 = close.lo file_pos.lo format.lo \
+ $(am__objects_46) $(am__objects_47) $(am__objects_48) \
+ $(am__objects_49) $(am__objects_50) $(am__objects_51)
+@LIBGFOR_MINIMAL_FALSE@am__objects_53 = close.lo file_pos.lo format.lo \
@LIBGFOR_MINIMAL_FALSE@ inquire.lo intrinsics.lo list_read.lo \
@LIBGFOR_MINIMAL_FALSE@ lock.lo open.lo read.lo transfer.lo \
@LIBGFOR_MINIMAL_FALSE@ transfer128.lo unit.lo unix.lo write.lo \
@LIBGFOR_MINIMAL_FALSE@ fbuf.lo async.lo
-am__objects_49 = size_from_kind.lo $(am__objects_48)
-@LIBGFOR_MINIMAL_FALSE@am__objects_50 = access.lo c99_functions.lo \
+am__objects_54 = size_from_kind.lo $(am__objects_53)
+@LIBGFOR_MINIMAL_FALSE@am__objects_55 = access.lo c99_functions.lo \
@LIBGFOR_MINIMAL_FALSE@ chdir.lo chmod.lo clock.lo cpu_time.lo \
@LIBGFOR_MINIMAL_FALSE@ ctime.lo date_and_time.lo dtime.lo \
@LIBGFOR_MINIMAL_FALSE@ env.lo etime.lo execute_command_line.lo \
@@ -365,19 +375,19 @@ am__objects_49 = size_from_kind.lo $(am__objects_48)
@LIBGFOR_MINIMAL_FALSE@ rename.lo stat.lo symlnk.lo \
@LIBGFOR_MINIMAL_FALSE@ system_clock.lo time.lo umask.lo \
@LIBGFOR_MINIMAL_FALSE@ unlink.lo
-@IEEE_SUPPORT_TRUE@am__objects_51 = ieee_helper.lo
-am__objects_52 = associated.lo abort.lo args.lo cshift0.lo eoshift0.lo \
+@IEEE_SUPPORT_TRUE@am__objects_56 = ieee_helper.lo
+am__objects_57 = associated.lo abort.lo args.lo cshift0.lo eoshift0.lo \
eoshift2.lo erfc_scaled.lo extends_type_of.lo fnum.lo \
ierrno.lo ishftc.lo mvbits.lo move_alloc.lo pack_generic.lo \
selected_char_kind.lo size.lo spread_generic.lo \
string_intrinsics.lo rand.lo random.lo reshape_generic.lo \
reshape_packed.lo selected_int_kind.lo selected_real_kind.lo \
unpack_generic.lo in_pack_generic.lo in_unpack_generic.lo \
- $(am__objects_50) $(am__objects_51)
-@IEEE_SUPPORT_TRUE@am__objects_53 = ieee_arithmetic.lo \
+ $(am__objects_55) $(am__objects_56)
+@IEEE_SUPPORT_TRUE@am__objects_58 = ieee_arithmetic.lo \
@IEEE_SUPPORT_TRUE@ ieee_exceptions.lo ieee_features.lo
-am__objects_54 =
-am__objects_55 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
+am__objects_59 =
+am__objects_60 = _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 \
@@ -401,19 +411,19 @@ am__objects_55 = _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_56 = _sign_i4.lo _sign_i8.lo _sign_i16.lo _sign_r4.lo \
+am__objects_61 = _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_57 = misc_specifics.lo
-am__objects_58 = $(am__objects_55) $(am__objects_56) $(am__objects_57) \
+am__objects_62 = misc_specifics.lo
+am__objects_63 = $(am__objects_60) $(am__objects_61) $(am__objects_62) \
dprod_r8.lo f2c_specifics.lo random_init.lo
-am__objects_59 = $(am__objects_3) $(am__objects_47) $(am__objects_49) \
- $(am__objects_52) $(am__objects_53) $(am__objects_54) \
- $(am__objects_58)
-@onestep_FALSE@am_libgfortran_la_OBJECTS = $(am__objects_59)
+am__objects_64 = $(am__objects_3) $(am__objects_52) $(am__objects_54) \
+ $(am__objects_57) $(am__objects_58) $(am__objects_59) \
+ $(am__objects_63)
+@onestep_FALSE@am_libgfortran_la_OBJECTS = $(am__objects_64)
@onestep_TRUE@am_libgfortran_la_OBJECTS = libgfortran_c.lo
libgfortran_la_OBJECTS = $(am_libgfortran_la_OBJECTS)
DEFAULT_INCLUDES = -I.@am__isrc@
@@ -725,6 +735,44 @@ $(srcdir)/generated/iparity_i4.c \
$(srcdir)/generated/iparity_i8.c \
$(srcdir)/generated/iparity_i16.c
+i_findloc0_c = \
+$(srcdir)/generated/findloc0_i1.c \
+$(srcdir)/generated/findloc0_i2.c \
+$(srcdir)/generated/findloc0_i4.c \
+$(srcdir)/generated/findloc0_i8.c \
+$(srcdir)/generated/findloc0_i16.c \
+$(srcdir)/generated/findloc0_r4.c \
+$(srcdir)/generated/findloc0_r8.c \
+$(srcdir)/generated/findloc0_r16.c \
+$(srcdir)/generated/findloc0_c4.c \
+$(srcdir)/generated/findloc0_c8.c \
+$(srcdir)/generated/findloc0_c16.c
+
+i_findloc0s_c = \
+$(srcdir)/generated/findloc0_s1.c \
+$(srcdir)/generated/findloc0_s4.c
+
+i_findloc1_c = \
+$(srcdir)/generated/findloc1_i1.c \
+$(srcdir)/generated/findloc1_i2.c \
+$(srcdir)/generated/findloc1_i4.c \
+$(srcdir)/generated/findloc1_i8.c \
+$(srcdir)/generated/findloc1_i16.c \
+$(srcdir)/generated/findloc1_r4.c \
+$(srcdir)/generated/findloc1_r8.c \
+$(srcdir)/generated/findloc1_r16.c \
+$(srcdir)/generated/findloc1_c4.c \
+$(srcdir)/generated/findloc1_c8.c \
+$(srcdir)/generated/findloc1_c16.c
+
+i_findloc1s_c = \
+$(srcdir)/generated/findloc1_s1.c \
+$(srcdir)/generated/findloc1_s4.c
+
+i_findloc2s_c = \
+$(srcdir)/generated/findloc2_s1.c \
+$(srcdir)/generated/findloc2_s4.c
+
i_maxloc0_c = \
$(srcdir)/generated/maxloc0_4_i1.c \
$(srcdir)/generated/maxloc0_8_i1.c \
@@ -1213,7 +1261,9 @@ m4_files = m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \
m4/pow.m4 \
m4/misc_specifics.m4 m4/pack.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 m4/iforeach-s.m4
+ m4/iall.m4 m4/iany.m4 m4/iparity.m4 m4/iforeach-s.m4 m4/findloc0.m4 \
+ m4/findloc0s.m4 m4/ifindloc0.m4 m4/findloc1.m4 m4/ifindloc1.m4 \
+ m4/findloc2s.m4 m4/ifindloc2.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) \
@@ -1226,7 +1276,9 @@ gfor_built_src = $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \
$(i_cshift0_c) kinds.inc c99_protos.inc fpu-target.h fpu-target.inc \
$(i_cshift1a_c) $(i_maxloc0s_c) $(i_minloc0s_c) $(i_maxloc1s_c) \
$(i_minloc1s_c) $(i_maxloc2s_c) $(i_minloc2s_c) $(i_maxvals_c) \
- $(i_maxval0s_c) $(i_minval0s_c) $(i_maxval1s_c) $(i_minval1s_c)
+ $(i_maxval0s_c) $(i_minval0s_c) $(i_maxval1s_c) $(i_minval1s_c) \
+ $(i_findloc0_c) $(i_findloc0s_c) $(i_findloc1_c) $(i_findloc1s_c) \
+ $(i_findloc2s_c)
# Machine generated specifics
@@ -1407,6 +1459,9 @@ I_M4_DEPS3 = $(I_M4_DEPS) m4/iforeach-s.m4
I_M4_DEPS4 = $(I_M4_DEPS) m4/ifunction-s.m4
I_M4_DEPS5 = $(I_M4_DEPS) m4/iforeach-s2.m4
I_M4_DEPS6 = $(I_M4_DEPS) m4/ifunction-s2.m4
+I_M4_DEPS7 = $(I_M4_DEPS) m4/ifindloc0.m4
+I_M4_DEPS8 = $(I_M4_DEPS) m4/ifindloc1.m4
+I_M4_DEPS9 = $(I_M4_DEPS) m4/ifindloc2.m4
EXTRA_DIST = $(m4_files)
all: $(BUILT_SOURCES) config.h
$(MAKE) $(AM_MAKEFLAGS) all-am
@@ -1650,6 +1705,34 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/extends_type_of.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fbuf.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/file_pos.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc0_c16.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc0_c4.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc0_c8.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc0_i1.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc0_i16.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc0_i2.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc0_i4.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc0_i8.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc0_r16.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc0_r4.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc0_r8.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc0_s1.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc0_s4.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc1_c16.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc1_c4.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc1_c8.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc1_i1.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc1_i16.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc1_i2.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc1_i4.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc1_i8.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc1_r16.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc1_r4.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc1_r8.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc1_s1.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc1_s4.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc2_s1.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/findloc2_s4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fnum.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/format.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fpu.Plo@am__quote@
@@ -5705,6 +5788,202 @@ minval1_s4.lo: $(srcdir)/generated/minval1_s4.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 minval1_s4.lo `test -f '$(srcdir)/generated/minval1_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minval1_s4.c
+findloc0_i1.lo: $(srcdir)/generated/findloc0_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 findloc0_i1.lo -MD -MP -MF $(DEPDIR)/findloc0_i1.Tpo -c -o findloc0_i1.lo `test -f '$(srcdir)/generated/findloc0_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_i1.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc0_i1.Tpo $(DEPDIR)/findloc0_i1.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc0_i1.c' object='findloc0_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 findloc0_i1.lo `test -f '$(srcdir)/generated/findloc0_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_i1.c
+
+findloc0_i2.lo: $(srcdir)/generated/findloc0_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 findloc0_i2.lo -MD -MP -MF $(DEPDIR)/findloc0_i2.Tpo -c -o findloc0_i2.lo `test -f '$(srcdir)/generated/findloc0_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_i2.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc0_i2.Tpo $(DEPDIR)/findloc0_i2.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc0_i2.c' object='findloc0_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 findloc0_i2.lo `test -f '$(srcdir)/generated/findloc0_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_i2.c
+
+findloc0_i4.lo: $(srcdir)/generated/findloc0_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 findloc0_i4.lo -MD -MP -MF $(DEPDIR)/findloc0_i4.Tpo -c -o findloc0_i4.lo `test -f '$(srcdir)/generated/findloc0_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_i4.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc0_i4.Tpo $(DEPDIR)/findloc0_i4.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc0_i4.c' object='findloc0_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 findloc0_i4.lo `test -f '$(srcdir)/generated/findloc0_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_i4.c
+
+findloc0_i8.lo: $(srcdir)/generated/findloc0_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 findloc0_i8.lo -MD -MP -MF $(DEPDIR)/findloc0_i8.Tpo -c -o findloc0_i8.lo `test -f '$(srcdir)/generated/findloc0_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_i8.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc0_i8.Tpo $(DEPDIR)/findloc0_i8.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc0_i8.c' object='findloc0_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 findloc0_i8.lo `test -f '$(srcdir)/generated/findloc0_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_i8.c
+
+findloc0_i16.lo: $(srcdir)/generated/findloc0_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 findloc0_i16.lo -MD -MP -MF $(DEPDIR)/findloc0_i16.Tpo -c -o findloc0_i16.lo `test -f '$(srcdir)/generated/findloc0_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_i16.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc0_i16.Tpo $(DEPDIR)/findloc0_i16.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc0_i16.c' object='findloc0_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 findloc0_i16.lo `test -f '$(srcdir)/generated/findloc0_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_i16.c
+
+findloc0_r4.lo: $(srcdir)/generated/findloc0_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 findloc0_r4.lo -MD -MP -MF $(DEPDIR)/findloc0_r4.Tpo -c -o findloc0_r4.lo `test -f '$(srcdir)/generated/findloc0_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_r4.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc0_r4.Tpo $(DEPDIR)/findloc0_r4.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc0_r4.c' object='findloc0_r4.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 findloc0_r4.lo `test -f '$(srcdir)/generated/findloc0_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_r4.c
+
+findloc0_r8.lo: $(srcdir)/generated/findloc0_r8.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT findloc0_r8.lo -MD -MP -MF $(DEPDIR)/findloc0_r8.Tpo -c -o findloc0_r8.lo `test -f '$(srcdir)/generated/findloc0_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_r8.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc0_r8.Tpo $(DEPDIR)/findloc0_r8.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc0_r8.c' object='findloc0_r8.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 findloc0_r8.lo `test -f '$(srcdir)/generated/findloc0_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_r8.c
+
+findloc0_r16.lo: $(srcdir)/generated/findloc0_r16.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT findloc0_r16.lo -MD -MP -MF $(DEPDIR)/findloc0_r16.Tpo -c -o findloc0_r16.lo `test -f '$(srcdir)/generated/findloc0_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_r16.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc0_r16.Tpo $(DEPDIR)/findloc0_r16.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc0_r16.c' object='findloc0_r16.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 findloc0_r16.lo `test -f '$(srcdir)/generated/findloc0_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_r16.c
+
+findloc0_c4.lo: $(srcdir)/generated/findloc0_c4.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT findloc0_c4.lo -MD -MP -MF $(DEPDIR)/findloc0_c4.Tpo -c -o findloc0_c4.lo `test -f '$(srcdir)/generated/findloc0_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_c4.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc0_c4.Tpo $(DEPDIR)/findloc0_c4.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc0_c4.c' object='findloc0_c4.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 findloc0_c4.lo `test -f '$(srcdir)/generated/findloc0_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_c4.c
+
+findloc0_c8.lo: $(srcdir)/generated/findloc0_c8.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT findloc0_c8.lo -MD -MP -MF $(DEPDIR)/findloc0_c8.Tpo -c -o findloc0_c8.lo `test -f '$(srcdir)/generated/findloc0_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_c8.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc0_c8.Tpo $(DEPDIR)/findloc0_c8.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc0_c8.c' object='findloc0_c8.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 findloc0_c8.lo `test -f '$(srcdir)/generated/findloc0_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_c8.c
+
+findloc0_c16.lo: $(srcdir)/generated/findloc0_c16.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT findloc0_c16.lo -MD -MP -MF $(DEPDIR)/findloc0_c16.Tpo -c -o findloc0_c16.lo `test -f '$(srcdir)/generated/findloc0_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_c16.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc0_c16.Tpo $(DEPDIR)/findloc0_c16.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc0_c16.c' object='findloc0_c16.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 findloc0_c16.lo `test -f '$(srcdir)/generated/findloc0_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_c16.c
+
+findloc0_s1.lo: $(srcdir)/generated/findloc0_s1.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT findloc0_s1.lo -MD -MP -MF $(DEPDIR)/findloc0_s1.Tpo -c -o findloc0_s1.lo `test -f '$(srcdir)/generated/findloc0_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_s1.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc0_s1.Tpo $(DEPDIR)/findloc0_s1.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc0_s1.c' object='findloc0_s1.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 findloc0_s1.lo `test -f '$(srcdir)/generated/findloc0_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_s1.c
+
+findloc0_s4.lo: $(srcdir)/generated/findloc0_s4.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT findloc0_s4.lo -MD -MP -MF $(DEPDIR)/findloc0_s4.Tpo -c -o findloc0_s4.lo `test -f '$(srcdir)/generated/findloc0_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_s4.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc0_s4.Tpo $(DEPDIR)/findloc0_s4.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc0_s4.c' object='findloc0_s4.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 findloc0_s4.lo `test -f '$(srcdir)/generated/findloc0_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc0_s4.c
+
+findloc1_i1.lo: $(srcdir)/generated/findloc1_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 findloc1_i1.lo -MD -MP -MF $(DEPDIR)/findloc1_i1.Tpo -c -o findloc1_i1.lo `test -f '$(srcdir)/generated/findloc1_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_i1.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc1_i1.Tpo $(DEPDIR)/findloc1_i1.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc1_i1.c' object='findloc1_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 findloc1_i1.lo `test -f '$(srcdir)/generated/findloc1_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_i1.c
+
+findloc1_i2.lo: $(srcdir)/generated/findloc1_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 findloc1_i2.lo -MD -MP -MF $(DEPDIR)/findloc1_i2.Tpo -c -o findloc1_i2.lo `test -f '$(srcdir)/generated/findloc1_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_i2.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc1_i2.Tpo $(DEPDIR)/findloc1_i2.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc1_i2.c' object='findloc1_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 findloc1_i2.lo `test -f '$(srcdir)/generated/findloc1_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_i2.c
+
+findloc1_i4.lo: $(srcdir)/generated/findloc1_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 findloc1_i4.lo -MD -MP -MF $(DEPDIR)/findloc1_i4.Tpo -c -o findloc1_i4.lo `test -f '$(srcdir)/generated/findloc1_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_i4.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc1_i4.Tpo $(DEPDIR)/findloc1_i4.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc1_i4.c' object='findloc1_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 findloc1_i4.lo `test -f '$(srcdir)/generated/findloc1_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_i4.c
+
+findloc1_i8.lo: $(srcdir)/generated/findloc1_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 findloc1_i8.lo -MD -MP -MF $(DEPDIR)/findloc1_i8.Tpo -c -o findloc1_i8.lo `test -f '$(srcdir)/generated/findloc1_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_i8.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc1_i8.Tpo $(DEPDIR)/findloc1_i8.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc1_i8.c' object='findloc1_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 findloc1_i8.lo `test -f '$(srcdir)/generated/findloc1_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_i8.c
+
+findloc1_i16.lo: $(srcdir)/generated/findloc1_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 findloc1_i16.lo -MD -MP -MF $(DEPDIR)/findloc1_i16.Tpo -c -o findloc1_i16.lo `test -f '$(srcdir)/generated/findloc1_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_i16.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc1_i16.Tpo $(DEPDIR)/findloc1_i16.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc1_i16.c' object='findloc1_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 findloc1_i16.lo `test -f '$(srcdir)/generated/findloc1_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_i16.c
+
+findloc1_r4.lo: $(srcdir)/generated/findloc1_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 findloc1_r4.lo -MD -MP -MF $(DEPDIR)/findloc1_r4.Tpo -c -o findloc1_r4.lo `test -f '$(srcdir)/generated/findloc1_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_r4.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc1_r4.Tpo $(DEPDIR)/findloc1_r4.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc1_r4.c' object='findloc1_r4.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 findloc1_r4.lo `test -f '$(srcdir)/generated/findloc1_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_r4.c
+
+findloc1_r8.lo: $(srcdir)/generated/findloc1_r8.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT findloc1_r8.lo -MD -MP -MF $(DEPDIR)/findloc1_r8.Tpo -c -o findloc1_r8.lo `test -f '$(srcdir)/generated/findloc1_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_r8.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc1_r8.Tpo $(DEPDIR)/findloc1_r8.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc1_r8.c' object='findloc1_r8.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 findloc1_r8.lo `test -f '$(srcdir)/generated/findloc1_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_r8.c
+
+findloc1_r16.lo: $(srcdir)/generated/findloc1_r16.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT findloc1_r16.lo -MD -MP -MF $(DEPDIR)/findloc1_r16.Tpo -c -o findloc1_r16.lo `test -f '$(srcdir)/generated/findloc1_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_r16.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc1_r16.Tpo $(DEPDIR)/findloc1_r16.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc1_r16.c' object='findloc1_r16.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 findloc1_r16.lo `test -f '$(srcdir)/generated/findloc1_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_r16.c
+
+findloc1_c4.lo: $(srcdir)/generated/findloc1_c4.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT findloc1_c4.lo -MD -MP -MF $(DEPDIR)/findloc1_c4.Tpo -c -o findloc1_c4.lo `test -f '$(srcdir)/generated/findloc1_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_c4.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc1_c4.Tpo $(DEPDIR)/findloc1_c4.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc1_c4.c' object='findloc1_c4.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 findloc1_c4.lo `test -f '$(srcdir)/generated/findloc1_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_c4.c
+
+findloc1_c8.lo: $(srcdir)/generated/findloc1_c8.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT findloc1_c8.lo -MD -MP -MF $(DEPDIR)/findloc1_c8.Tpo -c -o findloc1_c8.lo `test -f '$(srcdir)/generated/findloc1_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_c8.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc1_c8.Tpo $(DEPDIR)/findloc1_c8.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc1_c8.c' object='findloc1_c8.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 findloc1_c8.lo `test -f '$(srcdir)/generated/findloc1_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_c8.c
+
+findloc1_c16.lo: $(srcdir)/generated/findloc1_c16.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT findloc1_c16.lo -MD -MP -MF $(DEPDIR)/findloc1_c16.Tpo -c -o findloc1_c16.lo `test -f '$(srcdir)/generated/findloc1_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_c16.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc1_c16.Tpo $(DEPDIR)/findloc1_c16.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc1_c16.c' object='findloc1_c16.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 findloc1_c16.lo `test -f '$(srcdir)/generated/findloc1_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_c16.c
+
+findloc1_s1.lo: $(srcdir)/generated/findloc1_s1.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT findloc1_s1.lo -MD -MP -MF $(DEPDIR)/findloc1_s1.Tpo -c -o findloc1_s1.lo `test -f '$(srcdir)/generated/findloc1_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_s1.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc1_s1.Tpo $(DEPDIR)/findloc1_s1.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc1_s1.c' object='findloc1_s1.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 findloc1_s1.lo `test -f '$(srcdir)/generated/findloc1_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_s1.c
+
+findloc1_s4.lo: $(srcdir)/generated/findloc1_s4.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT findloc1_s4.lo -MD -MP -MF $(DEPDIR)/findloc1_s4.Tpo -c -o findloc1_s4.lo `test -f '$(srcdir)/generated/findloc1_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_s4.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc1_s4.Tpo $(DEPDIR)/findloc1_s4.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc1_s4.c' object='findloc1_s4.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 findloc1_s4.lo `test -f '$(srcdir)/generated/findloc1_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc1_s4.c
+
+findloc2_s1.lo: $(srcdir)/generated/findloc2_s1.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT findloc2_s1.lo -MD -MP -MF $(DEPDIR)/findloc2_s1.Tpo -c -o findloc2_s1.lo `test -f '$(srcdir)/generated/findloc2_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc2_s1.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc2_s1.Tpo $(DEPDIR)/findloc2_s1.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc2_s1.c' object='findloc2_s1.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 findloc2_s1.lo `test -f '$(srcdir)/generated/findloc2_s1.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc2_s1.c
+
+findloc2_s4.lo: $(srcdir)/generated/findloc2_s4.c
+@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT findloc2_s4.lo -MD -MP -MF $(DEPDIR)/findloc2_s4.Tpo -c -o findloc2_s4.lo `test -f '$(srcdir)/generated/findloc2_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc2_s4.c
+@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/findloc2_s4.Tpo $(DEPDIR)/findloc2_s4.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/findloc2_s4.c' object='findloc2_s4.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 findloc2_s4.lo `test -f '$(srcdir)/generated/findloc2_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc2_s4.c
+
size_from_kind.lo: io/size_from_kind.c
@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT size_from_kind.lo -MD -MP -MF $(DEPDIR)/size_from_kind.Tpo -c -o size_from_kind.lo `test -f 'io/size_from_kind.c' || echo '$(srcdir)/'`io/size_from_kind.c
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/size_from_kind.Tpo $(DEPDIR)/size_from_kind.Plo
@@ -6583,6 +6862,21 @@ fpu-target.inc: fpu-target.h $(srcdir)/libgfortran.h
@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_findloc0_c): m4/findloc0.m4 $(I_M4_DEPS7)
+@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 findloc0.m4 > $@
+
+@MAINTAINER_MODE_TRUE@$(i_findloc0s_c): m4/findloc0s.m4 $(I_M4_DEPS7)
+@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 findloc0s.m4 > $@
+
+@MAINTAINER_MODE_TRUE@$(i_findloc1_c): m4/findloc1.m4 $(I_M4_DEPS8)
+@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 findloc1.m4 > $@
+
+@MAINTAINER_MODE_TRUE@$(i_findloc1s_c): m4/findloc1s.m4 $(I_M4_DEPS8)
+@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 findloc1s.m4 > $@
+
+@MAINTAINER_MODE_TRUE@$(i_findloc2s_c): m4/findloc2s.m4 $(I_M4_DEPS9)
+@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 findloc2s.m4 > $@
+
@MAINTAINER_MODE_TRUE@$(i_iall_c): m4/iall.m4 $(I_M4_DEPS1)
@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 iall.m4 > $@
diff --git a/libgfortran/generated/findloc0_c16.c b/libgfortran/generated/findloc0_c16.c
new file mode 100644
index 0000000..8afb0c5
--- /dev/null
+++ b/libgfortran/generated/findloc0_c16.c
@@ -0,0 +1,375 @@
+
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_COMPLEX_16)
+extern void findloc0_c16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c16 * const restrict array, GFC_COMPLEX_16 value,
+ GFC_LOGICAL_4);
+export_proto(findloc0_c16);
+
+void
+findloc0_c16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c16 * const restrict array, GFC_COMPLEX_16 value,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_COMPLEX_16 *base;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * 1;
+
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * 1;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * 1;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * 1;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void mfindloc0_c16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c16 * const restrict array, GFC_COMPLEX_16 value,
+ gfc_array_l1 *const restrict, GFC_LOGICAL_4);
+export_proto(mfindloc0_c16);
+
+void
+mfindloc0_c16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c16 * const restrict array, GFC_COMPLEX_16 value,
+ gfc_array_l1 *const restrict mask, GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_COMPLEX_16 *base;
+ index_type * restrict dest;
+ GFC_LOGICAL_1 *mbase;
+ index_type rank;
+ index_type n;
+ int mask_kind;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "FINDLOC");
+ }
+ }
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * 1;
+ mbase = mbase + (sz - 1) * mask_kind;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && *base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * 1;
+ mbase -= mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * 1;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && *base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * 1;
+ mbase += mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n]* 1;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void sfindloc0_c16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c16 * const restrict array, GFC_COMPLEX_16 value,
+ GFC_LOGICAL_4 *, GFC_LOGICAL_4);
+export_proto(sfindloc0_c16);
+
+void
+sfindloc0_c16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c16 * const restrict array, GFC_COMPLEX_16 value,
+ GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back)
+{
+ index_type rank;
+ index_type dstride;
+ index_type * restrict dest;
+ index_type n;
+
+ if (*mask)
+ {
+ findloc0_c16 (retarray, array, value, back);
+ return;
+ }
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+
+ if (rank <= 0)
+ internal_error (NULL, "Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+ for (n = 0; n<rank; n++)
+ dest[n * dstride] = 0 ;
+}
+
+#endif
diff --git a/libgfortran/generated/findloc0_c4.c b/libgfortran/generated/findloc0_c4.c
new file mode 100644
index 0000000..42f010b
--- /dev/null
+++ b/libgfortran/generated/findloc0_c4.c
@@ -0,0 +1,375 @@
+
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_COMPLEX_4)
+extern void findloc0_c4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c4 * const restrict array, GFC_COMPLEX_4 value,
+ GFC_LOGICAL_4);
+export_proto(findloc0_c4);
+
+void
+findloc0_c4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c4 * const restrict array, GFC_COMPLEX_4 value,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_COMPLEX_4 *base;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * 1;
+
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * 1;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * 1;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * 1;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void mfindloc0_c4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c4 * const restrict array, GFC_COMPLEX_4 value,
+ gfc_array_l1 *const restrict, GFC_LOGICAL_4);
+export_proto(mfindloc0_c4);
+
+void
+mfindloc0_c4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c4 * const restrict array, GFC_COMPLEX_4 value,
+ gfc_array_l1 *const restrict mask, GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_COMPLEX_4 *base;
+ index_type * restrict dest;
+ GFC_LOGICAL_1 *mbase;
+ index_type rank;
+ index_type n;
+ int mask_kind;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "FINDLOC");
+ }
+ }
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * 1;
+ mbase = mbase + (sz - 1) * mask_kind;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && *base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * 1;
+ mbase -= mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * 1;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && *base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * 1;
+ mbase += mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n]* 1;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void sfindloc0_c4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c4 * const restrict array, GFC_COMPLEX_4 value,
+ GFC_LOGICAL_4 *, GFC_LOGICAL_4);
+export_proto(sfindloc0_c4);
+
+void
+sfindloc0_c4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c4 * const restrict array, GFC_COMPLEX_4 value,
+ GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back)
+{
+ index_type rank;
+ index_type dstride;
+ index_type * restrict dest;
+ index_type n;
+
+ if (*mask)
+ {
+ findloc0_c4 (retarray, array, value, back);
+ return;
+ }
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+
+ if (rank <= 0)
+ internal_error (NULL, "Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+ for (n = 0; n<rank; n++)
+ dest[n * dstride] = 0 ;
+}
+
+#endif
diff --git a/libgfortran/generated/findloc0_c8.c b/libgfortran/generated/findloc0_c8.c
new file mode 100644
index 0000000..8eb7303
--- /dev/null
+++ b/libgfortran/generated/findloc0_c8.c
@@ -0,0 +1,375 @@
+
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_COMPLEX_8)
+extern void findloc0_c8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c8 * const restrict array, GFC_COMPLEX_8 value,
+ GFC_LOGICAL_4);
+export_proto(findloc0_c8);
+
+void
+findloc0_c8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c8 * const restrict array, GFC_COMPLEX_8 value,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_COMPLEX_8 *base;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * 1;
+
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * 1;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * 1;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * 1;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void mfindloc0_c8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c8 * const restrict array, GFC_COMPLEX_8 value,
+ gfc_array_l1 *const restrict, GFC_LOGICAL_4);
+export_proto(mfindloc0_c8);
+
+void
+mfindloc0_c8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c8 * const restrict array, GFC_COMPLEX_8 value,
+ gfc_array_l1 *const restrict mask, GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_COMPLEX_8 *base;
+ index_type * restrict dest;
+ GFC_LOGICAL_1 *mbase;
+ index_type rank;
+ index_type n;
+ int mask_kind;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "FINDLOC");
+ }
+ }
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * 1;
+ mbase = mbase + (sz - 1) * mask_kind;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && *base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * 1;
+ mbase -= mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * 1;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && *base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * 1;
+ mbase += mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n]* 1;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void sfindloc0_c8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c8 * const restrict array, GFC_COMPLEX_8 value,
+ GFC_LOGICAL_4 *, GFC_LOGICAL_4);
+export_proto(sfindloc0_c8);
+
+void
+sfindloc0_c8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c8 * const restrict array, GFC_COMPLEX_8 value,
+ GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back)
+{
+ index_type rank;
+ index_type dstride;
+ index_type * restrict dest;
+ index_type n;
+
+ if (*mask)
+ {
+ findloc0_c8 (retarray, array, value, back);
+ return;
+ }
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+
+ if (rank <= 0)
+ internal_error (NULL, "Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+ for (n = 0; n<rank; n++)
+ dest[n * dstride] = 0 ;
+}
+
+#endif
diff --git a/libgfortran/generated/findloc0_i1.c b/libgfortran/generated/findloc0_i1.c
new file mode 100644
index 0000000..76b5400
--- /dev/null
+++ b/libgfortran/generated/findloc0_i1.c
@@ -0,0 +1,375 @@
+
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_INTEGER_1)
+extern void findloc0_i1 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i1 * const restrict array, GFC_INTEGER_1 value,
+ GFC_LOGICAL_4);
+export_proto(findloc0_i1);
+
+void
+findloc0_i1 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i1 * const restrict array, GFC_INTEGER_1 value,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_INTEGER_1 *base;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * 1;
+
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * 1;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * 1;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * 1;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void mfindloc0_i1 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i1 * const restrict array, GFC_INTEGER_1 value,
+ gfc_array_l1 *const restrict, GFC_LOGICAL_4);
+export_proto(mfindloc0_i1);
+
+void
+mfindloc0_i1 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i1 * const restrict array, GFC_INTEGER_1 value,
+ gfc_array_l1 *const restrict mask, GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_INTEGER_1 *base;
+ index_type * restrict dest;
+ GFC_LOGICAL_1 *mbase;
+ index_type rank;
+ index_type n;
+ int mask_kind;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "FINDLOC");
+ }
+ }
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * 1;
+ mbase = mbase + (sz - 1) * mask_kind;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && *base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * 1;
+ mbase -= mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * 1;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && *base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * 1;
+ mbase += mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n]* 1;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void sfindloc0_i1 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i1 * const restrict array, GFC_INTEGER_1 value,
+ GFC_LOGICAL_4 *, GFC_LOGICAL_4);
+export_proto(sfindloc0_i1);
+
+void
+sfindloc0_i1 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i1 * const restrict array, GFC_INTEGER_1 value,
+ GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back)
+{
+ index_type rank;
+ index_type dstride;
+ index_type * restrict dest;
+ index_type n;
+
+ if (*mask)
+ {
+ findloc0_i1 (retarray, array, value, back);
+ return;
+ }
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+
+ if (rank <= 0)
+ internal_error (NULL, "Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+ for (n = 0; n<rank; n++)
+ dest[n * dstride] = 0 ;
+}
+
+#endif
diff --git a/libgfortran/generated/findloc0_i16.c b/libgfortran/generated/findloc0_i16.c
new file mode 100644
index 0000000..bdfd69a
--- /dev/null
+++ b/libgfortran/generated/findloc0_i16.c
@@ -0,0 +1,375 @@
+
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_INTEGER_16)
+extern void findloc0_i16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i16 * const restrict array, GFC_INTEGER_16 value,
+ GFC_LOGICAL_4);
+export_proto(findloc0_i16);
+
+void
+findloc0_i16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i16 * const restrict array, GFC_INTEGER_16 value,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_INTEGER_16 *base;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * 1;
+
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * 1;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * 1;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * 1;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void mfindloc0_i16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i16 * const restrict array, GFC_INTEGER_16 value,
+ gfc_array_l1 *const restrict, GFC_LOGICAL_4);
+export_proto(mfindloc0_i16);
+
+void
+mfindloc0_i16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i16 * const restrict array, GFC_INTEGER_16 value,
+ gfc_array_l1 *const restrict mask, GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_INTEGER_16 *base;
+ index_type * restrict dest;
+ GFC_LOGICAL_1 *mbase;
+ index_type rank;
+ index_type n;
+ int mask_kind;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "FINDLOC");
+ }
+ }
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * 1;
+ mbase = mbase + (sz - 1) * mask_kind;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && *base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * 1;
+ mbase -= mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * 1;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && *base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * 1;
+ mbase += mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n]* 1;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void sfindloc0_i16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i16 * const restrict array, GFC_INTEGER_16 value,
+ GFC_LOGICAL_4 *, GFC_LOGICAL_4);
+export_proto(sfindloc0_i16);
+
+void
+sfindloc0_i16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i16 * const restrict array, GFC_INTEGER_16 value,
+ GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back)
+{
+ index_type rank;
+ index_type dstride;
+ index_type * restrict dest;
+ index_type n;
+
+ if (*mask)
+ {
+ findloc0_i16 (retarray, array, value, back);
+ return;
+ }
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+
+ if (rank <= 0)
+ internal_error (NULL, "Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+ for (n = 0; n<rank; n++)
+ dest[n * dstride] = 0 ;
+}
+
+#endif
diff --git a/libgfortran/generated/findloc0_i2.c b/libgfortran/generated/findloc0_i2.c
new file mode 100644
index 0000000..712262f
--- /dev/null
+++ b/libgfortran/generated/findloc0_i2.c
@@ -0,0 +1,375 @@
+
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_INTEGER_2)
+extern void findloc0_i2 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i2 * const restrict array, GFC_INTEGER_2 value,
+ GFC_LOGICAL_4);
+export_proto(findloc0_i2);
+
+void
+findloc0_i2 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i2 * const restrict array, GFC_INTEGER_2 value,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_INTEGER_2 *base;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * 1;
+
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * 1;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * 1;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * 1;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void mfindloc0_i2 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i2 * const restrict array, GFC_INTEGER_2 value,
+ gfc_array_l1 *const restrict, GFC_LOGICAL_4);
+export_proto(mfindloc0_i2);
+
+void
+mfindloc0_i2 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i2 * const restrict array, GFC_INTEGER_2 value,
+ gfc_array_l1 *const restrict mask, GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_INTEGER_2 *base;
+ index_type * restrict dest;
+ GFC_LOGICAL_1 *mbase;
+ index_type rank;
+ index_type n;
+ int mask_kind;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "FINDLOC");
+ }
+ }
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * 1;
+ mbase = mbase + (sz - 1) * mask_kind;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && *base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * 1;
+ mbase -= mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * 1;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && *base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * 1;
+ mbase += mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n]* 1;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void sfindloc0_i2 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i2 * const restrict array, GFC_INTEGER_2 value,
+ GFC_LOGICAL_4 *, GFC_LOGICAL_4);
+export_proto(sfindloc0_i2);
+
+void
+sfindloc0_i2 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i2 * const restrict array, GFC_INTEGER_2 value,
+ GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back)
+{
+ index_type rank;
+ index_type dstride;
+ index_type * restrict dest;
+ index_type n;
+
+ if (*mask)
+ {
+ findloc0_i2 (retarray, array, value, back);
+ return;
+ }
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+
+ if (rank <= 0)
+ internal_error (NULL, "Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+ for (n = 0; n<rank; n++)
+ dest[n * dstride] = 0 ;
+}
+
+#endif
diff --git a/libgfortran/generated/findloc0_i4.c b/libgfortran/generated/findloc0_i4.c
new file mode 100644
index 0000000..db72489
--- /dev/null
+++ b/libgfortran/generated/findloc0_i4.c
@@ -0,0 +1,375 @@
+
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_INTEGER_4)
+extern void findloc0_i4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i4 * const restrict array, GFC_INTEGER_4 value,
+ GFC_LOGICAL_4);
+export_proto(findloc0_i4);
+
+void
+findloc0_i4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i4 * const restrict array, GFC_INTEGER_4 value,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_INTEGER_4 *base;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * 1;
+
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * 1;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * 1;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * 1;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void mfindloc0_i4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i4 * const restrict array, GFC_INTEGER_4 value,
+ gfc_array_l1 *const restrict, GFC_LOGICAL_4);
+export_proto(mfindloc0_i4);
+
+void
+mfindloc0_i4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i4 * const restrict array, GFC_INTEGER_4 value,
+ gfc_array_l1 *const restrict mask, GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_INTEGER_4 *base;
+ index_type * restrict dest;
+ GFC_LOGICAL_1 *mbase;
+ index_type rank;
+ index_type n;
+ int mask_kind;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "FINDLOC");
+ }
+ }
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * 1;
+ mbase = mbase + (sz - 1) * mask_kind;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && *base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * 1;
+ mbase -= mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * 1;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && *base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * 1;
+ mbase += mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n]* 1;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void sfindloc0_i4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i4 * const restrict array, GFC_INTEGER_4 value,
+ GFC_LOGICAL_4 *, GFC_LOGICAL_4);
+export_proto(sfindloc0_i4);
+
+void
+sfindloc0_i4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i4 * const restrict array, GFC_INTEGER_4 value,
+ GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back)
+{
+ index_type rank;
+ index_type dstride;
+ index_type * restrict dest;
+ index_type n;
+
+ if (*mask)
+ {
+ findloc0_i4 (retarray, array, value, back);
+ return;
+ }
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+
+ if (rank <= 0)
+ internal_error (NULL, "Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+ for (n = 0; n<rank; n++)
+ dest[n * dstride] = 0 ;
+}
+
+#endif
diff --git a/libgfortran/generated/findloc0_i8.c b/libgfortran/generated/findloc0_i8.c
new file mode 100644
index 0000000..6fb3e2c
--- /dev/null
+++ b/libgfortran/generated/findloc0_i8.c
@@ -0,0 +1,375 @@
+
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_INTEGER_8)
+extern void findloc0_i8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i8 * const restrict array, GFC_INTEGER_8 value,
+ GFC_LOGICAL_4);
+export_proto(findloc0_i8);
+
+void
+findloc0_i8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i8 * const restrict array, GFC_INTEGER_8 value,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_INTEGER_8 *base;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * 1;
+
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * 1;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * 1;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * 1;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void mfindloc0_i8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i8 * const restrict array, GFC_INTEGER_8 value,
+ gfc_array_l1 *const restrict, GFC_LOGICAL_4);
+export_proto(mfindloc0_i8);
+
+void
+mfindloc0_i8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i8 * const restrict array, GFC_INTEGER_8 value,
+ gfc_array_l1 *const restrict mask, GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_INTEGER_8 *base;
+ index_type * restrict dest;
+ GFC_LOGICAL_1 *mbase;
+ index_type rank;
+ index_type n;
+ int mask_kind;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "FINDLOC");
+ }
+ }
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * 1;
+ mbase = mbase + (sz - 1) * mask_kind;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && *base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * 1;
+ mbase -= mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * 1;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && *base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * 1;
+ mbase += mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n]* 1;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void sfindloc0_i8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i8 * const restrict array, GFC_INTEGER_8 value,
+ GFC_LOGICAL_4 *, GFC_LOGICAL_4);
+export_proto(sfindloc0_i8);
+
+void
+sfindloc0_i8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i8 * const restrict array, GFC_INTEGER_8 value,
+ GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back)
+{
+ index_type rank;
+ index_type dstride;
+ index_type * restrict dest;
+ index_type n;
+
+ if (*mask)
+ {
+ findloc0_i8 (retarray, array, value, back);
+ return;
+ }
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+
+ if (rank <= 0)
+ internal_error (NULL, "Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+ for (n = 0; n<rank; n++)
+ dest[n * dstride] = 0 ;
+}
+
+#endif
diff --git a/libgfortran/generated/findloc0_r16.c b/libgfortran/generated/findloc0_r16.c
new file mode 100644
index 0000000..23ecd98
--- /dev/null
+++ b/libgfortran/generated/findloc0_r16.c
@@ -0,0 +1,375 @@
+
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_REAL_16)
+extern void findloc0_r16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r16 * const restrict array, GFC_REAL_16 value,
+ GFC_LOGICAL_4);
+export_proto(findloc0_r16);
+
+void
+findloc0_r16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r16 * const restrict array, GFC_REAL_16 value,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_REAL_16 *base;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * 1;
+
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * 1;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * 1;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * 1;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void mfindloc0_r16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r16 * const restrict array, GFC_REAL_16 value,
+ gfc_array_l1 *const restrict, GFC_LOGICAL_4);
+export_proto(mfindloc0_r16);
+
+void
+mfindloc0_r16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r16 * const restrict array, GFC_REAL_16 value,
+ gfc_array_l1 *const restrict mask, GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_REAL_16 *base;
+ index_type * restrict dest;
+ GFC_LOGICAL_1 *mbase;
+ index_type rank;
+ index_type n;
+ int mask_kind;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "FINDLOC");
+ }
+ }
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * 1;
+ mbase = mbase + (sz - 1) * mask_kind;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && *base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * 1;
+ mbase -= mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * 1;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && *base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * 1;
+ mbase += mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n]* 1;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void sfindloc0_r16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r16 * const restrict array, GFC_REAL_16 value,
+ GFC_LOGICAL_4 *, GFC_LOGICAL_4);
+export_proto(sfindloc0_r16);
+
+void
+sfindloc0_r16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r16 * const restrict array, GFC_REAL_16 value,
+ GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back)
+{
+ index_type rank;
+ index_type dstride;
+ index_type * restrict dest;
+ index_type n;
+
+ if (*mask)
+ {
+ findloc0_r16 (retarray, array, value, back);
+ return;
+ }
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+
+ if (rank <= 0)
+ internal_error (NULL, "Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+ for (n = 0; n<rank; n++)
+ dest[n * dstride] = 0 ;
+}
+
+#endif
diff --git a/libgfortran/generated/findloc0_r4.c b/libgfortran/generated/findloc0_r4.c
new file mode 100644
index 0000000..08d59e9
--- /dev/null
+++ b/libgfortran/generated/findloc0_r4.c
@@ -0,0 +1,375 @@
+
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_REAL_4)
+extern void findloc0_r4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r4 * const restrict array, GFC_REAL_4 value,
+ GFC_LOGICAL_4);
+export_proto(findloc0_r4);
+
+void
+findloc0_r4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r4 * const restrict array, GFC_REAL_4 value,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_REAL_4 *base;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * 1;
+
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * 1;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * 1;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * 1;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void mfindloc0_r4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r4 * const restrict array, GFC_REAL_4 value,
+ gfc_array_l1 *const restrict, GFC_LOGICAL_4);
+export_proto(mfindloc0_r4);
+
+void
+mfindloc0_r4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r4 * const restrict array, GFC_REAL_4 value,
+ gfc_array_l1 *const restrict mask, GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_REAL_4 *base;
+ index_type * restrict dest;
+ GFC_LOGICAL_1 *mbase;
+ index_type rank;
+ index_type n;
+ int mask_kind;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "FINDLOC");
+ }
+ }
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * 1;
+ mbase = mbase + (sz - 1) * mask_kind;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && *base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * 1;
+ mbase -= mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * 1;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && *base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * 1;
+ mbase += mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n]* 1;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void sfindloc0_r4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r4 * const restrict array, GFC_REAL_4 value,
+ GFC_LOGICAL_4 *, GFC_LOGICAL_4);
+export_proto(sfindloc0_r4);
+
+void
+sfindloc0_r4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r4 * const restrict array, GFC_REAL_4 value,
+ GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back)
+{
+ index_type rank;
+ index_type dstride;
+ index_type * restrict dest;
+ index_type n;
+
+ if (*mask)
+ {
+ findloc0_r4 (retarray, array, value, back);
+ return;
+ }
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+
+ if (rank <= 0)
+ internal_error (NULL, "Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+ for (n = 0; n<rank; n++)
+ dest[n * dstride] = 0 ;
+}
+
+#endif
diff --git a/libgfortran/generated/findloc0_r8.c b/libgfortran/generated/findloc0_r8.c
new file mode 100644
index 0000000..c731531
--- /dev/null
+++ b/libgfortran/generated/findloc0_r8.c
@@ -0,0 +1,375 @@
+
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_REAL_8)
+extern void findloc0_r8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r8 * const restrict array, GFC_REAL_8 value,
+ GFC_LOGICAL_4);
+export_proto(findloc0_r8);
+
+void
+findloc0_r8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r8 * const restrict array, GFC_REAL_8 value,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_REAL_8 *base;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * 1;
+
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * 1;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * 1;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * 1;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void mfindloc0_r8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r8 * const restrict array, GFC_REAL_8 value,
+ gfc_array_l1 *const restrict, GFC_LOGICAL_4);
+export_proto(mfindloc0_r8);
+
+void
+mfindloc0_r8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r8 * const restrict array, GFC_REAL_8 value,
+ gfc_array_l1 *const restrict mask, GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_REAL_8 *base;
+ index_type * restrict dest;
+ GFC_LOGICAL_1 *mbase;
+ index_type rank;
+ index_type n;
+ int mask_kind;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "FINDLOC");
+ }
+ }
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * 1;
+ mbase = mbase + (sz - 1) * mask_kind;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && *base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * 1;
+ mbase -= mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * 1;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && *base == value))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * 1;
+ mbase += mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 1;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n]* 1;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void sfindloc0_r8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r8 * const restrict array, GFC_REAL_8 value,
+ GFC_LOGICAL_4 *, GFC_LOGICAL_4);
+export_proto(sfindloc0_r8);
+
+void
+sfindloc0_r8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r8 * const restrict array, GFC_REAL_8 value,
+ GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back)
+{
+ index_type rank;
+ index_type dstride;
+ index_type * restrict dest;
+ index_type n;
+
+ if (*mask)
+ {
+ findloc0_r8 (retarray, array, value, back);
+ return;
+ }
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+
+ if (rank <= 0)
+ internal_error (NULL, "Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+ for (n = 0; n<rank; n++)
+ dest[n * dstride] = 0 ;
+}
+
+#endif
diff --git a/libgfortran/generated/findloc0_s1.c b/libgfortran/generated/findloc0_s1.c
new file mode 100644
index 0000000..3b0f9b0
--- /dev/null
+++ b/libgfortran/generated/findloc0_s1.c
@@ -0,0 +1,383 @@
+
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_UINTEGER_1)
+extern void findloc0_s1 (gfc_array_index_type * const restrict retarray,
+ gfc_array_s1 * const restrict array, GFC_UINTEGER_1 *value,
+ GFC_LOGICAL_4 back, gfc_charlen_type len_array, gfc_charlen_type len_value);
+
+export_proto(findloc0_s1);
+
+void
+findloc0_s1 (gfc_array_index_type * const restrict retarray,
+ gfc_array_s1 * const restrict array, GFC_UINTEGER_1 *value,
+ GFC_LOGICAL_4 back, gfc_charlen_type len_array, gfc_charlen_type len_value)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_UINTEGER_1 *base;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * len_array;
+
+ while (1)
+ {
+ do
+ {
+ if (unlikely(compare_string (len_array, (char *) base, len_value, (char *) value) == 0))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * len_array;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * len_array;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * len_array;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(compare_string (len_array, (char *) base, len_value, (char *) value) == 0))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * len_array;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * len_array;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n] * len_array;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void mfindloc0_s1 (gfc_array_index_type * const restrict retarray,
+ gfc_array_s1 * const restrict array, GFC_UINTEGER_1 *value,
+ gfc_array_l1 *const restrict, GFC_LOGICAL_4 back, gfc_charlen_type len_array,
+ gfc_charlen_type len_value);
+export_proto(mfindloc0_s1);
+
+void
+mfindloc0_s1 (gfc_array_index_type * const restrict retarray,
+ gfc_array_s1 * const restrict array, GFC_UINTEGER_1 *value,
+ gfc_array_l1 *const restrict mask, GFC_LOGICAL_4 back,
+ gfc_charlen_type len_array, gfc_charlen_type len_value)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_UINTEGER_1 *base;
+ index_type * restrict dest;
+ GFC_LOGICAL_1 *mbase;
+ index_type rank;
+ index_type n;
+ int mask_kind;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "FINDLOC");
+ }
+ }
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * len_array;
+ mbase = mbase + (sz - 1) * mask_kind;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && compare_string (len_array, (char *) base, len_value, (char *) value) == 0))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * len_array;
+ mbase -= mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * len_array;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * len_array;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && compare_string (len_array, (char *) base, len_value, (char *) value) == 0))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * len_array;
+ mbase += mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * len_array;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n]* len_array;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void sfindloc0_s1 (gfc_array_index_type * const restrict retarray,
+ gfc_array_s1 * const restrict array, GFC_UINTEGER_1 *value,
+ GFC_LOGICAL_4 *, GFC_LOGICAL_4 back, gfc_charlen_type len_array,
+ gfc_charlen_type len_value);
+export_proto(sfindloc0_s1);
+
+void
+sfindloc0_s1 (gfc_array_index_type * const restrict retarray,
+ gfc_array_s1 * const restrict array, GFC_UINTEGER_1 *value,
+ GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back, gfc_charlen_type len_array,
+ gfc_charlen_type len_value)
+{
+ index_type rank;
+ index_type dstride;
+ index_type * restrict dest;
+ index_type n;
+
+ if (*mask)
+ {
+ findloc0_s1 (retarray, array, value, back, len_array, len_value);
+ return;
+ }
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+
+ if (rank <= 0)
+ internal_error (NULL, "Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+ for (n = 0; n<rank; n++)
+ dest[n * dstride] = 0 ;
+}
+
+#endif
+
+
+
diff --git a/libgfortran/generated/findloc0_s4.c b/libgfortran/generated/findloc0_s4.c
new file mode 100644
index 0000000..fa23503
--- /dev/null
+++ b/libgfortran/generated/findloc0_s4.c
@@ -0,0 +1,383 @@
+
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_UINTEGER_4)
+extern void findloc0_s4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_s4 * const restrict array, GFC_UINTEGER_4 *value,
+ GFC_LOGICAL_4 back, gfc_charlen_type len_array, gfc_charlen_type len_value);
+
+export_proto(findloc0_s4);
+
+void
+findloc0_s4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_s4 * const restrict array, GFC_UINTEGER_4 *value,
+ GFC_LOGICAL_4 back, gfc_charlen_type len_array, gfc_charlen_type len_value)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_UINTEGER_4 *base;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * len_array;
+
+ while (1)
+ {
+ do
+ {
+ if (unlikely(compare_string_char4 (len_array, base, len_value, value) == 0))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * len_array;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * len_array;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * len_array;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(compare_string_char4 (len_array, base, len_value, value) == 0))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * len_array;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * len_array;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n] * len_array;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void mfindloc0_s4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_s4 * const restrict array, GFC_UINTEGER_4 *value,
+ gfc_array_l1 *const restrict, GFC_LOGICAL_4 back, gfc_charlen_type len_array,
+ gfc_charlen_type len_value);
+export_proto(mfindloc0_s4);
+
+void
+mfindloc0_s4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_s4 * const restrict array, GFC_UINTEGER_4 *value,
+ gfc_array_l1 *const restrict mask, GFC_LOGICAL_4 back,
+ gfc_charlen_type len_array, gfc_charlen_type len_value)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const GFC_UINTEGER_4 *base;
+ index_type * restrict dest;
+ GFC_LOGICAL_1 *mbase;
+ index_type rank;
+ index_type n;
+ int mask_kind;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "FINDLOC");
+ }
+ }
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * len_array;
+ mbase = mbase + (sz - 1) * mask_kind;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && compare_string_char4 (len_array, base, len_value, value) == 0))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * len_array;
+ mbase -= mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * len_array;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * len_array;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && compare_string_char4 (len_array, base, len_value, value) == 0))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * len_array;
+ mbase += mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * len_array;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n]* len_array;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+extern void sfindloc0_s4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_s4 * const restrict array, GFC_UINTEGER_4 *value,
+ GFC_LOGICAL_4 *, GFC_LOGICAL_4 back, gfc_charlen_type len_array,
+ gfc_charlen_type len_value);
+export_proto(sfindloc0_s4);
+
+void
+sfindloc0_s4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_s4 * const restrict array, GFC_UINTEGER_4 *value,
+ GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back, gfc_charlen_type len_array,
+ gfc_charlen_type len_value)
+{
+ index_type rank;
+ index_type dstride;
+ index_type * restrict dest;
+ index_type n;
+
+ if (*mask)
+ {
+ findloc0_s4 (retarray, array, value, back, len_array, len_value);
+ return;
+ }
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+
+ if (rank <= 0)
+ internal_error (NULL, "Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+ for (n = 0; n<rank; n++)
+ dest[n * dstride] = 0 ;
+}
+
+#endif
+
+
+
diff --git a/libgfortran/generated/findloc1_c16.c b/libgfortran/generated/findloc1_c16.c
new file mode 100644
index 0000000..3c03c0b
--- /dev/null
+++ b/libgfortran/generated/findloc1_c16.c
@@ -0,0 +1,523 @@
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_COMPLEX_16)
+extern void findloc1_c16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c16 * const restrict array, GFC_COMPLEX_16 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back);
+export_proto(findloc1_c16);
+
+extern void
+findloc1_c16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c16 * const restrict array, GFC_COMPLEX_16 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back)
+{
+ 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_COMPLEX_16 * restrict base;
+ index_type * 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. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_COMPLEX_16 * restrict src;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * 1;
+ for (n = len; n > 0; n--, src -= delta * 1)
+ {
+ if (*src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ for (n = 1; n <= len; n++, src += delta * 1)
+ {
+ if (*src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * 1;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * 1;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void mfindloc1_c16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c16 * const restrict array, GFC_COMPLEX_16 value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back);
+export_proto(mfindloc1_c16);
+
+extern void
+mfindloc1_c16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c16 * const restrict array, GFC_COMPLEX_16 value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_COMPLEX_16 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ index_type dim;
+ int mask_kind;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_COMPLEX_16 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * 1;
+ msrc = mbase + (len - 1) * mdelta;
+ for (n = len; n > 0; n--, src -= delta * 1, msrc -= mdelta)
+ {
+ if (*msrc && *src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ msrc = mbase;
+ for (n = 1; n <= len; n++, src += delta * 1, msrc += mdelta)
+ {
+ if (*msrc && *src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * 1;
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * 1;
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void sfindloc1_c16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c16 * const restrict array, GFC_COMPLEX_16 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back);
+export_proto(sfindloc1_c16);
+
+extern void
+sfindloc1_c16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c16 * const restrict array, GFC_COMPLEX_16 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type dim;
+ bool continue_loop;
+
+ if (*mask)
+ {
+ findloc1_c16 (retarray, array, value, pdim, back);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ while (continue_loop)
+ {
+ *dest = 0;
+
+ count[0]++;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+#endif
diff --git a/libgfortran/generated/findloc1_c4.c b/libgfortran/generated/findloc1_c4.c
new file mode 100644
index 0000000..6355e2b
--- /dev/null
+++ b/libgfortran/generated/findloc1_c4.c
@@ -0,0 +1,523 @@
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_COMPLEX_4)
+extern void findloc1_c4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c4 * const restrict array, GFC_COMPLEX_4 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back);
+export_proto(findloc1_c4);
+
+extern void
+findloc1_c4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c4 * const restrict array, GFC_COMPLEX_4 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back)
+{
+ 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_COMPLEX_4 * restrict base;
+ index_type * 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. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_COMPLEX_4 * restrict src;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * 1;
+ for (n = len; n > 0; n--, src -= delta * 1)
+ {
+ if (*src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ for (n = 1; n <= len; n++, src += delta * 1)
+ {
+ if (*src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * 1;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * 1;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void mfindloc1_c4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c4 * const restrict array, GFC_COMPLEX_4 value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back);
+export_proto(mfindloc1_c4);
+
+extern void
+mfindloc1_c4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c4 * const restrict array, GFC_COMPLEX_4 value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_COMPLEX_4 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ index_type dim;
+ int mask_kind;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_COMPLEX_4 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * 1;
+ msrc = mbase + (len - 1) * mdelta;
+ for (n = len; n > 0; n--, src -= delta * 1, msrc -= mdelta)
+ {
+ if (*msrc && *src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ msrc = mbase;
+ for (n = 1; n <= len; n++, src += delta * 1, msrc += mdelta)
+ {
+ if (*msrc && *src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * 1;
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * 1;
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void sfindloc1_c4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c4 * const restrict array, GFC_COMPLEX_4 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back);
+export_proto(sfindloc1_c4);
+
+extern void
+sfindloc1_c4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c4 * const restrict array, GFC_COMPLEX_4 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type dim;
+ bool continue_loop;
+
+ if (*mask)
+ {
+ findloc1_c4 (retarray, array, value, pdim, back);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ while (continue_loop)
+ {
+ *dest = 0;
+
+ count[0]++;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+#endif
diff --git a/libgfortran/generated/findloc1_c8.c b/libgfortran/generated/findloc1_c8.c
new file mode 100644
index 0000000..dec5172
--- /dev/null
+++ b/libgfortran/generated/findloc1_c8.c
@@ -0,0 +1,523 @@
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_COMPLEX_8)
+extern void findloc1_c8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c8 * const restrict array, GFC_COMPLEX_8 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back);
+export_proto(findloc1_c8);
+
+extern void
+findloc1_c8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c8 * const restrict array, GFC_COMPLEX_8 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back)
+{
+ 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_COMPLEX_8 * restrict base;
+ index_type * 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. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_COMPLEX_8 * restrict src;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * 1;
+ for (n = len; n > 0; n--, src -= delta * 1)
+ {
+ if (*src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ for (n = 1; n <= len; n++, src += delta * 1)
+ {
+ if (*src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * 1;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * 1;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void mfindloc1_c8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c8 * const restrict array, GFC_COMPLEX_8 value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back);
+export_proto(mfindloc1_c8);
+
+extern void
+mfindloc1_c8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c8 * const restrict array, GFC_COMPLEX_8 value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_COMPLEX_8 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ index_type dim;
+ int mask_kind;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_COMPLEX_8 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * 1;
+ msrc = mbase + (len - 1) * mdelta;
+ for (n = len; n > 0; n--, src -= delta * 1, msrc -= mdelta)
+ {
+ if (*msrc && *src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ msrc = mbase;
+ for (n = 1; n <= len; n++, src += delta * 1, msrc += mdelta)
+ {
+ if (*msrc && *src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * 1;
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * 1;
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void sfindloc1_c8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c8 * const restrict array, GFC_COMPLEX_8 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back);
+export_proto(sfindloc1_c8);
+
+extern void
+sfindloc1_c8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_c8 * const restrict array, GFC_COMPLEX_8 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type dim;
+ bool continue_loop;
+
+ if (*mask)
+ {
+ findloc1_c8 (retarray, array, value, pdim, back);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ while (continue_loop)
+ {
+ *dest = 0;
+
+ count[0]++;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+#endif
diff --git a/libgfortran/generated/findloc1_i1.c b/libgfortran/generated/findloc1_i1.c
new file mode 100644
index 0000000..26b497e
--- /dev/null
+++ b/libgfortran/generated/findloc1_i1.c
@@ -0,0 +1,523 @@
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_INTEGER_1)
+extern void findloc1_i1 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i1 * const restrict array, GFC_INTEGER_1 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back);
+export_proto(findloc1_i1);
+
+extern void
+findloc1_i1 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i1 * const restrict array, GFC_INTEGER_1 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back)
+{
+ 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;
+ index_type * 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. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_INTEGER_1 * restrict src;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * 1;
+ for (n = len; n > 0; n--, src -= delta * 1)
+ {
+ if (*src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ for (n = 1; n <= len; n++, src += delta * 1)
+ {
+ if (*src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * 1;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * 1;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void mfindloc1_i1 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i1 * const restrict array, GFC_INTEGER_1 value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back);
+export_proto(mfindloc1_i1);
+
+extern void
+mfindloc1_i1 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i1 * const restrict array, GFC_INTEGER_1 value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_INTEGER_1 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ index_type dim;
+ int mask_kind;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_INTEGER_1 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * 1;
+ msrc = mbase + (len - 1) * mdelta;
+ for (n = len; n > 0; n--, src -= delta * 1, msrc -= mdelta)
+ {
+ if (*msrc && *src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ msrc = mbase;
+ for (n = 1; n <= len; n++, src += delta * 1, msrc += mdelta)
+ {
+ if (*msrc && *src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * 1;
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * 1;
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void sfindloc1_i1 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i1 * const restrict array, GFC_INTEGER_1 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back);
+export_proto(sfindloc1_i1);
+
+extern void
+sfindloc1_i1 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i1 * const restrict array, GFC_INTEGER_1 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type dim;
+ bool continue_loop;
+
+ if (*mask)
+ {
+ findloc1_i1 (retarray, array, value, pdim, back);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ while (continue_loop)
+ {
+ *dest = 0;
+
+ count[0]++;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+#endif
diff --git a/libgfortran/generated/findloc1_i16.c b/libgfortran/generated/findloc1_i16.c
new file mode 100644
index 0000000..edb52e2
--- /dev/null
+++ b/libgfortran/generated/findloc1_i16.c
@@ -0,0 +1,523 @@
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_INTEGER_16)
+extern void findloc1_i16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i16 * const restrict array, GFC_INTEGER_16 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back);
+export_proto(findloc1_i16);
+
+extern void
+findloc1_i16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i16 * const restrict array, GFC_INTEGER_16 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back)
+{
+ 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;
+ index_type * 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. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_INTEGER_16 * restrict src;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * 1;
+ for (n = len; n > 0; n--, src -= delta * 1)
+ {
+ if (*src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ for (n = 1; n <= len; n++, src += delta * 1)
+ {
+ if (*src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * 1;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * 1;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void mfindloc1_i16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i16 * const restrict array, GFC_INTEGER_16 value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back);
+export_proto(mfindloc1_i16);
+
+extern void
+mfindloc1_i16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i16 * const restrict array, GFC_INTEGER_16 value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_INTEGER_16 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ index_type dim;
+ int mask_kind;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_INTEGER_16 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * 1;
+ msrc = mbase + (len - 1) * mdelta;
+ for (n = len; n > 0; n--, src -= delta * 1, msrc -= mdelta)
+ {
+ if (*msrc && *src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ msrc = mbase;
+ for (n = 1; n <= len; n++, src += delta * 1, msrc += mdelta)
+ {
+ if (*msrc && *src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * 1;
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * 1;
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void sfindloc1_i16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i16 * const restrict array, GFC_INTEGER_16 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back);
+export_proto(sfindloc1_i16);
+
+extern void
+sfindloc1_i16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i16 * const restrict array, GFC_INTEGER_16 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type dim;
+ bool continue_loop;
+
+ if (*mask)
+ {
+ findloc1_i16 (retarray, array, value, pdim, back);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ while (continue_loop)
+ {
+ *dest = 0;
+
+ count[0]++;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+#endif
diff --git a/libgfortran/generated/findloc1_i2.c b/libgfortran/generated/findloc1_i2.c
new file mode 100644
index 0000000..280b7b8
--- /dev/null
+++ b/libgfortran/generated/findloc1_i2.c
@@ -0,0 +1,523 @@
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_INTEGER_2)
+extern void findloc1_i2 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i2 * const restrict array, GFC_INTEGER_2 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back);
+export_proto(findloc1_i2);
+
+extern void
+findloc1_i2 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i2 * const restrict array, GFC_INTEGER_2 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back)
+{
+ 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;
+ index_type * 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. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_INTEGER_2 * restrict src;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * 1;
+ for (n = len; n > 0; n--, src -= delta * 1)
+ {
+ if (*src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ for (n = 1; n <= len; n++, src += delta * 1)
+ {
+ if (*src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * 1;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * 1;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void mfindloc1_i2 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i2 * const restrict array, GFC_INTEGER_2 value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back);
+export_proto(mfindloc1_i2);
+
+extern void
+mfindloc1_i2 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i2 * const restrict array, GFC_INTEGER_2 value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_INTEGER_2 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ index_type dim;
+ int mask_kind;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_INTEGER_2 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * 1;
+ msrc = mbase + (len - 1) * mdelta;
+ for (n = len; n > 0; n--, src -= delta * 1, msrc -= mdelta)
+ {
+ if (*msrc && *src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ msrc = mbase;
+ for (n = 1; n <= len; n++, src += delta * 1, msrc += mdelta)
+ {
+ if (*msrc && *src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * 1;
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * 1;
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void sfindloc1_i2 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i2 * const restrict array, GFC_INTEGER_2 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back);
+export_proto(sfindloc1_i2);
+
+extern void
+sfindloc1_i2 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i2 * const restrict array, GFC_INTEGER_2 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type dim;
+ bool continue_loop;
+
+ if (*mask)
+ {
+ findloc1_i2 (retarray, array, value, pdim, back);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ while (continue_loop)
+ {
+ *dest = 0;
+
+ count[0]++;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+#endif
diff --git a/libgfortran/generated/findloc1_i4.c b/libgfortran/generated/findloc1_i4.c
new file mode 100644
index 0000000..a9e3abc
--- /dev/null
+++ b/libgfortran/generated/findloc1_i4.c
@@ -0,0 +1,523 @@
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_INTEGER_4)
+extern void findloc1_i4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i4 * const restrict array, GFC_INTEGER_4 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back);
+export_proto(findloc1_i4);
+
+extern void
+findloc1_i4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i4 * const restrict array, GFC_INTEGER_4 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back)
+{
+ 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;
+ index_type * 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. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_INTEGER_4 * restrict src;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * 1;
+ for (n = len; n > 0; n--, src -= delta * 1)
+ {
+ if (*src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ for (n = 1; n <= len; n++, src += delta * 1)
+ {
+ if (*src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * 1;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * 1;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void mfindloc1_i4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i4 * const restrict array, GFC_INTEGER_4 value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back);
+export_proto(mfindloc1_i4);
+
+extern void
+mfindloc1_i4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i4 * const restrict array, GFC_INTEGER_4 value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_INTEGER_4 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ index_type dim;
+ int mask_kind;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_INTEGER_4 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * 1;
+ msrc = mbase + (len - 1) * mdelta;
+ for (n = len; n > 0; n--, src -= delta * 1, msrc -= mdelta)
+ {
+ if (*msrc && *src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ msrc = mbase;
+ for (n = 1; n <= len; n++, src += delta * 1, msrc += mdelta)
+ {
+ if (*msrc && *src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * 1;
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * 1;
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void sfindloc1_i4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i4 * const restrict array, GFC_INTEGER_4 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back);
+export_proto(sfindloc1_i4);
+
+extern void
+sfindloc1_i4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i4 * const restrict array, GFC_INTEGER_4 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type dim;
+ bool continue_loop;
+
+ if (*mask)
+ {
+ findloc1_i4 (retarray, array, value, pdim, back);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ while (continue_loop)
+ {
+ *dest = 0;
+
+ count[0]++;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+#endif
diff --git a/libgfortran/generated/findloc1_i8.c b/libgfortran/generated/findloc1_i8.c
new file mode 100644
index 0000000..79b5a5a
--- /dev/null
+++ b/libgfortran/generated/findloc1_i8.c
@@ -0,0 +1,523 @@
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_INTEGER_8)
+extern void findloc1_i8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i8 * const restrict array, GFC_INTEGER_8 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back);
+export_proto(findloc1_i8);
+
+extern void
+findloc1_i8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i8 * const restrict array, GFC_INTEGER_8 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back)
+{
+ 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;
+ index_type * 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. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_INTEGER_8 * restrict src;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * 1;
+ for (n = len; n > 0; n--, src -= delta * 1)
+ {
+ if (*src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ for (n = 1; n <= len; n++, src += delta * 1)
+ {
+ if (*src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * 1;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * 1;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void mfindloc1_i8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i8 * const restrict array, GFC_INTEGER_8 value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back);
+export_proto(mfindloc1_i8);
+
+extern void
+mfindloc1_i8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i8 * const restrict array, GFC_INTEGER_8 value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_INTEGER_8 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ index_type dim;
+ int mask_kind;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_INTEGER_8 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * 1;
+ msrc = mbase + (len - 1) * mdelta;
+ for (n = len; n > 0; n--, src -= delta * 1, msrc -= mdelta)
+ {
+ if (*msrc && *src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ msrc = mbase;
+ for (n = 1; n <= len; n++, src += delta * 1, msrc += mdelta)
+ {
+ if (*msrc && *src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * 1;
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * 1;
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void sfindloc1_i8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i8 * const restrict array, GFC_INTEGER_8 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back);
+export_proto(sfindloc1_i8);
+
+extern void
+sfindloc1_i8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_i8 * const restrict array, GFC_INTEGER_8 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type dim;
+ bool continue_loop;
+
+ if (*mask)
+ {
+ findloc1_i8 (retarray, array, value, pdim, back);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ while (continue_loop)
+ {
+ *dest = 0;
+
+ count[0]++;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+#endif
diff --git a/libgfortran/generated/findloc1_r16.c b/libgfortran/generated/findloc1_r16.c
new file mode 100644
index 0000000..90f3db0
--- /dev/null
+++ b/libgfortran/generated/findloc1_r16.c
@@ -0,0 +1,523 @@
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_REAL_16)
+extern void findloc1_r16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r16 * const restrict array, GFC_REAL_16 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back);
+export_proto(findloc1_r16);
+
+extern void
+findloc1_r16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r16 * const restrict array, GFC_REAL_16 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back)
+{
+ 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_REAL_16 * restrict base;
+ index_type * 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. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_REAL_16 * restrict src;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * 1;
+ for (n = len; n > 0; n--, src -= delta * 1)
+ {
+ if (*src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ for (n = 1; n <= len; n++, src += delta * 1)
+ {
+ if (*src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * 1;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * 1;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void mfindloc1_r16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r16 * const restrict array, GFC_REAL_16 value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back);
+export_proto(mfindloc1_r16);
+
+extern void
+mfindloc1_r16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r16 * const restrict array, GFC_REAL_16 value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_REAL_16 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ index_type dim;
+ int mask_kind;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_REAL_16 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * 1;
+ msrc = mbase + (len - 1) * mdelta;
+ for (n = len; n > 0; n--, src -= delta * 1, msrc -= mdelta)
+ {
+ if (*msrc && *src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ msrc = mbase;
+ for (n = 1; n <= len; n++, src += delta * 1, msrc += mdelta)
+ {
+ if (*msrc && *src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * 1;
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * 1;
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void sfindloc1_r16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r16 * const restrict array, GFC_REAL_16 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back);
+export_proto(sfindloc1_r16);
+
+extern void
+sfindloc1_r16 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r16 * const restrict array, GFC_REAL_16 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type dim;
+ bool continue_loop;
+
+ if (*mask)
+ {
+ findloc1_r16 (retarray, array, value, pdim, back);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ while (continue_loop)
+ {
+ *dest = 0;
+
+ count[0]++;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+#endif
diff --git a/libgfortran/generated/findloc1_r4.c b/libgfortran/generated/findloc1_r4.c
new file mode 100644
index 0000000..d573cbb
--- /dev/null
+++ b/libgfortran/generated/findloc1_r4.c
@@ -0,0 +1,523 @@
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_REAL_4)
+extern void findloc1_r4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r4 * const restrict array, GFC_REAL_4 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back);
+export_proto(findloc1_r4);
+
+extern void
+findloc1_r4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r4 * const restrict array, GFC_REAL_4 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back)
+{
+ 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_REAL_4 * restrict base;
+ index_type * 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. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_REAL_4 * restrict src;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * 1;
+ for (n = len; n > 0; n--, src -= delta * 1)
+ {
+ if (*src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ for (n = 1; n <= len; n++, src += delta * 1)
+ {
+ if (*src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * 1;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * 1;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void mfindloc1_r4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r4 * const restrict array, GFC_REAL_4 value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back);
+export_proto(mfindloc1_r4);
+
+extern void
+mfindloc1_r4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r4 * const restrict array, GFC_REAL_4 value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_REAL_4 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ index_type dim;
+ int mask_kind;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_REAL_4 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * 1;
+ msrc = mbase + (len - 1) * mdelta;
+ for (n = len; n > 0; n--, src -= delta * 1, msrc -= mdelta)
+ {
+ if (*msrc && *src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ msrc = mbase;
+ for (n = 1; n <= len; n++, src += delta * 1, msrc += mdelta)
+ {
+ if (*msrc && *src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * 1;
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * 1;
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void sfindloc1_r4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r4 * const restrict array, GFC_REAL_4 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back);
+export_proto(sfindloc1_r4);
+
+extern void
+sfindloc1_r4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r4 * const restrict array, GFC_REAL_4 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type dim;
+ bool continue_loop;
+
+ if (*mask)
+ {
+ findloc1_r4 (retarray, array, value, pdim, back);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ while (continue_loop)
+ {
+ *dest = 0;
+
+ count[0]++;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+#endif
diff --git a/libgfortran/generated/findloc1_r8.c b/libgfortran/generated/findloc1_r8.c
new file mode 100644
index 0000000..037993c
--- /dev/null
+++ b/libgfortran/generated/findloc1_r8.c
@@ -0,0 +1,523 @@
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_REAL_8)
+extern void findloc1_r8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r8 * const restrict array, GFC_REAL_8 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back);
+export_proto(findloc1_r8);
+
+extern void
+findloc1_r8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r8 * const restrict array, GFC_REAL_8 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back)
+{
+ 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_REAL_8 * restrict base;
+ index_type * 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. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_REAL_8 * restrict src;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * 1;
+ for (n = len; n > 0; n--, src -= delta * 1)
+ {
+ if (*src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ for (n = 1; n <= len; n++, src += delta * 1)
+ {
+ if (*src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * 1;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * 1;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void mfindloc1_r8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r8 * const restrict array, GFC_REAL_8 value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back);
+export_proto(mfindloc1_r8);
+
+extern void
+mfindloc1_r8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r8 * const restrict array, GFC_REAL_8 value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_REAL_8 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ index_type dim;
+ int mask_kind;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_REAL_8 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * 1;
+ msrc = mbase + (len - 1) * mdelta;
+ for (n = len; n > 0; n--, src -= delta * 1, msrc -= mdelta)
+ {
+ if (*msrc && *src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ msrc = mbase;
+ for (n = 1; n <= len; n++, src += delta * 1, msrc += mdelta)
+ {
+ if (*msrc && *src == value)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * 1;
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * 1;
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 1;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void sfindloc1_r8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r8 * const restrict array, GFC_REAL_8 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back);
+export_proto(sfindloc1_r8);
+
+extern void
+sfindloc1_r8 (gfc_array_index_type * const restrict retarray,
+ gfc_array_r8 * const restrict array, GFC_REAL_8 value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type dim;
+ bool continue_loop;
+
+ if (*mask)
+ {
+ findloc1_r8 (retarray, array, value, pdim, back);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ while (continue_loop)
+ {
+ *dest = 0;
+
+ count[0]++;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+#endif
diff --git a/libgfortran/generated/findloc1_s1.c b/libgfortran/generated/findloc1_s1.c
new file mode 100644
index 0000000..0b331ac
--- /dev/null
+++ b/libgfortran/generated/findloc1_s1.c
@@ -0,0 +1,525 @@
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_UINTEGER_1)
+extern void findloc1_s1 (gfc_array_index_type * const restrict retarray,
+ gfc_array_s1 * const restrict array, GFC_UINTEGER_1 *const restrict value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back,
+ gfc_charlen_type len_array, gfc_charlen_type len_value);
+export_proto(findloc1_s1);
+
+extern void
+findloc1_s1 (gfc_array_index_type * const restrict retarray,
+ gfc_array_s1 * const restrict array, GFC_UINTEGER_1 *const restrict value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back,
+ gfc_charlen_type len_array, gfc_charlen_type len_value)
+{
+ 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_UINTEGER_1 * restrict base;
+ index_type * 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. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_UINTEGER_1 * restrict src;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * len_array;
+ for (n = len; n > 0; n--, src -= delta * len_array)
+ {
+ if (compare_string (len_array, (char *) src, len_value, (char *) value) == 0)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ for (n = 1; n <= len; n++, src += delta * len_array)
+ {
+ if (compare_string (len_array, (char *) src, len_value, (char *) value) == 0)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * len_array;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * len_array;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * len_array;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void mfindloc1_s1 (gfc_array_index_type * const restrict retarray,
+ gfc_array_s1 * const restrict array, GFC_UINTEGER_1 *const restrict value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back, gfc_charlen_type len_array, gfc_charlen_type len_value);
+export_proto(mfindloc1_s1);
+
+extern void
+mfindloc1_s1 (gfc_array_index_type * const restrict retarray,
+ gfc_array_s1 * const restrict array, GFC_UINTEGER_1 *const restrict value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back, gfc_charlen_type len_array, gfc_charlen_type len_value)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_UINTEGER_1 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ index_type dim;
+ int mask_kind;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_UINTEGER_1 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * len_array;
+ msrc = mbase + (len - 1) * mdelta;
+ for (n = len; n > 0; n--, src -= delta * len_array, msrc -= mdelta)
+ {
+ if (*msrc && compare_string (len_array, (char *) src, len_value, (char *) value) == 0)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ msrc = mbase;
+ for (n = 1; n <= len; n++, src += delta * len_array, msrc += mdelta)
+ {
+ if (*msrc && compare_string (len_array, (char *) src, len_value, (char *) value) == 0)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * len_array;
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * len_array;
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * len_array;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void sfindloc1_s1 (gfc_array_index_type * const restrict retarray,
+ gfc_array_s1 * const restrict array, GFC_UINTEGER_1 *const restrict value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back, gfc_charlen_type len_array, gfc_charlen_type len_value);
+export_proto(sfindloc1_s1);
+
+extern void
+sfindloc1_s1 (gfc_array_index_type * const restrict retarray,
+ gfc_array_s1 * const restrict array, GFC_UINTEGER_1 *const restrict value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back, gfc_charlen_type len_array, gfc_charlen_type len_value)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type dim;
+ bool continue_loop;
+
+ if (*mask)
+ {
+ findloc1_s1 (retarray, array, value, pdim, back, len_array, len_value);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ while (continue_loop)
+ {
+ *dest = 0;
+
+ count[0]++;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+#endif
diff --git a/libgfortran/generated/findloc1_s4.c b/libgfortran/generated/findloc1_s4.c
new file mode 100644
index 0000000..6b42d10
--- /dev/null
+++ b/libgfortran/generated/findloc1_s4.c
@@ -0,0 +1,525 @@
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_GFC_UINTEGER_4)
+extern void findloc1_s4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_s4 * const restrict array, GFC_UINTEGER_4 *const restrict value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back,
+ gfc_charlen_type len_array, gfc_charlen_type len_value);
+export_proto(findloc1_s4);
+
+extern void
+findloc1_s4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_s4 * const restrict array, GFC_UINTEGER_4 *const restrict value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 back,
+ gfc_charlen_type len_array, gfc_charlen_type len_value)
+{
+ 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_UINTEGER_4 * restrict base;
+ index_type * 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. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_UINTEGER_4 * restrict src;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * len_array;
+ for (n = len; n > 0; n--, src -= delta * len_array)
+ {
+ if (compare_string_char4 (len_array, src, len_value, value) == 0)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ for (n = 1; n <= len; n++, src += delta * len_array)
+ {
+ if (compare_string_char4 (len_array, src, len_value, value) == 0)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * len_array;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * len_array;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * len_array;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void mfindloc1_s4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_s4 * const restrict array, GFC_UINTEGER_4 *const restrict value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back, gfc_charlen_type len_array, gfc_charlen_type len_value);
+export_proto(mfindloc1_s4);
+
+extern void
+mfindloc1_s4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_s4 * const restrict array, GFC_UINTEGER_4 *const restrict value,
+ const index_type * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back, gfc_charlen_type len_array, gfc_charlen_type len_value)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const GFC_UINTEGER_4 * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ index_type dim;
+ int mask_kind;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const GFC_UINTEGER_4 * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * len_array;
+ msrc = mbase + (len - 1) * mdelta;
+ for (n = len; n > 0; n--, src -= delta * len_array, msrc -= mdelta)
+ {
+ if (*msrc && compare_string_char4 (len_array, src, len_value, value) == 0)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ msrc = mbase;
+ for (n = 1; n <= len; n++, src += delta * len_array, msrc += mdelta)
+ {
+ if (*msrc && compare_string_char4 (len_array, src, len_value, value) == 0)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * len_array;
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * len_array;
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * len_array;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+extern void sfindloc1_s4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_s4 * const restrict array, GFC_UINTEGER_4 *const restrict value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back, gfc_charlen_type len_array, gfc_charlen_type len_value);
+export_proto(sfindloc1_s4);
+
+extern void
+sfindloc1_s4 (gfc_array_index_type * const restrict retarray,
+ gfc_array_s4 * const restrict array, GFC_UINTEGER_4 *const restrict value,
+ const index_type * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back, gfc_charlen_type len_array, gfc_charlen_type len_value)
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type dim;
+ bool continue_loop;
+
+ if (*mask)
+ {
+ findloc1_s4 (retarray, array, value, pdim, back, len_array, len_value);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ while (continue_loop)
+ {
+ *dest = 0;
+
+ count[0]++;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+#endif
diff --git a/libgfortran/generated/findloc2_s1.c b/libgfortran/generated/findloc2_s1.c
new file mode 100644
index 0000000..bfeca02
--- /dev/null
+++ b/libgfortran/generated/findloc2_s1.c
@@ -0,0 +1,154 @@
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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"
+
+#ifdef HAVE_GFC_UINTEGER_1
+index_type findloc2_s1 (gfc_array_s1 * const restrict array,
+ const GFC_UINTEGER_1 * restrict value, GFC_LOGICAL_4 back,
+ gfc_charlen_type len_array, gfc_charlen_type len_value);
+export_proto(findloc2_s1);
+
+index_type
+findloc2_s1 (gfc_array_s1 * const restrict array, const GFC_UINTEGER_1 * restrict value,
+ GFC_LOGICAL_4 back,
+ gfc_charlen_type len_array, gfc_charlen_type len_value)
+{
+ index_type i;
+ index_type sstride;
+ index_type extent;
+ const GFC_UINTEGER_1 * restrict src;
+
+ extent = GFC_DESCRIPTOR_EXTENT(array,0);
+ if (extent <= 0)
+ return 0;
+
+ sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len_array;
+ if (back)
+ {
+ src = array->base_addr + (extent - 1) * sstride;
+ for (i = extent; i >= 0; i--)
+ {
+ if (compare_string (len_array, (char *) src, len_value, (char *) value) == 0)
+ return i;
+ src -= sstride;
+ }
+ }
+ else
+ {
+ src = array->base_addr;
+ for (i = 1; i <= extent; i++)
+ {
+ if (compare_string (len_array, (char *) src, len_value, (char *) value) == 0)
+ return i;
+ src += sstride;
+ }
+ }
+ return 0;
+}
+
+index_type mfindloc2_s1 (gfc_array_s1 * const restrict array,
+ const GFC_UINTEGER_1 * restrict value,
+ gfc_array_l1 *const restrict mask, GFC_LOGICAL_4 back,
+ gfc_charlen_type len_array, gfc_charlen_type len_value);
+export_proto(mfindloc2_s1);
+
+index_type
+mfindloc2_s1 (gfc_array_s1 * const restrict array,
+ const GFC_UINTEGER_1 * restrict value, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back, gfc_charlen_type len_array,
+ gfc_charlen_type len_value)
+{
+ index_type i;
+ index_type sstride;
+ index_type extent;
+ const GFC_UINTEGER_1 * restrict src;
+ const GFC_LOGICAL_1 * restrict mbase;
+ int mask_kind;
+ index_type mstride;
+
+ extent = GFC_DESCRIPTOR_EXTENT(array,0);
+ if (extent <= 0)
+ return 0;
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len_array;
+ mstride = GFC_DESCRIPTOR_STRIDE_BYTES(mask,0);
+
+ if (back)
+ {
+ src = array->base_addr + (extent - 1) * sstride;
+ mbase += (extent - 1) * mstride;
+ for (i = extent; i >= 0; i--)
+ {
+ if (*mbase && (compare_string (len_array, (char *) src, len_value, (char *) value) == 0))
+ return i;
+ src -= sstride;
+ mbase -= mstride;
+ }
+ }
+ else
+ {
+ src = array->base_addr;
+ for (i = 1; i <= extent; i++)
+ {
+ if (*mbase && (compare_string (len_array, (char *) src, len_value, (char *) value) == 0))
+ return i;
+ src += sstride;
+ mbase += mstride;
+ }
+ }
+ return 0;
+}
+index_type sfindloc2_s1 (gfc_array_s1 * const restrict array,
+ const GFC_UINTEGER_1 * restrict value,
+ GFC_LOGICAL_4 *const restrict mask, GFC_LOGICAL_4 back,
+ gfc_charlen_type len_array, gfc_charlen_type len_value);
+export_proto(sfindloc2_s1);
+
+index_type
+sfindloc2_s1 (gfc_array_s1 * const restrict array,
+ const GFC_UINTEGER_1 * restrict value, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back, gfc_charlen_type len_array,
+ gfc_charlen_type len_value)
+{
+ if (*mask)
+ {
+ return findloc2_s1 (array, value, back, len_array, len_value);
+ }
+ return 0;
+}
+#endif
diff --git a/libgfortran/generated/findloc2_s4.c b/libgfortran/generated/findloc2_s4.c
new file mode 100644
index 0000000..6597b56
--- /dev/null
+++ b/libgfortran/generated/findloc2_s4.c
@@ -0,0 +1,154 @@
+/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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"
+
+#ifdef HAVE_GFC_UINTEGER_4
+index_type findloc2_s4 (gfc_array_s4 * const restrict array,
+ const GFC_UINTEGER_4 * restrict value, GFC_LOGICAL_4 back,
+ gfc_charlen_type len_array, gfc_charlen_type len_value);
+export_proto(findloc2_s4);
+
+index_type
+findloc2_s4 (gfc_array_s4 * const restrict array, const GFC_UINTEGER_4 * restrict value,
+ GFC_LOGICAL_4 back,
+ gfc_charlen_type len_array, gfc_charlen_type len_value)
+{
+ index_type i;
+ index_type sstride;
+ index_type extent;
+ const GFC_UINTEGER_4 * restrict src;
+
+ extent = GFC_DESCRIPTOR_EXTENT(array,0);
+ if (extent <= 0)
+ return 0;
+
+ sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len_array;
+ if (back)
+ {
+ src = array->base_addr + (extent - 1) * sstride;
+ for (i = extent; i >= 0; i--)
+ {
+ if (compare_string_char4 (len_array, src, len_value, value) == 0)
+ return i;
+ src -= sstride;
+ }
+ }
+ else
+ {
+ src = array->base_addr;
+ for (i = 1; i <= extent; i++)
+ {
+ if (compare_string_char4 (len_array, src, len_value, value) == 0)
+ return i;
+ src += sstride;
+ }
+ }
+ return 0;
+}
+
+index_type mfindloc2_s4 (gfc_array_s4 * const restrict array,
+ const GFC_UINTEGER_4 * restrict value,
+ gfc_array_l1 *const restrict mask, GFC_LOGICAL_4 back,
+ gfc_charlen_type len_array, gfc_charlen_type len_value);
+export_proto(mfindloc2_s4);
+
+index_type
+mfindloc2_s4 (gfc_array_s4 * const restrict array,
+ const GFC_UINTEGER_4 * restrict value, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back, gfc_charlen_type len_array,
+ gfc_charlen_type len_value)
+{
+ index_type i;
+ index_type sstride;
+ index_type extent;
+ const GFC_UINTEGER_4 * restrict src;
+ const GFC_LOGICAL_1 * restrict mbase;
+ int mask_kind;
+ index_type mstride;
+
+ extent = GFC_DESCRIPTOR_EXTENT(array,0);
+ if (extent <= 0)
+ return 0;
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ sstride = GFC_DESCRIPTOR_STRIDE(array,0) * len_array;
+ mstride = GFC_DESCRIPTOR_STRIDE_BYTES(mask,0);
+
+ if (back)
+ {
+ src = array->base_addr + (extent - 1) * sstride;
+ mbase += (extent - 1) * mstride;
+ for (i = extent; i >= 0; i--)
+ {
+ if (*mbase && (compare_string_char4 (len_array, src, len_value, value) == 0))
+ return i;
+ src -= sstride;
+ mbase -= mstride;
+ }
+ }
+ else
+ {
+ src = array->base_addr;
+ for (i = 1; i <= extent; i++)
+ {
+ if (*mbase && (compare_string_char4 (len_array, src, len_value, value) == 0))
+ return i;
+ src += sstride;
+ mbase += mstride;
+ }
+ }
+ return 0;
+}
+index_type sfindloc2_s4 (gfc_array_s4 * const restrict array,
+ const GFC_UINTEGER_4 * restrict value,
+ GFC_LOGICAL_4 *const restrict mask, GFC_LOGICAL_4 back,
+ gfc_charlen_type len_array, gfc_charlen_type len_value);
+export_proto(sfindloc2_s4);
+
+index_type
+sfindloc2_s4 (gfc_array_s4 * const restrict array,
+ const GFC_UINTEGER_4 * restrict value, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back, gfc_charlen_type len_array,
+ gfc_charlen_type len_value)
+{
+ if (*mask)
+ {
+ return findloc2_s4 (array, value, back, len_array, len_value);
+ }
+ return 0;
+}
+#endif
diff --git a/libgfortran/generated/maxloc0_16_s1.c b/libgfortran/generated/maxloc0_16_s1.c
index cc2b4f0..cfe3568 100644
--- a/libgfortran/generated/maxloc0_16_s1.c
+++ b/libgfortran/generated/maxloc0_16_s1.c
@@ -30,14 +30,14 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <limits.h>
-#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_16)
+#if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_INTEGER_16)
#define HAVE_BACK_ARG 1
static inline int
-compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_1) == 1)
+ if (sizeof (GFC_UINTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -56,7 +56,7 @@ maxloc0_16_s1 (gfc_array_i16 * const restrict retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
- const GFC_INTEGER_1 *base;
+ const GFC_UINTEGER_1 *base;
GFC_INTEGER_16 * restrict dest;
index_type rank;
index_type n;
@@ -102,7 +102,7 @@ maxloc0_16_s1 (gfc_array_i16 * const restrict retarray,
dest[n * dstride] = 1;
{
- const GFC_INTEGER_1 *maxval;
+ const GFC_UINTEGER_1 *maxval;
maxval = NULL;
while (base)
@@ -168,7 +168,7 @@ mmaxloc0_16_s1 (gfc_array_i16 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_16 *dest;
- const GFC_INTEGER_1 *base;
+ const GFC_UINTEGER_1 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
@@ -234,7 +234,7 @@ mmaxloc0_16_s1 (gfc_array_i16 * const restrict retarray,
dest[n * dstride] = 0;
{
- const GFC_INTEGER_1 *maxval;
+ const GFC_UINTEGER_1 *maxval;
maxval = NULL;
diff --git a/libgfortran/generated/maxloc0_16_s4.c b/libgfortran/generated/maxloc0_16_s4.c
index ff2c885..dc16503 100644
--- a/libgfortran/generated/maxloc0_16_s4.c
+++ b/libgfortran/generated/maxloc0_16_s4.c
@@ -30,14 +30,14 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <limits.h>
-#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
+#if defined (HAVE_GFC_UINTEGER_4) && defined (HAVE_GFC_INTEGER_16)
#define HAVE_BACK_ARG 1
static inline int
-compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_4 *a, const GFC_UINTEGER_4 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_4) == 1)
+ if (sizeof (GFC_UINTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -56,7 +56,7 @@ maxloc0_16_s4 (gfc_array_i16 * const restrict retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
- const GFC_INTEGER_4 *base;
+ const GFC_UINTEGER_4 *base;
GFC_INTEGER_16 * restrict dest;
index_type rank;
index_type n;
@@ -102,7 +102,7 @@ maxloc0_16_s4 (gfc_array_i16 * const restrict retarray,
dest[n * dstride] = 1;
{
- const GFC_INTEGER_4 *maxval;
+ const GFC_UINTEGER_4 *maxval;
maxval = NULL;
while (base)
@@ -168,7 +168,7 @@ mmaxloc0_16_s4 (gfc_array_i16 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_16 *dest;
- const GFC_INTEGER_4 *base;
+ const GFC_UINTEGER_4 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
@@ -234,7 +234,7 @@ mmaxloc0_16_s4 (gfc_array_i16 * const restrict retarray,
dest[n * dstride] = 0;
{
- const GFC_INTEGER_4 *maxval;
+ const GFC_UINTEGER_4 *maxval;
maxval = NULL;
diff --git a/libgfortran/generated/maxloc0_4_s1.c b/libgfortran/generated/maxloc0_4_s1.c
index 1c1e631..094a5b4 100644
--- a/libgfortran/generated/maxloc0_4_s1.c
+++ b/libgfortran/generated/maxloc0_4_s1.c
@@ -30,14 +30,14 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <limits.h>
-#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_4)
+#if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_INTEGER_4)
#define HAVE_BACK_ARG 1
static inline int
-compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_1) == 1)
+ if (sizeof (GFC_UINTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -56,7 +56,7 @@ maxloc0_4_s1 (gfc_array_i4 * const restrict retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
- const GFC_INTEGER_1 *base;
+ const GFC_UINTEGER_1 *base;
GFC_INTEGER_4 * restrict dest;
index_type rank;
index_type n;
@@ -102,7 +102,7 @@ maxloc0_4_s1 (gfc_array_i4 * const restrict retarray,
dest[n * dstride] = 1;
{
- const GFC_INTEGER_1 *maxval;
+ const GFC_UINTEGER_1 *maxval;
maxval = NULL;
while (base)
@@ -168,7 +168,7 @@ mmaxloc0_4_s1 (gfc_array_i4 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_4 *dest;
- const GFC_INTEGER_1 *base;
+ const GFC_UINTEGER_1 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
@@ -234,7 +234,7 @@ mmaxloc0_4_s1 (gfc_array_i4 * const restrict retarray,
dest[n * dstride] = 0;
{
- const GFC_INTEGER_1 *maxval;
+ const GFC_UINTEGER_1 *maxval;
maxval = NULL;
diff --git a/libgfortran/generated/maxloc0_4_s4.c b/libgfortran/generated/maxloc0_4_s4.c
index 15bdb0b..b751faa 100644
--- a/libgfortran/generated/maxloc0_4_s4.c
+++ b/libgfortran/generated/maxloc0_4_s4.c
@@ -30,14 +30,14 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <limits.h>
-#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+#if defined (HAVE_GFC_UINTEGER_4) && defined (HAVE_GFC_INTEGER_4)
#define HAVE_BACK_ARG 1
static inline int
-compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_4 *a, const GFC_UINTEGER_4 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_4) == 1)
+ if (sizeof (GFC_UINTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -56,7 +56,7 @@ maxloc0_4_s4 (gfc_array_i4 * const restrict retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
- const GFC_INTEGER_4 *base;
+ const GFC_UINTEGER_4 *base;
GFC_INTEGER_4 * restrict dest;
index_type rank;
index_type n;
@@ -102,7 +102,7 @@ maxloc0_4_s4 (gfc_array_i4 * const restrict retarray,
dest[n * dstride] = 1;
{
- const GFC_INTEGER_4 *maxval;
+ const GFC_UINTEGER_4 *maxval;
maxval = NULL;
while (base)
@@ -168,7 +168,7 @@ mmaxloc0_4_s4 (gfc_array_i4 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_4 *dest;
- const GFC_INTEGER_4 *base;
+ const GFC_UINTEGER_4 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
@@ -234,7 +234,7 @@ mmaxloc0_4_s4 (gfc_array_i4 * const restrict retarray,
dest[n * dstride] = 0;
{
- const GFC_INTEGER_4 *maxval;
+ const GFC_UINTEGER_4 *maxval;
maxval = NULL;
diff --git a/libgfortran/generated/maxloc0_8_s1.c b/libgfortran/generated/maxloc0_8_s1.c
index 81ed1bb..173aa13 100644
--- a/libgfortran/generated/maxloc0_8_s1.c
+++ b/libgfortran/generated/maxloc0_8_s1.c
@@ -30,14 +30,14 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <limits.h>
-#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_8)
+#if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_INTEGER_8)
#define HAVE_BACK_ARG 1
static inline int
-compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_1) == 1)
+ if (sizeof (GFC_UINTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -56,7 +56,7 @@ maxloc0_8_s1 (gfc_array_i8 * const restrict retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
- const GFC_INTEGER_1 *base;
+ const GFC_UINTEGER_1 *base;
GFC_INTEGER_8 * restrict dest;
index_type rank;
index_type n;
@@ -102,7 +102,7 @@ maxloc0_8_s1 (gfc_array_i8 * const restrict retarray,
dest[n * dstride] = 1;
{
- const GFC_INTEGER_1 *maxval;
+ const GFC_UINTEGER_1 *maxval;
maxval = NULL;
while (base)
@@ -168,7 +168,7 @@ mmaxloc0_8_s1 (gfc_array_i8 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_8 *dest;
- const GFC_INTEGER_1 *base;
+ const GFC_UINTEGER_1 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
@@ -234,7 +234,7 @@ mmaxloc0_8_s1 (gfc_array_i8 * const restrict retarray,
dest[n * dstride] = 0;
{
- const GFC_INTEGER_1 *maxval;
+ const GFC_UINTEGER_1 *maxval;
maxval = NULL;
diff --git a/libgfortran/generated/maxloc0_8_s4.c b/libgfortran/generated/maxloc0_8_s4.c
index 873c4dc..60176b4 100644
--- a/libgfortran/generated/maxloc0_8_s4.c
+++ b/libgfortran/generated/maxloc0_8_s4.c
@@ -30,14 +30,14 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <limits.h>
-#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
+#if defined (HAVE_GFC_UINTEGER_4) && defined (HAVE_GFC_INTEGER_8)
#define HAVE_BACK_ARG 1
static inline int
-compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_4 *a, const GFC_UINTEGER_4 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_4) == 1)
+ if (sizeof (GFC_UINTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -56,7 +56,7 @@ maxloc0_8_s4 (gfc_array_i8 * const restrict retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
- const GFC_INTEGER_4 *base;
+ const GFC_UINTEGER_4 *base;
GFC_INTEGER_8 * restrict dest;
index_type rank;
index_type n;
@@ -102,7 +102,7 @@ maxloc0_8_s4 (gfc_array_i8 * const restrict retarray,
dest[n * dstride] = 1;
{
- const GFC_INTEGER_4 *maxval;
+ const GFC_UINTEGER_4 *maxval;
maxval = NULL;
while (base)
@@ -168,7 +168,7 @@ mmaxloc0_8_s4 (gfc_array_i8 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_8 *dest;
- const GFC_INTEGER_4 *base;
+ const GFC_UINTEGER_4 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
@@ -234,7 +234,7 @@ mmaxloc0_8_s4 (gfc_array_i8 * const restrict retarray,
dest[n * dstride] = 0;
{
- const GFC_INTEGER_4 *maxval;
+ const GFC_UINTEGER_4 *maxval;
maxval = NULL;
diff --git a/libgfortran/generated/maxloc1_16_s1.c b/libgfortran/generated/maxloc1_16_s1.c
index a6cb47a..538d44c 100644
--- a/libgfortran/generated/maxloc1_16_s1.c
+++ b/libgfortran/generated/maxloc1_16_s1.c
@@ -26,7 +26,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "libgfortran.h"
-#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_16)
+#if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_INTEGER_16)
#define HAVE_BACK_ARG 1
@@ -34,9 +34,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <assert.h>
static inline int
-compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_1) == 1)
+ if (sizeof (GFC_UINTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -57,7 +57,7 @@ maxloc1_16_s1 (gfc_array_i16 * const restrict retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
- const GFC_INTEGER_1 * restrict base;
+ const GFC_UINTEGER_1 * restrict base;
GFC_INTEGER_16 * restrict dest;
index_type rank;
index_type n;
@@ -155,12 +155,12 @@ maxloc1_16_s1 (gfc_array_i16 * const restrict retarray,
continue_loop = 1;
while (continue_loop)
{
- const GFC_INTEGER_1 * restrict src;
+ const GFC_UINTEGER_1 * restrict src;
GFC_INTEGER_16 result;
src = base;
{
- const GFC_INTEGER_1 *maxval;
+ const GFC_UINTEGER_1 *maxval;
maxval = NULL;
result = 0;
if (len <= 0)
@@ -231,7 +231,7 @@ mmaxloc1_16_s1 (gfc_array_i16 * const restrict retarray,
index_type dstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest;
- const GFC_INTEGER_1 * restrict base;
+ const GFC_UINTEGER_1 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
@@ -349,14 +349,14 @@ mmaxloc1_16_s1 (gfc_array_i16 * const restrict retarray,
while (base)
{
- const GFC_INTEGER_1 * restrict src;
+ const GFC_UINTEGER_1 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_16 result;
src = base;
msrc = mbase;
{
- const GFC_INTEGER_1 *maxval;
+ const GFC_UINTEGER_1 *maxval;
maxval = base;
result = 0;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
diff --git a/libgfortran/generated/maxloc1_16_s4.c b/libgfortran/generated/maxloc1_16_s4.c
index a5b5e54..dce5c89 100644
--- a/libgfortran/generated/maxloc1_16_s4.c
+++ b/libgfortran/generated/maxloc1_16_s4.c
@@ -26,7 +26,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "libgfortran.h"
-#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
+#if defined (HAVE_GFC_UINTEGER_4) && defined (HAVE_GFC_INTEGER_16)
#define HAVE_BACK_ARG 1
@@ -34,9 +34,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <assert.h>
static inline int
-compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_4 *a, const GFC_UINTEGER_4 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_4) == 1)
+ if (sizeof (GFC_UINTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -57,7 +57,7 @@ maxloc1_16_s4 (gfc_array_i16 * const restrict retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
- const GFC_INTEGER_4 * restrict base;
+ const GFC_UINTEGER_4 * restrict base;
GFC_INTEGER_16 * restrict dest;
index_type rank;
index_type n;
@@ -155,12 +155,12 @@ maxloc1_16_s4 (gfc_array_i16 * const restrict retarray,
continue_loop = 1;
while (continue_loop)
{
- const GFC_INTEGER_4 * restrict src;
+ const GFC_UINTEGER_4 * restrict src;
GFC_INTEGER_16 result;
src = base;
{
- const GFC_INTEGER_4 *maxval;
+ const GFC_UINTEGER_4 *maxval;
maxval = NULL;
result = 0;
if (len <= 0)
@@ -231,7 +231,7 @@ mmaxloc1_16_s4 (gfc_array_i16 * const restrict retarray,
index_type dstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest;
- const GFC_INTEGER_4 * restrict base;
+ const GFC_UINTEGER_4 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
@@ -349,14 +349,14 @@ mmaxloc1_16_s4 (gfc_array_i16 * const restrict retarray,
while (base)
{
- const GFC_INTEGER_4 * restrict src;
+ const GFC_UINTEGER_4 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_16 result;
src = base;
msrc = mbase;
{
- const GFC_INTEGER_4 *maxval;
+ const GFC_UINTEGER_4 *maxval;
maxval = base;
result = 0;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
diff --git a/libgfortran/generated/maxloc1_4_s1.c b/libgfortran/generated/maxloc1_4_s1.c
index 257ede2..d194d70 100644
--- a/libgfortran/generated/maxloc1_4_s1.c
+++ b/libgfortran/generated/maxloc1_4_s1.c
@@ -26,7 +26,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "libgfortran.h"
-#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_4)
+#if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_INTEGER_4)
#define HAVE_BACK_ARG 1
@@ -34,9 +34,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <assert.h>
static inline int
-compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_1) == 1)
+ if (sizeof (GFC_UINTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -57,7 +57,7 @@ maxloc1_4_s1 (gfc_array_i4 * const restrict retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
- const GFC_INTEGER_1 * restrict base;
+ const GFC_UINTEGER_1 * restrict base;
GFC_INTEGER_4 * restrict dest;
index_type rank;
index_type n;
@@ -155,12 +155,12 @@ maxloc1_4_s1 (gfc_array_i4 * const restrict retarray,
continue_loop = 1;
while (continue_loop)
{
- const GFC_INTEGER_1 * restrict src;
+ const GFC_UINTEGER_1 * restrict src;
GFC_INTEGER_4 result;
src = base;
{
- const GFC_INTEGER_1 *maxval;
+ const GFC_UINTEGER_1 *maxval;
maxval = NULL;
result = 0;
if (len <= 0)
@@ -231,7 +231,7 @@ mmaxloc1_4_s1 (gfc_array_i4 * const restrict retarray,
index_type dstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_4 * restrict dest;
- const GFC_INTEGER_1 * restrict base;
+ const GFC_UINTEGER_1 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
@@ -349,14 +349,14 @@ mmaxloc1_4_s1 (gfc_array_i4 * const restrict retarray,
while (base)
{
- const GFC_INTEGER_1 * restrict src;
+ const GFC_UINTEGER_1 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_4 result;
src = base;
msrc = mbase;
{
- const GFC_INTEGER_1 *maxval;
+ const GFC_UINTEGER_1 *maxval;
maxval = base;
result = 0;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
diff --git a/libgfortran/generated/maxloc1_4_s4.c b/libgfortran/generated/maxloc1_4_s4.c
index e8df7d0..b3e68b5 100644
--- a/libgfortran/generated/maxloc1_4_s4.c
+++ b/libgfortran/generated/maxloc1_4_s4.c
@@ -26,7 +26,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "libgfortran.h"
-#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+#if defined (HAVE_GFC_UINTEGER_4) && defined (HAVE_GFC_INTEGER_4)
#define HAVE_BACK_ARG 1
@@ -34,9 +34,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <assert.h>
static inline int
-compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_4 *a, const GFC_UINTEGER_4 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_4) == 1)
+ if (sizeof (GFC_UINTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -57,7 +57,7 @@ maxloc1_4_s4 (gfc_array_i4 * const restrict retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
- const GFC_INTEGER_4 * restrict base;
+ const GFC_UINTEGER_4 * restrict base;
GFC_INTEGER_4 * restrict dest;
index_type rank;
index_type n;
@@ -155,12 +155,12 @@ maxloc1_4_s4 (gfc_array_i4 * const restrict retarray,
continue_loop = 1;
while (continue_loop)
{
- const GFC_INTEGER_4 * restrict src;
+ const GFC_UINTEGER_4 * restrict src;
GFC_INTEGER_4 result;
src = base;
{
- const GFC_INTEGER_4 *maxval;
+ const GFC_UINTEGER_4 *maxval;
maxval = NULL;
result = 0;
if (len <= 0)
@@ -231,7 +231,7 @@ mmaxloc1_4_s4 (gfc_array_i4 * const restrict retarray,
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_UINTEGER_4 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
@@ -349,14 +349,14 @@ mmaxloc1_4_s4 (gfc_array_i4 * const restrict retarray,
while (base)
{
- const GFC_INTEGER_4 * restrict src;
+ const GFC_UINTEGER_4 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_4 result;
src = base;
msrc = mbase;
{
- const GFC_INTEGER_4 *maxval;
+ const GFC_UINTEGER_4 *maxval;
maxval = base;
result = 0;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
diff --git a/libgfortran/generated/maxloc1_8_s1.c b/libgfortran/generated/maxloc1_8_s1.c
index 6745ada..0832e7b 100644
--- a/libgfortran/generated/maxloc1_8_s1.c
+++ b/libgfortran/generated/maxloc1_8_s1.c
@@ -26,7 +26,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "libgfortran.h"
-#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_8)
+#if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_INTEGER_8)
#define HAVE_BACK_ARG 1
@@ -34,9 +34,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <assert.h>
static inline int
-compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_1) == 1)
+ if (sizeof (GFC_UINTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -57,7 +57,7 @@ maxloc1_8_s1 (gfc_array_i8 * const restrict retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
- const GFC_INTEGER_1 * restrict base;
+ const GFC_UINTEGER_1 * restrict base;
GFC_INTEGER_8 * restrict dest;
index_type rank;
index_type n;
@@ -155,12 +155,12 @@ maxloc1_8_s1 (gfc_array_i8 * const restrict retarray,
continue_loop = 1;
while (continue_loop)
{
- const GFC_INTEGER_1 * restrict src;
+ const GFC_UINTEGER_1 * restrict src;
GFC_INTEGER_8 result;
src = base;
{
- const GFC_INTEGER_1 *maxval;
+ const GFC_UINTEGER_1 *maxval;
maxval = NULL;
result = 0;
if (len <= 0)
@@ -231,7 +231,7 @@ mmaxloc1_8_s1 (gfc_array_i8 * const restrict retarray,
index_type dstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_8 * restrict dest;
- const GFC_INTEGER_1 * restrict base;
+ const GFC_UINTEGER_1 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
@@ -349,14 +349,14 @@ mmaxloc1_8_s1 (gfc_array_i8 * const restrict retarray,
while (base)
{
- const GFC_INTEGER_1 * restrict src;
+ const GFC_UINTEGER_1 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_8 result;
src = base;
msrc = mbase;
{
- const GFC_INTEGER_1 *maxval;
+ const GFC_UINTEGER_1 *maxval;
maxval = base;
result = 0;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
diff --git a/libgfortran/generated/maxloc1_8_s4.c b/libgfortran/generated/maxloc1_8_s4.c
index 25c711d..967f3fd 100644
--- a/libgfortran/generated/maxloc1_8_s4.c
+++ b/libgfortran/generated/maxloc1_8_s4.c
@@ -26,7 +26,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "libgfortran.h"
-#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
+#if defined (HAVE_GFC_UINTEGER_4) && defined (HAVE_GFC_INTEGER_8)
#define HAVE_BACK_ARG 1
@@ -34,9 +34,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <assert.h>
static inline int
-compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_4 *a, const GFC_UINTEGER_4 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_4) == 1)
+ if (sizeof (GFC_UINTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -57,7 +57,7 @@ maxloc1_8_s4 (gfc_array_i8 * const restrict retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
- const GFC_INTEGER_4 * restrict base;
+ const GFC_UINTEGER_4 * restrict base;
GFC_INTEGER_8 * restrict dest;
index_type rank;
index_type n;
@@ -155,12 +155,12 @@ maxloc1_8_s4 (gfc_array_i8 * const restrict retarray,
continue_loop = 1;
while (continue_loop)
{
- const GFC_INTEGER_4 * restrict src;
+ const GFC_UINTEGER_4 * restrict src;
GFC_INTEGER_8 result;
src = base;
{
- const GFC_INTEGER_4 *maxval;
+ const GFC_UINTEGER_4 *maxval;
maxval = NULL;
result = 0;
if (len <= 0)
@@ -231,7 +231,7 @@ mmaxloc1_8_s4 (gfc_array_i8 * const restrict retarray,
index_type dstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_8 * restrict dest;
- const GFC_INTEGER_4 * restrict base;
+ const GFC_UINTEGER_4 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
@@ -349,14 +349,14 @@ mmaxloc1_8_s4 (gfc_array_i8 * const restrict retarray,
while (base)
{
- const GFC_INTEGER_4 * restrict src;
+ const GFC_UINTEGER_4 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_8 result;
src = base;
msrc = mbase;
{
- const GFC_INTEGER_4 *maxval;
+ const GFC_UINTEGER_4 *maxval;
maxval = base;
result = 0;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
diff --git a/libgfortran/generated/maxloc2_16_s1.c b/libgfortran/generated/maxloc2_16_s1.c
index 9efa7cb..d97fcd0 100644
--- a/libgfortran/generated/maxloc2_16_s1.c
+++ b/libgfortran/generated/maxloc2_16_s1.c
@@ -28,12 +28,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <string.h>
#include <assert.h>
-#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_16)
+#if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_INTEGER_16)
static inline int
-compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_1) == 1)
+ if (sizeof (GFC_UINTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -49,8 +49,8 @@ maxloc2_16_s1 (gfc_array_s1 * const restrict array, GFC_LOGICAL_4 back, gfc_char
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_1 *src;
- const GFC_INTEGER_1 *maxval;
+ const GFC_UINTEGER_1 *src;
+ const GFC_UINTEGER_1 *maxval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
@@ -88,8 +88,8 @@ mmaxloc2_16_s1 (gfc_array_s1 * const restrict array,
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_1 *src;
- const GFC_INTEGER_1 *maxval;
+ const GFC_UINTEGER_1 *src;
+ const GFC_UINTEGER_1 *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
diff --git a/libgfortran/generated/maxloc2_16_s4.c b/libgfortran/generated/maxloc2_16_s4.c
index 65573f8..995cac9 100644
--- a/libgfortran/generated/maxloc2_16_s4.c
+++ b/libgfortran/generated/maxloc2_16_s4.c
@@ -28,12 +28,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <string.h>
#include <assert.h>
-#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
+#if defined (HAVE_GFC_UINTEGER_4) && defined (HAVE_GFC_INTEGER_16)
static inline int
-compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_4 *a, const GFC_UINTEGER_4 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_4) == 1)
+ if (sizeof (GFC_UINTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -49,8 +49,8 @@ maxloc2_16_s4 (gfc_array_s4 * const restrict array, GFC_LOGICAL_4 back, gfc_char
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_4 *src;
- const GFC_INTEGER_4 *maxval;
+ const GFC_UINTEGER_4 *src;
+ const GFC_UINTEGER_4 *maxval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
@@ -88,8 +88,8 @@ mmaxloc2_16_s4 (gfc_array_s4 * const restrict array,
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_4 *src;
- const GFC_INTEGER_4 *maxval;
+ const GFC_UINTEGER_4 *src;
+ const GFC_UINTEGER_4 *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
diff --git a/libgfortran/generated/maxloc2_4_s1.c b/libgfortran/generated/maxloc2_4_s1.c
index 68e02f5..932d3d6 100644
--- a/libgfortran/generated/maxloc2_4_s1.c
+++ b/libgfortran/generated/maxloc2_4_s1.c
@@ -28,12 +28,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <string.h>
#include <assert.h>
-#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_4)
+#if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_INTEGER_4)
static inline int
-compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_1) == 1)
+ if (sizeof (GFC_UINTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -49,8 +49,8 @@ maxloc2_4_s1 (gfc_array_s1 * const restrict array, GFC_LOGICAL_4 back, gfc_charl
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_1 *src;
- const GFC_INTEGER_1 *maxval;
+ const GFC_UINTEGER_1 *src;
+ const GFC_UINTEGER_1 *maxval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
@@ -88,8 +88,8 @@ mmaxloc2_4_s1 (gfc_array_s1 * const restrict array,
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_1 *src;
- const GFC_INTEGER_1 *maxval;
+ const GFC_UINTEGER_1 *src;
+ const GFC_UINTEGER_1 *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
diff --git a/libgfortran/generated/maxloc2_4_s4.c b/libgfortran/generated/maxloc2_4_s4.c
index aa5a47a..0242f25 100644
--- a/libgfortran/generated/maxloc2_4_s4.c
+++ b/libgfortran/generated/maxloc2_4_s4.c
@@ -28,12 +28,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <string.h>
#include <assert.h>
-#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+#if defined (HAVE_GFC_UINTEGER_4) && defined (HAVE_GFC_INTEGER_4)
static inline int
-compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_4 *a, const GFC_UINTEGER_4 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_4) == 1)
+ if (sizeof (GFC_UINTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -49,8 +49,8 @@ maxloc2_4_s4 (gfc_array_s4 * const restrict array, GFC_LOGICAL_4 back, gfc_charl
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_4 *src;
- const GFC_INTEGER_4 *maxval;
+ const GFC_UINTEGER_4 *src;
+ const GFC_UINTEGER_4 *maxval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
@@ -88,8 +88,8 @@ mmaxloc2_4_s4 (gfc_array_s4 * const restrict array,
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_4 *src;
- const GFC_INTEGER_4 *maxval;
+ const GFC_UINTEGER_4 *src;
+ const GFC_UINTEGER_4 *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
diff --git a/libgfortran/generated/maxloc2_8_s1.c b/libgfortran/generated/maxloc2_8_s1.c
index c9c3160..e401722 100644
--- a/libgfortran/generated/maxloc2_8_s1.c
+++ b/libgfortran/generated/maxloc2_8_s1.c
@@ -28,12 +28,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <string.h>
#include <assert.h>
-#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_8)
+#if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_INTEGER_8)
static inline int
-compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_1) == 1)
+ if (sizeof (GFC_UINTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -49,8 +49,8 @@ maxloc2_8_s1 (gfc_array_s1 * const restrict array, GFC_LOGICAL_4 back, gfc_charl
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_1 *src;
- const GFC_INTEGER_1 *maxval;
+ const GFC_UINTEGER_1 *src;
+ const GFC_UINTEGER_1 *maxval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
@@ -88,8 +88,8 @@ mmaxloc2_8_s1 (gfc_array_s1 * const restrict array,
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_1 *src;
- const GFC_INTEGER_1 *maxval;
+ const GFC_UINTEGER_1 *src;
+ const GFC_UINTEGER_1 *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
diff --git a/libgfortran/generated/maxloc2_8_s4.c b/libgfortran/generated/maxloc2_8_s4.c
index f707b14..dfb4ba5 100644
--- a/libgfortran/generated/maxloc2_8_s4.c
+++ b/libgfortran/generated/maxloc2_8_s4.c
@@ -28,12 +28,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <string.h>
#include <assert.h>
-#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
+#if defined (HAVE_GFC_UINTEGER_4) && defined (HAVE_GFC_INTEGER_8)
static inline int
-compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_4 *a, const GFC_UINTEGER_4 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_4) == 1)
+ if (sizeof (GFC_UINTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -49,8 +49,8 @@ maxloc2_8_s4 (gfc_array_s4 * const restrict array, GFC_LOGICAL_4 back, gfc_charl
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_4 *src;
- const GFC_INTEGER_4 *maxval;
+ const GFC_UINTEGER_4 *src;
+ const GFC_UINTEGER_4 *maxval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
@@ -88,8 +88,8 @@ mmaxloc2_8_s4 (gfc_array_s4 * const restrict array,
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_4 *src;
- const GFC_INTEGER_4 *maxval;
+ const GFC_UINTEGER_4 *src;
+ const GFC_UINTEGER_4 *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
diff --git a/libgfortran/generated/maxval0_s1.c b/libgfortran/generated/maxval0_s1.c
index 54b3e2d..6903918 100644
--- a/libgfortran/generated/maxval0_s1.c
+++ b/libgfortran/generated/maxval0_s1.c
@@ -30,12 +30,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <limits.h>
-#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_1)
+#if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_UINTEGER_1)
static inline int
-compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_1) == 1)
+ if (sizeof (GFC_UINTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -44,20 +44,20 @@ compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
#define INITVAL 0
-extern void maxval0_s1 (GFC_INTEGER_1 * restrict,
+extern void maxval0_s1 (GFC_UINTEGER_1 * restrict,
gfc_charlen_type,
gfc_array_s1 * const restrict array, gfc_charlen_type);
export_proto(maxval0_s1);
void
-maxval0_s1 (GFC_INTEGER_1 * restrict ret,
+maxval0_s1 (GFC_UINTEGER_1 * restrict ret,
gfc_charlen_type xlen,
gfc_array_s1 * const restrict array, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
- const GFC_INTEGER_1 *base;
+ const GFC_UINTEGER_1 *base;
index_type rank;
index_type n;
@@ -83,7 +83,7 @@ maxval0_s1 (GFC_INTEGER_1 * restrict ret,
{
- const GFC_INTEGER_1 *retval;
+ const GFC_UINTEGER_1 *retval;
retval = ret;
while (base)
@@ -130,13 +130,13 @@ maxval0_s1 (GFC_INTEGER_1 * restrict ret,
}
-extern void mmaxval0_s1 (GFC_INTEGER_1 * restrict,
+extern void mmaxval0_s1 (GFC_UINTEGER_1 * restrict,
gfc_charlen_type, gfc_array_s1 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len);
export_proto(mmaxval0_s1);
void
-mmaxval0_s1 (GFC_INTEGER_1 * const restrict ret,
+mmaxval0_s1 (GFC_UINTEGER_1 * const restrict ret,
gfc_charlen_type xlen, gfc_array_s1 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len)
{
@@ -144,7 +144,7 @@ mmaxval0_s1 (GFC_INTEGER_1 * const restrict ret,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
- const GFC_INTEGER_1 *base;
+ const GFC_UINTEGER_1 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
@@ -185,7 +185,7 @@ mmaxval0_s1 (GFC_INTEGER_1 * const restrict ret,
base = array->base_addr;
{
- const GFC_INTEGER_1 *retval;
+ const GFC_UINTEGER_1 *retval;
retval = ret;
@@ -236,13 +236,13 @@ mmaxval0_s1 (GFC_INTEGER_1 * const restrict ret,
}
-extern void smaxval0_s1 (GFC_INTEGER_1 * restrict,
+extern void smaxval0_s1 (GFC_UINTEGER_1 * restrict,
gfc_charlen_type,
gfc_array_s1 * const restrict array, GFC_LOGICAL_4 *, gfc_charlen_type);
export_proto(smaxval0_s1);
void
-smaxval0_s1 (GFC_INTEGER_1 * restrict ret,
+smaxval0_s1 (GFC_UINTEGER_1 * restrict ret,
gfc_charlen_type xlen, gfc_array_s1 * const restrict array,
GFC_LOGICAL_4 *mask, gfc_charlen_type len)
diff --git a/libgfortran/generated/maxval0_s4.c b/libgfortran/generated/maxval0_s4.c
index b360aab..111a5de 100644
--- a/libgfortran/generated/maxval0_s4.c
+++ b/libgfortran/generated/maxval0_s4.c
@@ -30,12 +30,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <limits.h>
-#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+#if defined (HAVE_GFC_UINTEGER_4) && defined (HAVE_GFC_UINTEGER_4)
static inline int
-compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_4 *a, const GFC_UINTEGER_4 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_4) == 1)
+ if (sizeof (GFC_UINTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -44,20 +44,20 @@ compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
#define INITVAL 0
-extern void maxval0_s4 (GFC_INTEGER_4 * restrict,
+extern void maxval0_s4 (GFC_UINTEGER_4 * restrict,
gfc_charlen_type,
gfc_array_s4 * const restrict array, gfc_charlen_type);
export_proto(maxval0_s4);
void
-maxval0_s4 (GFC_INTEGER_4 * restrict ret,
+maxval0_s4 (GFC_UINTEGER_4 * restrict ret,
gfc_charlen_type xlen,
gfc_array_s4 * const restrict array, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
- const GFC_INTEGER_4 *base;
+ const GFC_UINTEGER_4 *base;
index_type rank;
index_type n;
@@ -83,7 +83,7 @@ maxval0_s4 (GFC_INTEGER_4 * restrict ret,
{
- const GFC_INTEGER_4 *retval;
+ const GFC_UINTEGER_4 *retval;
retval = ret;
while (base)
@@ -130,13 +130,13 @@ maxval0_s4 (GFC_INTEGER_4 * restrict ret,
}
-extern void mmaxval0_s4 (GFC_INTEGER_4 * restrict,
+extern void mmaxval0_s4 (GFC_UINTEGER_4 * restrict,
gfc_charlen_type, gfc_array_s4 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len);
export_proto(mmaxval0_s4);
void
-mmaxval0_s4 (GFC_INTEGER_4 * const restrict ret,
+mmaxval0_s4 (GFC_UINTEGER_4 * const restrict ret,
gfc_charlen_type xlen, gfc_array_s4 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len)
{
@@ -144,7 +144,7 @@ mmaxval0_s4 (GFC_INTEGER_4 * const restrict ret,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
- const GFC_INTEGER_4 *base;
+ const GFC_UINTEGER_4 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
@@ -185,7 +185,7 @@ mmaxval0_s4 (GFC_INTEGER_4 * const restrict ret,
base = array->base_addr;
{
- const GFC_INTEGER_4 *retval;
+ const GFC_UINTEGER_4 *retval;
retval = ret;
@@ -236,13 +236,13 @@ mmaxval0_s4 (GFC_INTEGER_4 * const restrict ret,
}
-extern void smaxval0_s4 (GFC_INTEGER_4 * restrict,
+extern void smaxval0_s4 (GFC_UINTEGER_4 * restrict,
gfc_charlen_type,
gfc_array_s4 * const restrict array, GFC_LOGICAL_4 *, gfc_charlen_type);
export_proto(smaxval0_s4);
void
-smaxval0_s4 (GFC_INTEGER_4 * restrict ret,
+smaxval0_s4 (GFC_UINTEGER_4 * restrict ret,
gfc_charlen_type xlen, gfc_array_s4 * const restrict array,
GFC_LOGICAL_4 *mask, gfc_charlen_type len)
diff --git a/libgfortran/generated/maxval1_s1.c b/libgfortran/generated/maxval1_s1.c
index e151b67..1cc6483 100644
--- a/libgfortran/generated/maxval1_s1.c
+++ b/libgfortran/generated/maxval1_s1.c
@@ -26,15 +26,15 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "libgfortran.h"
-#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_1)
+#if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_UINTEGER_1)
#include <string.h>
#include <assert.h>
static inline int
-compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_1) == 1)
+ if (sizeof (GFC_UINTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -54,8 +54,8 @@ maxval1_s1 (gfc_array_s1 * const restrict retarray,
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;
+ const GFC_UINTEGER_1 * restrict base;
+ GFC_UINTEGER_1 * restrict dest;
index_type rank;
index_type n;
index_type len;
@@ -119,7 +119,7 @@ maxval1_s1 (gfc_array_s1 * const restrict retarray,
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]
* string_len;
- retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_1));
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_UINTEGER_1));
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
@@ -155,11 +155,11 @@ maxval1_s1 (gfc_array_s1 * const restrict retarray,
continue_loop = 1;
while (continue_loop)
{
- const GFC_INTEGER_1 * restrict src;
+ const GFC_UINTEGER_1 * restrict src;
src = base;
{
- const GFC_INTEGER_1 *retval;
+ const GFC_UINTEGER_1 *retval;
retval = base;
if (len <= 0)
memset (dest, 0, sizeof (*dest) * string_len);
@@ -228,8 +228,8 @@ mmaxval1_s1 (gfc_array_s1 * const restrict retarray,
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;
+ GFC_UINTEGER_1 * restrict dest;
+ const GFC_UINTEGER_1 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
@@ -319,7 +319,7 @@ mmaxval1_s1 (gfc_array_s1 * const restrict retarray,
return;
}
else
- retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_1));
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_UINTEGER_1));
}
else
@@ -349,14 +349,14 @@ mmaxval1_s1 (gfc_array_s1 * const restrict retarray,
while (base)
{
- const GFC_INTEGER_1 * restrict src;
+ const GFC_UINTEGER_1 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
src = base;
msrc = mbase;
{
- const GFC_INTEGER_1 *retval;
+ const GFC_UINTEGER_1 *retval;
memset (dest, 0, sizeof (*dest) * string_len);
retval = dest;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
@@ -430,7 +430,7 @@ smaxval1_s1 (gfc_array_s1 * const restrict retarray,
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
- GFC_INTEGER_1 * restrict dest;
+ GFC_UINTEGER_1 * restrict dest;
index_type rank;
index_type n;
index_type dim;
@@ -497,7 +497,7 @@ smaxval1_s1 (gfc_array_s1 * const restrict retarray,
return;
}
else
- retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_1));
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_UINTEGER_1));
}
else
{
diff --git a/libgfortran/generated/maxval1_s4.c b/libgfortran/generated/maxval1_s4.c
index dbde1bc..6e0e8be 100644
--- a/libgfortran/generated/maxval1_s4.c
+++ b/libgfortran/generated/maxval1_s4.c
@@ -26,15 +26,15 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "libgfortran.h"
-#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+#if defined (HAVE_GFC_UINTEGER_4) && defined (HAVE_GFC_UINTEGER_4)
#include <string.h>
#include <assert.h>
static inline int
-compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_4 *a, const GFC_UINTEGER_4 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_4) == 1)
+ if (sizeof (GFC_UINTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -54,8 +54,8 @@ maxval1_s4 (gfc_array_s4 * const restrict retarray,
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;
+ const GFC_UINTEGER_4 * restrict base;
+ GFC_UINTEGER_4 * restrict dest;
index_type rank;
index_type n;
index_type len;
@@ -119,7 +119,7 @@ maxval1_s4 (gfc_array_s4 * const restrict retarray,
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]
* string_len;
- retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_UINTEGER_4));
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
@@ -155,11 +155,11 @@ maxval1_s4 (gfc_array_s4 * const restrict retarray,
continue_loop = 1;
while (continue_loop)
{
- const GFC_INTEGER_4 * restrict src;
+ const GFC_UINTEGER_4 * restrict src;
src = base;
{
- const GFC_INTEGER_4 *retval;
+ const GFC_UINTEGER_4 *retval;
retval = base;
if (len <= 0)
memset (dest, 0, sizeof (*dest) * string_len);
@@ -228,8 +228,8 @@ mmaxval1_s4 (gfc_array_s4 * const restrict retarray,
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;
+ GFC_UINTEGER_4 * restrict dest;
+ const GFC_UINTEGER_4 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
@@ -319,7 +319,7 @@ mmaxval1_s4 (gfc_array_s4 * const restrict retarray,
return;
}
else
- retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_UINTEGER_4));
}
else
@@ -349,14 +349,14 @@ mmaxval1_s4 (gfc_array_s4 * const restrict retarray,
while (base)
{
- const GFC_INTEGER_4 * restrict src;
+ const GFC_UINTEGER_4 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
src = base;
msrc = mbase;
{
- const GFC_INTEGER_4 *retval;
+ const GFC_UINTEGER_4 *retval;
memset (dest, 0, sizeof (*dest) * string_len);
retval = dest;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
@@ -430,7 +430,7 @@ smaxval1_s4 (gfc_array_s4 * const restrict retarray,
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
- GFC_INTEGER_4 * restrict dest;
+ GFC_UINTEGER_4 * restrict dest;
index_type rank;
index_type n;
index_type dim;
@@ -497,7 +497,7 @@ smaxval1_s4 (gfc_array_s4 * const restrict retarray,
return;
}
else
- retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_UINTEGER_4));
}
else
{
diff --git a/libgfortran/generated/minloc0_16_s1.c b/libgfortran/generated/minloc0_16_s1.c
index d4cad49..66fa30c 100644
--- a/libgfortran/generated/minloc0_16_s1.c
+++ b/libgfortran/generated/minloc0_16_s1.c
@@ -30,14 +30,14 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <limits.h>
-#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_16)
+#if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_INTEGER_16)
#define HAVE_BACK_ARG 1
static inline int
-compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_1) == 1)
+ if (sizeof (GFC_UINTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -56,7 +56,7 @@ minloc0_16_s1 (gfc_array_i16 * const restrict retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
- const GFC_INTEGER_1 *base;
+ const GFC_UINTEGER_1 *base;
GFC_INTEGER_16 * restrict dest;
index_type rank;
index_type n;
@@ -102,7 +102,7 @@ minloc0_16_s1 (gfc_array_i16 * const restrict retarray,
dest[n * dstride] = 1;
{
- const GFC_INTEGER_1 *minval;
+ const GFC_UINTEGER_1 *minval;
minval = NULL;
while (base)
@@ -168,7 +168,7 @@ mminloc0_16_s1 (gfc_array_i16 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_16 *dest;
- const GFC_INTEGER_1 *base;
+ const GFC_UINTEGER_1 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
@@ -234,7 +234,7 @@ mminloc0_16_s1 (gfc_array_i16 * const restrict retarray,
dest[n * dstride] = 0;
{
- const GFC_INTEGER_1 *minval;
+ const GFC_UINTEGER_1 *minval;
minval = NULL;
diff --git a/libgfortran/generated/minloc0_16_s4.c b/libgfortran/generated/minloc0_16_s4.c
index 7ccaf17..378990c 100644
--- a/libgfortran/generated/minloc0_16_s4.c
+++ b/libgfortran/generated/minloc0_16_s4.c
@@ -30,14 +30,14 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <limits.h>
-#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
+#if defined (HAVE_GFC_UINTEGER_4) && defined (HAVE_GFC_INTEGER_16)
#define HAVE_BACK_ARG 1
static inline int
-compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_4 *a, const GFC_UINTEGER_4 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_4) == 1)
+ if (sizeof (GFC_UINTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -56,7 +56,7 @@ minloc0_16_s4 (gfc_array_i16 * const restrict retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
- const GFC_INTEGER_4 *base;
+ const GFC_UINTEGER_4 *base;
GFC_INTEGER_16 * restrict dest;
index_type rank;
index_type n;
@@ -102,7 +102,7 @@ minloc0_16_s4 (gfc_array_i16 * const restrict retarray,
dest[n * dstride] = 1;
{
- const GFC_INTEGER_4 *minval;
+ const GFC_UINTEGER_4 *minval;
minval = NULL;
while (base)
@@ -168,7 +168,7 @@ mminloc0_16_s4 (gfc_array_i16 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_16 *dest;
- const GFC_INTEGER_4 *base;
+ const GFC_UINTEGER_4 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
@@ -234,7 +234,7 @@ mminloc0_16_s4 (gfc_array_i16 * const restrict retarray,
dest[n * dstride] = 0;
{
- const GFC_INTEGER_4 *minval;
+ const GFC_UINTEGER_4 *minval;
minval = NULL;
diff --git a/libgfortran/generated/minloc0_4_s1.c b/libgfortran/generated/minloc0_4_s1.c
index f80a67f..c2615d2 100644
--- a/libgfortran/generated/minloc0_4_s1.c
+++ b/libgfortran/generated/minloc0_4_s1.c
@@ -30,14 +30,14 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <limits.h>
-#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_4)
+#if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_INTEGER_4)
#define HAVE_BACK_ARG 1
static inline int
-compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_1) == 1)
+ if (sizeof (GFC_UINTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -56,7 +56,7 @@ minloc0_4_s1 (gfc_array_i4 * const restrict retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
- const GFC_INTEGER_1 *base;
+ const GFC_UINTEGER_1 *base;
GFC_INTEGER_4 * restrict dest;
index_type rank;
index_type n;
@@ -102,7 +102,7 @@ minloc0_4_s1 (gfc_array_i4 * const restrict retarray,
dest[n * dstride] = 1;
{
- const GFC_INTEGER_1 *minval;
+ const GFC_UINTEGER_1 *minval;
minval = NULL;
while (base)
@@ -168,7 +168,7 @@ mminloc0_4_s1 (gfc_array_i4 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_4 *dest;
- const GFC_INTEGER_1 *base;
+ const GFC_UINTEGER_1 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
@@ -234,7 +234,7 @@ mminloc0_4_s1 (gfc_array_i4 * const restrict retarray,
dest[n * dstride] = 0;
{
- const GFC_INTEGER_1 *minval;
+ const GFC_UINTEGER_1 *minval;
minval = NULL;
diff --git a/libgfortran/generated/minloc0_4_s4.c b/libgfortran/generated/minloc0_4_s4.c
index c1527f7..5568cdb 100644
--- a/libgfortran/generated/minloc0_4_s4.c
+++ b/libgfortran/generated/minloc0_4_s4.c
@@ -30,14 +30,14 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <limits.h>
-#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+#if defined (HAVE_GFC_UINTEGER_4) && defined (HAVE_GFC_INTEGER_4)
#define HAVE_BACK_ARG 1
static inline int
-compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_4 *a, const GFC_UINTEGER_4 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_4) == 1)
+ if (sizeof (GFC_UINTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -56,7 +56,7 @@ minloc0_4_s4 (gfc_array_i4 * const restrict retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
- const GFC_INTEGER_4 *base;
+ const GFC_UINTEGER_4 *base;
GFC_INTEGER_4 * restrict dest;
index_type rank;
index_type n;
@@ -102,7 +102,7 @@ minloc0_4_s4 (gfc_array_i4 * const restrict retarray,
dest[n * dstride] = 1;
{
- const GFC_INTEGER_4 *minval;
+ const GFC_UINTEGER_4 *minval;
minval = NULL;
while (base)
@@ -168,7 +168,7 @@ mminloc0_4_s4 (gfc_array_i4 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_4 *dest;
- const GFC_INTEGER_4 *base;
+ const GFC_UINTEGER_4 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
@@ -234,7 +234,7 @@ mminloc0_4_s4 (gfc_array_i4 * const restrict retarray,
dest[n * dstride] = 0;
{
- const GFC_INTEGER_4 *minval;
+ const GFC_UINTEGER_4 *minval;
minval = NULL;
diff --git a/libgfortran/generated/minloc0_8_s1.c b/libgfortran/generated/minloc0_8_s1.c
index fdeabd8..e22f4f9 100644
--- a/libgfortran/generated/minloc0_8_s1.c
+++ b/libgfortran/generated/minloc0_8_s1.c
@@ -30,14 +30,14 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <limits.h>
-#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_8)
+#if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_INTEGER_8)
#define HAVE_BACK_ARG 1
static inline int
-compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_1) == 1)
+ if (sizeof (GFC_UINTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -56,7 +56,7 @@ minloc0_8_s1 (gfc_array_i8 * const restrict retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
- const GFC_INTEGER_1 *base;
+ const GFC_UINTEGER_1 *base;
GFC_INTEGER_8 * restrict dest;
index_type rank;
index_type n;
@@ -102,7 +102,7 @@ minloc0_8_s1 (gfc_array_i8 * const restrict retarray,
dest[n * dstride] = 1;
{
- const GFC_INTEGER_1 *minval;
+ const GFC_UINTEGER_1 *minval;
minval = NULL;
while (base)
@@ -168,7 +168,7 @@ mminloc0_8_s1 (gfc_array_i8 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_8 *dest;
- const GFC_INTEGER_1 *base;
+ const GFC_UINTEGER_1 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
@@ -234,7 +234,7 @@ mminloc0_8_s1 (gfc_array_i8 * const restrict retarray,
dest[n * dstride] = 0;
{
- const GFC_INTEGER_1 *minval;
+ const GFC_UINTEGER_1 *minval;
minval = NULL;
diff --git a/libgfortran/generated/minloc0_8_s4.c b/libgfortran/generated/minloc0_8_s4.c
index 15871ca..52ca057 100644
--- a/libgfortran/generated/minloc0_8_s4.c
+++ b/libgfortran/generated/minloc0_8_s4.c
@@ -30,14 +30,14 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <limits.h>
-#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
+#if defined (HAVE_GFC_UINTEGER_4) && defined (HAVE_GFC_INTEGER_8)
#define HAVE_BACK_ARG 1
static inline int
-compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_4 *a, const GFC_UINTEGER_4 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_4) == 1)
+ if (sizeof (GFC_UINTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -56,7 +56,7 @@ minloc0_8_s4 (gfc_array_i8 * const restrict retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride;
- const GFC_INTEGER_4 *base;
+ const GFC_UINTEGER_4 *base;
GFC_INTEGER_8 * restrict dest;
index_type rank;
index_type n;
@@ -102,7 +102,7 @@ minloc0_8_s4 (gfc_array_i8 * const restrict retarray,
dest[n * dstride] = 1;
{
- const GFC_INTEGER_4 *minval;
+ const GFC_UINTEGER_4 *minval;
minval = NULL;
while (base)
@@ -168,7 +168,7 @@ mminloc0_8_s4 (gfc_array_i8 * const restrict retarray,
index_type mstride[GFC_MAX_DIMENSIONS];
index_type dstride;
GFC_INTEGER_8 *dest;
- const GFC_INTEGER_4 *base;
+ const GFC_UINTEGER_4 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
@@ -234,7 +234,7 @@ mminloc0_8_s4 (gfc_array_i8 * const restrict retarray,
dest[n * dstride] = 0;
{
- const GFC_INTEGER_4 *minval;
+ const GFC_UINTEGER_4 *minval;
minval = NULL;
diff --git a/libgfortran/generated/minloc1_16_s1.c b/libgfortran/generated/minloc1_16_s1.c
index 36dd6d5..b0cb8be 100644
--- a/libgfortran/generated/minloc1_16_s1.c
+++ b/libgfortran/generated/minloc1_16_s1.c
@@ -26,7 +26,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "libgfortran.h"
-#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_16)
+#if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_INTEGER_16)
#define HAVE_BACK_ARG 1
@@ -34,9 +34,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <assert.h>
static inline int
-compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_1) == 1)
+ if (sizeof (GFC_UINTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -57,7 +57,7 @@ minloc1_16_s1 (gfc_array_i16 * const restrict retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
- const GFC_INTEGER_1 * restrict base;
+ const GFC_UINTEGER_1 * restrict base;
GFC_INTEGER_16 * restrict dest;
index_type rank;
index_type n;
@@ -155,12 +155,12 @@ minloc1_16_s1 (gfc_array_i16 * const restrict retarray,
continue_loop = 1;
while (continue_loop)
{
- const GFC_INTEGER_1 * restrict src;
+ const GFC_UINTEGER_1 * restrict src;
GFC_INTEGER_16 result;
src = base;
{
- const GFC_INTEGER_1 *minval;
+ const GFC_UINTEGER_1 *minval;
minval = NULL;
result = 0;
if (len <= 0)
@@ -231,7 +231,7 @@ mminloc1_16_s1 (gfc_array_i16 * const restrict retarray,
index_type dstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest;
- const GFC_INTEGER_1 * restrict base;
+ const GFC_UINTEGER_1 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
@@ -349,14 +349,14 @@ mminloc1_16_s1 (gfc_array_i16 * const restrict retarray,
while (base)
{
- const GFC_INTEGER_1 * restrict src;
+ const GFC_UINTEGER_1 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_16 result;
src = base;
msrc = mbase;
{
- const GFC_INTEGER_1 *minval;
+ const GFC_UINTEGER_1 *minval;
minval = base;
result = 0;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
diff --git a/libgfortran/generated/minloc1_16_s4.c b/libgfortran/generated/minloc1_16_s4.c
index 922fc83..b422262 100644
--- a/libgfortran/generated/minloc1_16_s4.c
+++ b/libgfortran/generated/minloc1_16_s4.c
@@ -26,7 +26,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "libgfortran.h"
-#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
+#if defined (HAVE_GFC_UINTEGER_4) && defined (HAVE_GFC_INTEGER_16)
#define HAVE_BACK_ARG 1
@@ -34,9 +34,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <assert.h>
static inline int
-compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_4 *a, const GFC_UINTEGER_4 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_4) == 1)
+ if (sizeof (GFC_UINTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -57,7 +57,7 @@ minloc1_16_s4 (gfc_array_i16 * const restrict retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
- const GFC_INTEGER_4 * restrict base;
+ const GFC_UINTEGER_4 * restrict base;
GFC_INTEGER_16 * restrict dest;
index_type rank;
index_type n;
@@ -155,12 +155,12 @@ minloc1_16_s4 (gfc_array_i16 * const restrict retarray,
continue_loop = 1;
while (continue_loop)
{
- const GFC_INTEGER_4 * restrict src;
+ const GFC_UINTEGER_4 * restrict src;
GFC_INTEGER_16 result;
src = base;
{
- const GFC_INTEGER_4 *minval;
+ const GFC_UINTEGER_4 *minval;
minval = NULL;
result = 0;
if (len <= 0)
@@ -231,7 +231,7 @@ mminloc1_16_s4 (gfc_array_i16 * const restrict retarray,
index_type dstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_16 * restrict dest;
- const GFC_INTEGER_4 * restrict base;
+ const GFC_UINTEGER_4 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
@@ -349,14 +349,14 @@ mminloc1_16_s4 (gfc_array_i16 * const restrict retarray,
while (base)
{
- const GFC_INTEGER_4 * restrict src;
+ const GFC_UINTEGER_4 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_16 result;
src = base;
msrc = mbase;
{
- const GFC_INTEGER_4 *minval;
+ const GFC_UINTEGER_4 *minval;
minval = base;
result = 0;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
diff --git a/libgfortran/generated/minloc1_4_s1.c b/libgfortran/generated/minloc1_4_s1.c
index 4be5668..0a52c34 100644
--- a/libgfortran/generated/minloc1_4_s1.c
+++ b/libgfortran/generated/minloc1_4_s1.c
@@ -26,7 +26,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "libgfortran.h"
-#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_4)
+#if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_INTEGER_4)
#define HAVE_BACK_ARG 1
@@ -34,9 +34,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <assert.h>
static inline int
-compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_1) == 1)
+ if (sizeof (GFC_UINTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -57,7 +57,7 @@ minloc1_4_s1 (gfc_array_i4 * const restrict retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
- const GFC_INTEGER_1 * restrict base;
+ const GFC_UINTEGER_1 * restrict base;
GFC_INTEGER_4 * restrict dest;
index_type rank;
index_type n;
@@ -155,12 +155,12 @@ minloc1_4_s1 (gfc_array_i4 * const restrict retarray,
continue_loop = 1;
while (continue_loop)
{
- const GFC_INTEGER_1 * restrict src;
+ const GFC_UINTEGER_1 * restrict src;
GFC_INTEGER_4 result;
src = base;
{
- const GFC_INTEGER_1 *minval;
+ const GFC_UINTEGER_1 *minval;
minval = NULL;
result = 0;
if (len <= 0)
@@ -231,7 +231,7 @@ mminloc1_4_s1 (gfc_array_i4 * const restrict retarray,
index_type dstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_4 * restrict dest;
- const GFC_INTEGER_1 * restrict base;
+ const GFC_UINTEGER_1 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
@@ -349,14 +349,14 @@ mminloc1_4_s1 (gfc_array_i4 * const restrict retarray,
while (base)
{
- const GFC_INTEGER_1 * restrict src;
+ const GFC_UINTEGER_1 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_4 result;
src = base;
msrc = mbase;
{
- const GFC_INTEGER_1 *minval;
+ const GFC_UINTEGER_1 *minval;
minval = base;
result = 0;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
diff --git a/libgfortran/generated/minloc1_4_s4.c b/libgfortran/generated/minloc1_4_s4.c
index 27f8745..0338f6a 100644
--- a/libgfortran/generated/minloc1_4_s4.c
+++ b/libgfortran/generated/minloc1_4_s4.c
@@ -26,7 +26,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "libgfortran.h"
-#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+#if defined (HAVE_GFC_UINTEGER_4) && defined (HAVE_GFC_INTEGER_4)
#define HAVE_BACK_ARG 1
@@ -34,9 +34,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <assert.h>
static inline int
-compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_4 *a, const GFC_UINTEGER_4 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_4) == 1)
+ if (sizeof (GFC_UINTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -57,7 +57,7 @@ minloc1_4_s4 (gfc_array_i4 * const restrict retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
- const GFC_INTEGER_4 * restrict base;
+ const GFC_UINTEGER_4 * restrict base;
GFC_INTEGER_4 * restrict dest;
index_type rank;
index_type n;
@@ -155,12 +155,12 @@ minloc1_4_s4 (gfc_array_i4 * const restrict retarray,
continue_loop = 1;
while (continue_loop)
{
- const GFC_INTEGER_4 * restrict src;
+ const GFC_UINTEGER_4 * restrict src;
GFC_INTEGER_4 result;
src = base;
{
- const GFC_INTEGER_4 *minval;
+ const GFC_UINTEGER_4 *minval;
minval = NULL;
result = 0;
if (len <= 0)
@@ -231,7 +231,7 @@ mminloc1_4_s4 (gfc_array_i4 * const restrict retarray,
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_UINTEGER_4 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
@@ -349,14 +349,14 @@ mminloc1_4_s4 (gfc_array_i4 * const restrict retarray,
while (base)
{
- const GFC_INTEGER_4 * restrict src;
+ const GFC_UINTEGER_4 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_4 result;
src = base;
msrc = mbase;
{
- const GFC_INTEGER_4 *minval;
+ const GFC_UINTEGER_4 *minval;
minval = base;
result = 0;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
diff --git a/libgfortran/generated/minloc1_8_s1.c b/libgfortran/generated/minloc1_8_s1.c
index 8e62188..2c38790 100644
--- a/libgfortran/generated/minloc1_8_s1.c
+++ b/libgfortran/generated/minloc1_8_s1.c
@@ -26,7 +26,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "libgfortran.h"
-#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_8)
+#if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_INTEGER_8)
#define HAVE_BACK_ARG 1
@@ -34,9 +34,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <assert.h>
static inline int
-compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_1) == 1)
+ if (sizeof (GFC_UINTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -57,7 +57,7 @@ minloc1_8_s1 (gfc_array_i8 * const restrict retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
- const GFC_INTEGER_1 * restrict base;
+ const GFC_UINTEGER_1 * restrict base;
GFC_INTEGER_8 * restrict dest;
index_type rank;
index_type n;
@@ -155,12 +155,12 @@ minloc1_8_s1 (gfc_array_i8 * const restrict retarray,
continue_loop = 1;
while (continue_loop)
{
- const GFC_INTEGER_1 * restrict src;
+ const GFC_UINTEGER_1 * restrict src;
GFC_INTEGER_8 result;
src = base;
{
- const GFC_INTEGER_1 *minval;
+ const GFC_UINTEGER_1 *minval;
minval = NULL;
result = 0;
if (len <= 0)
@@ -231,7 +231,7 @@ mminloc1_8_s1 (gfc_array_i8 * const restrict retarray,
index_type dstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_8 * restrict dest;
- const GFC_INTEGER_1 * restrict base;
+ const GFC_UINTEGER_1 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
@@ -349,14 +349,14 @@ mminloc1_8_s1 (gfc_array_i8 * const restrict retarray,
while (base)
{
- const GFC_INTEGER_1 * restrict src;
+ const GFC_UINTEGER_1 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_8 result;
src = base;
msrc = mbase;
{
- const GFC_INTEGER_1 *minval;
+ const GFC_UINTEGER_1 *minval;
minval = base;
result = 0;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
diff --git a/libgfortran/generated/minloc1_8_s4.c b/libgfortran/generated/minloc1_8_s4.c
index 2345ad1..59d2d6f 100644
--- a/libgfortran/generated/minloc1_8_s4.c
+++ b/libgfortran/generated/minloc1_8_s4.c
@@ -26,7 +26,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "libgfortran.h"
-#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
+#if defined (HAVE_GFC_UINTEGER_4) && defined (HAVE_GFC_INTEGER_8)
#define HAVE_BACK_ARG 1
@@ -34,9 +34,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <assert.h>
static inline int
-compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_4 *a, const GFC_UINTEGER_4 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_4) == 1)
+ if (sizeof (GFC_UINTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -57,7 +57,7 @@ minloc1_8_s4 (gfc_array_i8 * const restrict retarray,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
- const GFC_INTEGER_4 * restrict base;
+ const GFC_UINTEGER_4 * restrict base;
GFC_INTEGER_8 * restrict dest;
index_type rank;
index_type n;
@@ -155,12 +155,12 @@ minloc1_8_s4 (gfc_array_i8 * const restrict retarray,
continue_loop = 1;
while (continue_loop)
{
- const GFC_INTEGER_4 * restrict src;
+ const GFC_UINTEGER_4 * restrict src;
GFC_INTEGER_8 result;
src = base;
{
- const GFC_INTEGER_4 *minval;
+ const GFC_UINTEGER_4 *minval;
minval = NULL;
result = 0;
if (len <= 0)
@@ -231,7 +231,7 @@ mminloc1_8_s4 (gfc_array_i8 * const restrict retarray,
index_type dstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
GFC_INTEGER_8 * restrict dest;
- const GFC_INTEGER_4 * restrict base;
+ const GFC_UINTEGER_4 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
@@ -349,14 +349,14 @@ mminloc1_8_s4 (gfc_array_i8 * const restrict retarray,
while (base)
{
- const GFC_INTEGER_4 * restrict src;
+ const GFC_UINTEGER_4 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
GFC_INTEGER_8 result;
src = base;
msrc = mbase;
{
- const GFC_INTEGER_4 *minval;
+ const GFC_UINTEGER_4 *minval;
minval = base;
result = 0;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
diff --git a/libgfortran/generated/minloc2_16_s1.c b/libgfortran/generated/minloc2_16_s1.c
index 30fdd82..823c8d2 100644
--- a/libgfortran/generated/minloc2_16_s1.c
+++ b/libgfortran/generated/minloc2_16_s1.c
@@ -28,12 +28,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <string.h>
#include <assert.h>
-#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_16)
+#if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_INTEGER_16)
static inline int
-compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_1) == 1)
+ if (sizeof (GFC_UINTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -50,8 +50,8 @@ minloc2_16_s1 (gfc_array_s1 * const restrict array, GFC_LOGICAL_4 back,
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_1 *src;
- const GFC_INTEGER_1 *minval;
+ const GFC_UINTEGER_1 *src;
+ const GFC_UINTEGER_1 *minval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
@@ -89,8 +89,8 @@ mminloc2_16_s1 (gfc_array_s1 * const restrict array,
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_1 *src;
- const GFC_INTEGER_1 *maxval;
+ const GFC_UINTEGER_1 *src;
+ const GFC_UINTEGER_1 *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
diff --git a/libgfortran/generated/minloc2_16_s4.c b/libgfortran/generated/minloc2_16_s4.c
index 4b0b873..6f98369 100644
--- a/libgfortran/generated/minloc2_16_s4.c
+++ b/libgfortran/generated/minloc2_16_s4.c
@@ -28,12 +28,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <string.h>
#include <assert.h>
-#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
+#if defined (HAVE_GFC_UINTEGER_4) && defined (HAVE_GFC_INTEGER_16)
static inline int
-compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_4 *a, const GFC_UINTEGER_4 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_4) == 1)
+ if (sizeof (GFC_UINTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -50,8 +50,8 @@ minloc2_16_s4 (gfc_array_s4 * const restrict array, GFC_LOGICAL_4 back,
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_4 *src;
- const GFC_INTEGER_4 *minval;
+ const GFC_UINTEGER_4 *src;
+ const GFC_UINTEGER_4 *minval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
@@ -89,8 +89,8 @@ mminloc2_16_s4 (gfc_array_s4 * const restrict array,
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_4 *src;
- const GFC_INTEGER_4 *maxval;
+ const GFC_UINTEGER_4 *src;
+ const GFC_UINTEGER_4 *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
diff --git a/libgfortran/generated/minloc2_4_s1.c b/libgfortran/generated/minloc2_4_s1.c
index f4c8bb3..854aba4 100644
--- a/libgfortran/generated/minloc2_4_s1.c
+++ b/libgfortran/generated/minloc2_4_s1.c
@@ -28,12 +28,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <string.h>
#include <assert.h>
-#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_4)
+#if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_INTEGER_4)
static inline int
-compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_1) == 1)
+ if (sizeof (GFC_UINTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -50,8 +50,8 @@ minloc2_4_s1 (gfc_array_s1 * const restrict array, GFC_LOGICAL_4 back,
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_1 *src;
- const GFC_INTEGER_1 *minval;
+ const GFC_UINTEGER_1 *src;
+ const GFC_UINTEGER_1 *minval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
@@ -89,8 +89,8 @@ mminloc2_4_s1 (gfc_array_s1 * const restrict array,
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_1 *src;
- const GFC_INTEGER_1 *maxval;
+ const GFC_UINTEGER_1 *src;
+ const GFC_UINTEGER_1 *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
diff --git a/libgfortran/generated/minloc2_4_s4.c b/libgfortran/generated/minloc2_4_s4.c
index 8e973f0..9a1b1c8 100644
--- a/libgfortran/generated/minloc2_4_s4.c
+++ b/libgfortran/generated/minloc2_4_s4.c
@@ -28,12 +28,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <string.h>
#include <assert.h>
-#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+#if defined (HAVE_GFC_UINTEGER_4) && defined (HAVE_GFC_INTEGER_4)
static inline int
-compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_4 *a, const GFC_UINTEGER_4 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_4) == 1)
+ if (sizeof (GFC_UINTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -50,8 +50,8 @@ minloc2_4_s4 (gfc_array_s4 * const restrict array, GFC_LOGICAL_4 back,
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_4 *src;
- const GFC_INTEGER_4 *minval;
+ const GFC_UINTEGER_4 *src;
+ const GFC_UINTEGER_4 *minval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
@@ -89,8 +89,8 @@ mminloc2_4_s4 (gfc_array_s4 * const restrict array,
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_4 *src;
- const GFC_INTEGER_4 *maxval;
+ const GFC_UINTEGER_4 *src;
+ const GFC_UINTEGER_4 *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
diff --git a/libgfortran/generated/minloc2_8_s1.c b/libgfortran/generated/minloc2_8_s1.c
index 44b65bf..7ee25ce 100644
--- a/libgfortran/generated/minloc2_8_s1.c
+++ b/libgfortran/generated/minloc2_8_s1.c
@@ -28,12 +28,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <string.h>
#include <assert.h>
-#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_8)
+#if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_INTEGER_8)
static inline int
-compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_1) == 1)
+ if (sizeof (GFC_UINTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -50,8 +50,8 @@ minloc2_8_s1 (gfc_array_s1 * const restrict array, GFC_LOGICAL_4 back,
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_1 *src;
- const GFC_INTEGER_1 *minval;
+ const GFC_UINTEGER_1 *src;
+ const GFC_UINTEGER_1 *minval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
@@ -89,8 +89,8 @@ mminloc2_8_s1 (gfc_array_s1 * const restrict array,
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_1 *src;
- const GFC_INTEGER_1 *maxval;
+ const GFC_UINTEGER_1 *src;
+ const GFC_UINTEGER_1 *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
diff --git a/libgfortran/generated/minloc2_8_s4.c b/libgfortran/generated/minloc2_8_s4.c
index f6f9341..7b0cfd3 100644
--- a/libgfortran/generated/minloc2_8_s4.c
+++ b/libgfortran/generated/minloc2_8_s4.c
@@ -28,12 +28,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <string.h>
#include <assert.h>
-#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
+#if defined (HAVE_GFC_UINTEGER_4) && defined (HAVE_GFC_INTEGER_8)
static inline int
-compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_4 *a, const GFC_UINTEGER_4 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_4) == 1)
+ if (sizeof (GFC_UINTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -50,8 +50,8 @@ minloc2_8_s4 (gfc_array_s4 * const restrict array, GFC_LOGICAL_4 back,
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_4 *src;
- const GFC_INTEGER_4 *minval;
+ const GFC_UINTEGER_4 *src;
+ const GFC_UINTEGER_4 *minval;
index_type i;
extent = GFC_DESCRIPTOR_EXTENT(array,0);
@@ -89,8 +89,8 @@ mminloc2_8_s4 (gfc_array_s4 * const restrict array,
index_type ret;
index_type sstride;
index_type extent;
- const GFC_INTEGER_4 *src;
- const GFC_INTEGER_4 *maxval;
+ const GFC_UINTEGER_4 *src;
+ const GFC_UINTEGER_4 *maxval;
index_type i, j;
GFC_LOGICAL_1 *mbase;
int mask_kind;
diff --git a/libgfortran/generated/minval0_s1.c b/libgfortran/generated/minval0_s1.c
index a346f47..a15b835 100644
--- a/libgfortran/generated/minval0_s1.c
+++ b/libgfortran/generated/minval0_s1.c
@@ -30,12 +30,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <limits.h>
-#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_1)
+#if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_UINTEGER_1)
static inline int
-compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_1) == 1)
+ if (sizeof (GFC_UINTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -44,20 +44,20 @@ compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
#define INITVAL 255
-extern void minval0_s1 (GFC_INTEGER_1 * restrict,
+extern void minval0_s1 (GFC_UINTEGER_1 * restrict,
gfc_charlen_type,
gfc_array_s1 * const restrict array, gfc_charlen_type);
export_proto(minval0_s1);
void
-minval0_s1 (GFC_INTEGER_1 * restrict ret,
+minval0_s1 (GFC_UINTEGER_1 * restrict ret,
gfc_charlen_type xlen,
gfc_array_s1 * const restrict array, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
- const GFC_INTEGER_1 *base;
+ const GFC_UINTEGER_1 *base;
index_type rank;
index_type n;
@@ -83,7 +83,7 @@ minval0_s1 (GFC_INTEGER_1 * restrict ret,
{
- const GFC_INTEGER_1 *retval;
+ const GFC_UINTEGER_1 *retval;
retval = ret;
while (base)
@@ -130,13 +130,13 @@ minval0_s1 (GFC_INTEGER_1 * restrict ret,
}
-extern void mminval0_s1 (GFC_INTEGER_1 * restrict,
+extern void mminval0_s1 (GFC_UINTEGER_1 * restrict,
gfc_charlen_type, gfc_array_s1 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len);
export_proto(mminval0_s1);
void
-mminval0_s1 (GFC_INTEGER_1 * const restrict ret,
+mminval0_s1 (GFC_UINTEGER_1 * const restrict ret,
gfc_charlen_type xlen, gfc_array_s1 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len)
{
@@ -144,7 +144,7 @@ mminval0_s1 (GFC_INTEGER_1 * const restrict ret,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
- const GFC_INTEGER_1 *base;
+ const GFC_UINTEGER_1 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
@@ -185,7 +185,7 @@ mminval0_s1 (GFC_INTEGER_1 * const restrict ret,
base = array->base_addr;
{
- const GFC_INTEGER_1 *retval;
+ const GFC_UINTEGER_1 *retval;
retval = ret;
@@ -236,13 +236,13 @@ mminval0_s1 (GFC_INTEGER_1 * const restrict ret,
}
-extern void sminval0_s1 (GFC_INTEGER_1 * restrict,
+extern void sminval0_s1 (GFC_UINTEGER_1 * restrict,
gfc_charlen_type,
gfc_array_s1 * const restrict array, GFC_LOGICAL_4 *, gfc_charlen_type);
export_proto(sminval0_s1);
void
-sminval0_s1 (GFC_INTEGER_1 * restrict ret,
+sminval0_s1 (GFC_UINTEGER_1 * restrict ret,
gfc_charlen_type xlen, gfc_array_s1 * const restrict array,
GFC_LOGICAL_4 *mask, gfc_charlen_type len)
diff --git a/libgfortran/generated/minval0_s4.c b/libgfortran/generated/minval0_s4.c
index 2b78ebd..2b3c332 100644
--- a/libgfortran/generated/minval0_s4.c
+++ b/libgfortran/generated/minval0_s4.c
@@ -30,12 +30,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <limits.h>
-#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+#if defined (HAVE_GFC_UINTEGER_4) && defined (HAVE_GFC_UINTEGER_4)
static inline int
-compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_4 *a, const GFC_UINTEGER_4 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_4) == 1)
+ if (sizeof (GFC_UINTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -44,20 +44,20 @@ compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
#define INITVAL 255
-extern void minval0_s4 (GFC_INTEGER_4 * restrict,
+extern void minval0_s4 (GFC_UINTEGER_4 * restrict,
gfc_charlen_type,
gfc_array_s4 * const restrict array, gfc_charlen_type);
export_proto(minval0_s4);
void
-minval0_s4 (GFC_INTEGER_4 * restrict ret,
+minval0_s4 (GFC_UINTEGER_4 * restrict ret,
gfc_charlen_type xlen,
gfc_array_s4 * const restrict array, gfc_charlen_type len)
{
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
- const GFC_INTEGER_4 *base;
+ const GFC_UINTEGER_4 *base;
index_type rank;
index_type n;
@@ -83,7 +83,7 @@ minval0_s4 (GFC_INTEGER_4 * restrict ret,
{
- const GFC_INTEGER_4 *retval;
+ const GFC_UINTEGER_4 *retval;
retval = ret;
while (base)
@@ -130,13 +130,13 @@ minval0_s4 (GFC_INTEGER_4 * restrict ret,
}
-extern void mminval0_s4 (GFC_INTEGER_4 * restrict,
+extern void mminval0_s4 (GFC_UINTEGER_4 * restrict,
gfc_charlen_type, gfc_array_s4 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len);
export_proto(mminval0_s4);
void
-mminval0_s4 (GFC_INTEGER_4 * const restrict ret,
+mminval0_s4 (GFC_UINTEGER_4 * const restrict ret,
gfc_charlen_type xlen, gfc_array_s4 * const restrict array,
gfc_array_l1 * const restrict mask, gfc_charlen_type len)
{
@@ -144,7 +144,7 @@ mminval0_s4 (GFC_INTEGER_4 * const restrict ret,
index_type extent[GFC_MAX_DIMENSIONS];
index_type sstride[GFC_MAX_DIMENSIONS];
index_type mstride[GFC_MAX_DIMENSIONS];
- const GFC_INTEGER_4 *base;
+ const GFC_UINTEGER_4 *base;
GFC_LOGICAL_1 *mbase;
int rank;
index_type n;
@@ -185,7 +185,7 @@ mminval0_s4 (GFC_INTEGER_4 * const restrict ret,
base = array->base_addr;
{
- const GFC_INTEGER_4 *retval;
+ const GFC_UINTEGER_4 *retval;
retval = ret;
@@ -236,13 +236,13 @@ mminval0_s4 (GFC_INTEGER_4 * const restrict ret,
}
-extern void sminval0_s4 (GFC_INTEGER_4 * restrict,
+extern void sminval0_s4 (GFC_UINTEGER_4 * restrict,
gfc_charlen_type,
gfc_array_s4 * const restrict array, GFC_LOGICAL_4 *, gfc_charlen_type);
export_proto(sminval0_s4);
void
-sminval0_s4 (GFC_INTEGER_4 * restrict ret,
+sminval0_s4 (GFC_UINTEGER_4 * restrict ret,
gfc_charlen_type xlen, gfc_array_s4 * const restrict array,
GFC_LOGICAL_4 *mask, gfc_charlen_type len)
diff --git a/libgfortran/generated/minval1_s1.c b/libgfortran/generated/minval1_s1.c
index ba876d3..be747be 100644
--- a/libgfortran/generated/minval1_s1.c
+++ b/libgfortran/generated/minval1_s1.c
@@ -26,15 +26,15 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "libgfortran.h"
-#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_1)
+#if defined (HAVE_GFC_UINTEGER_1) && defined (HAVE_GFC_UINTEGER_1)
#include <string.h>
#include <assert.h>
static inline int
-compare_fcn (const GFC_INTEGER_1 *a, const GFC_INTEGER_1 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_1 *a, const GFC_UINTEGER_1 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_1) == 1)
+ if (sizeof (GFC_UINTEGER_1) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -54,8 +54,8 @@ minval1_s1 (gfc_array_s1 * const restrict retarray,
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;
+ const GFC_UINTEGER_1 * restrict base;
+ GFC_UINTEGER_1 * restrict dest;
index_type rank;
index_type n;
index_type len;
@@ -119,7 +119,7 @@ minval1_s1 (gfc_array_s1 * const restrict retarray,
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]
* string_len;
- retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_1));
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_UINTEGER_1));
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
@@ -155,11 +155,11 @@ minval1_s1 (gfc_array_s1 * const restrict retarray,
continue_loop = 1;
while (continue_loop)
{
- const GFC_INTEGER_1 * restrict src;
+ const GFC_UINTEGER_1 * restrict src;
src = base;
{
- const GFC_INTEGER_1 *retval;
+ const GFC_UINTEGER_1 *retval;
retval = base;
if (len <= 0)
memset (dest, 255, sizeof (*dest) * string_len);
@@ -228,8 +228,8 @@ mminval1_s1 (gfc_array_s1 * const restrict retarray,
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;
+ GFC_UINTEGER_1 * restrict dest;
+ const GFC_UINTEGER_1 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
@@ -319,7 +319,7 @@ mminval1_s1 (gfc_array_s1 * const restrict retarray,
return;
}
else
- retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_1));
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_UINTEGER_1));
}
else
@@ -349,14 +349,14 @@ mminval1_s1 (gfc_array_s1 * const restrict retarray,
while (base)
{
- const GFC_INTEGER_1 * restrict src;
+ const GFC_UINTEGER_1 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
src = base;
msrc = mbase;
{
- const GFC_INTEGER_1 *retval;
+ const GFC_UINTEGER_1 *retval;
memset (dest, 255, sizeof (*dest) * string_len);
retval = dest;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
@@ -430,7 +430,7 @@ sminval1_s1 (gfc_array_s1 * const restrict retarray,
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
- GFC_INTEGER_1 * restrict dest;
+ GFC_UINTEGER_1 * restrict dest;
index_type rank;
index_type n;
index_type dim;
@@ -497,7 +497,7 @@ sminval1_s1 (gfc_array_s1 * const restrict retarray,
return;
}
else
- retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_1));
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_UINTEGER_1));
}
else
{
diff --git a/libgfortran/generated/minval1_s4.c b/libgfortran/generated/minval1_s4.c
index 74915fb..abd449e 100644
--- a/libgfortran/generated/minval1_s4.c
+++ b/libgfortran/generated/minval1_s4.c
@@ -26,15 +26,15 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "libgfortran.h"
-#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+#if defined (HAVE_GFC_UINTEGER_4) && defined (HAVE_GFC_UINTEGER_4)
#include <string.h>
#include <assert.h>
static inline int
-compare_fcn (const GFC_INTEGER_4 *a, const GFC_INTEGER_4 *b, gfc_charlen_type n)
+compare_fcn (const GFC_UINTEGER_4 *a, const GFC_UINTEGER_4 *b, gfc_charlen_type n)
{
- if (sizeof (GFC_INTEGER_4) == 1)
+ if (sizeof (GFC_UINTEGER_4) == 1)
return memcmp (a, b, n);
else
return memcmp_char4 (a, b, n);
@@ -54,8 +54,8 @@ minval1_s4 (gfc_array_s4 * const restrict retarray,
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;
+ const GFC_UINTEGER_4 * restrict base;
+ GFC_UINTEGER_4 * restrict dest;
index_type rank;
index_type n;
index_type len;
@@ -119,7 +119,7 @@ minval1_s4 (gfc_array_s4 * const restrict retarray,
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]
* string_len;
- retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_UINTEGER_4));
if (alloc_size == 0)
{
/* Make sure we have a zero-sized array. */
@@ -155,11 +155,11 @@ minval1_s4 (gfc_array_s4 * const restrict retarray,
continue_loop = 1;
while (continue_loop)
{
- const GFC_INTEGER_4 * restrict src;
+ const GFC_UINTEGER_4 * restrict src;
src = base;
{
- const GFC_INTEGER_4 *retval;
+ const GFC_UINTEGER_4 *retval;
retval = base;
if (len <= 0)
memset (dest, 255, sizeof (*dest) * string_len);
@@ -228,8 +228,8 @@ mminval1_s4 (gfc_array_s4 * const restrict retarray,
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;
+ GFC_UINTEGER_4 * restrict dest;
+ const GFC_UINTEGER_4 * restrict base;
const GFC_LOGICAL_1 * restrict mbase;
index_type rank;
index_type dim;
@@ -319,7 +319,7 @@ mminval1_s4 (gfc_array_s4 * const restrict retarray,
return;
}
else
- retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_UINTEGER_4));
}
else
@@ -349,14 +349,14 @@ mminval1_s4 (gfc_array_s4 * const restrict retarray,
while (base)
{
- const GFC_INTEGER_4 * restrict src;
+ const GFC_UINTEGER_4 * restrict src;
const GFC_LOGICAL_1 * restrict msrc;
src = base;
msrc = mbase;
{
- const GFC_INTEGER_4 *retval;
+ const GFC_UINTEGER_4 *retval;
memset (dest, 255, sizeof (*dest) * string_len);
retval = dest;
for (n = 0; n < len; n++, src += delta, msrc += mdelta)
@@ -430,7 +430,7 @@ sminval1_s4 (gfc_array_s4 * const restrict retarray,
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
index_type dstride[GFC_MAX_DIMENSIONS];
- GFC_INTEGER_4 * restrict dest;
+ GFC_UINTEGER_4 * restrict dest;
index_type rank;
index_type n;
index_type dim;
@@ -497,7 +497,7 @@ sminval1_s4 (gfc_array_s4 * const restrict retarray,
return;
}
else
- retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_UINTEGER_4));
}
else
{
diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map
index a303a2e..8dcb329 100644
--- a/libgfortran/gfortran.map
+++ b/libgfortran/gfortran.map
@@ -1486,5 +1486,91 @@ GFORTRAN_C99_8 {
GFORTRAN_9 {
global:
+ _gfortran_findloc0_c16;
+ _gfortran_findloc0_c4;
+ _gfortran_findloc0_c8;
+ _gfortran_findloc0_i1;
+ _gfortran_findloc0_i16;
+ _gfortran_findloc0_i4;
+ _gfortran_findloc0_i8;
+ _gfortran_findloc0_l1;
+ _gfortran_findloc0_l16;
+ _gfortran_findloc0_l2;
+ _gfortran_findloc0_l4;
+ _gfortran_findloc0_l8;
+ _gfortran_findloc0_r16;
+ _gfortran_findloc0_r4;
+ _gfortran_findloc0_r8;
+ _gfortran_findloc0_s1;
+ _gfortran_findloc0_s4;
+ _gfortran_findloc1_c16;
+ _gfortran_findloc1_c4;
+ _gfortran_findloc1_c8;
+ _gfortran_findloc1_i1;
+ _gfortran_findloc1_i16;
+ _gfortran_findloc1_i2;
+ _gfortran_findloc1_i4;
+ _gfortran_findloc1_i8;
+ _gfortran_findloc1_r16;
+ _gfortran_findloc1_r4;
+ _gfortran_findloc1_r8;
+ _gfortran_findloc1_s1;
+ _gfortran_findloc1_s4;
+ _gfortran_findloc2_s1;
+ _gfortran_findloc2_s4;
+ _gfortran_mfindloc0_c16;
+ _gfortran_mfindloc0_c4;
+ _gfortran_mfindloc0_c8;
+ _gfortran_mfindloc0_i1;
+ _gfortran_mfindloc0_i16;
+ _gfortran_mfindloc0_i4;
+ _gfortran_mfindloc0_i8;
+ _gfortran_mfindloc0_r16;
+ _gfortran_mfindloc0_r4;
+ _gfortran_mfindloc0_r8;
+ _gfortran_mfindloc0_s1;
+ _gfortran_mfindloc0_s4;
+ _gfortran_mfindloc1_c16;
+ _gfortran_mfindloc1_c4;
+ _gfortran_mfindloc1_c8;
+ _gfortran_mfindloc1_i1;
+ _gfortran_mfindloc1_i16;
+ _gfortran_mfindloc1_i2;
+ _gfortran_mfindloc1_i4;
+ _gfortran_mfindloc1_i8;
+ _gfortran_mfindloc1_r16;
+ _gfortran_mfindloc1_r4;
+ _gfortran_mfindloc1_r8;
+ _gfortran_mfindloc1_s1;
+ _gfortran_mfindloc1_s4;
+ _gfortran_mfindloc2_s1;
+ _gfortran_mfindloc2_s4;
+ _gfortran_sfindloc0_c16;
+ _gfortran_sfindloc0_c4;
+ _gfortran_sfindloc0_c8;
+ _gfortran_sfindloc0_i1;
+ _gfortran_sfindloc0_i16;
+ _gfortran_sfindloc0_i4;
+ _gfortran_sfindloc0_i8;
+ _gfortran_sfindloc0_r16;
+ _gfortran_sfindloc0_r4;
+ _gfortran_sfindloc0_r8;
+ _gfortran_sfindloc0_s1;
+ _gfortran_sfindloc0_s4;
+ _gfortran_sfindloc1_c16;
+ _gfortran_sfindloc1_c4;
+ _gfortran_sfindloc1_c8;
+ _gfortran_sfindloc1_i1;
+ _gfortran_sfindloc1_i16;
+ _gfortran_sfindloc1_i2;
+ _gfortran_sfindloc1_i4;
+ _gfortran_sfindloc1_i8;
+ _gfortran_sfindloc1_r16;
+ _gfortran_sfindloc1_r4;
+ _gfortran_sfindloc1_r8;
+ _gfortran_sfindloc1_s1;
+ _gfortran_sfindloc1_s4;
+ _gfortran_sfindloc2_s1;
+ _gfortran_sfindloc2_s4;
_gfortran_st_wait_async;
};
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 1179812..bea83f3 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -359,6 +359,7 @@ typedef GFC_ARRAY_DESCRIPTOR (GFC_INTEGER_1) gfc_array_i1;
typedef GFC_ARRAY_DESCRIPTOR (GFC_INTEGER_2) gfc_array_i2;
typedef GFC_ARRAY_DESCRIPTOR (GFC_INTEGER_4) gfc_array_i4;
typedef GFC_ARRAY_DESCRIPTOR (GFC_INTEGER_8) gfc_array_i8;
+typedef GFC_ARRAY_DESCRIPTOR (index_type) gfc_array_index_type;
#ifdef HAVE_GFC_INTEGER_16
typedef GFC_ARRAY_DESCRIPTOR (GFC_INTEGER_16) gfc_array_i16;
#endif
@@ -385,8 +386,9 @@ typedef GFC_ARRAY_DESCRIPTOR (GFC_LOGICAL_8) gfc_array_l8;
#ifdef HAVE_GFC_LOGICAL_16
typedef GFC_ARRAY_DESCRIPTOR (GFC_LOGICAL_16) gfc_array_l16;
#endif
-typedef gfc_array_i1 gfc_array_s1;
-typedef gfc_array_i4 gfc_array_s4;
+
+typedef GFC_ARRAY_DESCRIPTOR (GFC_UINTEGER_1) gfc_array_s1;
+typedef GFC_ARRAY_DESCRIPTOR (GFC_UINTEGER_4) gfc_array_s4;
/* These are for when you actually want to declare a descriptor, as
opposed to a pointer to it. */
@@ -1757,7 +1759,9 @@ void cshift1_16_c16 (gfc_array_c16 * const restrict,
internal_proto(cshift1_16_c16);
#endif
-/* Define this if we support asynchronous I/O on this platform. This
- currently requires weak symbols. */
+/* We always have these. */
+
+#define HAVE_GFC_UINTEGER_1 1
+#define HAVE_GFC_UINTEGER_4 1
#endif /* LIBGFOR_H */
diff --git a/libgfortran/m4/findloc0.m4 b/libgfortran/m4/findloc0.m4
new file mode 100644
index 0000000..c64e527
--- /dev/null
+++ b/libgfortran/m4/findloc0.m4
@@ -0,0 +1,38 @@
+dnl Support macros for findloc.
+dnl This file is part of the GNU Fortran Runtime Library (libgfortran)
+dnl Distributed under the GNU GPL with exception. See COPYING for details.
+include(iparm.m4)dnl
+define(header1,`extern void findloc0_'atype_code` (gfc_array_index_type * const restrict retarray,
+ 'atype` * const restrict array, 'atype_name` value,
+ GFC_LOGICAL_4);
+export_proto(findloc0_'atype_code`);
+
+void
+findloc0_'atype_code` (gfc_array_index_type * const restrict retarray,
+ 'atype` * const restrict array, 'atype_name` value,
+ GFC_LOGICAL_4 back)')dnl
+dnl
+define(header2,`extern void mfindloc0_'atype_code` (gfc_array_index_type * const restrict retarray,
+ 'atype` * const restrict array, 'atype_name` value,
+ gfc_array_l1 *const restrict, GFC_LOGICAL_4);
+export_proto(mfindloc0_'atype_code`);
+
+void
+mfindloc0_'atype_code` (gfc_array_index_type * const restrict retarray,
+ 'atype` * const restrict array, 'atype_name` value,
+ gfc_array_l1 *const restrict mask, GFC_LOGICAL_4 back)')
+dnl
+define(header3,`extern void sfindloc0_'atype_code` (gfc_array_index_type * const restrict retarray,
+ 'atype` * const restrict array, 'atype_name` value,
+ GFC_LOGICAL_4 *, GFC_LOGICAL_4);
+export_proto(sfindloc0_'atype_code`);
+
+void
+sfindloc0_'atype_code` (gfc_array_index_type * const restrict retarray,
+ 'atype` * const restrict array, 'atype_name` value,
+ GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back)')dnl
+dnl
+define(comparison,`*base == value')dnl
+define(len_arg,`')dnl
+define(base_mult,1)dnl
+include(ifindloc0.m4)dnl
diff --git a/libgfortran/m4/findloc0s.m4 b/libgfortran/m4/findloc0s.m4
new file mode 100644
index 0000000..18be2c1
--- /dev/null
+++ b/libgfortran/m4/findloc0s.m4
@@ -0,0 +1,48 @@
+dnl Support macros for findloc.
+dnl This file is part of the GNU Fortran Runtime Library (libgfortran)
+dnl Distributed under the GNU GPL with exception. See COPYING for details.
+include(iparm.m4)dnl
+define(header1,`extern void findloc0_'atype_code` (gfc_array_index_type * const restrict retarray,
+ 'atype` * const restrict array, 'atype_name` *value,
+ GFC_LOGICAL_4 back, gfc_charlen_type len_array, gfc_charlen_type len_value);
+
+export_proto(findloc0_'atype_code`);
+
+void
+findloc0_'atype_code` (gfc_array_index_type * const restrict retarray,
+ 'atype` * const restrict array, 'atype_name` *value,
+ GFC_LOGICAL_4 back, gfc_charlen_type len_array, gfc_charlen_type len_value)')dnl
+dnl
+define(header2,`extern void mfindloc0_'atype_code` (gfc_array_index_type * const restrict retarray,
+ 'atype` * const restrict array, 'atype_name` *value,
+ gfc_array_l1 *const restrict, GFC_LOGICAL_4 back, gfc_charlen_type len_array,
+ gfc_charlen_type len_value);
+export_proto(mfindloc0_'atype_code`);
+
+void
+mfindloc0_'atype_code` (gfc_array_index_type * const restrict retarray,
+ 'atype` * const restrict array, 'atype_name` *value,
+ gfc_array_l1 *const restrict mask, GFC_LOGICAL_4 back,
+ gfc_charlen_type len_array, gfc_charlen_type len_value)')
+dnl
+define(header3,`extern void sfindloc0_'atype_code` (gfc_array_index_type * const restrict retarray,
+ 'atype` * const restrict array, 'atype_name` *value,
+ GFC_LOGICAL_4 *, GFC_LOGICAL_4 back, gfc_charlen_type len_array,
+ gfc_charlen_type len_value);
+export_proto(sfindloc0_'atype_code`);
+
+void
+sfindloc0_'atype_code` (gfc_array_index_type * const restrict retarray,
+ 'atype` * const restrict array, 'atype_name` *value,
+ GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back, gfc_charlen_type len_array,
+ gfc_charlen_type len_value)')dnl
+dnl
+define(comparison,ifelse(atype_kind,4,dnl
+`compare_string_char4 (len_array, base, len_value, value) == 0',dnl
+`compare_string (len_array, (char *) base, len_value, (char *) value) == 0'))dnl
+define(len_arg,`, len_array, len_value')dnl
+define(base_mult,`len_array')dnl
+include(ifindloc0.m4)dnl
+
+
+
diff --git a/libgfortran/m4/findloc1.m4 b/libgfortran/m4/findloc1.m4
new file mode 100644
index 0000000..1623355
--- /dev/null
+++ b/libgfortran/m4/findloc1.m4
@@ -0,0 +1,40 @@
+dnl Support macros for findloc.
+dnl This file is part of the GNU Fortran Runtime Library (libgfortran)
+dnl Distributed under the GNU GPL with exception. See COPYING for details.
+include(iparm.m4)dnl
+define(header1,`extern void findloc1_'atype_code` (gfc_array_index_type * const restrict retarray,
+ 'atype` * const restrict array, 'atype_name` value,
+ const 'index_type` * restrict pdim, GFC_LOGICAL_4 back);
+export_proto(findloc1_'atype_code`);
+
+extern void
+findloc1_'atype_code` (gfc_array_index_type * const restrict retarray,
+ 'atype` * const restrict array, 'atype_name` value,
+ const 'index_type` * restrict pdim, GFC_LOGICAL_4 back)')dnl
+dnl
+define(header2,`extern void mfindloc1_'atype_code` (gfc_array_index_type * const restrict retarray,
+ 'atype` * const restrict array, 'atype_name` value,
+ const 'index_type` * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back);
+export_proto(mfindloc1_'atype_code`);
+
+extern void
+mfindloc1_'atype_code` (gfc_array_index_type * const restrict retarray,
+ 'atype` * const restrict array, 'atype_name` value,
+ const 'index_type` * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back)')dnl
+define(header3,`extern void sfindloc1_'atype_code` (gfc_array_index_type * const restrict retarray,
+ 'atype` * const restrict array, 'atype_name` value,
+ const 'index_type` * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back);
+export_proto(sfindloc1_'atype_code`);
+
+extern void
+sfindloc1_'atype_code` (gfc_array_index_type * const restrict retarray,
+ 'atype` * const restrict array, 'atype_name` value,
+ const 'index_type` * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back)')dnl
+define(comparison,`*src == value')dnl
+define(len_arg,`')dnl
+define(base_mult,1)dnl
+include(ifindloc1.m4)dnl
diff --git a/libgfortran/m4/findloc1s.m4 b/libgfortran/m4/findloc1s.m4
new file mode 100644
index 0000000..439617c
--- /dev/null
+++ b/libgfortran/m4/findloc1s.m4
@@ -0,0 +1,44 @@
+dnl Support macros for findloc.
+dnl This file is part of the GNU Fortran Runtime Library (libgfortran)
+dnl Distributed under the GNU GPL with exception. See COPYING for details.
+include(iparm.m4)dnl
+define(header1,`extern void findloc1_'atype_code` (gfc_array_index_type * const restrict retarray,
+ 'atype` * const restrict array, 'atype_name` *const restrict value,
+ const 'index_type` * restrict pdim, GFC_LOGICAL_4 back,
+ gfc_charlen_type len_array, gfc_charlen_type len_value);
+export_proto(findloc1_'atype_code`);
+
+extern void
+findloc1_'atype_code` (gfc_array_index_type * const restrict retarray,
+ 'atype` * const restrict array, 'atype_name` *const restrict value,
+ const 'index_type` * restrict pdim, GFC_LOGICAL_4 back,
+ gfc_charlen_type len_array, gfc_charlen_type len_value)')dnl
+dnl
+define(header2,`extern void mfindloc1_'atype_code` (gfc_array_index_type * const restrict retarray,
+ 'atype` * const restrict array, 'atype_name` *const restrict value,
+ const 'index_type` * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back, gfc_charlen_type len_array, gfc_charlen_type len_value);
+export_proto(mfindloc1_'atype_code`);
+
+extern void
+mfindloc1_'atype_code` (gfc_array_index_type * const restrict retarray,
+ 'atype` * const restrict array, 'atype_name` *const restrict value,
+ const 'index_type` * restrict pdim, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back, gfc_charlen_type len_array, gfc_charlen_type len_value)')dnl
+define(header3,`extern void sfindloc1_'atype_code` (gfc_array_index_type * const restrict retarray,
+ 'atype` * const restrict array, 'atype_name` *const restrict value,
+ const 'index_type` * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back, gfc_charlen_type len_array, gfc_charlen_type len_value);
+export_proto(sfindloc1_'atype_code`);
+
+extern void
+sfindloc1_'atype_code` (gfc_array_index_type * const restrict retarray,
+ 'atype` * const restrict array, 'atype_name` *const restrict value,
+ const 'index_type` * restrict pdim, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back, gfc_charlen_type len_array, gfc_charlen_type len_value)')dnl
+define(comparison,ifelse(atype_kind,4,dnl
+`compare_string_char4 (len_array, src, len_value, value) == 0',dnl
+`compare_string (len_array, (char *) src, len_value, (char *) value) == 0'))dnl
+define(len_arg,`, len_array, len_value')dnl
+define(base_mult,`len_array')dnl
+include(ifindloc1.m4)dnl
diff --git a/libgfortran/m4/findloc2s.m4 b/libgfortran/m4/findloc2s.m4
new file mode 100644
index 0000000..a0f13f8
--- /dev/null
+++ b/libgfortran/m4/findloc2s.m4
@@ -0,0 +1,44 @@
+dnl Support macros for findloc.
+dnl This file is part of the GNU Fortran Runtime Library (libgfortran)
+dnl Distributed under the GNU GPL with exception. See COPYING for details.
+include(iparm.m4)dnl
+define(header1,`index_type findloc2_'atype_code` ('atype` * const restrict array,
+ const 'atype_name` * restrict value, GFC_LOGICAL_4 back,
+ gfc_charlen_type len_array, gfc_charlen_type len_value);
+export_proto(findloc2_'atype_code`);
+
+index_type
+findloc2_'atype_code` ('atype` * const restrict array, const 'atype_name` * restrict value,
+ GFC_LOGICAL_4 back,
+ gfc_charlen_type len_array, gfc_charlen_type len_value)')dnl
+dnl
+define(header2,`index_type mfindloc2_'atype_code` ('atype` * const restrict array,
+ const 'atype_name` * restrict value,
+ gfc_array_l1 *const restrict mask, GFC_LOGICAL_4 back,
+ gfc_charlen_type len_array, gfc_charlen_type len_value);
+export_proto(mfindloc2_'atype_code`);
+
+index_type
+mfindloc2_'atype_code` ('atype` * const restrict array,
+ const 'atype_name` * restrict value, gfc_array_l1 *const restrict mask,
+ GFC_LOGICAL_4 back, gfc_charlen_type len_array,
+ gfc_charlen_type len_value)')dnl
+dnl
+define(header3,`index_type sfindloc2_'atype_code` ('atype` * const restrict array,
+ const 'atype_name` * restrict value,
+ GFC_LOGICAL_4 *const restrict mask, GFC_LOGICAL_4 back,
+ gfc_charlen_type len_array, gfc_charlen_type len_value);
+export_proto(sfindloc2_'atype_code`);
+
+index_type
+sfindloc2_'atype_code` ('atype` * const restrict array,
+ const 'atype_name` * restrict value, GFC_LOGICAL_4 *const restrict mask,
+ GFC_LOGICAL_4 back, gfc_charlen_type len_array,
+ gfc_charlen_type len_value)')dnl
+dnl
+define(comparison,ifelse(atype_kind,4,dnl
+`compare_string_char4 (len_array, src, len_value, value) == 0',dnl
+`compare_string (len_array, (char *) src, len_value, (char *) value) == 0'))dnl
+define(len_arg,`len_array, len_value')dnl
+define(base_mult,`len_array')dnl
+include(ifindloc2.m4)dnl
diff --git a/libgfortran/m4/ifindloc0.m4 b/libgfortran/m4/ifindloc0.m4
new file mode 100644
index 0000000..94937f1
--- /dev/null
+++ b/libgfortran/m4/ifindloc0.m4
@@ -0,0 +1,350 @@
+`/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_'atype_name`)
+'header1`
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const 'atype_name` *base;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * 'base_mult`'`;
+
+ while (1)
+ {
+ do
+ {
+ if (unlikely('comparison`))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * 'base_mult`'`;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 'base_mult`'`;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * 'base_mult`'`;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely('comparison`))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * 'base_mult`'`;
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 'base_mult`'`;
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 'base_mult`'`;
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+'header2`
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride;
+ const 'atype_name` *base;
+ index_type * restrict dest;
+ GFC_LOGICAL_1 *mbase;
+ index_type rank;
+ index_type n;
+ int mask_kind;
+ index_type sz;
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ if (rank <= 0)
+ runtime_error ("Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else
+ {
+ if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "FINDLOC");
+ }
+ }
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+
+ /* Set the return value. */
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = 0;
+
+ sz = 1;
+ for (n = 0; n < rank; n++)
+ {
+ sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
+ mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ sz *= extent[n];
+ if (extent[n] <= 0)
+ return;
+ }
+
+ for (n = 0; n < rank; n++)
+ count[n] = 0;
+
+ if (back)
+ {
+ base = array->base_addr + (sz - 1) * 'base_mult`'`;
+ mbase = mbase + (sz - 1) * mask_kind;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && 'comparison`))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = extent[n] - count[n];
+
+ return;
+ }
+ base -= sstride[0] * 'base_mult`'`;
+ mbase -= mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 'base_mult`'`;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base -= sstride[n] * 'base_mult`'`;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ else
+ {
+ base = array->base_addr;
+ while (1)
+ {
+ do
+ {
+ if (unlikely(*mbase && 'comparison`))
+ {
+ for (n = 0; n < rank; n++)
+ dest[n * dstride] = count[n] + 1;
+
+ return;
+ }
+ base += sstride[0] * 'base_mult`'`;
+ mbase += mstride[0];
+ } while(++count[0] != extent[0]);
+
+ n = 0;
+ do
+ {
+ /* 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] * 'base_mult`'`;
+ mbase -= mstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ return;
+ else
+ {
+ count[n]++;
+ base += sstride[n]* 'base_mult`'`;
+ mbase += mstride[n];
+ }
+ } while (count[n] == extent[n]);
+ }
+ }
+ return;
+}
+
+'header3`
+{
+ index_type rank;
+ index_type dstride;
+ index_type * restrict dest;
+ index_type n;
+
+ if (*mask)
+ {
+ findloc0_'atype_code` (retarray, array, value, back'len_arg`);
+ return;
+ }
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+
+ if (rank <= 0)
+ internal_error (NULL, "Rank of array needs to be > 0");
+
+ if (retarray->base_addr == NULL)
+ {
+ GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1);
+ retarray->dtype.rank = 1;
+ retarray->offset = 0;
+ retarray->base_addr = xmallocarray (rank, sizeof (GFC_INTEGER_4));
+ }
+ else if (unlikely (compile_options.bounds_check))
+ {
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "FINDLOC");
+ }
+
+ dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
+ dest = retarray->base_addr;
+ for (n = 0; n<rank; n++)
+ dest[n * dstride] = 0 ;
+}
+
+#endif'
diff --git a/libgfortran/m4/ifindloc1.m4 b/libgfortran/m4/ifindloc1.m4
new file mode 100644
index 0000000..70638be
--- /dev/null
+++ b/libgfortran/m4/ifindloc1.m4
@@ -0,0 +1,495 @@
+`/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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 <assert.h>
+
+#if defined (HAVE_'atype_name`)
+'header1`
+{
+ 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 'atype_name`'` * restrict base;
+ index_type * 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. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const 'atype_name`'` * restrict src;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * 'base_mult`;
+ for (n = len; n > 0; n--, src -= delta * 'base_mult`)
+ {
+ if ('comparison`'`)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ for (n = 1; n <= len; n++, src += delta * 'base_mult`)
+ {
+ if ('comparison`'`)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * 'base_mult`;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * 'base_mult`;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 'base_mult`;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+'header2`'`
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type sstride[GFC_MAX_DIMENSIONS];
+ index_type mstride[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ const 'atype_name`'` * restrict base;
+ const GFC_LOGICAL_1 * restrict mbase;
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type delta;
+ index_type mdelta;
+ index_type dim;
+ int mask_kind;
+ int continue_loop;
+
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ delta = GFC_DESCRIPTOR_STRIDE(array,dim);
+ mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
+
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ base = array->base_addr;
+ while (continue_loop)
+ {
+ const 'atype_name`'` * restrict src;
+ const GFC_LOGICAL_1 * restrict msrc;
+ index_type result;
+
+ result = 0;
+ if (back)
+ {
+ src = base + (len - 1) * delta * 'base_mult`;
+ msrc = mbase + (len - 1) * mdelta;
+ for (n = len; n > 0; n--, src -= delta * 'base_mult`, msrc -= mdelta)
+ {
+ if (*msrc && 'comparison`'`)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ else
+ {
+ src = base;
+ msrc = mbase;
+ for (n = 1; n <= len; n++, src += delta * 'base_mult`, msrc += mdelta)
+ {
+ if (*msrc && 'comparison`'`)
+ {
+ result = n;
+ break;
+ }
+ }
+ }
+ *dest = result;
+
+ count[0]++;
+ base += sstride[0] * 'base_mult`;
+ mbase += mstride[0];
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ base -= sstride[n] * extent[n] * 'base_mult`;
+ mbase -= mstride[n] * extent[n];
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ base += sstride[n] * 'base_mult`;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+'header3`'`
+{
+ index_type count[GFC_MAX_DIMENSIONS];
+ index_type extent[GFC_MAX_DIMENSIONS];
+ index_type dstride[GFC_MAX_DIMENSIONS];
+ index_type * restrict dest;
+ index_type rank;
+ index_type n;
+ index_type len;
+ index_type dim;
+ bool continue_loop;
+
+ if (*mask)
+ {
+ findloc1_'atype_code`'` (retarray, array, value, pdim, back'len_arg`'`);
+ return;
+ }
+ /* Make dim zero based to avoid confusion. */
+ rank = GFC_DESCRIPTOR_RANK (array) - 1;
+ dim = (*pdim) - 1;
+
+ if (unlikely (dim < 0 || dim > rank))
+ {
+ runtime_error ("Dim argument incorrect in FINDLOC intrinsic: "
+ "is %ld, should be between 1 and %ld",
+ (long int) dim + 1, (long int) rank + 1);
+ }
+
+ len = GFC_DESCRIPTOR_EXTENT(array,dim);
+ if (len < 0)
+ len = 0;
+
+ 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->base_addr == 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.rank = rank;
+
+ alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1];
+
+ retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_4));
+ if (alloc_size == 0)
+ {
+ /* Make sure we have a zero-sized array. */
+ GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
+ return;
+ }
+ }
+ else
+ {
+ if (rank != GFC_DESCRIPTOR_RANK (retarray))
+ runtime_error ("rank of return array incorrect in"
+ " FINDLOC 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", "FINDLOC");
+ }
+
+ for (n = 0; n < rank; n++)
+ {
+ count[n] = 0;
+ dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
+ if (extent[n] <= 0)
+ return;
+ }
+ dest = retarray->base_addr;
+ continue_loop = 1;
+
+ while (continue_loop)
+ {
+ *dest = 0;
+
+ count[0]++;
+ dest += dstride[0];
+ n = 0;
+ while (count[n] == extent[n])
+ {
+ count[n] = 0;
+ dest -= dstride[n] * extent[n];
+ n++;
+ if (n >= rank)
+ {
+ continue_loop = 0;
+ break;
+ }
+ else
+ {
+ count[n]++;
+ dest += dstride[n];
+ }
+ }
+ }
+}
+#endif'
diff --git a/libgfortran/m4/ifindloc2.m4 b/libgfortran/m4/ifindloc2.m4
new file mode 100644
index 0000000..ede7041
--- /dev/null
+++ b/libgfortran/m4/ifindloc2.m4
@@ -0,0 +1,126 @@
+`/* Implementation of the FINDLOC intrinsic
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Thomas König <tk@tkoenig.net>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 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"
+
+#ifdef HAVE_'atype_name`'`
+'header1`'`
+{
+ index_type i;
+ index_type sstride;
+ index_type extent;
+ const 'atype_name`'` * restrict src;
+
+ extent = GFC_DESCRIPTOR_EXTENT(array,0);
+ if (extent <= 0)
+ return 0;
+
+ sstride = GFC_DESCRIPTOR_STRIDE(array,0) * 'base_mult`'`;
+ if (back)
+ {
+ src = array->base_addr + (extent - 1) * sstride;
+ for (i = extent; i >= 0; i--)
+ {
+ if ('comparison`'`)
+ return i;
+ src -= sstride;
+ }
+ }
+ else
+ {
+ src = array->base_addr;
+ for (i = 1; i <= extent; i++)
+ {
+ if ('comparison`'`)
+ return i;
+ src += sstride;
+ }
+ }
+ return 0;
+}
+
+'header2`'`
+{
+ index_type i;
+ index_type sstride;
+ index_type extent;
+ const 'atype_name`'` * restrict src;
+ const GFC_LOGICAL_1 * restrict mbase;
+ int mask_kind;
+ index_type mstride;
+
+ extent = GFC_DESCRIPTOR_EXTENT(array,0);
+ if (extent <= 0)
+ return 0;
+
+ mask_kind = GFC_DESCRIPTOR_SIZE (mask);
+ mbase = mask->base_addr;
+
+ 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
+ internal_error (NULL, "Funny sized logical array");
+
+ sstride = GFC_DESCRIPTOR_STRIDE(array,0) * 'base_mult`'`;
+ mstride = GFC_DESCRIPTOR_STRIDE_BYTES(mask,0);
+
+ if (back)
+ {
+ src = array->base_addr + (extent - 1) * sstride;
+ mbase += (extent - 1) * mstride;
+ for (i = extent; i >= 0; i--)
+ {
+ if (*mbase && ('comparison`'`))
+ return i;
+ src -= sstride;
+ mbase -= mstride;
+ }
+ }
+ else
+ {
+ src = array->base_addr;
+ for (i = 1; i <= extent; i++)
+ {
+ if (*mbase && ('comparison`'`))
+ return i;
+ src += sstride;
+ mbase += mstride;
+ }
+ }
+ return 0;
+}
+'header3`'`
+{
+ if (*mask)
+ {
+ return findloc2_'atype_code` (array, value, back, len_array, len_value);
+ }
+ return 0;
+}
+#endif'
diff --git a/libgfortran/m4/iparm.m4 b/libgfortran/m4/iparm.m4
index 23f05ce..b474620 100644
--- a/libgfortran/m4/iparm.m4
+++ b/libgfortran/m4/iparm.m4
@@ -4,7 +4,7 @@ dnl This file is part of the GNU Fortran 95 Runtime Library (libgfortran)
dnl Distributed under the GNU GPL with exception. See COPYING for details.
dnl M4 macro file to get type names from filenames
define(get_typename2, `GFC_$1_$2')dnl
-define(get_typename, `get_typename2(ifelse($1,i,INTEGER,ifelse($1,r,REAL,ifelse($1,l,LOGICAL,ifelse($1,c,COMPLEX,ifelse($1,s,INTEGER,unknown))))),`$2')')dnl
+define(get_typename, `get_typename2(ifelse($1,i,INTEGER,ifelse($1,r,REAL,ifelse($1,l,LOGICAL,ifelse($1,c,COMPLEX,ifelse($1,s,UINTEGER,unknown))))),`$2')')dnl
define(get_arraytype, `gfc_array_$1$2')dnl
define(define_type, `dnl
ifelse(regexp($2,`^[0-9]'),-1,`dnl