PR libfortran/19308
authorfxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 3 Oct 2005 07:22:20 +0000 (07:22 +0000)
committerfxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 3 Oct 2005 07:22:20 +0000 (07:22 +0000)
PR fortran/20120
PR libfortran/22437

* Makefile.am: Add generated files for large real and integers
kinds. Add a rule to create the kinds.inc c99_protos.inc files.
Use kinds.inc to preprocess Fortran generated files.
* libgfortran.h: Add macro definitions for GFC_INTEGER_16_HUGE,
GFC_REAL_10_HUGE and GFC_REAL_16_HUGE. Add types gfc_array_i16,
gfc_array_r10, gfc_array_r16, gfc_array_c10, gfc_array_c16,
gfc_array_l16.
* mk-kinds-h.sh: Define macros HAVE_GFC_LOGICAL_* and
HAVE_GFC_COMPLEX_* when these types are available.
* intrinsics/ishftc.c (ishftc16): New function for GFC_INTEGER_16.
* m4/all.m4, m4/any.m4, m4/count.m4, m4/cshift1.m4, m4/dotprod.m4,
m4/dotprodc.m4, m4/dotprodl.m4, m4/eoshift1.m4, m4/eoshift3.m4,
m4/exponent.m4, m4/fraction.m4, m4/in_pack.m4, m4/in_unpack.m4,
m4/matmul.m4, m4/matmull.m4, m4/maxloc0.m4, m4/maxloc1.m4,
m4/maxval.m4, m4/minloc0.m4, m4/minloc1.m4, m4/minval.m4, m4/mtype.m4,
m4/nearest.m4, m4/pow.m4, m4/product.m4, m4/reshape.m4,
m4/set_exponent.m4, m4/shape.m4, m4/specific.m4, m4/specific2.m4,
m4/sum.m4, m4/transpose.m4: Protect generated functions with
appropriate "#if defined (HAVE_GFC_type_kind)" preprocessor directives.
* Makefile.in: Regenerate.
* all files in generated/: Regenerate.

* f95-lang.c (DO_DEFINE_MATH_BUILTIN): Add support for long
double builtin function.
(gfc_init_builtin_functions): Add mfunc_longdouble,
mfunc_clongdouble and func_clongdouble_longdouble trees. Build
them for round, trunc, cabs, copysign and pow functions.
* iresolve.c (gfc_resolve_reshape, gfc_resolve_transpose): Add
case for kind 10 and 16.
* trans-decl.c: Add trees for cpowl10, cpowl16, ishftc16,
exponent10 and exponent16.
(gfc_build_intrinsic_function_decls): Build nodes for int16,
real10, real16, complex10 and complex16 types. Build all possible
combinations for function _gfortran_pow_?n_?n. Build function
calls cpowl10, cpowl16, ishftc16, exponent10 and exponent16.
* trans-expr.c (gfc_conv_power_op): Add case for integer(16),
real(10) and real(16).
* trans-intrinsic.c: Add suppport for long double builtin
functions in BUILT_IN_FUNCTION, LIBM_FUNCTION and LIBF_FUNCTION
macros.
(gfc_conv_intrinsic_aint): Add case for integer(16), real(10) and
real(16) kinds.
(gfc_build_intrinsic_lib_fndecls): Add support for real10_decl
and real16_decl in library functions.
(gfc_get_intrinsic_lib_fndecl): Add cases for real and complex
kinds 10 and 16.
(gfc_conv_intrinsic_exponent): Add cases for real(10) and real(16)
kinds.
(gfc_conv_intrinsic_sign): Likewise.
(gfc_conv_intrinsic_ishftc): Add case for integer(16) kind.
* trans-types.c (gfc_get_int_type, gfc_get_real_type,
gfc_get_complex_type, gfc_get_logical_type): Doesn't error out in
the case of kinds not available.
* trans.h: Declare trees for cpowl10, cpowl16, ishftc16,
exponent10 and exponent16.

* gfortran.dg/large_real_kind_2.F90: New test.
* gfortran.dg/large_integer_kind_2.f90: New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@104889 138bc75d-0d04-0410-961f-82ee72b054a4

419 files changed:
gcc/fortran/ChangeLog
gcc/fortran/f95-lang.c
gcc/fortran/iresolve.c
gcc/fortran/trans-decl.c
gcc/fortran/trans-expr.c
gcc/fortran/trans-intrinsic.c
gcc/fortran/trans-types.c
gcc/fortran/trans.h
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/large_integer_kind_2.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/large_real_kind_2.F90 [new file with mode: 0644]
libgfortran/ChangeLog
libgfortran/Makefile.am
libgfortran/Makefile.in
libgfortran/generated/_abs_c10.F90 [new file with mode: 0644]
libgfortran/generated/_abs_c16.F90 [new file with mode: 0644]
libgfortran/generated/_abs_c4.F90 [moved from libgfortran/generated/_abs_c4.f90 with 92% similarity]
libgfortran/generated/_abs_c8.F90 [moved from libgfortran/generated/_abs_c8.f90 with 92% similarity]
libgfortran/generated/_abs_i16.F90 [new file with mode: 0644]
libgfortran/generated/_abs_i4.F90 [moved from libgfortran/generated/_abs_i4.f90 with 93% similarity]
libgfortran/generated/_abs_i8.F90 [moved from libgfortran/generated/_abs_i8.f90 with 93% similarity]
libgfortran/generated/_abs_r10.F90 [new file with mode: 0644]
libgfortran/generated/_abs_r16.F90 [new file with mode: 0644]
libgfortran/generated/_abs_r4.F90 [moved from libgfortran/generated/_abs_r4.f90 with 92% similarity]
libgfortran/generated/_abs_r8.F90 [moved from libgfortran/generated/_abs_r8.f90 with 92% similarity]
libgfortran/generated/_acos_r10.F90 [new file with mode: 0644]
libgfortran/generated/_acos_r16.F90 [new file with mode: 0644]
libgfortran/generated/_acos_r4.F90 [moved from libgfortran/generated/_acos_r4.f90 with 92% similarity]
libgfortran/generated/_acos_r8.F90 [moved from libgfortran/generated/_acos_r8.f90 with 92% similarity]
libgfortran/generated/_aint_r10.F90 [new file with mode: 0644]
libgfortran/generated/_aint_r16.F90 [new file with mode: 0644]
libgfortran/generated/_aint_r4.F90 [moved from libgfortran/generated/_aint_r4.f90 with 92% similarity]
libgfortran/generated/_aint_r8.F90 [moved from libgfortran/generated/_aint_r8.f90 with 92% similarity]
libgfortran/generated/_anint_r10.F90 [new file with mode: 0644]
libgfortran/generated/_anint_r16.F90 [new file with mode: 0644]
libgfortran/generated/_anint_r4.F90 [moved from libgfortran/generated/_anint_r4.f90 with 92% similarity]
libgfortran/generated/_anint_r8.F90 [moved from libgfortran/generated/_anint_r8.f90 with 92% similarity]
libgfortran/generated/_asin_r10.F90 [new file with mode: 0644]
libgfortran/generated/_asin_r16.F90 [new file with mode: 0644]
libgfortran/generated/_asin_r4.F90 [moved from libgfortran/generated/_asin_r4.f90 with 92% similarity]
libgfortran/generated/_asin_r8.F90 [moved from libgfortran/generated/_asin_r8.f90 with 92% similarity]
libgfortran/generated/_atan2_r10.F90 [new file with mode: 0644]
libgfortran/generated/_atan2_r16.F90 [new file with mode: 0644]
libgfortran/generated/_atan2_r4.F90 [moved from libgfortran/generated/_atan2_r4.f90 with 92% similarity]
libgfortran/generated/_atan2_r8.F90 [moved from libgfortran/generated/_atan2_r8.f90 with 92% similarity]
libgfortran/generated/_atan_r10.F90 [new file with mode: 0644]
libgfortran/generated/_atan_r16.F90 [new file with mode: 0644]
libgfortran/generated/_atan_r4.F90 [moved from libgfortran/generated/_atan_r4.f90 with 92% similarity]
libgfortran/generated/_atan_r8.F90 [moved from libgfortran/generated/_atan_r8.f90 with 92% similarity]
libgfortran/generated/_conjg_c10.F90 [new file with mode: 0644]
libgfortran/generated/_conjg_c16.F90 [new file with mode: 0644]
libgfortran/generated/_conjg_c4.F90 [moved from libgfortran/generated/_conjg_c4.f90 with 93% similarity]
libgfortran/generated/_conjg_c8.F90 [moved from libgfortran/generated/_conjg_c8.f90 with 93% similarity]
libgfortran/generated/_cos_c10.F90 [new file with mode: 0644]
libgfortran/generated/_cos_c16.F90 [new file with mode: 0644]
libgfortran/generated/_cos_c4.F90 [moved from libgfortran/generated/_cos_c4.f90 with 92% similarity]
libgfortran/generated/_cos_c8.F90 [moved from libgfortran/generated/_cos_c8.f90 with 92% similarity]
libgfortran/generated/_cos_r10.F90 [new file with mode: 0644]
libgfortran/generated/_cos_r16.F90 [new file with mode: 0644]
libgfortran/generated/_cos_r4.F90 [moved from libgfortran/generated/_cos_r4.f90 with 92% similarity]
libgfortran/generated/_cos_r8.F90 [moved from libgfortran/generated/_cos_r8.f90 with 92% similarity]
libgfortran/generated/_cosh_r10.F90 [new file with mode: 0644]
libgfortran/generated/_cosh_r16.F90 [new file with mode: 0644]
libgfortran/generated/_cosh_r4.F90 [moved from libgfortran/generated/_cosh_r4.f90 with 92% similarity]
libgfortran/generated/_cosh_r8.F90 [moved from libgfortran/generated/_cosh_r8.f90 with 92% similarity]
libgfortran/generated/_dim_i16.F90 [new file with mode: 0644]
libgfortran/generated/_dim_i4.F90 [moved from libgfortran/generated/_dim_i4.f90 with 93% similarity]
libgfortran/generated/_dim_i8.F90 [moved from libgfortran/generated/_dim_i8.f90 with 93% similarity]
libgfortran/generated/_dim_r10.F90 [new file with mode: 0644]
libgfortran/generated/_dim_r16.F90 [new file with mode: 0644]
libgfortran/generated/_dim_r4.F90 [moved from libgfortran/generated/_dim_r4.f90 with 93% similarity]
libgfortran/generated/_dim_r8.F90 [moved from libgfortran/generated/_dim_r8.f90 with 93% similarity]
libgfortran/generated/_exp_c10.F90 [new file with mode: 0644]
libgfortran/generated/_exp_c16.F90 [new file with mode: 0644]
libgfortran/generated/_exp_c4.F90 [moved from libgfortran/generated/_exp_c4.f90 with 92% similarity]
libgfortran/generated/_exp_c8.F90 [moved from libgfortran/generated/_exp_c8.f90 with 92% similarity]
libgfortran/generated/_exp_r10.F90 [new file with mode: 0644]
libgfortran/generated/_exp_r16.F90 [new file with mode: 0644]
libgfortran/generated/_exp_r4.F90 [moved from libgfortran/generated/_exp_r4.f90 with 92% similarity]
libgfortran/generated/_exp_r8.F90 [moved from libgfortran/generated/_exp_r8.f90 with 92% similarity]
libgfortran/generated/_log10_r10.F90 [new file with mode: 0644]
libgfortran/generated/_log10_r16.F90 [new file with mode: 0644]
libgfortran/generated/_log10_r4.F90 [moved from libgfortran/generated/_log10_r4.f90 with 92% similarity]
libgfortran/generated/_log10_r8.F90 [moved from libgfortran/generated/_log10_r8.f90 with 92% similarity]
libgfortran/generated/_log_c10.F90 [new file with mode: 0644]
libgfortran/generated/_log_c16.F90 [new file with mode: 0644]
libgfortran/generated/_log_c4.F90 [moved from libgfortran/generated/_log_c4.f90 with 92% similarity]
libgfortran/generated/_log_c8.F90 [moved from libgfortran/generated/_log_c8.f90 with 92% similarity]
libgfortran/generated/_log_r10.F90 [new file with mode: 0644]
libgfortran/generated/_log_r16.F90 [new file with mode: 0644]
libgfortran/generated/_log_r4.F90 [moved from libgfortran/generated/_log_r4.f90 with 92% similarity]
libgfortran/generated/_log_r8.F90 [moved from libgfortran/generated/_log_r8.f90 with 92% similarity]
libgfortran/generated/_mod_i16.F90 [new file with mode: 0644]
libgfortran/generated/_mod_i4.F90 [moved from libgfortran/generated/_mod_i4.f90 with 93% similarity]
libgfortran/generated/_mod_i8.F90 [moved from libgfortran/generated/_mod_i8.f90 with 93% similarity]
libgfortran/generated/_mod_r4.F90 [moved from libgfortran/generated/_mod_r4.f90 with 93% similarity]
libgfortran/generated/_mod_r8.F90 [moved from libgfortran/generated/_mod_r8.f90 with 93% similarity]
libgfortran/generated/_sign_i16.F90 [new file with mode: 0644]
libgfortran/generated/_sign_i4.F90 [moved from libgfortran/generated/_sign_i4.f90 with 93% similarity]
libgfortran/generated/_sign_i8.F90 [moved from libgfortran/generated/_sign_i8.f90 with 93% similarity]
libgfortran/generated/_sign_r10.F90 [new file with mode: 0644]
libgfortran/generated/_sign_r16.F90 [new file with mode: 0644]
libgfortran/generated/_sign_r4.F90 [moved from libgfortran/generated/_sign_r4.f90 with 93% similarity]
libgfortran/generated/_sign_r8.F90 [moved from libgfortran/generated/_sign_r8.f90 with 93% similarity]
libgfortran/generated/_sin_c10.F90 [new file with mode: 0644]
libgfortran/generated/_sin_c16.F90 [new file with mode: 0644]
libgfortran/generated/_sin_c4.F90 [moved from libgfortran/generated/_sin_c4.f90 with 92% similarity]
libgfortran/generated/_sin_c8.F90 [moved from libgfortran/generated/_sin_c8.f90 with 92% similarity]
libgfortran/generated/_sin_r10.F90 [new file with mode: 0644]
libgfortran/generated/_sin_r16.F90 [new file with mode: 0644]
libgfortran/generated/_sin_r4.F90 [moved from libgfortran/generated/_sin_r4.f90 with 92% similarity]
libgfortran/generated/_sin_r8.F90 [moved from libgfortran/generated/_sin_r8.f90 with 92% similarity]
libgfortran/generated/_sinh_r10.F90 [new file with mode: 0644]
libgfortran/generated/_sinh_r16.F90 [new file with mode: 0644]
libgfortran/generated/_sinh_r4.F90 [moved from libgfortran/generated/_sinh_r4.f90 with 92% similarity]
libgfortran/generated/_sinh_r8.F90 [moved from libgfortran/generated/_sinh_r8.f90 with 92% similarity]
libgfortran/generated/_sqrt_c10.F90 [new file with mode: 0644]
libgfortran/generated/_sqrt_c16.F90 [new file with mode: 0644]
libgfortran/generated/_sqrt_c4.F90 [moved from libgfortran/generated/_sqrt_c4.f90 with 92% similarity]
libgfortran/generated/_sqrt_c8.F90 [moved from libgfortran/generated/_sqrt_c8.f90 with 92% similarity]
libgfortran/generated/_sqrt_r10.F90 [new file with mode: 0644]
libgfortran/generated/_sqrt_r16.F90 [new file with mode: 0644]
libgfortran/generated/_sqrt_r4.F90 [moved from libgfortran/generated/_sqrt_r4.f90 with 92% similarity]
libgfortran/generated/_sqrt_r8.F90 [moved from libgfortran/generated/_sqrt_r8.f90 with 92% similarity]
libgfortran/generated/_tan_r10.F90 [new file with mode: 0644]
libgfortran/generated/_tan_r16.F90 [new file with mode: 0644]
libgfortran/generated/_tan_r4.F90 [moved from libgfortran/generated/_tan_r4.f90 with 92% similarity]
libgfortran/generated/_tan_r8.F90 [moved from libgfortran/generated/_tan_r8.f90 with 92% similarity]
libgfortran/generated/_tanh_r10.F90 [new file with mode: 0644]
libgfortran/generated/_tanh_r16.F90 [new file with mode: 0644]
libgfortran/generated/_tanh_r4.F90 [moved from libgfortran/generated/_tanh_r4.f90 with 92% similarity]
libgfortran/generated/_tanh_r8.F90 [moved from libgfortran/generated/_tanh_r8.f90 with 92% similarity]
libgfortran/generated/all_l16.c [new file with mode: 0644]
libgfortran/generated/all_l4.c
libgfortran/generated/all_l8.c
libgfortran/generated/any_l16.c [new file with mode: 0644]
libgfortran/generated/any_l4.c
libgfortran/generated/any_l8.c
libgfortran/generated/count_16_l16.c [new file with mode: 0644]
libgfortran/generated/count_16_l4.c [new file with mode: 0644]
libgfortran/generated/count_16_l8.c [new file with mode: 0644]
libgfortran/generated/count_4_l16.c [new file with mode: 0644]
libgfortran/generated/count_4_l4.c
libgfortran/generated/count_4_l8.c
libgfortran/generated/count_8_l16.c [new file with mode: 0644]
libgfortran/generated/count_8_l4.c
libgfortran/generated/count_8_l8.c
libgfortran/generated/cshift1_16.c [new file with mode: 0644]
libgfortran/generated/cshift1_4.c
libgfortran/generated/cshift1_8.c
libgfortran/generated/dotprod_c10.c [new file with mode: 0644]
libgfortran/generated/dotprod_c16.c [new file with mode: 0644]
libgfortran/generated/dotprod_c4.c
libgfortran/generated/dotprod_c8.c
libgfortran/generated/dotprod_i16.c [new file with mode: 0644]
libgfortran/generated/dotprod_i4.c
libgfortran/generated/dotprod_i8.c
libgfortran/generated/dotprod_l16.c [new file with mode: 0644]
libgfortran/generated/dotprod_l4.c
libgfortran/generated/dotprod_l8.c
libgfortran/generated/dotprod_r10.c [new file with mode: 0644]
libgfortran/generated/dotprod_r16.c [new file with mode: 0644]
libgfortran/generated/dotprod_r4.c
libgfortran/generated/dotprod_r8.c
libgfortran/generated/eoshift1_16.c [new file with mode: 0644]
libgfortran/generated/eoshift1_4.c
libgfortran/generated/eoshift1_8.c
libgfortran/generated/eoshift3_16.c [new file with mode: 0644]
libgfortran/generated/eoshift3_4.c
libgfortran/generated/eoshift3_8.c
libgfortran/generated/exponent_r10.c [new file with mode: 0644]
libgfortran/generated/exponent_r16.c [new file with mode: 0644]
libgfortran/generated/exponent_r4.c
libgfortran/generated/exponent_r8.c
libgfortran/generated/fraction_r10.c [new file with mode: 0644]
libgfortran/generated/fraction_r16.c [new file with mode: 0644]
libgfortran/generated/fraction_r4.c
libgfortran/generated/fraction_r8.c
libgfortran/generated/in_pack_c10.c [new file with mode: 0644]
libgfortran/generated/in_pack_c16.c [new file with mode: 0644]
libgfortran/generated/in_pack_c4.c
libgfortran/generated/in_pack_c8.c
libgfortran/generated/in_pack_i16.c [new file with mode: 0644]
libgfortran/generated/in_pack_i4.c
libgfortran/generated/in_pack_i8.c
libgfortran/generated/in_unpack_c10.c [new file with mode: 0644]
libgfortran/generated/in_unpack_c16.c [new file with mode: 0644]
libgfortran/generated/in_unpack_c4.c
libgfortran/generated/in_unpack_c8.c
libgfortran/generated/in_unpack_i16.c [new file with mode: 0644]
libgfortran/generated/in_unpack_i4.c
libgfortran/generated/in_unpack_i8.c
libgfortran/generated/matmul_c10.c [new file with mode: 0644]
libgfortran/generated/matmul_c16.c [new file with mode: 0644]
libgfortran/generated/matmul_c4.c
libgfortran/generated/matmul_c8.c
libgfortran/generated/matmul_i16.c [new file with mode: 0644]
libgfortran/generated/matmul_i4.c
libgfortran/generated/matmul_i8.c
libgfortran/generated/matmul_l16.c [new file with mode: 0644]
libgfortran/generated/matmul_l4.c
libgfortran/generated/matmul_l8.c
libgfortran/generated/matmul_r10.c [new file with mode: 0644]
libgfortran/generated/matmul_r16.c [new file with mode: 0644]
libgfortran/generated/matmul_r4.c
libgfortran/generated/matmul_r8.c
libgfortran/generated/maxloc0_16_i16.c [new file with mode: 0644]
libgfortran/generated/maxloc0_16_i4.c [new file with mode: 0644]
libgfortran/generated/maxloc0_16_i8.c [new file with mode: 0644]
libgfortran/generated/maxloc0_16_r10.c [new file with mode: 0644]
libgfortran/generated/maxloc0_16_r16.c [new file with mode: 0644]
libgfortran/generated/maxloc0_16_r4.c [new file with mode: 0644]
libgfortran/generated/maxloc0_16_r8.c [new file with mode: 0644]
libgfortran/generated/maxloc0_4_i16.c [new file with mode: 0644]
libgfortran/generated/maxloc0_4_i4.c
libgfortran/generated/maxloc0_4_i8.c
libgfortran/generated/maxloc0_4_r10.c [new file with mode: 0644]
libgfortran/generated/maxloc0_4_r16.c [new file with mode: 0644]
libgfortran/generated/maxloc0_4_r4.c
libgfortran/generated/maxloc0_4_r8.c
libgfortran/generated/maxloc0_8_i16.c [new file with mode: 0644]
libgfortran/generated/maxloc0_8_i4.c
libgfortran/generated/maxloc0_8_i8.c
libgfortran/generated/maxloc0_8_r10.c [new file with mode: 0644]
libgfortran/generated/maxloc0_8_r16.c [new file with mode: 0644]
libgfortran/generated/maxloc0_8_r4.c
libgfortran/generated/maxloc0_8_r8.c
libgfortran/generated/maxloc1_16_i16.c [new file with mode: 0644]
libgfortran/generated/maxloc1_16_i4.c [new file with mode: 0644]
libgfortran/generated/maxloc1_16_i8.c [new file with mode: 0644]
libgfortran/generated/maxloc1_16_r10.c [new file with mode: 0644]
libgfortran/generated/maxloc1_16_r16.c [new file with mode: 0644]
libgfortran/generated/maxloc1_16_r4.c [new file with mode: 0644]
libgfortran/generated/maxloc1_16_r8.c [new file with mode: 0644]
libgfortran/generated/maxloc1_4_i16.c [new file with mode: 0644]
libgfortran/generated/maxloc1_4_i4.c
libgfortran/generated/maxloc1_4_i8.c
libgfortran/generated/maxloc1_4_r10.c [new file with mode: 0644]
libgfortran/generated/maxloc1_4_r16.c [new file with mode: 0644]
libgfortran/generated/maxloc1_4_r4.c
libgfortran/generated/maxloc1_4_r8.c
libgfortran/generated/maxloc1_8_i16.c [new file with mode: 0644]
libgfortran/generated/maxloc1_8_i4.c
libgfortran/generated/maxloc1_8_i8.c
libgfortran/generated/maxloc1_8_r10.c [new file with mode: 0644]
libgfortran/generated/maxloc1_8_r16.c [new file with mode: 0644]
libgfortran/generated/maxloc1_8_r4.c
libgfortran/generated/maxloc1_8_r8.c
libgfortran/generated/maxval_i16.c [new file with mode: 0644]
libgfortran/generated/maxval_i4.c
libgfortran/generated/maxval_i8.c
libgfortran/generated/maxval_r10.c [new file with mode: 0644]
libgfortran/generated/maxval_r16.c [new file with mode: 0644]
libgfortran/generated/maxval_r4.c
libgfortran/generated/maxval_r8.c
libgfortran/generated/minloc0_16_i16.c [new file with mode: 0644]
libgfortran/generated/minloc0_16_i4.c [new file with mode: 0644]
libgfortran/generated/minloc0_16_i8.c [new file with mode: 0644]
libgfortran/generated/minloc0_16_r10.c [new file with mode: 0644]
libgfortran/generated/minloc0_16_r16.c [new file with mode: 0644]
libgfortran/generated/minloc0_16_r4.c [new file with mode: 0644]
libgfortran/generated/minloc0_16_r8.c [new file with mode: 0644]
libgfortran/generated/minloc0_4_i16.c [new file with mode: 0644]
libgfortran/generated/minloc0_4_i4.c
libgfortran/generated/minloc0_4_i8.c
libgfortran/generated/minloc0_4_r10.c [new file with mode: 0644]
libgfortran/generated/minloc0_4_r16.c [new file with mode: 0644]
libgfortran/generated/minloc0_4_r4.c
libgfortran/generated/minloc0_4_r8.c
libgfortran/generated/minloc0_8_i16.c [new file with mode: 0644]
libgfortran/generated/minloc0_8_i4.c
libgfortran/generated/minloc0_8_i8.c
libgfortran/generated/minloc0_8_r10.c [new file with mode: 0644]
libgfortran/generated/minloc0_8_r16.c [new file with mode: 0644]
libgfortran/generated/minloc0_8_r4.c
libgfortran/generated/minloc0_8_r8.c
libgfortran/generated/minloc1_16_i16.c [new file with mode: 0644]
libgfortran/generated/minloc1_16_i4.c [new file with mode: 0644]
libgfortran/generated/minloc1_16_i8.c [new file with mode: 0644]
libgfortran/generated/minloc1_16_r10.c [new file with mode: 0644]
libgfortran/generated/minloc1_16_r16.c [new file with mode: 0644]
libgfortran/generated/minloc1_16_r4.c [new file with mode: 0644]
libgfortran/generated/minloc1_16_r8.c [new file with mode: 0644]
libgfortran/generated/minloc1_4_i16.c [new file with mode: 0644]
libgfortran/generated/minloc1_4_i4.c
libgfortran/generated/minloc1_4_i8.c
libgfortran/generated/minloc1_4_r10.c [new file with mode: 0644]
libgfortran/generated/minloc1_4_r16.c [new file with mode: 0644]
libgfortran/generated/minloc1_4_r4.c
libgfortran/generated/minloc1_4_r8.c
libgfortran/generated/minloc1_8_i16.c [new file with mode: 0644]
libgfortran/generated/minloc1_8_i4.c
libgfortran/generated/minloc1_8_i8.c
libgfortran/generated/minloc1_8_r10.c [new file with mode: 0644]
libgfortran/generated/minloc1_8_r16.c [new file with mode: 0644]
libgfortran/generated/minloc1_8_r4.c
libgfortran/generated/minloc1_8_r8.c
libgfortran/generated/minval_i16.c [new file with mode: 0644]
libgfortran/generated/minval_i4.c
libgfortran/generated/minval_i8.c
libgfortran/generated/minval_r10.c [new file with mode: 0644]
libgfortran/generated/minval_r16.c [new file with mode: 0644]
libgfortran/generated/minval_r4.c
libgfortran/generated/minval_r8.c
libgfortran/generated/nearest_r10.c [new file with mode: 0644]
libgfortran/generated/nearest_r16.c [new file with mode: 0644]
libgfortran/generated/nearest_r4.c
libgfortran/generated/nearest_r8.c
libgfortran/generated/pow_c10_i16.c [new file with mode: 0644]
libgfortran/generated/pow_c10_i4.c [new file with mode: 0644]
libgfortran/generated/pow_c10_i8.c [new file with mode: 0644]
libgfortran/generated/pow_c16_i16.c [new file with mode: 0644]
libgfortran/generated/pow_c16_i4.c [new file with mode: 0644]
libgfortran/generated/pow_c16_i8.c [new file with mode: 0644]
libgfortran/generated/pow_c4_i16.c [new file with mode: 0644]
libgfortran/generated/pow_c4_i4.c
libgfortran/generated/pow_c4_i8.c
libgfortran/generated/pow_c8_i16.c [new file with mode: 0644]
libgfortran/generated/pow_c8_i4.c
libgfortran/generated/pow_c8_i8.c
libgfortran/generated/pow_i16_i16.c [new file with mode: 0644]
libgfortran/generated/pow_i16_i4.c [new file with mode: 0644]
libgfortran/generated/pow_i16_i8.c [new file with mode: 0644]
libgfortran/generated/pow_i4_i16.c [new file with mode: 0644]
libgfortran/generated/pow_i4_i4.c
libgfortran/generated/pow_i4_i8.c
libgfortran/generated/pow_i8_i16.c [new file with mode: 0644]
libgfortran/generated/pow_i8_i4.c
libgfortran/generated/pow_i8_i8.c
libgfortran/generated/pow_r10_i16.c [new file with mode: 0644]
libgfortran/generated/pow_r10_i4.c [new file with mode: 0644]
libgfortran/generated/pow_r10_i8.c [new file with mode: 0644]
libgfortran/generated/pow_r16_i16.c [new file with mode: 0644]
libgfortran/generated/pow_r16_i4.c [new file with mode: 0644]
libgfortran/generated/pow_r16_i8.c [new file with mode: 0644]
libgfortran/generated/pow_r4_i16.c [new file with mode: 0644]
libgfortran/generated/pow_r4_i4.c
libgfortran/generated/pow_r4_i8.c
libgfortran/generated/pow_r8_i16.c [new file with mode: 0644]
libgfortran/generated/pow_r8_i4.c
libgfortran/generated/pow_r8_i8.c
libgfortran/generated/product_c10.c [new file with mode: 0644]
libgfortran/generated/product_c16.c [new file with mode: 0644]
libgfortran/generated/product_c4.c
libgfortran/generated/product_c8.c
libgfortran/generated/product_i16.c [new file with mode: 0644]
libgfortran/generated/product_i4.c
libgfortran/generated/product_i8.c
libgfortran/generated/product_r10.c [new file with mode: 0644]
libgfortran/generated/product_r16.c [new file with mode: 0644]
libgfortran/generated/product_r4.c
libgfortran/generated/product_r8.c
libgfortran/generated/reshape_c10.c [new file with mode: 0644]
libgfortran/generated/reshape_c16.c [new file with mode: 0644]
libgfortran/generated/reshape_c4.c
libgfortran/generated/reshape_c8.c
libgfortran/generated/reshape_i16.c [new file with mode: 0644]
libgfortran/generated/reshape_i4.c
libgfortran/generated/reshape_i8.c
libgfortran/generated/set_exponent_r10.c [new file with mode: 0644]
libgfortran/generated/set_exponent_r16.c [new file with mode: 0644]
libgfortran/generated/set_exponent_r4.c
libgfortran/generated/set_exponent_r8.c
libgfortran/generated/shape_i16.c [new file with mode: 0644]
libgfortran/generated/shape_i4.c
libgfortran/generated/shape_i8.c
libgfortran/generated/sum_c10.c [new file with mode: 0644]
libgfortran/generated/sum_c16.c [new file with mode: 0644]
libgfortran/generated/sum_c4.c
libgfortran/generated/sum_c8.c
libgfortran/generated/sum_i16.c [new file with mode: 0644]
libgfortran/generated/sum_i4.c
libgfortran/generated/sum_i8.c
libgfortran/generated/sum_r10.c [new file with mode: 0644]
libgfortran/generated/sum_r16.c [new file with mode: 0644]
libgfortran/generated/sum_r4.c
libgfortran/generated/sum_r8.c
libgfortran/generated/transpose_c10.c [new file with mode: 0644]
libgfortran/generated/transpose_c16.c [new file with mode: 0644]
libgfortran/generated/transpose_c4.c
libgfortran/generated/transpose_c8.c
libgfortran/generated/transpose_i16.c [new file with mode: 0644]
libgfortran/generated/transpose_i4.c
libgfortran/generated/transpose_i8.c
libgfortran/intrinsics/ishftc.c
libgfortran/libgfortran.h
libgfortran/m4/all.m4
libgfortran/m4/any.m4
libgfortran/m4/count.m4
libgfortran/m4/cshift1.m4
libgfortran/m4/dotprod.m4
libgfortran/m4/dotprodc.m4
libgfortran/m4/dotprodl.m4
libgfortran/m4/eoshift1.m4
libgfortran/m4/eoshift3.m4
libgfortran/m4/exponent.m4
libgfortran/m4/fraction.m4
libgfortran/m4/in_pack.m4
libgfortran/m4/in_unpack.m4
libgfortran/m4/matmul.m4
libgfortran/m4/matmull.m4
libgfortran/m4/maxloc0.m4
libgfortran/m4/maxloc1.m4
libgfortran/m4/maxval.m4
libgfortran/m4/minloc0.m4
libgfortran/m4/minloc1.m4
libgfortran/m4/minval.m4
libgfortran/m4/mtype.m4
libgfortran/m4/nearest.m4
libgfortran/m4/pow.m4
libgfortran/m4/product.m4
libgfortran/m4/reshape.m4
libgfortran/m4/set_exponent.m4
libgfortran/m4/shape.m4
libgfortran/m4/specific.m4
libgfortran/m4/specific2.m4
libgfortran/m4/sum.m4
libgfortran/m4/transpose.m4
libgfortran/mk-kinds-h.sh

index 145d10b..0a8c443 100644 (file)
@@ -1,3 +1,40 @@
+2005-10-03  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+       PR fortran/20120
+       * f95-lang.c (DO_DEFINE_MATH_BUILTIN): Add support for long
+       double builtin function.
+       (gfc_init_builtin_functions): Add mfunc_longdouble,
+       mfunc_clongdouble and func_clongdouble_longdouble trees. Build
+       them for round, trunc, cabs, copysign and pow functions.
+       * iresolve.c (gfc_resolve_reshape, gfc_resolve_transpose): Add
+       case for kind 10 and 16.
+       * trans-decl.c: Add trees for cpowl10, cpowl16, ishftc16,
+       exponent10 and exponent16.
+       (gfc_build_intrinsic_function_decls): Build nodes for int16,
+       real10, real16, complex10 and complex16 types. Build all possible
+       combinations for function _gfortran_pow_?n_?n. Build function
+       calls cpowl10, cpowl16, ishftc16, exponent10 and exponent16.
+       * trans-expr.c (gfc_conv_power_op): Add case for integer(16),
+       real(10) and real(16).
+       * trans-intrinsic.c: Add suppport for long double builtin
+       functions in BUILT_IN_FUNCTION, LIBM_FUNCTION and LIBF_FUNCTION
+       macros.
+       (gfc_conv_intrinsic_aint): Add case for integer(16), real(10) and
+       real(16) kinds.
+       (gfc_build_intrinsic_lib_fndecls): Add support for real10_decl
+       and real16_decl in library functions.
+       (gfc_get_intrinsic_lib_fndecl): Add cases for real and complex
+       kinds 10 and 16.
+       (gfc_conv_intrinsic_exponent): Add cases for real(10) and real(16)
+       kinds.
+       (gfc_conv_intrinsic_sign): Likewise.
+       (gfc_conv_intrinsic_ishftc): Add case for integer(16) kind.
+       * trans-types.c (gfc_get_int_type, gfc_get_real_type,
+       gfc_get_complex_type, gfc_get_logical_type): Doesn't error out in
+       the case of kinds not available.
+       * trans.h: Declare trees for cpowl10, cpowl16, ishftc16,
+       exponent10 and exponent16.
+
 2005-10-01  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/16404
index 6e607e9..b28980b 100644 (file)
@@ -718,6 +718,8 @@ gfc_define_builtin (const char * name,
 
 
 #define DO_DEFINE_MATH_BUILTIN(code, name, argtype, tbase) \
+    gfc_define_builtin ("__builtin_" name "l", tbase##longdouble[argtype], \
+                       BUILT_IN_ ## code ## L, name "l", true); \
     gfc_define_builtin ("__builtin_" name, tbase##double[argtype], \
                        BUILT_IN_ ## code, name, true); \
     gfc_define_builtin ("__builtin_" name "f", tbase##float[argtype], \
@@ -726,11 +728,9 @@ gfc_define_builtin (const char * name,
 #define DEFINE_MATH_BUILTIN(code, name, argtype) \
     DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
 
-/* The middle-end is missing builtins for some complex math functions, so
-   we don't use them yet.  */
 #define DEFINE_MATH_BUILTIN_C(code, name, argtype) \
-    DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
-/*    DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c)*/
+    DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_) \
+    DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c)
 
 
 /* Create function types for builtin functions.  */
@@ -760,17 +760,22 @@ gfc_init_builtin_functions (void)
 {
   tree mfunc_float[3];
   tree mfunc_double[3];
+  tree mfunc_longdouble[3];
   tree mfunc_cfloat[3];
   tree mfunc_cdouble[3];
+  tree mfunc_clongdouble[3];
   tree func_cfloat_float;
   tree func_cdouble_double;
+  tree func_clongdouble_longdouble;
   tree ftype;
   tree tmp;
 
   build_builtin_fntypes (mfunc_float, float_type_node);
   build_builtin_fntypes (mfunc_double, double_type_node);
+  build_builtin_fntypes (mfunc_longdouble, long_double_type_node);
   build_builtin_fntypes (mfunc_cfloat, complex_float_type_node);
   build_builtin_fntypes (mfunc_cdouble, complex_double_type_node);
+  build_builtin_fntypes (mfunc_clongdouble, complex_long_double_type_node);
 
   tmp = tree_cons (NULL_TREE, complex_float_type_node, void_list_node);
   func_cfloat_float = build_function_type (float_type_node, tmp);
@@ -778,30 +783,45 @@ gfc_init_builtin_functions (void)
   tmp = tree_cons (NULL_TREE, complex_double_type_node, void_list_node);
   func_cdouble_double = build_function_type (double_type_node, tmp);
 
+  tmp = tree_cons (NULL_TREE, complex_long_double_type_node, void_list_node);
+  func_clongdouble_longdouble =
+    build_function_type (long_double_type_node, tmp);
+
 #include "mathbuiltins.def"
 
   /* We define these separately as the fortran versions have different
      semantics (they return an integer type) */
+  gfc_define_builtin ("__builtin_roundl", mfunc_longdouble[0], 
+                     BUILT_IN_ROUNDL, "roundl", true);
   gfc_define_builtin ("__builtin_round", mfunc_double[0], 
                      BUILT_IN_ROUND, "round", true);
   gfc_define_builtin ("__builtin_roundf", mfunc_float[0], 
                      BUILT_IN_ROUNDF, "roundf", true);
+
+  gfc_define_builtin ("__builtin_truncl", mfunc_longdouble[0],
+                     BUILT_IN_TRUNCL, "truncl", true);
   gfc_define_builtin ("__builtin_trunc", mfunc_double[0],
                       BUILT_IN_TRUNC, "trunc", true);
   gfc_define_builtin ("__builtin_truncf", mfunc_float[0],
                       BUILT_IN_TRUNCF, "truncf", true);
 
+  gfc_define_builtin ("__builtin_cabsl", func_clongdouble_longdouble, 
+                     BUILT_IN_CABSL, "cabsl", true);
   gfc_define_builtin ("__builtin_cabs", func_cdouble_double, 
                      BUILT_IN_CABS, "cabs", true);
   gfc_define_builtin ("__builtin_cabsf", func_cfloat_float, 
                      BUILT_IN_CABSF, "cabsf", true);
  
+  gfc_define_builtin ("__builtin_copysignl", mfunc_longdouble[1], 
+                     BUILT_IN_COPYSIGNL, "copysignl", true);
   gfc_define_builtin ("__builtin_copysign", mfunc_double[1], 
                      BUILT_IN_COPYSIGN, "copysign", true);
   gfc_define_builtin ("__builtin_copysignf", mfunc_float[1], 
                      BUILT_IN_COPYSIGNF, "copysignf", true);
 
   /* These are used to implement the ** operator.  */
+  gfc_define_builtin ("__builtin_powl", mfunc_longdouble[1], 
+                     BUILT_IN_POWL, "powl", true);
   gfc_define_builtin ("__builtin_pow", mfunc_double[1], 
                      BUILT_IN_POW, "pow", true);
   gfc_define_builtin ("__builtin_powf", mfunc_float[1], 
index dda6acb..195f05e 100644 (file)
@@ -1217,7 +1217,8 @@ gfc_resolve_reshape (gfc_expr * f, gfc_expr * source, gfc_expr * shape,
     {
     case 4:
     case 8:
-    /* case 16: */
+    case 10:
+    case 16:
       if (source->ts.type == BT_COMPLEX)
        f->value.function.name =
          gfc_get_string (PREFIX("reshape_%c%d"),
@@ -1538,6 +1539,8 @@ gfc_resolve_transpose (gfc_expr * f, gfc_expr * matrix)
     {
     case 4:
     case 8:
+    case 10:
+    case 16:
       switch (matrix->ts.type)
         {
         case BT_COMPLEX:
index 73e02f0..3f656dd 100644 (file)
@@ -94,13 +94,18 @@ tree gfor_fndecl_associated;
 /* Math functions.  Many other math functions are handled in
    trans-intrinsic.c.  */
 
-gfc_powdecl_list gfor_fndecl_math_powi[3][2];
+gfc_powdecl_list gfor_fndecl_math_powi[4][3];
 tree gfor_fndecl_math_cpowf;
 tree gfor_fndecl_math_cpow;
+tree gfor_fndecl_math_cpowl10;
+tree gfor_fndecl_math_cpowl16;
 tree gfor_fndecl_math_ishftc4;
 tree gfor_fndecl_math_ishftc8;
+tree gfor_fndecl_math_ishftc16;
 tree gfor_fndecl_math_exponent4;
 tree gfor_fndecl_math_exponent8;
+tree gfor_fndecl_math_exponent10;
+tree gfor_fndecl_math_exponent16;
 
 
 /* String functions.  */
@@ -1691,11 +1696,16 @@ gfc_build_intrinsic_function_decls (void)
 {
   tree gfc_int4_type_node = gfc_get_int_type (4);
   tree gfc_int8_type_node = gfc_get_int_type (8);
+  tree gfc_int16_type_node = gfc_get_int_type (16);
   tree gfc_logical4_type_node = gfc_get_logical_type (4);
   tree gfc_real4_type_node = gfc_get_real_type (4);
   tree gfc_real8_type_node = gfc_get_real_type (8);
+  tree gfc_real10_type_node = gfc_get_real_type (10);
+  tree gfc_real16_type_node = gfc_get_real_type (16);
   tree gfc_complex4_type_node = gfc_get_complex_type (4);
   tree gfc_complex8_type_node = gfc_get_complex_type (8);
+  tree gfc_complex10_type_node = gfc_get_complex_type (10);
+  tree gfc_complex16_type_node = gfc_get_complex_type (16);
 
   /* String functions.  */
   gfor_fndecl_copy_string =
@@ -1793,37 +1803,56 @@ gfc_build_intrinsic_function_decls (void)
 
   /* Power functions.  */
   {
-    tree type;
-    tree itype;
-    int kind;
-    int ikind;
-    static int kinds[2] = {4, 8};
-    char name[PREFIX_LEN + 10]; /* _gfortran_pow_?n_?n */
-
-    for (ikind=0; ikind < 2; ikind++)
+    tree ctype, rtype, itype, jtype;
+    int rkind, ikind, jkind;
+#define NIKINDS 3
+#define NRKINDS 4
+    static int ikinds[NIKINDS] = {4, 8, 16};
+    static int rkinds[NRKINDS] = {4, 8, 10, 16};
+    char name[PREFIX_LEN + 12]; /* _gfortran_pow_?n_?n */
+
+    for (ikind=0; ikind < NIKINDS; ikind++)
       {
-       itype = gfc_get_int_type (kinds[ikind]);
-       for (kind = 0; kind < 2; kind ++)
+       itype = gfc_get_int_type (ikinds[ikind]);
+
+       for (jkind=0; jkind < NIKINDS; jkind++)
+         {
+           jtype = gfc_get_int_type (ikinds[jkind]);
+           if (itype && jtype)
+             {
+               sprintf(name, PREFIX("pow_i%d_i%d"), ikinds[ikind],
+                       ikinds[jkind]);
+               gfor_fndecl_math_powi[jkind][ikind].integer =
+                 gfc_build_library_function_decl (get_identifier (name),
+                   jtype, 2, jtype, itype);
+             }
+         }
+
+       for (rkind = 0; rkind < NRKINDS; rkind ++)
          {
-           type = gfc_get_int_type (kinds[kind]);
-           sprintf(name, PREFIX("pow_i%d_i%d"), kinds[kind], kinds[ikind]);
-           gfor_fndecl_math_powi[kind][ikind].integer =
-             gfc_build_library_function_decl (get_identifier (name),
-                 type, 2, type, itype);
-
-           type = gfc_get_real_type (kinds[kind]);
-           sprintf(name, PREFIX("pow_r%d_i%d"), kinds[kind], kinds[ikind]);
-           gfor_fndecl_math_powi[kind][ikind].real =
-             gfc_build_library_function_decl (get_identifier (name),
-                 type, 2, type, itype);
-
-           type = gfc_get_complex_type (kinds[kind]);
-           sprintf(name, PREFIX("pow_c%d_i%d"), kinds[kind], kinds[ikind]);
-           gfor_fndecl_math_powi[kind][ikind].cmplx =
-             gfc_build_library_function_decl (get_identifier (name),
-                 type, 2, type, itype);
+           rtype = gfc_get_real_type (rkinds[rkind]);
+           if (rtype && itype)
+             {
+               sprintf(name, PREFIX("pow_r%d_i%d"), rkinds[rkind],
+                       ikinds[ikind]);
+               gfor_fndecl_math_powi[rkind][ikind].real =
+                 gfc_build_library_function_decl (get_identifier (name),
+                   rtype, 2, rtype, itype);
+             }
+
+           ctype = gfc_get_complex_type (rkinds[rkind]);
+           if (ctype && itype)
+             {
+               sprintf(name, PREFIX("pow_c%d_i%d"), rkinds[rkind],
+                       ikinds[ikind]);
+               gfor_fndecl_math_powi[rkind][ikind].cmplx =
+                 gfc_build_library_function_decl (get_identifier (name),
+                   ctype, 2,ctype, itype);
+             }
          }
       }
+#undef NIKINDS
+#undef NRKINDS
   }
 
   gfor_fndecl_math_cpowf =
@@ -1834,6 +1863,17 @@ gfc_build_intrinsic_function_decls (void)
     gfc_build_library_function_decl (get_identifier ("cpow"),
                                     gfc_complex8_type_node,
                                     1, gfc_complex8_type_node);
+  if (gfc_complex10_type_node)
+    gfor_fndecl_math_cpowl10 =
+      gfc_build_library_function_decl (get_identifier ("cpowl"),
+                                      gfc_complex10_type_node, 1,
+                                      gfc_complex10_type_node);
+  if (gfc_complex16_type_node)
+    gfor_fndecl_math_cpowl16 =
+      gfc_build_library_function_decl (get_identifier ("cpowl"),
+                                      gfc_complex16_type_node, 1,
+                                      gfc_complex16_type_node);
+
   gfor_fndecl_math_ishftc4 =
     gfc_build_library_function_decl (get_identifier (PREFIX("ishftc4")),
                                     gfc_int4_type_node,
@@ -1843,7 +1883,15 @@ gfc_build_intrinsic_function_decls (void)
     gfc_build_library_function_decl (get_identifier (PREFIX("ishftc8")),
                                     gfc_int8_type_node,
                                     3, gfc_int8_type_node,
-                                    gfc_int8_type_node, gfc_int8_type_node);
+                                    gfc_int4_type_node, gfc_int4_type_node);
+  if (gfc_int16_type_node)
+    gfor_fndecl_math_ishftc16 =
+      gfc_build_library_function_decl (get_identifier (PREFIX("ishftc16")),
+                                      gfc_int16_type_node, 3,
+                                      gfc_int16_type_node,
+                                      gfc_int4_type_node,
+                                      gfc_int4_type_node);
+
   gfor_fndecl_math_exponent4 =
     gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r4")),
                                     gfc_int4_type_node,
@@ -1852,6 +1900,16 @@ gfc_build_intrinsic_function_decls (void)
     gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r8")),
                                     gfc_int4_type_node,
                                     1, gfc_real8_type_node);
+  if (gfc_real10_type_node)
+    gfor_fndecl_math_exponent10 =
+      gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r10")),
+                                      gfc_int4_type_node, 1,
+                                      gfc_real10_type_node);
+  if (gfc_real16_type_node)
+    gfor_fndecl_math_exponent16 =
+      gfc_build_library_function_decl (get_identifier (PREFIX("exponent_r16")),
+                                      gfc_int4_type_node, 1,
+                                      gfc_real16_type_node);
 
   /* Other functions.  */
   gfor_fndecl_size0 =
index 913f7e6..7c6b409 100644 (file)
@@ -691,6 +691,10 @@ gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
          ikind = 1;
          break;
 
+       case 16:
+         ikind = 2;
+         break;
+
        default:
          gcc_unreachable ();
        }
@@ -712,6 +716,14 @@ gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
          kind = 1;
          break;
 
+       case 10:
+         kind = 2;
+         break;
+
+       case 16:
+         kind = 3;
+         break;
+
        default:
          gcc_unreachable ();
        }
@@ -719,6 +731,8 @@ gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
       switch (expr->value.op.op1->ts.type)
        {
        case BT_INTEGER:
+         if (kind == 3) /* Case 16 was not handled properly above.  */
+           kind = 2;
          fndecl = gfor_fndecl_math_powi[kind][ikind].integer;
          break;
 
@@ -744,6 +758,10 @@ gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
        case 8:
          fndecl = built_in_decls[BUILT_IN_POW];
          break;
+       case 10:
+       case 16:
+         fndecl = built_in_decls[BUILT_IN_POWL];
+         break;
        default:
          gcc_unreachable ();
        }
@@ -758,6 +776,12 @@ gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
        case 8:
          fndecl = gfor_fndecl_math_cpow;
          break;
+       case 10:
+         fndecl = gfor_fndecl_math_cpowl10;
+         break;
+       case 16:
+         fndecl = gfor_fndecl_math_cpowl16;
+         break;
        default:
          gcc_unreachable ();
        }
index d498717..1d958e1 100644 (file)
@@ -52,14 +52,18 @@ typedef struct gfc_intrinsic_map_t  GTY(())
 
   /* Enum value from the "language-independent", aka C-centric, part
      of gcc, or END_BUILTINS of no such value set.  */
-  /* ??? There are now complex variants in builtins.def, though we
-     don't currently do anything with them.  */
-  enum built_in_function code4;
-  enum built_in_function code8;
+  enum built_in_function code_r4;
+  enum built_in_function code_r8;
+  enum built_in_function code_r10;
+  enum built_in_function code_r16;
+  enum built_in_function code_c4;
+  enum built_in_function code_c8;
+  enum built_in_function code_c10;
+  enum built_in_function code_c16;
 
   /* True if the naming pattern is to prepend "c" for complex and
      append "f" for kind=4.  False if the naming pattern is to
-     prepend "_gfortran_" and append "[rc][48]".  */
+     prepend "_gfortran_" and append "[rc](4|8|10|16)".  */
   bool libm_name;
 
   /* True if a complex version of the function exists.  */
@@ -74,32 +78,42 @@ typedef struct gfc_intrinsic_map_t  GTY(())
   /* Cache decls created for the various operand types.  */
   tree real4_decl;
   tree real8_decl;
+  tree real10_decl;
+  tree real16_decl;
   tree complex4_decl;
   tree complex8_decl;
+  tree complex10_decl;
+  tree complex16_decl;
 }
 gfc_intrinsic_map_t;
 
 /* ??? The NARGS==1 hack here is based on the fact that (c99 at least)
    defines complex variants of all of the entries in mathbuiltins.def
    except for atan2.  */
-#define BUILT_IN_FUNCTION(ID, NAME, HAVE_COMPLEX) \
-  { GFC_ISYM_ ## ID, BUILT_IN_ ## ID ## F, BUILT_IN_ ## ID, true, \
-    HAVE_COMPLEX, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE},
-
-#define DEFINE_MATH_BUILTIN(id, name, argtype) \
-  BUILT_IN_FUNCTION (id, name, false)
-
-/* TODO: Use builtin function for complex intrinsics.  */
-#define DEFINE_MATH_BUILTIN_C(id, name, argtype) \
-  BUILT_IN_FUNCTION (id, name, true)
+#define DEFINE_MATH_BUILTIN(ID, NAME, ARGTYPE) \
+  { GFC_ISYM_ ## ID, BUILT_IN_ ## ID ## F, BUILT_IN_ ## ID, \
+    BUILT_IN_ ## ID ## L, BUILT_IN_ ## ID ## L, 0, 0, 0, 0, true, \
+    false, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, \
+    NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE},
+
+#define DEFINE_MATH_BUILTIN_C(ID, NAME, ARGTYPE) \
+  { GFC_ISYM_ ## ID, BUILT_IN_ ## ID ## F, BUILT_IN_ ## ID, \
+    BUILT_IN_ ## ID ## L, BUILT_IN_ ## ID ## L, BUILT_IN_C ## ID ## F, \
+    BUILT_IN_C ## ID, BUILT_IN_C ## ID ## L, BUILT_IN_C ## ID ## L, true, \
+    true, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, \
+    NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE},
 
 #define LIBM_FUNCTION(ID, NAME, HAVE_COMPLEX) \
-  { GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, true, HAVE_COMPLEX, true, \
-    NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE }
+  { GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
+    END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
+    true, HAVE_COMPLEX, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, \
+    NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE }
 
 #define LIBF_FUNCTION(ID, NAME, HAVE_COMPLEX) \
-  { GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, false, HAVE_COMPLEX, true, \
-    NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE }
+  { GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
+    END_BUILTINS, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
+    false, HAVE_COMPLEX, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, \
+    NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE }
 
 static GTY(()) gfc_intrinsic_map_t gfc_intrinsic_map[] =
 {
@@ -122,7 +136,6 @@ static GTY(()) gfc_intrinsic_map_t gfc_intrinsic_map[] =
 };
 #undef DEFINE_MATH_BUILTIN
 #undef DEFINE_MATH_BUILTIN_C
-#undef BUILT_IN_FUNCTION
 #undef LIBM_FUNCTION
 #undef LIBF_FUNCTION
 
@@ -336,6 +349,11 @@ gfc_conv_intrinsic_aint (gfc_se * se, gfc_expr * expr, enum tree_code op)
        case 8:
          n = BUILT_IN_ROUND;
          break;
+
+       case 10:
+       case 16:
+         n = BUILT_IN_ROUNDL;
+         break;
        }
       break;
 
@@ -349,6 +367,11 @@ gfc_conv_intrinsic_aint (gfc_se * se, gfc_expr * expr, enum tree_code op)
        case 8:
          n = BUILT_IN_TRUNC;
          break;
+
+       case 10:
+       case 16:
+         n = BUILT_IN_TRUNCL;
+         break;
        }
       break;
 
@@ -469,10 +492,22 @@ gfc_build_intrinsic_lib_fndecls (void)
   /* Add GCC builtin functions.  */
   for (m = gfc_intrinsic_map; m->id != GFC_ISYM_NONE; m++)
     {
-      if (m->code4 != END_BUILTINS)
-        m->real4_decl = built_in_decls[m->code4];
-      if (m->code8 != END_BUILTINS)
-       m->real8_decl = built_in_decls[m->code8];
+      if (m->code_r4 != END_BUILTINS)
+       m->real4_decl = built_in_decls[m->code_r4];
+      if (m->code_r8 != END_BUILTINS)
+       m->real8_decl = built_in_decls[m->code_r8];
+      if (m->code_r10 != END_BUILTINS)
+       m->real10_decl = built_in_decls[m->code_r10];
+      if (m->code_r16 != END_BUILTINS)
+       m->real16_decl = built_in_decls[m->code_r16];
+      if (m->code_c4 != END_BUILTINS)
+       m->complex4_decl = built_in_decls[m->code_c4];
+      if (m->code_c8 != END_BUILTINS)
+       m->complex8_decl = built_in_decls[m->code_c8];
+      if (m->code_c10 != END_BUILTINS)
+       m->complex10_decl = built_in_decls[m->code_c10];
+      if (m->code_c16 != END_BUILTINS)
+       m->complex16_decl = built_in_decls[m->code_c16];
     }
 }
 
@@ -501,6 +536,12 @@ gfc_get_intrinsic_lib_fndecl (gfc_intrinsic_map_t * m, gfc_expr * expr)
        case 8:
          pdecl = &m->real8_decl;
          break;
+       case 10:
+         pdecl = &m->real10_decl;
+         break;
+       case 16:
+         pdecl = &m->real16_decl;
+         break;
        default:
          gcc_unreachable ();
        }
@@ -517,6 +558,12 @@ gfc_get_intrinsic_lib_fndecl (gfc_intrinsic_map_t * m, gfc_expr * expr)
        case 8:
          pdecl = &m->complex8_decl;
          break;
+       case 10:
+         pdecl = &m->complex10_decl;
+         break;
+       case 16:
+         pdecl = &m->complex16_decl;
+         break;
        default:
          gcc_unreachable ();
        }
@@ -529,7 +576,8 @@ gfc_get_intrinsic_lib_fndecl (gfc_intrinsic_map_t * m, gfc_expr * expr)
 
   if (m->libm_name)
     {
-      gcc_assert (ts->kind == 4 || ts->kind == 8);
+      gcc_assert (ts->kind == 4 || ts->kind == 8 || ts->kind == 10
+                 || ts->kind == 16);
       snprintf (name, sizeof (name), "%s%s%s",
                ts->type == BT_COMPLEX ? "c" : "",
                m->name,
@@ -615,6 +663,12 @@ gfc_conv_intrinsic_exponent (gfc_se * se, gfc_expr * expr)
     case 8:
       fndecl = gfor_fndecl_math_exponent8;
       break;
+    case 10:
+      fndecl = gfor_fndecl_math_exponent10;
+      break;
+    case 16:
+      fndecl = gfor_fndecl_math_exponent16;
+      break;
     default:
       gcc_unreachable ();
     }
@@ -734,6 +788,10 @@ gfc_conv_intrinsic_abs (gfc_se * se, gfc_expr * expr)
        case 8:
          n = BUILT_IN_CABS;
          break;
+       case 10:
+       case 16:
+         n = BUILT_IN_CABSL;
+         break;
        default:
          gcc_unreachable ();
        }
@@ -896,6 +954,10 @@ gfc_conv_intrinsic_sign (gfc_se * se, gfc_expr * expr)
        case 8:
          tmp = built_in_decls[BUILT_IN_COPYSIGN];
          break;
+       case 10:
+       case 16:
+         tmp = built_in_decls[BUILT_IN_COPYSIGNL];
+         break;
        default:
          gcc_unreachable ();
        }
@@ -1861,6 +1923,9 @@ gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr * expr)
        case 8:
          tmp = gfor_fndecl_math_ishftc8;
          break;
+       case 16:
+         tmp = gfor_fndecl_math_ishftc16;
+         break;
        default:
          gcc_unreachable ();
        }
index e89e63e..6482df8 100644 (file)
@@ -566,29 +566,29 @@ gfc_init_types (void)
 tree
 gfc_get_int_type (int kind)
 {
-  int index = gfc_validate_kind (BT_INTEGER, kind, false);
-  return gfc_integer_types[index];
+  int index = gfc_validate_kind (BT_INTEGER, kind, true);
+  return index < 0 ? 0 : gfc_integer_types[index];
 }
 
 tree
 gfc_get_real_type (int kind)
 {
-  int index = gfc_validate_kind (BT_REAL, kind, false);
-  return gfc_real_types[index];
+  int index = gfc_validate_kind (BT_REAL, kind, true);
+  return index < 0 ? 0 : gfc_real_types[index];
 }
 
 tree
 gfc_get_complex_type (int kind)
 {
-  int index = gfc_validate_kind (BT_COMPLEX, kind, false);
-  return gfc_complex_types[index];
+  int index = gfc_validate_kind (BT_COMPLEX, kind, true);
+  return index < 0 ? 0 : gfc_complex_types[index];
 }
 
 tree
 gfc_get_logical_type (int kind)
 {
-  int index = gfc_validate_kind (BT_LOGICAL, kind, false);
-  return gfc_logical_types[index];
+  int index = gfc_validate_kind (BT_LOGICAL, kind, true);
+  return index < 0 ? 0 : gfc_logical_types[index];
 }
 \f
 /* Create a character type with the given kind and length.  */
index a0b4334..e64640c 100644 (file)
@@ -471,13 +471,18 @@ typedef struct gfc_powdecl_list GTY(())
 }
 gfc_powdecl_list;
 
-extern GTY(()) gfc_powdecl_list gfor_fndecl_math_powi[3][2];
+extern GTY(()) gfc_powdecl_list gfor_fndecl_math_powi[4][3];
 extern GTY(()) tree gfor_fndecl_math_cpowf;
 extern GTY(()) tree gfor_fndecl_math_cpow;
+extern GTY(()) tree gfor_fndecl_math_cpowl10;
+extern GTY(()) tree gfor_fndecl_math_cpowl16;
 extern GTY(()) tree gfor_fndecl_math_ishftc4;
 extern GTY(()) tree gfor_fndecl_math_ishftc8;
+extern GTY(()) tree gfor_fndecl_math_ishftc16;
 extern GTY(()) tree gfor_fndecl_math_exponent4;
 extern GTY(()) tree gfor_fndecl_math_exponent8;
+extern GTY(()) tree gfor_fndecl_math_exponent10;
+extern GTY(()) tree gfor_fndecl_math_exponent16;
 
 /* String functions.  */
 extern GTY(()) tree gfor_fndecl_copy_string;
index a297cb3..ea8a2a7 100644 (file)
@@ -1,3 +1,9 @@
+2005-10-03  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+       PR libfortran/19308
+       * gfortran.dg/large_real_kind_2.F90: New test.
+       * gfortran.dg/large_integer_kind_2.f90: New test.
+
 2005-10-03  Uros Bizjak  <uros@kss-loka.si>
 
        * lib/target-supports.exp (check_effective_target_vect_shift):
diff --git a/gcc/testsuite/gfortran.dg/large_integer_kind_2.f90 b/gcc/testsuite/gfortran.dg/large_integer_kind_2.f90
new file mode 100644 (file)
index 0000000..68e64ab
--- /dev/null
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_int }
+
+! Testing library calls on large integer kinds (larger than kind=8)
+  implicit none
+
+  integer,parameter :: k = selected_int_kind (range (0_8) + 1)
+
+  integer(kind=k) :: i, j
+  integer(8) :: a, b
+
+  i = 0; j = 1; a = i; b = j
+  if (i ** j /= a ** b) call abort
+
+end
diff --git a/gcc/testsuite/gfortran.dg/large_real_kind_2.F90 b/gcc/testsuite/gfortran.dg/large_real_kind_2.F90
new file mode 100644 (file)
index 0000000..4eb5a7f
--- /dev/null
@@ -0,0 +1,106 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_real }
+
+! Testing library calls on large real kinds (larger than kind=8)
+  implicit none
+
+  integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
+  real(8),parameter :: eps = 1e-8
+
+  real(kind=k) :: x, x1
+  real(8) :: y, y1
+  complex(kind=k) :: z, z1
+  complex(8) :: w, w1
+
+#define TEST_FUNCTION(func,val) \
+ x = val ;\
+ y = x ;\
+ x = func (x) ;\
+ y = func (y) ;\
+ if (abs((y - x) / y) > eps) call abort
+  
+#define CTEST_FUNCTION(func,valc) \
+ z = valc ;\
+ w = z ;\
+ z = func (z) ;\
+ w = func (w) ;\
+ if (abs((z - w) / w) > eps) call abort
+
+ TEST_FUNCTION(cos,17.456)
+ TEST_FUNCTION(sin,17.456)
+ TEST_FUNCTION(tan,1.456)
+ TEST_FUNCTION(cosh,-2.45)
+ TEST_FUNCTION(sinh,7.1)
+ TEST_FUNCTION(tanh,12.7)
+ TEST_FUNCTION(acos,0.78)
+ TEST_FUNCTION(asin,-0.24)
+ TEST_FUNCTION(atan,-17.123)
+ TEST_FUNCTION(acosh,0.2)
+ TEST_FUNCTION(asinh,0.3)
+ TEST_FUNCTION(atanh,0.4)
+ TEST_FUNCTION(exp,1.74)
+ TEST_FUNCTION(log,0.00178914)
+ TEST_FUNCTION(log10,123789.123)
+ TEST_FUNCTION(sqrt,789.1356)
+ TEST_FUNCTION(erf,1.45123231)
+ TEST_FUNCTION(erfc,-0.123789)
+
+ CTEST_FUNCTION(cos,(17.456,-1.123))
+ CTEST_FUNCTION(sin,(17.456,-7.6))
+ CTEST_FUNCTION(exp,(1.74,-1.01))
+ CTEST_FUNCTION(log,(0.00178914,-1.207))
+ CTEST_FUNCTION(sqrt,(789.1356,2.4))
+
+#define TEST_POWER(val1,val2) \
+ x = val1 ; \
+ y = x ; \
+ x1 = val2 ; \
+ y1 = x1; \
+ if (abs((x**x1 - y**y1)/(y**y1)) > eps) call abort
+#define CTEST_POWER(val1,val2) \
+ z = val1 ; \
+ w = z ; \
+ z1 = val2 ; \
+ w1 = z1; \
+ if (abs((z**z1 - w**w1)/(w**w1)) > eps) call abort
+
+ CTEST_POWER (1.0,1.0)
+ CTEST_POWER (1.0,5.4)
+ CTEST_POWER (1.0,-5.4)
+ CTEST_POWER (1.0,0.0)
+ CTEST_POWER (-1.0,1.0)
+ CTEST_POWER (-1.0,5.4)
+ CTEST_POWER (-1.0,-5.4)
+ CTEST_POWER (-1.0,0.0)
+ CTEST_POWER (0.0,1.0)
+ CTEST_POWER (0.0,5.4)
+ CTEST_POWER (0.0,-5.4)
+ CTEST_POWER (0.0,0.0)
+ CTEST_POWER (7.6,1.0)
+ CTEST_POWER (7.6,5.4)
+ CTEST_POWER (7.6,-5.4)
+ CTEST_POWER (7.6,0.0)
+ CTEST_POWER (-7.6,1.0)
+ CTEST_POWER (-7.6,5.4)
+ CTEST_POWER (-7.6,-5.4)
+ CTEST_POWER (-7.6,0.0)
+
+ CTEST_POWER ((10.78,123.213),(14.123,13279.5))
+ CTEST_POWER ((-10.78,123.213),(14.123,13279.5))
+ CTEST_POWER ((10.78,-123.213),(14.123,13279.5))
+ CTEST_POWER ((10.78,123.213),(-14.123,13279.5))
+ CTEST_POWER ((10.78,123.213),(14.123,-13279.5))
+ CTEST_POWER ((-10.78,-123.213),(14.123,13279.5))
+ CTEST_POWER ((-10.78,123.213),(-14.123,13279.5))
+ CTEST_POWER ((-10.78,123.213),(14.123,-13279.5))
+ CTEST_POWER ((10.78,-123.213),(-14.123,13279.5))
+ CTEST_POWER ((10.78,-123.213),(14.123,-13279.5))
+ CTEST_POWER ((10.78,123.213),(-14.123,-13279.5))
+ CTEST_POWER ((-10.78,-123.213),(-14.123,13279.5))
+ CTEST_POWER ((-10.78,-123.213),(14.123,-13279.5))
+ CTEST_POWER ((-10.78,123.213),(-14.123,-13279.5))
+ CTEST_POWER ((10.78,-123.213),(-14.123,-13279.5))
+ CTEST_POWER ((-10.78,-123.213),(-14.123,-13279.5))
+end
index 7c91898..34b07eb 100644 (file)
@@ -1,3 +1,29 @@
+2005-10-03  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+       PR libfortran/19308
+       PR libfortran/22437
+       * Makefile.am: Add generated files for large real and integers
+       kinds. Add a rule to create the kinds.inc c99_protos.inc files.
+       Use kinds.inc to preprocess Fortran generated files.
+       * libgfortran.h: Add macro definitions for GFC_INTEGER_16_HUGE,
+       GFC_REAL_10_HUGE and GFC_REAL_16_HUGE. Add types gfc_array_i16,
+       gfc_array_r10, gfc_array_r16, gfc_array_c10, gfc_array_c16,
+       gfc_array_l16.
+       * mk-kinds-h.sh: Define macros HAVE_GFC_LOGICAL_* and
+       HAVE_GFC_COMPLEX_* when these types are available.
+       * intrinsics/ishftc.c (ishftc16): New function for GFC_INTEGER_16.
+       * m4/all.m4, m4/any.m4, m4/count.m4, m4/cshift1.m4, m4/dotprod.m4,
+       m4/dotprodc.m4, m4/dotprodl.m4, m4/eoshift1.m4, m4/eoshift3.m4,
+       m4/exponent.m4, m4/fraction.m4, m4/in_pack.m4, m4/in_unpack.m4,
+       m4/matmul.m4, m4/matmull.m4, m4/maxloc0.m4, m4/maxloc1.m4,
+       m4/maxval.m4, m4/minloc0.m4, m4/minloc1.m4, m4/minval.m4, m4/mtype.m4,
+       m4/nearest.m4, m4/pow.m4, m4/product.m4, m4/reshape.m4,
+       m4/set_exponent.m4, m4/shape.m4, m4/specific.m4, m4/specific2.m4,
+       m4/sum.m4, m4/transpose.m4: Protect generated functions with
+       appropriate "#if defined (HAVE_GFC_type_kind)" preprocessor directives.
+       * Makefile.in: Regenerate.
+       * all files in generated/: Regenerate.
+
 2005-10-01  Jakub Jelinek  <jakub@redhat.com>
 
        * runtime/memory.c (malloc_t): Remove.
@@ -65,7 +91,7 @@
        * config.h.in: Regenerate.
        * libgfortan.h (isfinite): undef if broken, set if needed.
        (isnan): undef if broken, set if needed.
-        (fpclassify): undef if broken, set if needed.
+       (fpclassify): undef if broken, set if needed.
        * io/write.c: Remove TODO comment about working isfinite.
        * intrinsics/c99_functions.c (round): Use isfinite instead
        of fpclassify.
index 831ad76..cac343b 100644 (file)
@@ -108,181 +108,313 @@ libgfortran.h
 
 i_all_c= \
 generated/all_l4.c \
-generated/all_l8.c
+generated/all_l8.c \
+generated/all_l16.c
 
 i_any_c= \
 generated/any_l4.c \
-generated/any_l8.c
+generated/any_l8.c \
+generated/any_l16.c
 
 i_count_c= \
 generated/count_4_l4.c \
 generated/count_8_l4.c \
+generated/count_16_l4.c \
 generated/count_4_l8.c \
-generated/count_8_l8.c
+generated/count_8_l8.c \
+generated/count_16_l8.c \
+generated/count_4_l16.c \
+generated/count_8_l16.c \
+generated/count_16_l16.c
 
 i_maxloc0_c= \
 generated/maxloc0_4_i4.c \
 generated/maxloc0_8_i4.c \
+generated/maxloc0_16_i4.c \
 generated/maxloc0_4_i8.c \
 generated/maxloc0_8_i8.c \
+generated/maxloc0_16_i8.c \
+generated/maxloc0_4_i16.c \
+generated/maxloc0_8_i16.c \
+generated/maxloc0_16_i16.c \
 generated/maxloc0_4_r4.c \
 generated/maxloc0_8_r4.c \
+generated/maxloc0_16_r4.c \
 generated/maxloc0_4_r8.c \
-generated/maxloc0_8_r8.c
+generated/maxloc0_8_r8.c \
+generated/maxloc0_16_r8.c \
+generated/maxloc0_4_r10.c \
+generated/maxloc0_8_r10.c \
+generated/maxloc0_16_r10.c \
+generated/maxloc0_4_r16.c \
+generated/maxloc0_8_r16.c \
+generated/maxloc0_16_r16.c
 
 i_maxloc1_c= \
 generated/maxloc1_4_i4.c \
 generated/maxloc1_8_i4.c \
+generated/maxloc1_16_i4.c \
 generated/maxloc1_4_i8.c \
 generated/maxloc1_8_i8.c \
+generated/maxloc1_16_i8.c \
+generated/maxloc1_4_i16.c \
+generated/maxloc1_8_i16.c \
+generated/maxloc1_16_i16.c \
 generated/maxloc1_4_r4.c \
 generated/maxloc1_8_r4.c \
+generated/maxloc1_16_r4.c \
 generated/maxloc1_4_r8.c \
-generated/maxloc1_8_r8.c
+generated/maxloc1_8_r8.c \
+generated/maxloc1_16_r8.c \
+generated/maxloc1_4_r10.c \
+generated/maxloc1_8_r10.c \
+generated/maxloc1_16_r10.c \
+generated/maxloc1_4_r16.c \
+generated/maxloc1_8_r16.c \
+generated/maxloc1_16_r16.c
 
 i_maxval_c= \
 generated/maxval_i4.c \
 generated/maxval_i8.c \
+generated/maxval_i16.c \
 generated/maxval_r4.c \
-generated/maxval_r8.c
+generated/maxval_r8.c \
+generated/maxval_r10.c \
+generated/maxval_r16.c
 
 i_minloc0_c= \
 generated/minloc0_4_i4.c \
 generated/minloc0_8_i4.c \
+generated/minloc0_16_i4.c \
 generated/minloc0_4_i8.c \
 generated/minloc0_8_i8.c \
+generated/minloc0_16_i8.c \
+generated/minloc0_4_i16.c \
+generated/minloc0_8_i16.c \
+generated/minloc0_16_i16.c \
 generated/minloc0_4_r4.c \
 generated/minloc0_8_r4.c \
+generated/minloc0_16_r4.c \
 generated/minloc0_4_r8.c \
-generated/minloc0_8_r8.c
+generated/minloc0_8_r8.c \
+generated/minloc0_16_r8.c \
+generated/minloc0_4_r10.c \
+generated/minloc0_8_r10.c \
+generated/minloc0_16_r10.c \
+generated/minloc0_4_r16.c \
+generated/minloc0_8_r16.c \
+generated/minloc0_16_r16.c
 
 i_minloc1_c= \
 generated/minloc1_4_i4.c \
 generated/minloc1_8_i4.c \
+generated/minloc1_16_i4.c \
 generated/minloc1_4_i8.c \
 generated/minloc1_8_i8.c \
+generated/minloc1_16_i8.c \
+generated/minloc1_4_i16.c \
+generated/minloc1_8_i16.c \
+generated/minloc1_16_i16.c \
 generated/minloc1_4_r4.c \
 generated/minloc1_8_r4.c \
+generated/minloc1_16_r4.c \
 generated/minloc1_4_r8.c \
-generated/minloc1_8_r8.c
+generated/minloc1_8_r8.c \
+generated/minloc1_16_r8.c \
+generated/minloc1_4_r10.c \
+generated/minloc1_8_r10.c \
+generated/minloc1_16_r10.c \
+generated/minloc1_4_r16.c \
+generated/minloc1_8_r16.c \
+generated/minloc1_16_r16.c
 
 i_minval_c= \
 generated/minval_i4.c \
 generated/minval_i8.c \
+generated/minval_i16.c \
 generated/minval_r4.c \
-generated/minval_r8.c
+generated/minval_r8.c \
+generated/minval_r10.c \
+generated/minval_r16.c
 
 i_sum_c= \
 generated/sum_i4.c \
 generated/sum_i8.c \
+generated/sum_i16.c \
 generated/sum_r4.c \
 generated/sum_r8.c \
+generated/sum_r10.c \
+generated/sum_r16.c \
 generated/sum_c4.c \
-generated/sum_c8.c
+generated/sum_c8.c \
+generated/sum_c10.c \
+generated/sum_c16.c
 
 i_product_c= \
 generated/product_i4.c \
 generated/product_i8.c \
+generated/product_i16.c \
 generated/product_r4.c \
 generated/product_r8.c \
+generated/product_r10.c \
+generated/product_r16.c \
 generated/product_c4.c \
-generated/product_c8.c
+generated/product_c8.c \
+generated/product_c10.c \
+generated/product_c16.c
 
 i_dotprod_c= \
 generated/dotprod_i4.c \
 generated/dotprod_i8.c \
+generated/dotprod_i16.c \
 generated/dotprod_r4.c \
-generated/dotprod_r8.c
+generated/dotprod_r8.c \
+generated/dotprod_r10.c \
+generated/dotprod_r16.c
 
 i_dotprodl_c= \
 generated/dotprod_l4.c \
-generated/dotprod_l8.c
+generated/dotprod_l8.c \
+generated/dotprod_l16.c
 
 i_dotprodc_c= \
 generated/dotprod_c4.c \
-generated/dotprod_c8.c
+generated/dotprod_c8.c \
+generated/dotprod_c10.c \
+generated/dotprod_c16.c
 
 i_matmul_c= \
 generated/matmul_i4.c \
 generated/matmul_i8.c \
+generated/matmul_i16.c \
 generated/matmul_r4.c \
 generated/matmul_r8.c \
+generated/matmul_r10.c \
+generated/matmul_r16.c \
 generated/matmul_c4.c \
-generated/matmul_c8.c
+generated/matmul_c8.c \
+generated/matmul_c10.c \
+generated/matmul_c16.c
 
 i_matmull_c= \
 generated/matmul_l4.c \
-generated/matmul_l8.c
+generated/matmul_l8.c \
+generated/matmul_l16.c
 
 i_transpose_c= \
 generated/transpose_i4.c \
 generated/transpose_i8.c \
+generated/transpose_i16.c \
 generated/transpose_c4.c \
-generated/transpose_c8.c
+generated/transpose_c8.c \
+generated/transpose_c10.c \
+generated/transpose_c16.c
 
 i_shape_c= \
 generated/shape_i4.c \
-generated/shape_i8.c
+generated/shape_i8.c \
+generated/shape_i16.c
 
 i_reshape_c= \
 generated/reshape_i4.c \
 generated/reshape_i8.c \
+generated/reshape_i16.c \
 generated/reshape_c4.c \
-generated/reshape_c8.c
+generated/reshape_c8.c \
+generated/reshape_c10.c \
+generated/reshape_c16.c
 
 i_eoshift1_c= \
 generated/eoshift1_4.c \
-generated/eoshift1_8.c
+generated/eoshift1_8.c \
+generated/eoshift1_16.c
 
 i_eoshift3_c= \
 generated/eoshift3_4.c \
-generated/eoshift3_8.c
+generated/eoshift3_8.c \
+generated/eoshift3_16.c
 
 i_cshift1_c= \
 generated/cshift1_4.c \
-generated/cshift1_8.c
+generated/cshift1_8.c \
+generated/cshift1_16.c
 
 in_pack_c = \
 generated/in_pack_i4.c \
 generated/in_pack_i8.c \
+generated/in_pack_i16.c \
 generated/in_pack_c4.c \
-generated/in_pack_c8.c
+generated/in_pack_c8.c \
+generated/in_pack_c10.c \
+generated/in_pack_c16.c
 
 in_unpack_c = \
 generated/in_unpack_i4.c \
 generated/in_unpack_i8.c \
+generated/in_unpack_i16.c \
 generated/in_unpack_c4.c \
-generated/in_unpack_c8.c
+generated/in_unpack_c8.c \
+generated/in_unpack_c10.c \
+generated/in_unpack_c16.c
 
 i_exponent_c = \
 generated/exponent_r4.c \
-generated/exponent_r8.c
+generated/exponent_r8.c \
+generated/exponent_r10.c \
+generated/exponent_r16.c
 
 i_fraction_c = \
 generated/fraction_r4.c \
-generated/fraction_r8.c
+generated/fraction_r8.c \
+generated/fraction_r10.c \
+generated/fraction_r16.c
 
 i_nearest_c = \
 generated/nearest_r4.c \
-generated/nearest_r8.c
+generated/nearest_r8.c \
+generated/nearest_r10.c \
+generated/nearest_r16.c
 
 i_set_exponent_c = \
 generated/set_exponent_r4.c \
-generated/set_exponent_r8.c
+generated/set_exponent_r8.c \
+generated/set_exponent_r10.c \
+generated/set_exponent_r16.c
 
 i_pow_c = \
 generated/pow_i4_i4.c \
 generated/pow_i8_i4.c \
+generated/pow_i16_i4.c \
 generated/pow_r4_i4.c \
 generated/pow_r8_i4.c \
+generated/pow_r10_i4.c \
+generated/pow_r16_i4.c \
 generated/pow_c4_i4.c \
 generated/pow_c8_i4.c \
+generated/pow_c10_i4.c \
+generated/pow_c16_i4.c \
 generated/pow_i4_i8.c \
 generated/pow_i8_i8.c \
+generated/pow_i16_i8.c \
 generated/pow_r4_i8.c \
 generated/pow_r8_i8.c \
+generated/pow_r10_i8.c \
+generated/pow_r16_i8.c \
 generated/pow_c4_i8.c \
-generated/pow_c8_i8.c
+generated/pow_c8_i8.c \
+generated/pow_c10_i8.c \
+generated/pow_c16_i8.c \
+generated/pow_i4_i16.c \
+generated/pow_i8_i16.c \
+generated/pow_i16_i16.c \
+generated/pow_r4_i16.c \
+generated/pow_r8_i16.c \
+generated/pow_r10_i16.c \
+generated/pow_r16_i16.c \
+generated/pow_c4_i16.c \
+generated/pow_c8_i16.c \
+generated/pow_c10_i16.c \
+generated/pow_c16_i16.c
 
 m4_files= m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \
     m4/any.m4 m4/count.m4 m4/maxloc0.m4 m4/maxloc1.m4 m4/maxval.m4 \
@@ -300,74 +432,135 @@ gfor_built_src= $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \
     $(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \
     $(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \
     $(i_pow_c) \
-    selected_int_kind.inc selected_real_kind.inc kinds.h
+    selected_int_kind.inc selected_real_kind.inc kinds.h \
+    kinds.inc c99_protos.inc
 
 # Machine generated specifics
 gfor_built_specific_src= \
-generated/_abs_c4.f90 \
-generated/_abs_c8.f90 \
-generated/_abs_i4.f90 \
-generated/_abs_i8.f90 \
-generated/_abs_r4.f90 \
-generated/_abs_r8.f90 \
-generated/_exp_r4.f90 \
-generated/_exp_r8.f90 \
-generated/_exp_c4.f90 \
-generated/_exp_c8.f90 \
-generated/_log_r4.f90 \
-generated/_log_r8.f90 \
-generated/_log_c4.f90 \
-generated/_log_c8.f90 \
-generated/_log10_r4.f90 \
-generated/_log10_r8.f90 \
-generated/_sqrt_r4.f90 \
-generated/_sqrt_r8.f90 \
-generated/_sqrt_c4.f90 \
-generated/_sqrt_c8.f90 \
-generated/_asin_r4.f90 \
-generated/_asin_r8.f90 \
-generated/_acos_r4.f90 \
-generated/_acos_r8.f90 \
-generated/_atan_r4.f90 \
-generated/_atan_r8.f90 \
-generated/_sin_r4.f90 \
-generated/_sin_r8.f90 \
-generated/_sin_c4.f90 \
-generated/_sin_c8.f90 \
-generated/_cos_r4.f90 \
-generated/_cos_r8.f90 \
-generated/_cos_c4.f90 \
-generated/_cos_c8.f90 \
-generated/_tan_r4.f90 \
-generated/_tan_r8.f90 \
-generated/_sinh_r4.f90 \
-generated/_sinh_r8.f90 \
-generated/_cosh_r4.f90 \
-generated/_cosh_r8.f90 \
-generated/_tanh_r4.f90 \
-generated/_tanh_r8.f90 \
-generated/_conjg_c4.f90 \
-generated/_conjg_c8.f90 \
-generated/_aint_r4.f90 \
-generated/_aint_r8.f90 \
-generated/_anint_r4.f90 \
-generated/_anint_r8.f90
+generated/_abs_c4.F90 \
+generated/_abs_c8.F90 \
+generated/_abs_c10.F90 \
+generated/_abs_c16.F90 \
+generated/_abs_i4.F90 \
+generated/_abs_i8.F90 \
+generated/_abs_i16.F90 \
+generated/_abs_r4.F90 \
+generated/_abs_r8.F90 \
+generated/_abs_r10.F90 \
+generated/_abs_r16.F90 \
+generated/_exp_r4.F90 \
+generated/_exp_r8.F90 \
+generated/_exp_r10.F90 \
+generated/_exp_r16.F90 \
+generated/_exp_c4.F90 \
+generated/_exp_c8.F90 \
+generated/_exp_c10.F90 \
+generated/_exp_c16.F90 \
+generated/_log_r4.F90 \
+generated/_log_r8.F90 \
+generated/_log_r10.F90 \
+generated/_log_r16.F90 \
+generated/_log_c4.F90 \
+generated/_log_c8.F90 \
+generated/_log_c10.F90 \
+generated/_log_c16.F90 \
+generated/_log10_r4.F90 \
+generated/_log10_r8.F90 \
+generated/_log10_r10.F90 \
+generated/_log10_r16.F90 \
+generated/_sqrt_r4.F90 \
+generated/_sqrt_r8.F90 \
+generated/_sqrt_r10.F90 \
+generated/_sqrt_r16.F90 \
+generated/_sqrt_c4.F90 \
+generated/_sqrt_c8.F90 \
+generated/_sqrt_c10.F90 \
+generated/_sqrt_c16.F90 \
+generated/_asin_r4.F90 \
+generated/_asin_r8.F90 \
+generated/_asin_r10.F90 \
+generated/_asin_r16.F90 \
+generated/_acos_r4.F90 \
+generated/_acos_r8.F90 \
+generated/_acos_r10.F90 \
+generated/_acos_r16.F90 \
+generated/_atan_r4.F90 \
+generated/_atan_r8.F90 \
+generated/_atan_r10.F90 \
+generated/_atan_r16.F90 \
+generated/_sin_r4.F90 \
+generated/_sin_r8.F90 \
+generated/_sin_r10.F90 \
+generated/_sin_r16.F90 \
+generated/_sin_c4.F90 \
+generated/_sin_c8.F90 \
+generated/_sin_c10.F90 \
+generated/_sin_c16.F90 \
+generated/_cos_r4.F90 \
+generated/_cos_r8.F90 \
+generated/_cos_r10.F90 \
+generated/_cos_r16.F90 \
+generated/_cos_c4.F90 \
+generated/_cos_c8.F90 \
+generated/_cos_c10.F90 \
+generated/_cos_c16.F90 \
+generated/_tan_r4.F90 \
+generated/_tan_r8.F90 \
+generated/_tan_r10.F90 \
+generated/_tan_r16.F90 \
+generated/_sinh_r4.F90 \
+generated/_sinh_r8.F90 \
+generated/_sinh_r10.F90 \
+generated/_sinh_r16.F90 \
+generated/_cosh_r4.F90 \
+generated/_cosh_r8.F90 \
+generated/_cosh_r10.F90 \
+generated/_cosh_r16.F90 \
+generated/_tanh_r4.F90 \
+generated/_tanh_r8.F90 \
+generated/_tanh_r10.F90 \
+generated/_tanh_r16.F90 \
+generated/_conjg_c4.F90 \
+generated/_conjg_c8.F90 \
+generated/_conjg_c10.F90 \
+generated/_conjg_c16.F90 \
+generated/_aint_r4.F90 \
+generated/_aint_r8.F90 \
+generated/_aint_r10.F90 \
+generated/_aint_r16.F90 \
+generated/_anint_r4.F90 \
+generated/_anint_r8.F90 \
+generated/_anint_r10.F90 \
+generated/_anint_r16.F90
 
 gfor_built_specific2_src= \
-generated/_sign_i4.f90 \
-generated/_sign_i8.f90 \
-generated/_sign_r4.f90 \
-generated/_sign_r8.f90 \
-generated/_dim_i4.f90 \
-generated/_dim_i8.f90 \
-generated/_dim_r4.f90 \
-generated/_dim_r8.f90 \
-generated/_atan2_r4.f90 \
-generated/_atan2_r8.f90 \
-generated/_mod_i4.f90 \
-generated/_mod_i8.f90 \
-generated/_mod_r4.f90 \
-generated/_mod_r8.f90
+generated/_sign_i4.F90 \
+generated/_sign_i8.F90 \
+generated/_sign_i16.F90 \
+generated/_sign_r4.F90 \
+generated/_sign_r8.F90 \
+generated/_sign_r10.F90 \
+generated/_sign_r16.F90 \
+generated/_dim_i4.F90 \
+generated/_dim_i8.F90 \
+generated/_dim_i16.F90 \
+generated/_dim_r4.F90 \
+generated/_dim_r8.F90 \
+generated/_dim_r10.F90 \
+generated/_dim_r16.F90 \
+generated/_atan2_r4.F90 \
+generated/_atan2_r8.F90 \
+generated/_atan2_r10.F90 \
+generated/_atan2_r16.F90 \
+generated/_mod_i4.F90 \
+generated/_mod_i8.F90 \
+generated/_mod_i16.F90 \
+generated/_mod_r4.F90 \
+generated/_mod_r8.F90
+# There are commented out due to a bug in the way the front-end
+# handles MOD
+#generated/_mod_r10.F90
+#generated/_mod_r16.F90
 
 gfor_specific_src= \
 $(gfor_built_specific_src) \
@@ -387,6 +580,12 @@ I_M4_DEPS1=$(I_M4_DEPS) m4/ifunction.m4
 kinds.h: $(srcdir)/mk-kinds-h.sh
        $(SHELL) $(srcdir)/mk-kinds-h.sh '$(FCCOMPILE)' > $@
 
+kinds.inc: kinds.h
+       grep '^#' < kinds.h > $@
+
+c99_protos.inc: $(srcdir)/c99_protos.h
+       grep '^#' < $(srcdir)/c99_protos.h > $@
+
 selected_int_kind.inc: $(srcdir)/mk-sik-inc.sh
        $(SHELL) $(srcdir)/mk-sik-inc.sh '$(FCCOMPILE)' > $@
 
index 06b90ce..c4d3be6 100644 (file)
@@ -68,54 +68,89 @@ LTLIBRARIES = $(toolexeclib_LTLIBRARIES)
 libgfortran_la_LIBADD =
 am__objects_1 = compile_options.lo environ.lo error.lo main.lo \
        memory.lo pause.lo stop.lo string.lo select.lo
-am__objects_2 = all_l4.lo all_l8.lo
-am__objects_3 = any_l4.lo any_l8.lo
-am__objects_4 = count_4_l4.lo count_8_l4.lo count_4_l8.lo \
-       count_8_l8.lo
-am__objects_5 = maxloc0_4_i4.lo maxloc0_8_i4.lo maxloc0_4_i8.lo \
-       maxloc0_8_i8.lo maxloc0_4_r4.lo maxloc0_8_r4.lo \
-       maxloc0_4_r8.lo maxloc0_8_r8.lo
-am__objects_6 = maxloc1_4_i4.lo maxloc1_8_i4.lo maxloc1_4_i8.lo \
-       maxloc1_8_i8.lo maxloc1_4_r4.lo maxloc1_8_r4.lo \
-       maxloc1_4_r8.lo maxloc1_8_r8.lo
-am__objects_7 = maxval_i4.lo maxval_i8.lo maxval_r4.lo maxval_r8.lo
-am__objects_8 = minloc0_4_i4.lo minloc0_8_i4.lo minloc0_4_i8.lo \
-       minloc0_8_i8.lo minloc0_4_r4.lo minloc0_8_r4.lo \
-       minloc0_4_r8.lo minloc0_8_r8.lo
-am__objects_9 = minloc1_4_i4.lo minloc1_8_i4.lo minloc1_4_i8.lo \
-       minloc1_8_i8.lo minloc1_4_r4.lo minloc1_8_r4.lo \
-       minloc1_4_r8.lo minloc1_8_r8.lo
-am__objects_10 = minval_i4.lo minval_i8.lo minval_r4.lo minval_r8.lo
-am__objects_11 = product_i4.lo product_i8.lo product_r4.lo \
-       product_r8.lo product_c4.lo product_c8.lo
-am__objects_12 = sum_i4.lo sum_i8.lo sum_r4.lo sum_r8.lo sum_c4.lo \
-       sum_c8.lo
-am__objects_13 = dotprod_i4.lo dotprod_i8.lo dotprod_r4.lo \
-       dotprod_r8.lo
-am__objects_14 = dotprod_l4.lo dotprod_l8.lo
-am__objects_15 = dotprod_c4.lo dotprod_c8.lo
-am__objects_16 = matmul_i4.lo matmul_i8.lo matmul_r4.lo matmul_r8.lo \
-       matmul_c4.lo matmul_c8.lo
-am__objects_17 = matmul_l4.lo matmul_l8.lo
-am__objects_18 = transpose_i4.lo transpose_i8.lo transpose_c4.lo \
-       transpose_c8.lo
-am__objects_19 = shape_i4.lo shape_i8.lo
-am__objects_20 = eoshift1_4.lo eoshift1_8.lo
-am__objects_21 = eoshift3_4.lo eoshift3_8.lo
-am__objects_22 = cshift1_4.lo cshift1_8.lo
-am__objects_23 = reshape_i4.lo reshape_i8.lo reshape_c4.lo \
-       reshape_c8.lo
-am__objects_24 = in_pack_i4.lo in_pack_i8.lo in_pack_c4.lo \
-       in_pack_c8.lo
-am__objects_25 = in_unpack_i4.lo in_unpack_i8.lo in_unpack_c4.lo \
-       in_unpack_c8.lo
-am__objects_26 = exponent_r4.lo exponent_r8.lo
-am__objects_27 = fraction_r4.lo fraction_r8.lo
-am__objects_28 = nearest_r4.lo nearest_r8.lo
-am__objects_29 = set_exponent_r4.lo set_exponent_r8.lo
-am__objects_30 = pow_i4_i4.lo pow_i8_i4.lo pow_r4_i4.lo pow_r8_i4.lo \
-       pow_c4_i4.lo pow_c8_i4.lo pow_i4_i8.lo pow_i8_i8.lo \
-       pow_r4_i8.lo pow_r8_i8.lo pow_c4_i8.lo pow_c8_i8.lo
+am__objects_2 = all_l4.lo all_l8.lo all_l16.lo
+am__objects_3 = any_l4.lo any_l8.lo any_l16.lo
+am__objects_4 = count_4_l4.lo count_8_l4.lo count_16_l4.lo \
+       count_4_l8.lo count_8_l8.lo count_16_l8.lo count_4_l16.lo \
+       count_8_l16.lo count_16_l16.lo
+am__objects_5 = maxloc0_4_i4.lo maxloc0_8_i4.lo maxloc0_16_i4.lo \
+       maxloc0_4_i8.lo maxloc0_8_i8.lo maxloc0_16_i8.lo \
+       maxloc0_4_i16.lo maxloc0_8_i16.lo maxloc0_16_i16.lo \
+       maxloc0_4_r4.lo maxloc0_8_r4.lo maxloc0_16_r4.lo \
+       maxloc0_4_r8.lo maxloc0_8_r8.lo maxloc0_16_r8.lo \
+       maxloc0_4_r10.lo maxloc0_8_r10.lo maxloc0_16_r10.lo \
+       maxloc0_4_r16.lo maxloc0_8_r16.lo maxloc0_16_r16.lo
+am__objects_6 = maxloc1_4_i4.lo maxloc1_8_i4.lo maxloc1_16_i4.lo \
+       maxloc1_4_i8.lo maxloc1_8_i8.lo maxloc1_16_i8.lo \
+       maxloc1_4_i16.lo maxloc1_8_i16.lo maxloc1_16_i16.lo \
+       maxloc1_4_r4.lo maxloc1_8_r4.lo maxloc1_16_r4.lo \
+       maxloc1_4_r8.lo maxloc1_8_r8.lo maxloc1_16_r8.lo \
+       maxloc1_4_r10.lo maxloc1_8_r10.lo maxloc1_16_r10.lo \
+       maxloc1_4_r16.lo maxloc1_8_r16.lo maxloc1_16_r16.lo
+am__objects_7 = maxval_i4.lo maxval_i8.lo maxval_i16.lo maxval_r4.lo \
+       maxval_r8.lo maxval_r10.lo maxval_r16.lo
+am__objects_8 = minloc0_4_i4.lo minloc0_8_i4.lo minloc0_16_i4.lo \
+       minloc0_4_i8.lo minloc0_8_i8.lo minloc0_16_i8.lo \
+       minloc0_4_i16.lo minloc0_8_i16.lo minloc0_16_i16.lo \
+       minloc0_4_r4.lo minloc0_8_r4.lo minloc0_16_r4.lo \
+       minloc0_4_r8.lo minloc0_8_r8.lo minloc0_16_r8.lo \
+       minloc0_4_r10.lo minloc0_8_r10.lo minloc0_16_r10.lo \
+       minloc0_4_r16.lo minloc0_8_r16.lo minloc0_16_r16.lo
+am__objects_9 = minloc1_4_i4.lo minloc1_8_i4.lo minloc1_16_i4.lo \
+       minloc1_4_i8.lo minloc1_8_i8.lo minloc1_16_i8.lo \
+       minloc1_4_i16.lo minloc1_8_i16.lo minloc1_16_i16.lo \
+       minloc1_4_r4.lo minloc1_8_r4.lo minloc1_16_r4.lo \
+       minloc1_4_r8.lo minloc1_8_r8.lo minloc1_16_r8.lo \
+       minloc1_4_r10.lo minloc1_8_r10.lo minloc1_16_r10.lo \
+       minloc1_4_r16.lo minloc1_8_r16.lo minloc1_16_r16.lo
+am__objects_10 = minval_i4.lo minval_i8.lo minval_i16.lo minval_r4.lo \
+       minval_r8.lo minval_r10.lo minval_r16.lo
+am__objects_11 = product_i4.lo product_i8.lo product_i16.lo \
+       product_r4.lo product_r8.lo product_r10.lo product_r16.lo \
+       product_c4.lo product_c8.lo product_c10.lo product_c16.lo
+am__objects_12 = sum_i4.lo sum_i8.lo sum_i16.lo sum_r4.lo sum_r8.lo \
+       sum_r10.lo sum_r16.lo sum_c4.lo sum_c8.lo sum_c10.lo \
+       sum_c16.lo
+am__objects_13 = dotprod_i4.lo dotprod_i8.lo dotprod_i16.lo \
+       dotprod_r4.lo dotprod_r8.lo dotprod_r10.lo dotprod_r16.lo
+am__objects_14 = dotprod_l4.lo dotprod_l8.lo dotprod_l16.lo
+am__objects_15 = dotprod_c4.lo dotprod_c8.lo dotprod_c10.lo \
+       dotprod_c16.lo
+am__objects_16 = matmul_i4.lo matmul_i8.lo matmul_i16.lo matmul_r4.lo \
+       matmul_r8.lo matmul_r10.lo matmul_r16.lo matmul_c4.lo \
+       matmul_c8.lo matmul_c10.lo matmul_c16.lo
+am__objects_17 = matmul_l4.lo matmul_l8.lo matmul_l16.lo
+am__objects_18 = transpose_i4.lo transpose_i8.lo transpose_i16.lo \
+       transpose_c4.lo transpose_c8.lo transpose_c10.lo \
+       transpose_c16.lo
+am__objects_19 = shape_i4.lo shape_i8.lo shape_i16.lo
+am__objects_20 = eoshift1_4.lo eoshift1_8.lo eoshift1_16.lo
+am__objects_21 = eoshift3_4.lo eoshift3_8.lo eoshift3_16.lo
+am__objects_22 = cshift1_4.lo cshift1_8.lo cshift1_16.lo
+am__objects_23 = reshape_i4.lo reshape_i8.lo reshape_i16.lo \
+       reshape_c4.lo reshape_c8.lo reshape_c10.lo reshape_c16.lo
+am__objects_24 = in_pack_i4.lo in_pack_i8.lo in_pack_i16.lo \
+       in_pack_c4.lo in_pack_c8.lo in_pack_c10.lo in_pack_c16.lo
+am__objects_25 = in_unpack_i4.lo in_unpack_i8.lo in_unpack_i16.lo \
+       in_unpack_c4.lo in_unpack_c8.lo in_unpack_c10.lo \
+       in_unpack_c16.lo
+am__objects_26 = exponent_r4.lo exponent_r8.lo exponent_r10.lo \
+       exponent_r16.lo
+am__objects_27 = fraction_r4.lo fraction_r8.lo fraction_r10.lo \
+       fraction_r16.lo
+am__objects_28 = nearest_r4.lo nearest_r8.lo nearest_r10.lo \
+       nearest_r16.lo
+am__objects_29 = set_exponent_r4.lo set_exponent_r8.lo \
+       set_exponent_r10.lo set_exponent_r16.lo
+am__objects_30 = pow_i4_i4.lo pow_i8_i4.lo pow_i16_i4.lo pow_r4_i4.lo \
+       pow_r8_i4.lo pow_r10_i4.lo pow_r16_i4.lo pow_c4_i4.lo \
+       pow_c8_i4.lo pow_c10_i4.lo pow_c16_i4.lo pow_i4_i8.lo \
+       pow_i8_i8.lo pow_i16_i8.lo pow_r4_i8.lo pow_r8_i8.lo \
+       pow_r10_i8.lo pow_r16_i8.lo pow_c4_i8.lo pow_c8_i8.lo \
+       pow_c10_i8.lo pow_c16_i8.lo pow_i4_i16.lo pow_i8_i16.lo \
+       pow_i16_i16.lo pow_r4_i16.lo pow_r8_i16.lo pow_r10_i16.lo \
+       pow_r16_i16.lo pow_c4_i16.lo pow_c8_i16.lo pow_c10_i16.lo \
+       pow_c16_i16.lo
 am__objects_31 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \
        $(am__objects_5) $(am__objects_6) $(am__objects_7) \
        $(am__objects_8) $(am__objects_9) $(am__objects_10) \
@@ -142,19 +177,31 @@ am__objects_33 = associated.lo abort.lo args.lo bessel.lo \
        tty.lo umask.lo unlink.lo unpack_generic.lo in_pack_generic.lo \
        in_unpack_generic.lo normalize.lo
 am__objects_34 =
-am__objects_35 = _abs_c4.lo _abs_c8.lo _abs_i4.lo _abs_i8.lo \
-       _abs_r4.lo _abs_r8.lo _exp_r4.lo _exp_r8.lo _exp_c4.lo \
-       _exp_c8.lo _log_r4.lo _log_r8.lo _log_c4.lo _log_c8.lo \
-       _log10_r4.lo _log10_r8.lo _sqrt_r4.lo _sqrt_r8.lo _sqrt_c4.lo \
-       _sqrt_c8.lo _asin_r4.lo _asin_r8.lo _acos_r4.lo _acos_r8.lo \
-       _atan_r4.lo _atan_r8.lo _sin_r4.lo _sin_r8.lo _sin_c4.lo \
-       _sin_c8.lo _cos_r4.lo _cos_r8.lo _cos_c4.lo _cos_c8.lo \
-       _tan_r4.lo _tan_r8.lo _sinh_r4.lo _sinh_r8.lo _cosh_r4.lo \
-       _cosh_r8.lo _tanh_r4.lo _tanh_r8.lo _conjg_c4.lo _conjg_c8.lo \
-       _aint_r4.lo _aint_r8.lo _anint_r4.lo _anint_r8.lo
-am__objects_36 = _sign_i4.lo _sign_i8.lo _sign_r4.lo _sign_r8.lo \
-       _dim_i4.lo _dim_i8.lo _dim_r4.lo _dim_r8.lo _atan2_r4.lo \
-       _atan2_r8.lo _mod_i4.lo _mod_i8.lo _mod_r4.lo _mod_r8.lo
+am__objects_35 = _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 _exp_r4.lo _exp_r8.lo _exp_r10.lo \
+       _exp_r16.lo _exp_c4.lo _exp_c8.lo _exp_c10.lo _exp_c16.lo \
+       _log_r4.lo _log_r8.lo _log_r10.lo _log_r16.lo _log_c4.lo \
+       _log_c8.lo _log_c10.lo _log_c16.lo _log10_r4.lo _log10_r8.lo \
+       _log10_r10.lo _log10_r16.lo _sqrt_r4.lo _sqrt_r8.lo \
+       _sqrt_r10.lo _sqrt_r16.lo _sqrt_c4.lo _sqrt_c8.lo _sqrt_c10.lo \
+       _sqrt_c16.lo _asin_r4.lo _asin_r8.lo _asin_r10.lo _asin_r16.lo \
+       _acos_r4.lo _acos_r8.lo _acos_r10.lo _acos_r16.lo _atan_r4.lo \
+       _atan_r8.lo _atan_r10.lo _atan_r16.lo _sin_r4.lo _sin_r8.lo \
+       _sin_r10.lo _sin_r16.lo _sin_c4.lo _sin_c8.lo _sin_c10.lo \
+       _sin_c16.lo _cos_r4.lo _cos_r8.lo _cos_r10.lo _cos_r16.lo \
+       _cos_c4.lo _cos_c8.lo _cos_c10.lo _cos_c16.lo _tan_r4.lo \
+       _tan_r8.lo _tan_r10.lo _tan_r16.lo _sinh_r4.lo _sinh_r8.lo \
+       _sinh_r10.lo _sinh_r16.lo _cosh_r4.lo _cosh_r8.lo _cosh_r10.lo \
+       _cosh_r16.lo _tanh_r4.lo _tanh_r8.lo _tanh_r10.lo _tanh_r16.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_36 = _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
 am__objects_37 = $(am__objects_35) $(am__objects_36) dprod_r8.lo \
        f2c_specifics.lo
 am_libgfortran_la_OBJECTS = $(am__objects_1) $(am__objects_31) \
@@ -399,181 +446,313 @@ libgfortran.h
 
 i_all_c = \
 generated/all_l4.c \
-generated/all_l8.c
+generated/all_l8.c \
+generated/all_l16.c
 
 i_any_c = \
 generated/any_l4.c \
-generated/any_l8.c
+generated/any_l8.c \
+generated/any_l16.c
 
 i_count_c = \
 generated/count_4_l4.c \
 generated/count_8_l4.c \
+generated/count_16_l4.c \
 generated/count_4_l8.c \
-generated/count_8_l8.c
+generated/count_8_l8.c \
+generated/count_16_l8.c \
+generated/count_4_l16.c \
+generated/count_8_l16.c \
+generated/count_16_l16.c
 
 i_maxloc0_c = \
 generated/maxloc0_4_i4.c \
 generated/maxloc0_8_i4.c \
+generated/maxloc0_16_i4.c \
 generated/maxloc0_4_i8.c \
 generated/maxloc0_8_i8.c \
+generated/maxloc0_16_i8.c \
+generated/maxloc0_4_i16.c \
+generated/maxloc0_8_i16.c \
+generated/maxloc0_16_i16.c \
 generated/maxloc0_4_r4.c \
 generated/maxloc0_8_r4.c \
+generated/maxloc0_16_r4.c \
 generated/maxloc0_4_r8.c \
-generated/maxloc0_8_r8.c
+generated/maxloc0_8_r8.c \
+generated/maxloc0_16_r8.c \
+generated/maxloc0_4_r10.c \
+generated/maxloc0_8_r10.c \
+generated/maxloc0_16_r10.c \
+generated/maxloc0_4_r16.c \
+generated/maxloc0_8_r16.c \
+generated/maxloc0_16_r16.c
 
 i_maxloc1_c = \
 generated/maxloc1_4_i4.c \
 generated/maxloc1_8_i4.c \
+generated/maxloc1_16_i4.c \
 generated/maxloc1_4_i8.c \
 generated/maxloc1_8_i8.c \
+generated/maxloc1_16_i8.c \
+generated/maxloc1_4_i16.c \
+generated/maxloc1_8_i16.c \
+generated/maxloc1_16_i16.c \
 generated/maxloc1_4_r4.c \
 generated/maxloc1_8_r4.c \
+generated/maxloc1_16_r4.c \
 generated/maxloc1_4_r8.c \
-generated/maxloc1_8_r8.c
+generated/maxloc1_8_r8.c \
+generated/maxloc1_16_r8.c \
+generated/maxloc1_4_r10.c \
+generated/maxloc1_8_r10.c \
+generated/maxloc1_16_r10.c \
+generated/maxloc1_4_r16.c \
+generated/maxloc1_8_r16.c \
+generated/maxloc1_16_r16.c
 
 i_maxval_c = \
 generated/maxval_i4.c \
 generated/maxval_i8.c \
+generated/maxval_i16.c \
 generated/maxval_r4.c \
-generated/maxval_r8.c
+generated/maxval_r8.c \
+generated/maxval_r10.c \
+generated/maxval_r16.c
 
 i_minloc0_c = \
 generated/minloc0_4_i4.c \
 generated/minloc0_8_i4.c \
+generated/minloc0_16_i4.c \
 generated/minloc0_4_i8.c \
 generated/minloc0_8_i8.c \
+generated/minloc0_16_i8.c \
+generated/minloc0_4_i16.c \
+generated/minloc0_8_i16.c \
+generated/minloc0_16_i16.c \
 generated/minloc0_4_r4.c \
 generated/minloc0_8_r4.c \
+generated/minloc0_16_r4.c \
 generated/minloc0_4_r8.c \
-generated/minloc0_8_r8.c
+generated/minloc0_8_r8.c \
+generated/minloc0_16_r8.c \
+generated/minloc0_4_r10.c \
+generated/minloc0_8_r10.c \
+generated/minloc0_16_r10.c \
+generated/minloc0_4_r16.c \
+generated/minloc0_8_r16.c \
+generated/minloc0_16_r16.c
 
 i_minloc1_c = \
 generated/minloc1_4_i4.c \
 generated/minloc1_8_i4.c \
+generated/minloc1_16_i4.c \
 generated/minloc1_4_i8.c \
 generated/minloc1_8_i8.c \
+generated/minloc1_16_i8.c \
+generated/minloc1_4_i16.c \
+generated/minloc1_8_i16.c \
+generated/minloc1_16_i16.c \
 generated/minloc1_4_r4.c \
 generated/minloc1_8_r4.c \
+generated/minloc1_16_r4.c \
 generated/minloc1_4_r8.c \
-generated/minloc1_8_r8.c
+generated/minloc1_8_r8.c \
+generated/minloc1_16_r8.c \
+generated/minloc1_4_r10.c \
+generated/minloc1_8_r10.c \
+generated/minloc1_16_r10.c \
+generated/minloc1_4_r16.c \
+generated/minloc1_8_r16.c \
+generated/minloc1_16_r16.c
 
 i_minval_c = \
 generated/minval_i4.c \
 generated/minval_i8.c \
+generated/minval_i16.c \
 generated/minval_r4.c \
-generated/minval_r8.c
+generated/minval_r8.c \
+generated/minval_r10.c \
+generated/minval_r16.c
 
 i_sum_c = \
 generated/sum_i4.c \
 generated/sum_i8.c \
+generated/sum_i16.c \
 generated/sum_r4.c \
 generated/sum_r8.c \
+generated/sum_r10.c \
+generated/sum_r16.c \
 generated/sum_c4.c \
-generated/sum_c8.c
+generated/sum_c8.c \
+generated/sum_c10.c \
+generated/sum_c16.c
 
 i_product_c = \
 generated/product_i4.c \
 generated/product_i8.c \
+generated/product_i16.c \
 generated/product_r4.c \
 generated/product_r8.c \
+generated/product_r10.c \
+generated/product_r16.c \
 generated/product_c4.c \
-generated/product_c8.c
+generated/product_c8.c \
+generated/product_c10.c \
+generated/product_c16.c
 
 i_dotprod_c = \
 generated/dotprod_i4.c \
 generated/dotprod_i8.c \
+generated/dotprod_i16.c \
 generated/dotprod_r4.c \
-generated/dotprod_r8.c
+generated/dotprod_r8.c \
+generated/dotprod_r10.c \
+generated/dotprod_r16.c
 
 i_dotprodl_c = \
 generated/dotprod_l4.c \
-generated/dotprod_l8.c
+generated/dotprod_l8.c \
+generated/dotprod_l16.c
 
 i_dotprodc_c = \
 generated/dotprod_c4.c \
-generated/dotprod_c8.c
+generated/dotprod_c8.c \
+generated/dotprod_c10.c \
+generated/dotprod_c16.c
 
 i_matmul_c = \
 generated/matmul_i4.c \
 generated/matmul_i8.c \
+generated/matmul_i16.c \
 generated/matmul_r4.c \
 generated/matmul_r8.c \
+generated/matmul_r10.c \
+generated/matmul_r16.c \
 generated/matmul_c4.c \
-generated/matmul_c8.c
+generated/matmul_c8.c \
+generated/matmul_c10.c \
+generated/matmul_c16.c
 
 i_matmull_c = \
 generated/matmul_l4.c \
-generated/matmul_l8.c
+generated/matmul_l8.c \
+generated/matmul_l16.c
 
 i_transpose_c = \
 generated/transpose_i4.c \
 generated/transpose_i8.c \
+generated/transpose_i16.c \
 generated/transpose_c4.c \
-generated/transpose_c8.c
+generated/transpose_c8.c \
+generated/transpose_c10.c \
+generated/transpose_c16.c
 
 i_shape_c = \
 generated/shape_i4.c \
-generated/shape_i8.c
+generated/shape_i8.c \
+generated/shape_i16.c
 
 i_reshape_c = \
 generated/reshape_i4.c \
 generated/reshape_i8.c \
+generated/reshape_i16.c \
 generated/reshape_c4.c \
-generated/reshape_c8.c
+generated/reshape_c8.c \
+generated/reshape_c10.c \
+generated/reshape_c16.c
 
 i_eoshift1_c = \
 generated/eoshift1_4.c \
-generated/eoshift1_8.c
+generated/eoshift1_8.c \
+generated/eoshift1_16.c
 
 i_eoshift3_c = \
 generated/eoshift3_4.c \
-generated/eoshift3_8.c
+generated/eoshift3_8.c \
+generated/eoshift3_16.c
 
 i_cshift1_c = \
 generated/cshift1_4.c \
-generated/cshift1_8.c
+generated/cshift1_8.c \
+generated/cshift1_16.c
 
 in_pack_c = \
 generated/in_pack_i4.c \
 generated/in_pack_i8.c \
+generated/in_pack_i16.c \
 generated/in_pack_c4.c \
-generated/in_pack_c8.c
+generated/in_pack_c8.c \
+generated/in_pack_c10.c \
+generated/in_pack_c16.c
 
 in_unpack_c = \
 generated/in_unpack_i4.c \
 generated/in_unpack_i8.c \
+generated/in_unpack_i16.c \
 generated/in_unpack_c4.c \
-generated/in_unpack_c8.c
+generated/in_unpack_c8.c \
+generated/in_unpack_c10.c \
+generated/in_unpack_c16.c
 
 i_exponent_c = \
 generated/exponent_r4.c \
-generated/exponent_r8.c
+generated/exponent_r8.c \
+generated/exponent_r10.c \
+generated/exponent_r16.c
 
 i_fraction_c = \
 generated/fraction_r4.c \
-generated/fraction_r8.c
+generated/fraction_r8.c \
+generated/fraction_r10.c \
+generated/fraction_r16.c
 
 i_nearest_c = \
 generated/nearest_r4.c \
-generated/nearest_r8.c
+generated/nearest_r8.c \
+generated/nearest_r10.c \
+generated/nearest_r16.c
 
 i_set_exponent_c = \
 generated/set_exponent_r4.c \
-generated/set_exponent_r8.c
+generated/set_exponent_r8.c \
+generated/set_exponent_r10.c \
+generated/set_exponent_r16.c
 
 i_pow_c = \
 generated/pow_i4_i4.c \
 generated/pow_i8_i4.c \
+generated/pow_i16_i4.c \
 generated/pow_r4_i4.c \
 generated/pow_r8_i4.c \
+generated/pow_r10_i4.c \
+generated/pow_r16_i4.c \
 generated/pow_c4_i4.c \
 generated/pow_c8_i4.c \
+generated/pow_c10_i4.c \
+generated/pow_c16_i4.c \
 generated/pow_i4_i8.c \
 generated/pow_i8_i8.c \
+generated/pow_i16_i8.c \
 generated/pow_r4_i8.c \
 generated/pow_r8_i8.c \
+generated/pow_r10_i8.c \
+generated/pow_r16_i8.c \
 generated/pow_c4_i8.c \
-generated/pow_c8_i8.c
+generated/pow_c8_i8.c \
+generated/pow_c10_i8.c \
+generated/pow_c16_i8.c \
+generated/pow_i4_i16.c \
+generated/pow_i8_i16.c \
+generated/pow_i16_i16.c \
+generated/pow_r4_i16.c \
+generated/pow_r8_i16.c \
+generated/pow_r10_i16.c \
+generated/pow_r16_i16.c \
+generated/pow_c4_i16.c \
+generated/pow_c8_i16.c \
+generated/pow_c10_i16.c \
+generated/pow_c16_i16.c
 
 m4_files = m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \
     m4/any.m4 m4/count.m4 m4/maxloc0.m4 m4/maxloc1.m4 m4/maxval.m4 \
@@ -591,76 +770,137 @@ gfor_built_src = $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \
     $(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \
     $(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \
     $(i_pow_c) \
-    selected_int_kind.inc selected_real_kind.inc kinds.h
+    selected_int_kind.inc selected_real_kind.inc kinds.h \
+    kinds.inc c99_protos.inc
 
 
 # Machine generated specifics
 gfor_built_specific_src = \
-generated/_abs_c4.f90 \
-generated/_abs_c8.f90 \
-generated/_abs_i4.f90 \
-generated/_abs_i8.f90 \
-generated/_abs_r4.f90 \
-generated/_abs_r8.f90 \
-generated/_exp_r4.f90 \
-generated/_exp_r8.f90 \
-generated/_exp_c4.f90 \
-generated/_exp_c8.f90 \
-generated/_log_r4.f90 \
-generated/_log_r8.f90 \
-generated/_log_c4.f90 \
-generated/_log_c8.f90 \
-generated/_log10_r4.f90 \
-generated/_log10_r8.f90 \
-generated/_sqrt_r4.f90 \
-generated/_sqrt_r8.f90 \
-generated/_sqrt_c4.f90 \
-generated/_sqrt_c8.f90 \
-generated/_asin_r4.f90 \
-generated/_asin_r8.f90 \
-generated/_acos_r4.f90 \
-generated/_acos_r8.f90 \
-generated/_atan_r4.f90 \
-generated/_atan_r8.f90 \
-generated/_sin_r4.f90 \
-generated/_sin_r8.f90 \
-generated/_sin_c4.f90 \
-generated/_sin_c8.f90 \
-generated/_cos_r4.f90 \
-generated/_cos_r8.f90 \
-generated/_cos_c4.f90 \
-generated/_cos_c8.f90 \
-generated/_tan_r4.f90 \
-generated/_tan_r8.f90 \
-generated/_sinh_r4.f90 \
-generated/_sinh_r8.f90 \
-generated/_cosh_r4.f90 \
-generated/_cosh_r8.f90 \
-generated/_tanh_r4.f90 \
-generated/_tanh_r8.f90 \
-generated/_conjg_c4.f90 \
-generated/_conjg_c8.f90 \
-generated/_aint_r4.f90 \
-generated/_aint_r8.f90 \
-generated/_anint_r4.f90 \
-generated/_anint_r8.f90
+generated/_abs_c4.F90 \
+generated/_abs_c8.F90 \
+generated/_abs_c10.F90 \
+generated/_abs_c16.F90 \
+generated/_abs_i4.F90 \
+generated/_abs_i8.F90 \
+generated/_abs_i16.F90 \
+generated/_abs_r4.F90 \
+generated/_abs_r8.F90 \
+generated/_abs_r10.F90 \
+generated/_abs_r16.F90 \
+generated/_exp_r4.F90 \
+generated/_exp_r8.F90 \
+generated/_exp_r10.F90 \
+generated/_exp_r16.F90 \
+generated/_exp_c4.F90 \
+generated/_exp_c8.F90 \
+generated/_exp_c10.F90 \
+generated/_exp_c16.F90 \
+generated/_log_r4.F90 \
+generated/_log_r8.F90 \
+generated/_log_r10.F90 \
+generated/_log_r16.F90 \
+generated/_log_c4.F90 \
+generated/_log_c8.F90 \
+generated/_log_c10.F90 \
+generated/_log_c16.F90 \
+generated/_log10_r4.F90 \
+generated/_log10_r8.F90 \
+generated/_log10_r10.F90 \
+generated/_log10_r16.F90 \
+generated/_sqrt_r4.F90 \
+generated/_sqrt_r8.F90 \
+generated/_sqrt_r10.F90 \
+generated/_sqrt_r16.F90 \
+generated/_sqrt_c4.F90 \
+generated/_sqrt_c8.F90 \
+generated/_sqrt_c10.F90 \
+generated/_sqrt_c16.F90 \
+generated/_asin_r4.F90 \
+generated/_asin_r8.F90 \
+generated/_asin_r10.F90 \
+generated/_asin_r16.F90 \
+generated/_acos_r4.F90 \
+generated/_acos_r8.F90 \
+generated/_acos_r10.F90 \
+generated/_acos_r16.F90 \
+generated/_atan_r4.F90 \
+generated/_atan_r8.F90 \
+generated/_atan_r10.F90 \
+generated/_atan_r16.F90 \
+generated/_sin_r4.F90 \
+generated/_sin_r8.F90 \
+generated/_sin_r10.F90 \
+generated/_sin_r16.F90 \
+generated/_sin_c4.F90 \
+generated/_sin_c8.F90 \
+generated/_sin_c10.F90 \
+generated/_sin_c16.F90 \
+generated/_cos_r4.F90 \
+generated/_cos_r8.F90 \
+generated/_cos_r10.F90 \
+generated/_cos_r16.F90 \
+generated/_cos_c4.F90 \
+generated/_cos_c8.F90 \
+generated/_cos_c10.F90 \
+generated/_cos_c16.F90 \
+generated/_tan_r4.F90 \
+generated/_tan_r8.F90 \
+generated/_tan_r10.F90 \
+generated/_tan_r16.F90 \
+generated/_sinh_r4.F90 \
+generated/_sinh_r8.F90 \
+generated/_sinh_r10.F90 \
+generated/_sinh_r16.F90 \
+generated/_cosh_r4.F90 \
+generated/_cosh_r8.F90 \
+generated/_cosh_r10.F90 \
+generated/_cosh_r16.F90 \
+generated/_tanh_r4.F90 \
+generated/_tanh_r8.F90 \
+generated/_tanh_r10.F90 \
+generated/_tanh_r16.F90 \
+generated/_conjg_c4.F90 \
+generated/_conjg_c8.F90 \
+generated/_conjg_c10.F90 \
+generated/_conjg_c16.F90 \
+generated/_aint_r4.F90 \
+generated/_aint_r8.F90 \
+generated/_aint_r10.F90 \
+generated/_aint_r16.F90 \
+generated/_anint_r4.F90 \
+generated/_anint_r8.F90 \
+generated/_anint_r10.F90 \
+generated/_anint_r16.F90
 
 gfor_built_specific2_src = \
-generated/_sign_i4.f90 \
-generated/_sign_i8.f90 \
-generated/_sign_r4.f90 \
-generated/_sign_r8.f90 \
-generated/_dim_i4.f90 \
-generated/_dim_i8.f90 \
-generated/_dim_r4.f90 \
-generated/_dim_r8.f90 \
-generated/_atan2_r4.f90 \
-generated/_atan2_r8.f90 \
-generated/_mod_i4.f90 \
-generated/_mod_i8.f90 \
-generated/_mod_r4.f90 \
-generated/_mod_r8.f90
-
+generated/_sign_i4.F90 \
+generated/_sign_i8.F90 \
+generated/_sign_i16.F90 \
+generated/_sign_r4.F90 \
+generated/_sign_r8.F90 \
+generated/_sign_r10.F90 \
+generated/_sign_r16.F90 \
+generated/_dim_i4.F90 \
+generated/_dim_i8.F90 \
+generated/_dim_i16.F90 \
+generated/_dim_r4.F90 \
+generated/_dim_r8.F90 \
+generated/_dim_r10.F90 \
+generated/_dim_r16.F90 \
+generated/_atan2_r4.F90 \
+generated/_atan2_r8.F90 \
+generated/_atan2_r10.F90 \
+generated/_atan2_r16.F90 \
+generated/_mod_i4.F90 \
+generated/_mod_i8.F90 \
+generated/_mod_i16.F90 \
+generated/_mod_r4.F90 \
+generated/_mod_r8.F90
+
+# There are commented out due to a bug in the way the front-end
+# handles MOD
+#generated/_mod_r10.F90
+#generated/_mod_r16.F90
 gfor_specific_src = \
 $(gfor_built_specific_src) \
 $(gfor_built_specific2_src) \
@@ -779,6 +1019,360 @@ distclean-compile:
 .F90.lo:
        $(LTPPFCCOMPILE) -c -o $@ $<
 
+_abs_c4.lo: generated/_abs_c4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_c4.lo `test -f 'generated/_abs_c4.F90' || echo '$(srcdir)/'`generated/_abs_c4.F90
+
+_abs_c8.lo: generated/_abs_c8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_c8.lo `test -f 'generated/_abs_c8.F90' || echo '$(srcdir)/'`generated/_abs_c8.F90
+
+_abs_c10.lo: generated/_abs_c10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_c10.lo `test -f 'generated/_abs_c10.F90' || echo '$(srcdir)/'`generated/_abs_c10.F90
+
+_abs_c16.lo: generated/_abs_c16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_c16.lo `test -f 'generated/_abs_c16.F90' || echo '$(srcdir)/'`generated/_abs_c16.F90
+
+_abs_i4.lo: generated/_abs_i4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_i4.lo `test -f 'generated/_abs_i4.F90' || echo '$(srcdir)/'`generated/_abs_i4.F90
+
+_abs_i8.lo: generated/_abs_i8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_i8.lo `test -f 'generated/_abs_i8.F90' || echo '$(srcdir)/'`generated/_abs_i8.F90
+
+_abs_i16.lo: generated/_abs_i16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_i16.lo `test -f 'generated/_abs_i16.F90' || echo '$(srcdir)/'`generated/_abs_i16.F90
+
+_abs_r4.lo: generated/_abs_r4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_r4.lo `test -f 'generated/_abs_r4.F90' || echo '$(srcdir)/'`generated/_abs_r4.F90
+
+_abs_r8.lo: generated/_abs_r8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_r8.lo `test -f 'generated/_abs_r8.F90' || echo '$(srcdir)/'`generated/_abs_r8.F90
+
+_abs_r10.lo: generated/_abs_r10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_r10.lo `test -f 'generated/_abs_r10.F90' || echo '$(srcdir)/'`generated/_abs_r10.F90
+
+_abs_r16.lo: generated/_abs_r16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_r16.lo `test -f 'generated/_abs_r16.F90' || echo '$(srcdir)/'`generated/_abs_r16.F90
+
+_exp_r4.lo: generated/_exp_r4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_r4.lo `test -f 'generated/_exp_r4.F90' || echo '$(srcdir)/'`generated/_exp_r4.F90
+
+_exp_r8.lo: generated/_exp_r8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_r8.lo `test -f 'generated/_exp_r8.F90' || echo '$(srcdir)/'`generated/_exp_r8.F90
+
+_exp_r10.lo: generated/_exp_r10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_r10.lo `test -f 'generated/_exp_r10.F90' || echo '$(srcdir)/'`generated/_exp_r10.F90
+
+_exp_r16.lo: generated/_exp_r16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_r16.lo `test -f 'generated/_exp_r16.F90' || echo '$(srcdir)/'`generated/_exp_r16.F90
+
+_exp_c4.lo: generated/_exp_c4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_c4.lo `test -f 'generated/_exp_c4.F90' || echo '$(srcdir)/'`generated/_exp_c4.F90
+
+_exp_c8.lo: generated/_exp_c8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_c8.lo `test -f 'generated/_exp_c8.F90' || echo '$(srcdir)/'`generated/_exp_c8.F90
+
+_exp_c10.lo: generated/_exp_c10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_c10.lo `test -f 'generated/_exp_c10.F90' || echo '$(srcdir)/'`generated/_exp_c10.F90
+
+_exp_c16.lo: generated/_exp_c16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_c16.lo `test -f 'generated/_exp_c16.F90' || echo '$(srcdir)/'`generated/_exp_c16.F90
+
+_log_r4.lo: generated/_log_r4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_r4.lo `test -f 'generated/_log_r4.F90' || echo '$(srcdir)/'`generated/_log_r4.F90
+
+_log_r8.lo: generated/_log_r8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_r8.lo `test -f 'generated/_log_r8.F90' || echo '$(srcdir)/'`generated/_log_r8.F90
+
+_log_r10.lo: generated/_log_r10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_r10.lo `test -f 'generated/_log_r10.F90' || echo '$(srcdir)/'`generated/_log_r10.F90
+
+_log_r16.lo: generated/_log_r16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_r16.lo `test -f 'generated/_log_r16.F90' || echo '$(srcdir)/'`generated/_log_r16.F90
+
+_log_c4.lo: generated/_log_c4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_c4.lo `test -f 'generated/_log_c4.F90' || echo '$(srcdir)/'`generated/_log_c4.F90
+
+_log_c8.lo: generated/_log_c8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_c8.lo `test -f 'generated/_log_c8.F90' || echo '$(srcdir)/'`generated/_log_c8.F90
+
+_log_c10.lo: generated/_log_c10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_c10.lo `test -f 'generated/_log_c10.F90' || echo '$(srcdir)/'`generated/_log_c10.F90
+
+_log_c16.lo: generated/_log_c16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_c16.lo `test -f 'generated/_log_c16.F90' || echo '$(srcdir)/'`generated/_log_c16.F90
+
+_log10_r4.lo: generated/_log10_r4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log10_r4.lo `test -f 'generated/_log10_r4.F90' || echo '$(srcdir)/'`generated/_log10_r4.F90
+
+_log10_r8.lo: generated/_log10_r8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log10_r8.lo `test -f 'generated/_log10_r8.F90' || echo '$(srcdir)/'`generated/_log10_r8.F90
+
+_log10_r10.lo: generated/_log10_r10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log10_r10.lo `test -f 'generated/_log10_r10.F90' || echo '$(srcdir)/'`generated/_log10_r10.F90
+
+_log10_r16.lo: generated/_log10_r16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log10_r16.lo `test -f 'generated/_log10_r16.F90' || echo '$(srcdir)/'`generated/_log10_r16.F90
+
+_sqrt_r4.lo: generated/_sqrt_r4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_r4.lo `test -f 'generated/_sqrt_r4.F90' || echo '$(srcdir)/'`generated/_sqrt_r4.F90
+
+_sqrt_r8.lo: generated/_sqrt_r8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_r8.lo `test -f 'generated/_sqrt_r8.F90' || echo '$(srcdir)/'`generated/_sqrt_r8.F90
+
+_sqrt_r10.lo: generated/_sqrt_r10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_r10.lo `test -f 'generated/_sqrt_r10.F90' || echo '$(srcdir)/'`generated/_sqrt_r10.F90
+
+_sqrt_r16.lo: generated/_sqrt_r16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_r16.lo `test -f 'generated/_sqrt_r16.F90' || echo '$(srcdir)/'`generated/_sqrt_r16.F90
+
+_sqrt_c4.lo: generated/_sqrt_c4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_c4.lo `test -f 'generated/_sqrt_c4.F90' || echo '$(srcdir)/'`generated/_sqrt_c4.F90
+
+_sqrt_c8.lo: generated/_sqrt_c8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_c8.lo `test -f 'generated/_sqrt_c8.F90' || echo '$(srcdir)/'`generated/_sqrt_c8.F90
+
+_sqrt_c10.lo: generated/_sqrt_c10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_c10.lo `test -f 'generated/_sqrt_c10.F90' || echo '$(srcdir)/'`generated/_sqrt_c10.F90
+
+_sqrt_c16.lo: generated/_sqrt_c16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_c16.lo `test -f 'generated/_sqrt_c16.F90' || echo '$(srcdir)/'`generated/_sqrt_c16.F90
+
+_asin_r4.lo: generated/_asin_r4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asin_r4.lo `test -f 'generated/_asin_r4.F90' || echo '$(srcdir)/'`generated/_asin_r4.F90
+
+_asin_r8.lo: generated/_asin_r8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asin_r8.lo `test -f 'generated/_asin_r8.F90' || echo '$(srcdir)/'`generated/_asin_r8.F90
+
+_asin_r10.lo: generated/_asin_r10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asin_r10.lo `test -f 'generated/_asin_r10.F90' || echo '$(srcdir)/'`generated/_asin_r10.F90
+
+_asin_r16.lo: generated/_asin_r16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asin_r16.lo `test -f 'generated/_asin_r16.F90' || echo '$(srcdir)/'`generated/_asin_r16.F90
+
+_acos_r4.lo: generated/_acos_r4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acos_r4.lo `test -f 'generated/_acos_r4.F90' || echo '$(srcdir)/'`generated/_acos_r4.F90
+
+_acos_r8.lo: generated/_acos_r8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acos_r8.lo `test -f 'generated/_acos_r8.F90' || echo '$(srcdir)/'`generated/_acos_r8.F90
+
+_acos_r10.lo: generated/_acos_r10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acos_r10.lo `test -f 'generated/_acos_r10.F90' || echo '$(srcdir)/'`generated/_acos_r10.F90
+
+_acos_r16.lo: generated/_acos_r16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acos_r16.lo `test -f 'generated/_acos_r16.F90' || echo '$(srcdir)/'`generated/_acos_r16.F90
+
+_atan_r4.lo: generated/_atan_r4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan_r4.lo `test -f 'generated/_atan_r4.F90' || echo '$(srcdir)/'`generated/_atan_r4.F90
+
+_atan_r8.lo: generated/_atan_r8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan_r8.lo `test -f 'generated/_atan_r8.F90' || echo '$(srcdir)/'`generated/_atan_r8.F90
+
+_atan_r10.lo: generated/_atan_r10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan_r10.lo `test -f 'generated/_atan_r10.F90' || echo '$(srcdir)/'`generated/_atan_r10.F90
+
+_atan_r16.lo: generated/_atan_r16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan_r16.lo `test -f 'generated/_atan_r16.F90' || echo '$(srcdir)/'`generated/_atan_r16.F90
+
+_sin_r4.lo: generated/_sin_r4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_r4.lo `test -f 'generated/_sin_r4.F90' || echo '$(srcdir)/'`generated/_sin_r4.F90
+
+_sin_r8.lo: generated/_sin_r8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_r8.lo `test -f 'generated/_sin_r8.F90' || echo '$(srcdir)/'`generated/_sin_r8.F90
+
+_sin_r10.lo: generated/_sin_r10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_r10.lo `test -f 'generated/_sin_r10.F90' || echo '$(srcdir)/'`generated/_sin_r10.F90
+
+_sin_r16.lo: generated/_sin_r16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_r16.lo `test -f 'generated/_sin_r16.F90' || echo '$(srcdir)/'`generated/_sin_r16.F90
+
+_sin_c4.lo: generated/_sin_c4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_c4.lo `test -f 'generated/_sin_c4.F90' || echo '$(srcdir)/'`generated/_sin_c4.F90
+
+_sin_c8.lo: generated/_sin_c8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_c8.lo `test -f 'generated/_sin_c8.F90' || echo '$(srcdir)/'`generated/_sin_c8.F90
+
+_sin_c10.lo: generated/_sin_c10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_c10.lo `test -f 'generated/_sin_c10.F90' || echo '$(srcdir)/'`generated/_sin_c10.F90
+
+_sin_c16.lo: generated/_sin_c16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_c16.lo `test -f 'generated/_sin_c16.F90' || echo '$(srcdir)/'`generated/_sin_c16.F90
+
+_cos_r4.lo: generated/_cos_r4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_r4.lo `test -f 'generated/_cos_r4.F90' || echo '$(srcdir)/'`generated/_cos_r4.F90
+
+_cos_r8.lo: generated/_cos_r8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_r8.lo `test -f 'generated/_cos_r8.F90' || echo '$(srcdir)/'`generated/_cos_r8.F90
+
+_cos_r10.lo: generated/_cos_r10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_r10.lo `test -f 'generated/_cos_r10.F90' || echo '$(srcdir)/'`generated/_cos_r10.F90
+
+_cos_r16.lo: generated/_cos_r16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_r16.lo `test -f 'generated/_cos_r16.F90' || echo '$(srcdir)/'`generated/_cos_r16.F90
+
+_cos_c4.lo: generated/_cos_c4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_c4.lo `test -f 'generated/_cos_c4.F90' || echo '$(srcdir)/'`generated/_cos_c4.F90
+
+_cos_c8.lo: generated/_cos_c8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_c8.lo `test -f 'generated/_cos_c8.F90' || echo '$(srcdir)/'`generated/_cos_c8.F90
+
+_cos_c10.lo: generated/_cos_c10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_c10.lo `test -f 'generated/_cos_c10.F90' || echo '$(srcdir)/'`generated/_cos_c10.F90
+
+_cos_c16.lo: generated/_cos_c16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_c16.lo `test -f 'generated/_cos_c16.F90' || echo '$(srcdir)/'`generated/_cos_c16.F90
+
+_tan_r4.lo: generated/_tan_r4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tan_r4.lo `test -f 'generated/_tan_r4.F90' || echo '$(srcdir)/'`generated/_tan_r4.F90
+
+_tan_r8.lo: generated/_tan_r8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tan_r8.lo `test -f 'generated/_tan_r8.F90' || echo '$(srcdir)/'`generated/_tan_r8.F90
+
+_tan_r10.lo: generated/_tan_r10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tan_r10.lo `test -f 'generated/_tan_r10.F90' || echo '$(srcdir)/'`generated/_tan_r10.F90
+
+_tan_r16.lo: generated/_tan_r16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tan_r16.lo `test -f 'generated/_tan_r16.F90' || echo '$(srcdir)/'`generated/_tan_r16.F90
+
+_sinh_r4.lo: generated/_sinh_r4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sinh_r4.lo `test -f 'generated/_sinh_r4.F90' || echo '$(srcdir)/'`generated/_sinh_r4.F90
+
+_sinh_r8.lo: generated/_sinh_r8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sinh_r8.lo `test -f 'generated/_sinh_r8.F90' || echo '$(srcdir)/'`generated/_sinh_r8.F90
+
+_sinh_r10.lo: generated/_sinh_r10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sinh_r10.lo `test -f 'generated/_sinh_r10.F90' || echo '$(srcdir)/'`generated/_sinh_r10.F90
+
+_sinh_r16.lo: generated/_sinh_r16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sinh_r16.lo `test -f 'generated/_sinh_r16.F90' || echo '$(srcdir)/'`generated/_sinh_r16.F90
+
+_cosh_r4.lo: generated/_cosh_r4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cosh_r4.lo `test -f 'generated/_cosh_r4.F90' || echo '$(srcdir)/'`generated/_cosh_r4.F90
+
+_cosh_r8.lo: generated/_cosh_r8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cosh_r8.lo `test -f 'generated/_cosh_r8.F90' || echo '$(srcdir)/'`generated/_cosh_r8.F90
+
+_cosh_r10.lo: generated/_cosh_r10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cosh_r10.lo `test -f 'generated/_cosh_r10.F90' || echo '$(srcdir)/'`generated/_cosh_r10.F90
+
+_cosh_r16.lo: generated/_cosh_r16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cosh_r16.lo `test -f 'generated/_cosh_r16.F90' || echo '$(srcdir)/'`generated/_cosh_r16.F90
+
+_tanh_r4.lo: generated/_tanh_r4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tanh_r4.lo `test -f 'generated/_tanh_r4.F90' || echo '$(srcdir)/'`generated/_tanh_r4.F90
+
+_tanh_r8.lo: generated/_tanh_r8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tanh_r8.lo `test -f 'generated/_tanh_r8.F90' || echo '$(srcdir)/'`generated/_tanh_r8.F90
+
+_tanh_r10.lo: generated/_tanh_r10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tanh_r10.lo `test -f 'generated/_tanh_r10.F90' || echo '$(srcdir)/'`generated/_tanh_r10.F90
+
+_tanh_r16.lo: generated/_tanh_r16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tanh_r16.lo `test -f 'generated/_tanh_r16.F90' || echo '$(srcdir)/'`generated/_tanh_r16.F90
+
+_conjg_c4.lo: generated/_conjg_c4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _conjg_c4.lo `test -f 'generated/_conjg_c4.F90' || echo '$(srcdir)/'`generated/_conjg_c4.F90
+
+_conjg_c8.lo: generated/_conjg_c8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _conjg_c8.lo `test -f 'generated/_conjg_c8.F90' || echo '$(srcdir)/'`generated/_conjg_c8.F90
+
+_conjg_c10.lo: generated/_conjg_c10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _conjg_c10.lo `test -f 'generated/_conjg_c10.F90' || echo '$(srcdir)/'`generated/_conjg_c10.F90
+
+_conjg_c16.lo: generated/_conjg_c16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _conjg_c16.lo `test -f 'generated/_conjg_c16.F90' || echo '$(srcdir)/'`generated/_conjg_c16.F90
+
+_aint_r4.lo: generated/_aint_r4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aint_r4.lo `test -f 'generated/_aint_r4.F90' || echo '$(srcdir)/'`generated/_aint_r4.F90
+
+_aint_r8.lo: generated/_aint_r8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aint_r8.lo `test -f 'generated/_aint_r8.F90' || echo '$(srcdir)/'`generated/_aint_r8.F90
+
+_aint_r10.lo: generated/_aint_r10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aint_r10.lo `test -f 'generated/_aint_r10.F90' || echo '$(srcdir)/'`generated/_aint_r10.F90
+
+_aint_r16.lo: generated/_aint_r16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aint_r16.lo `test -f 'generated/_aint_r16.F90' || echo '$(srcdir)/'`generated/_aint_r16.F90
+
+_anint_r4.lo: generated/_anint_r4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _anint_r4.lo `test -f 'generated/_anint_r4.F90' || echo '$(srcdir)/'`generated/_anint_r4.F90
+
+_anint_r8.lo: generated/_anint_r8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _anint_r8.lo `test -f 'generated/_anint_r8.F90' || echo '$(srcdir)/'`generated/_anint_r8.F90
+
+_anint_r10.lo: generated/_anint_r10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _anint_r10.lo `test -f 'generated/_anint_r10.F90' || echo '$(srcdir)/'`generated/_anint_r10.F90
+
+_anint_r16.lo: generated/_anint_r16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _anint_r16.lo `test -f 'generated/_anint_r16.F90' || echo '$(srcdir)/'`generated/_anint_r16.F90
+
+_sign_i4.lo: generated/_sign_i4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_i4.lo `test -f 'generated/_sign_i4.F90' || echo '$(srcdir)/'`generated/_sign_i4.F90
+
+_sign_i8.lo: generated/_sign_i8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_i8.lo `test -f 'generated/_sign_i8.F90' || echo '$(srcdir)/'`generated/_sign_i8.F90
+
+_sign_i16.lo: generated/_sign_i16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_i16.lo `test -f 'generated/_sign_i16.F90' || echo '$(srcdir)/'`generated/_sign_i16.F90
+
+_sign_r4.lo: generated/_sign_r4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_r4.lo `test -f 'generated/_sign_r4.F90' || echo '$(srcdir)/'`generated/_sign_r4.F90
+
+_sign_r8.lo: generated/_sign_r8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_r8.lo `test -f 'generated/_sign_r8.F90' || echo '$(srcdir)/'`generated/_sign_r8.F90
+
+_sign_r10.lo: generated/_sign_r10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_r10.lo `test -f 'generated/_sign_r10.F90' || echo '$(srcdir)/'`generated/_sign_r10.F90
+
+_sign_r16.lo: generated/_sign_r16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_r16.lo `test -f 'generated/_sign_r16.F90' || echo '$(srcdir)/'`generated/_sign_r16.F90
+
+_dim_i4.lo: generated/_dim_i4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_i4.lo `test -f 'generated/_dim_i4.F90' || echo '$(srcdir)/'`generated/_dim_i4.F90
+
+_dim_i8.lo: generated/_dim_i8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_i8.lo `test -f 'generated/_dim_i8.F90' || echo '$(srcdir)/'`generated/_dim_i8.F90
+
+_dim_i16.lo: generated/_dim_i16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_i16.lo `test -f 'generated/_dim_i16.F90' || echo '$(srcdir)/'`generated/_dim_i16.F90
+
+_dim_r4.lo: generated/_dim_r4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_r4.lo `test -f 'generated/_dim_r4.F90' || echo '$(srcdir)/'`generated/_dim_r4.F90
+
+_dim_r8.lo: generated/_dim_r8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_r8.lo `test -f 'generated/_dim_r8.F90' || echo '$(srcdir)/'`generated/_dim_r8.F90
+
+_dim_r10.lo: generated/_dim_r10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_r10.lo `test -f 'generated/_dim_r10.F90' || echo '$(srcdir)/'`generated/_dim_r10.F90
+
+_dim_r16.lo: generated/_dim_r16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_r16.lo `test -f 'generated/_dim_r16.F90' || echo '$(srcdir)/'`generated/_dim_r16.F90
+
+_atan2_r4.lo: generated/_atan2_r4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan2_r4.lo `test -f 'generated/_atan2_r4.F90' || echo '$(srcdir)/'`generated/_atan2_r4.F90
+
+_atan2_r8.lo: generated/_atan2_r8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan2_r8.lo `test -f 'generated/_atan2_r8.F90' || echo '$(srcdir)/'`generated/_atan2_r8.F90
+
+_atan2_r10.lo: generated/_atan2_r10.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan2_r10.lo `test -f 'generated/_atan2_r10.F90' || echo '$(srcdir)/'`generated/_atan2_r10.F90
+
+_atan2_r16.lo: generated/_atan2_r16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan2_r16.lo `test -f 'generated/_atan2_r16.F90' || echo '$(srcdir)/'`generated/_atan2_r16.F90
+
+_mod_i4.lo: generated/_mod_i4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_i4.lo `test -f 'generated/_mod_i4.F90' || echo '$(srcdir)/'`generated/_mod_i4.F90
+
+_mod_i8.lo: generated/_mod_i8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_i8.lo `test -f 'generated/_mod_i8.F90' || echo '$(srcdir)/'`generated/_mod_i8.F90
+
+_mod_i16.lo: generated/_mod_i16.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_i16.lo `test -f 'generated/_mod_i16.F90' || echo '$(srcdir)/'`generated/_mod_i16.F90
+
+_mod_r4.lo: generated/_mod_r4.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_r4.lo `test -f 'generated/_mod_r4.F90' || echo '$(srcdir)/'`generated/_mod_r4.F90
+
+_mod_r8.lo: generated/_mod_r8.F90
+       $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_r8.lo `test -f 'generated/_mod_r8.F90' || echo '$(srcdir)/'`generated/_mod_r8.F90
+
 f2c_specifics.lo: intrinsics/f2c_specifics.F90
        $(LIBTOOL) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o f2c_specifics.lo `test -f 'intrinsics/f2c_specifics.F90' || echo '$(srcdir)/'`intrinsics/f2c_specifics.F90
 
@@ -824,360 +1418,756 @@ all_l4.lo: generated/all_l4.c
 all_l8.lo: generated/all_l8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o all_l8.lo `test -f 'generated/all_l8.c' || echo '$(srcdir)/'`generated/all_l8.c
 
+all_l16.lo: generated/all_l16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o all_l16.lo `test -f 'generated/all_l16.c' || echo '$(srcdir)/'`generated/all_l16.c
+
 any_l4.lo: generated/any_l4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o any_l4.lo `test -f 'generated/any_l4.c' || echo '$(srcdir)/'`generated/any_l4.c
 
 any_l8.lo: generated/any_l8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o any_l8.lo `test -f 'generated/any_l8.c' || echo '$(srcdir)/'`generated/any_l8.c
 
+any_l16.lo: generated/any_l16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o any_l16.lo `test -f 'generated/any_l16.c' || echo '$(srcdir)/'`generated/any_l16.c
+
 count_4_l4.lo: generated/count_4_l4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_4_l4.lo `test -f 'generated/count_4_l4.c' || echo '$(srcdir)/'`generated/count_4_l4.c
 
 count_8_l4.lo: generated/count_8_l4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_8_l4.lo `test -f 'generated/count_8_l4.c' || echo '$(srcdir)/'`generated/count_8_l4.c
 
+count_16_l4.lo: generated/count_16_l4.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_16_l4.lo `test -f 'generated/count_16_l4.c' || echo '$(srcdir)/'`generated/count_16_l4.c
+
 count_4_l8.lo: generated/count_4_l8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_4_l8.lo `test -f 'generated/count_4_l8.c' || echo '$(srcdir)/'`generated/count_4_l8.c
 
 count_8_l8.lo: generated/count_8_l8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_8_l8.lo `test -f 'generated/count_8_l8.c' || echo '$(srcdir)/'`generated/count_8_l8.c
 
+count_16_l8.lo: generated/count_16_l8.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_16_l8.lo `test -f 'generated/count_16_l8.c' || echo '$(srcdir)/'`generated/count_16_l8.c
+
+count_4_l16.lo: generated/count_4_l16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_4_l16.lo `test -f 'generated/count_4_l16.c' || echo '$(srcdir)/'`generated/count_4_l16.c
+
+count_8_l16.lo: generated/count_8_l16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_8_l16.lo `test -f 'generated/count_8_l16.c' || echo '$(srcdir)/'`generated/count_8_l16.c
+
+count_16_l16.lo: generated/count_16_l16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_16_l16.lo `test -f 'generated/count_16_l16.c' || echo '$(srcdir)/'`generated/count_16_l16.c
+
 maxloc0_4_i4.lo: generated/maxloc0_4_i4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_i4.lo `test -f 'generated/maxloc0_4_i4.c' || echo '$(srcdir)/'`generated/maxloc0_4_i4.c
 
 maxloc0_8_i4.lo: generated/maxloc0_8_i4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_i4.lo `test -f 'generated/maxloc0_8_i4.c' || echo '$(srcdir)/'`generated/maxloc0_8_i4.c
 
+maxloc0_16_i4.lo: generated/maxloc0_16_i4.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_i4.lo `test -f 'generated/maxloc0_16_i4.c' || echo '$(srcdir)/'`generated/maxloc0_16_i4.c
+
 maxloc0_4_i8.lo: generated/maxloc0_4_i8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_i8.lo `test -f 'generated/maxloc0_4_i8.c' || echo '$(srcdir)/'`generated/maxloc0_4_i8.c
 
 maxloc0_8_i8.lo: generated/maxloc0_8_i8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_i8.lo `test -f 'generated/maxloc0_8_i8.c' || echo '$(srcdir)/'`generated/maxloc0_8_i8.c
 
+maxloc0_16_i8.lo: generated/maxloc0_16_i8.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_i8.lo `test -f 'generated/maxloc0_16_i8.c' || echo '$(srcdir)/'`generated/maxloc0_16_i8.c
+
+maxloc0_4_i16.lo: generated/maxloc0_4_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_i16.lo `test -f 'generated/maxloc0_4_i16.c' || echo '$(srcdir)/'`generated/maxloc0_4_i16.c
+
+maxloc0_8_i16.lo: generated/maxloc0_8_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_i16.lo `test -f 'generated/maxloc0_8_i16.c' || echo '$(srcdir)/'`generated/maxloc0_8_i16.c
+
+maxloc0_16_i16.lo: generated/maxloc0_16_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_i16.lo `test -f 'generated/maxloc0_16_i16.c' || echo '$(srcdir)/'`generated/maxloc0_16_i16.c
+
 maxloc0_4_r4.lo: generated/maxloc0_4_r4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_r4.lo `test -f 'generated/maxloc0_4_r4.c' || echo '$(srcdir)/'`generated/maxloc0_4_r4.c
 
 maxloc0_8_r4.lo: generated/maxloc0_8_r4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_r4.lo `test -f 'generated/maxloc0_8_r4.c' || echo '$(srcdir)/'`generated/maxloc0_8_r4.c
 
+maxloc0_16_r4.lo: generated/maxloc0_16_r4.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_r4.lo `test -f 'generated/maxloc0_16_r4.c' || echo '$(srcdir)/'`generated/maxloc0_16_r4.c
+
 maxloc0_4_r8.lo: generated/maxloc0_4_r8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_r8.lo `test -f 'generated/maxloc0_4_r8.c' || echo '$(srcdir)/'`generated/maxloc0_4_r8.c
 
 maxloc0_8_r8.lo: generated/maxloc0_8_r8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_r8.lo `test -f 'generated/maxloc0_8_r8.c' || echo '$(srcdir)/'`generated/maxloc0_8_r8.c
 
+maxloc0_16_r8.lo: generated/maxloc0_16_r8.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_r8.lo `test -f 'generated/maxloc0_16_r8.c' || echo '$(srcdir)/'`generated/maxloc0_16_r8.c
+
+maxloc0_4_r10.lo: generated/maxloc0_4_r10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_r10.lo `test -f 'generated/maxloc0_4_r10.c' || echo '$(srcdir)/'`generated/maxloc0_4_r10.c
+
+maxloc0_8_r10.lo: generated/maxloc0_8_r10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_r10.lo `test -f 'generated/maxloc0_8_r10.c' || echo '$(srcdir)/'`generated/maxloc0_8_r10.c
+
+maxloc0_16_r10.lo: generated/maxloc0_16_r10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_r10.lo `test -f 'generated/maxloc0_16_r10.c' || echo '$(srcdir)/'`generated/maxloc0_16_r10.c
+
+maxloc0_4_r16.lo: generated/maxloc0_4_r16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_r16.lo `test -f 'generated/maxloc0_4_r16.c' || echo '$(srcdir)/'`generated/maxloc0_4_r16.c
+
+maxloc0_8_r16.lo: generated/maxloc0_8_r16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_r16.lo `test -f 'generated/maxloc0_8_r16.c' || echo '$(srcdir)/'`generated/maxloc0_8_r16.c
+
+maxloc0_16_r16.lo: generated/maxloc0_16_r16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_r16.lo `test -f 'generated/maxloc0_16_r16.c' || echo '$(srcdir)/'`generated/maxloc0_16_r16.c
+
 maxloc1_4_i4.lo: generated/maxloc1_4_i4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_i4.lo `test -f 'generated/maxloc1_4_i4.c' || echo '$(srcdir)/'`generated/maxloc1_4_i4.c
 
 maxloc1_8_i4.lo: generated/maxloc1_8_i4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_i4.lo `test -f 'generated/maxloc1_8_i4.c' || echo '$(srcdir)/'`generated/maxloc1_8_i4.c
 
+maxloc1_16_i4.lo: generated/maxloc1_16_i4.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_i4.lo `test -f 'generated/maxloc1_16_i4.c' || echo '$(srcdir)/'`generated/maxloc1_16_i4.c
+
 maxloc1_4_i8.lo: generated/maxloc1_4_i8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_i8.lo `test -f 'generated/maxloc1_4_i8.c' || echo '$(srcdir)/'`generated/maxloc1_4_i8.c
 
 maxloc1_8_i8.lo: generated/maxloc1_8_i8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_i8.lo `test -f 'generated/maxloc1_8_i8.c' || echo '$(srcdir)/'`generated/maxloc1_8_i8.c
 
+maxloc1_16_i8.lo: generated/maxloc1_16_i8.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_i8.lo `test -f 'generated/maxloc1_16_i8.c' || echo '$(srcdir)/'`generated/maxloc1_16_i8.c
+
+maxloc1_4_i16.lo: generated/maxloc1_4_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_i16.lo `test -f 'generated/maxloc1_4_i16.c' || echo '$(srcdir)/'`generated/maxloc1_4_i16.c
+
+maxloc1_8_i16.lo: generated/maxloc1_8_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_i16.lo `test -f 'generated/maxloc1_8_i16.c' || echo '$(srcdir)/'`generated/maxloc1_8_i16.c
+
+maxloc1_16_i16.lo: generated/maxloc1_16_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_i16.lo `test -f 'generated/maxloc1_16_i16.c' || echo '$(srcdir)/'`generated/maxloc1_16_i16.c
+
 maxloc1_4_r4.lo: generated/maxloc1_4_r4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_r4.lo `test -f 'generated/maxloc1_4_r4.c' || echo '$(srcdir)/'`generated/maxloc1_4_r4.c
 
 maxloc1_8_r4.lo: generated/maxloc1_8_r4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_r4.lo `test -f 'generated/maxloc1_8_r4.c' || echo '$(srcdir)/'`generated/maxloc1_8_r4.c
 
+maxloc1_16_r4.lo: generated/maxloc1_16_r4.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_r4.lo `test -f 'generated/maxloc1_16_r4.c' || echo '$(srcdir)/'`generated/maxloc1_16_r4.c
+
 maxloc1_4_r8.lo: generated/maxloc1_4_r8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_r8.lo `test -f 'generated/maxloc1_4_r8.c' || echo '$(srcdir)/'`generated/maxloc1_4_r8.c
 
 maxloc1_8_r8.lo: generated/maxloc1_8_r8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_r8.lo `test -f 'generated/maxloc1_8_r8.c' || echo '$(srcdir)/'`generated/maxloc1_8_r8.c
 
+maxloc1_16_r8.lo: generated/maxloc1_16_r8.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_r8.lo `test -f 'generated/maxloc1_16_r8.c' || echo '$(srcdir)/'`generated/maxloc1_16_r8.c
+
+maxloc1_4_r10.lo: generated/maxloc1_4_r10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_r10.lo `test -f 'generated/maxloc1_4_r10.c' || echo '$(srcdir)/'`generated/maxloc1_4_r10.c
+
+maxloc1_8_r10.lo: generated/maxloc1_8_r10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_r10.lo `test -f 'generated/maxloc1_8_r10.c' || echo '$(srcdir)/'`generated/maxloc1_8_r10.c
+
+maxloc1_16_r10.lo: generated/maxloc1_16_r10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_r10.lo `test -f 'generated/maxloc1_16_r10.c' || echo '$(srcdir)/'`generated/maxloc1_16_r10.c
+
+maxloc1_4_r16.lo: generated/maxloc1_4_r16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_r16.lo `test -f 'generated/maxloc1_4_r16.c' || echo '$(srcdir)/'`generated/maxloc1_4_r16.c
+
+maxloc1_8_r16.lo: generated/maxloc1_8_r16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_r16.lo `test -f 'generated/maxloc1_8_r16.c' || echo '$(srcdir)/'`generated/maxloc1_8_r16.c
+
+maxloc1_16_r16.lo: generated/maxloc1_16_r16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_r16.lo `test -f 'generated/maxloc1_16_r16.c' || echo '$(srcdir)/'`generated/maxloc1_16_r16.c
+
 maxval_i4.lo: generated/maxval_i4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_i4.lo `test -f 'generated/maxval_i4.c' || echo '$(srcdir)/'`generated/maxval_i4.c
 
 maxval_i8.lo: generated/maxval_i8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_i8.lo `test -f 'generated/maxval_i8.c' || echo '$(srcdir)/'`generated/maxval_i8.c
 
+maxval_i16.lo: generated/maxval_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_i16.lo `test -f 'generated/maxval_i16.c' || echo '$(srcdir)/'`generated/maxval_i16.c
+
 maxval_r4.lo: generated/maxval_r4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_r4.lo `test -f 'generated/maxval_r4.c' || echo '$(srcdir)/'`generated/maxval_r4.c
 
 maxval_r8.lo: generated/maxval_r8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_r8.lo `test -f 'generated/maxval_r8.c' || echo '$(srcdir)/'`generated/maxval_r8.c
 
+maxval_r10.lo: generated/maxval_r10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_r10.lo `test -f 'generated/maxval_r10.c' || echo '$(srcdir)/'`generated/maxval_r10.c
+
+maxval_r16.lo: generated/maxval_r16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_r16.lo `test -f 'generated/maxval_r16.c' || echo '$(srcdir)/'`generated/maxval_r16.c
+
 minloc0_4_i4.lo: generated/minloc0_4_i4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_i4.lo `test -f 'generated/minloc0_4_i4.c' || echo '$(srcdir)/'`generated/minloc0_4_i4.c
 
 minloc0_8_i4.lo: generated/minloc0_8_i4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_i4.lo `test -f 'generated/minloc0_8_i4.c' || echo '$(srcdir)/'`generated/minloc0_8_i4.c
 
+minloc0_16_i4.lo: generated/minloc0_16_i4.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_i4.lo `test -f 'generated/minloc0_16_i4.c' || echo '$(srcdir)/'`generated/minloc0_16_i4.c
+
 minloc0_4_i8.lo: generated/minloc0_4_i8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_i8.lo `test -f 'generated/minloc0_4_i8.c' || echo '$(srcdir)/'`generated/minloc0_4_i8.c
 
 minloc0_8_i8.lo: generated/minloc0_8_i8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_i8.lo `test -f 'generated/minloc0_8_i8.c' || echo '$(srcdir)/'`generated/minloc0_8_i8.c
 
+minloc0_16_i8.lo: generated/minloc0_16_i8.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_i8.lo `test -f 'generated/minloc0_16_i8.c' || echo '$(srcdir)/'`generated/minloc0_16_i8.c
+
+minloc0_4_i16.lo: generated/minloc0_4_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_i16.lo `test -f 'generated/minloc0_4_i16.c' || echo '$(srcdir)/'`generated/minloc0_4_i16.c
+
+minloc0_8_i16.lo: generated/minloc0_8_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_i16.lo `test -f 'generated/minloc0_8_i16.c' || echo '$(srcdir)/'`generated/minloc0_8_i16.c
+
+minloc0_16_i16.lo: generated/minloc0_16_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_i16.lo `test -f 'generated/minloc0_16_i16.c' || echo '$(srcdir)/'`generated/minloc0_16_i16.c
+
 minloc0_4_r4.lo: generated/minloc0_4_r4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_r4.lo `test -f 'generated/minloc0_4_r4.c' || echo '$(srcdir)/'`generated/minloc0_4_r4.c
 
 minloc0_8_r4.lo: generated/minloc0_8_r4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_r4.lo `test -f 'generated/minloc0_8_r4.c' || echo '$(srcdir)/'`generated/minloc0_8_r4.c
 
+minloc0_16_r4.lo: generated/minloc0_16_r4.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_r4.lo `test -f 'generated/minloc0_16_r4.c' || echo '$(srcdir)/'`generated/minloc0_16_r4.c
+
 minloc0_4_r8.lo: generated/minloc0_4_r8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_r8.lo `test -f 'generated/minloc0_4_r8.c' || echo '$(srcdir)/'`generated/minloc0_4_r8.c
 
 minloc0_8_r8.lo: generated/minloc0_8_r8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_r8.lo `test -f 'generated/minloc0_8_r8.c' || echo '$(srcdir)/'`generated/minloc0_8_r8.c
 
+minloc0_16_r8.lo: generated/minloc0_16_r8.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_r8.lo `test -f 'generated/minloc0_16_r8.c' || echo '$(srcdir)/'`generated/minloc0_16_r8.c
+
+minloc0_4_r10.lo: generated/minloc0_4_r10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_r10.lo `test -f 'generated/minloc0_4_r10.c' || echo '$(srcdir)/'`generated/minloc0_4_r10.c
+
+minloc0_8_r10.lo: generated/minloc0_8_r10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_r10.lo `test -f 'generated/minloc0_8_r10.c' || echo '$(srcdir)/'`generated/minloc0_8_r10.c
+
+minloc0_16_r10.lo: generated/minloc0_16_r10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_r10.lo `test -f 'generated/minloc0_16_r10.c' || echo '$(srcdir)/'`generated/minloc0_16_r10.c
+
+minloc0_4_r16.lo: generated/minloc0_4_r16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_r16.lo `test -f 'generated/minloc0_4_r16.c' || echo '$(srcdir)/'`generated/minloc0_4_r16.c
+
+minloc0_8_r16.lo: generated/minloc0_8_r16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_r16.lo `test -f 'generated/minloc0_8_r16.c' || echo '$(srcdir)/'`generated/minloc0_8_r16.c
+
+minloc0_16_r16.lo: generated/minloc0_16_r16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_r16.lo `test -f 'generated/minloc0_16_r16.c' || echo '$(srcdir)/'`generated/minloc0_16_r16.c
+
 minloc1_4_i4.lo: generated/minloc1_4_i4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_i4.lo `test -f 'generated/minloc1_4_i4.c' || echo '$(srcdir)/'`generated/minloc1_4_i4.c
 
 minloc1_8_i4.lo: generated/minloc1_8_i4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_i4.lo `test -f 'generated/minloc1_8_i4.c' || echo '$(srcdir)/'`generated/minloc1_8_i4.c
 
+minloc1_16_i4.lo: generated/minloc1_16_i4.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_i4.lo `test -f 'generated/minloc1_16_i4.c' || echo '$(srcdir)/'`generated/minloc1_16_i4.c
+
 minloc1_4_i8.lo: generated/minloc1_4_i8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_i8.lo `test -f 'generated/minloc1_4_i8.c' || echo '$(srcdir)/'`generated/minloc1_4_i8.c
 
 minloc1_8_i8.lo: generated/minloc1_8_i8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_i8.lo `test -f 'generated/minloc1_8_i8.c' || echo '$(srcdir)/'`generated/minloc1_8_i8.c
 
+minloc1_16_i8.lo: generated/minloc1_16_i8.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_i8.lo `test -f 'generated/minloc1_16_i8.c' || echo '$(srcdir)/'`generated/minloc1_16_i8.c
+
+minloc1_4_i16.lo: generated/minloc1_4_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_i16.lo `test -f 'generated/minloc1_4_i16.c' || echo '$(srcdir)/'`generated/minloc1_4_i16.c
+
+minloc1_8_i16.lo: generated/minloc1_8_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_i16.lo `test -f 'generated/minloc1_8_i16.c' || echo '$(srcdir)/'`generated/minloc1_8_i16.c
+
+minloc1_16_i16.lo: generated/minloc1_16_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_i16.lo `test -f 'generated/minloc1_16_i16.c' || echo '$(srcdir)/'`generated/minloc1_16_i16.c
+
 minloc1_4_r4.lo: generated/minloc1_4_r4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_r4.lo `test -f 'generated/minloc1_4_r4.c' || echo '$(srcdir)/'`generated/minloc1_4_r4.c
 
 minloc1_8_r4.lo: generated/minloc1_8_r4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_r4.lo `test -f 'generated/minloc1_8_r4.c' || echo '$(srcdir)/'`generated/minloc1_8_r4.c
 
+minloc1_16_r4.lo: generated/minloc1_16_r4.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_r4.lo `test -f 'generated/minloc1_16_r4.c' || echo '$(srcdir)/'`generated/minloc1_16_r4.c
+
 minloc1_4_r8.lo: generated/minloc1_4_r8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_r8.lo `test -f 'generated/minloc1_4_r8.c' || echo '$(srcdir)/'`generated/minloc1_4_r8.c
 
 minloc1_8_r8.lo: generated/minloc1_8_r8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_r8.lo `test -f 'generated/minloc1_8_r8.c' || echo '$(srcdir)/'`generated/minloc1_8_r8.c
 
+minloc1_16_r8.lo: generated/minloc1_16_r8.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_r8.lo `test -f 'generated/minloc1_16_r8.c' || echo '$(srcdir)/'`generated/minloc1_16_r8.c
+
+minloc1_4_r10.lo: generated/minloc1_4_r10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_r10.lo `test -f 'generated/minloc1_4_r10.c' || echo '$(srcdir)/'`generated/minloc1_4_r10.c
+
+minloc1_8_r10.lo: generated/minloc1_8_r10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_r10.lo `test -f 'generated/minloc1_8_r10.c' || echo '$(srcdir)/'`generated/minloc1_8_r10.c
+
+minloc1_16_r10.lo: generated/minloc1_16_r10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_r10.lo `test -f 'generated/minloc1_16_r10.c' || echo '$(srcdir)/'`generated/minloc1_16_r10.c
+
+minloc1_4_r16.lo: generated/minloc1_4_r16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_r16.lo `test -f 'generated/minloc1_4_r16.c' || echo '$(srcdir)/'`generated/minloc1_4_r16.c
+
+minloc1_8_r16.lo: generated/minloc1_8_r16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_r16.lo `test -f 'generated/minloc1_8_r16.c' || echo '$(srcdir)/'`generated/minloc1_8_r16.c
+
+minloc1_16_r16.lo: generated/minloc1_16_r16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_r16.lo `test -f 'generated/minloc1_16_r16.c' || echo '$(srcdir)/'`generated/minloc1_16_r16.c
+
 minval_i4.lo: generated/minval_i4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_i4.lo `test -f 'generated/minval_i4.c' || echo '$(srcdir)/'`generated/minval_i4.c
 
 minval_i8.lo: generated/minval_i8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_i8.lo `test -f 'generated/minval_i8.c' || echo '$(srcdir)/'`generated/minval_i8.c
 
+minval_i16.lo: generated/minval_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_i16.lo `test -f 'generated/minval_i16.c' || echo '$(srcdir)/'`generated/minval_i16.c
+
 minval_r4.lo: generated/minval_r4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_r4.lo `test -f 'generated/minval_r4.c' || echo '$(srcdir)/'`generated/minval_r4.c
 
 minval_r8.lo: generated/minval_r8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_r8.lo `test -f 'generated/minval_r8.c' || echo '$(srcdir)/'`generated/minval_r8.c
 
+minval_r10.lo: generated/minval_r10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_r10.lo `test -f 'generated/minval_r10.c' || echo '$(srcdir)/'`generated/minval_r10.c
+
+minval_r16.lo: generated/minval_r16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_r16.lo `test -f 'generated/minval_r16.c' || echo '$(srcdir)/'`generated/minval_r16.c
+
 product_i4.lo: generated/product_i4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_i4.lo `test -f 'generated/product_i4.c' || echo '$(srcdir)/'`generated/product_i4.c
 
 product_i8.lo: generated/product_i8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_i8.lo `test -f 'generated/product_i8.c' || echo '$(srcdir)/'`generated/product_i8.c
 
+product_i16.lo: generated/product_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_i16.lo `test -f 'generated/product_i16.c' || echo '$(srcdir)/'`generated/product_i16.c
+
 product_r4.lo: generated/product_r4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_r4.lo `test -f 'generated/product_r4.c' || echo '$(srcdir)/'`generated/product_r4.c
 
 product_r8.lo: generated/product_r8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_r8.lo `test -f 'generated/product_r8.c' || echo '$(srcdir)/'`generated/product_r8.c
 
+product_r10.lo: generated/product_r10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_r10.lo `test -f 'generated/product_r10.c' || echo '$(srcdir)/'`generated/product_r10.c
+
+product_r16.lo: generated/product_r16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_r16.lo `test -f 'generated/product_r16.c' || echo '$(srcdir)/'`generated/product_r16.c
+
 product_c4.lo: generated/product_c4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_c4.lo `test -f 'generated/product_c4.c' || echo '$(srcdir)/'`generated/product_c4.c
 
 product_c8.lo: generated/product_c8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_c8.lo `test -f 'generated/product_c8.c' || echo '$(srcdir)/'`generated/product_c8.c
 
+product_c10.lo: generated/product_c10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_c10.lo `test -f 'generated/product_c10.c' || echo '$(srcdir)/'`generated/product_c10.c
+
+product_c16.lo: generated/product_c16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_c16.lo `test -f 'generated/product_c16.c' || echo '$(srcdir)/'`generated/product_c16.c
+
 sum_i4.lo: generated/sum_i4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_i4.lo `test -f 'generated/sum_i4.c' || echo '$(srcdir)/'`generated/sum_i4.c
 
 sum_i8.lo: generated/sum_i8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_i8.lo `test -f 'generated/sum_i8.c' || echo '$(srcdir)/'`generated/sum_i8.c
 
+sum_i16.lo: generated/sum_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_i16.lo `test -f 'generated/sum_i16.c' || echo '$(srcdir)/'`generated/sum_i16.c
+
 sum_r4.lo: generated/sum_r4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_r4.lo `test -f 'generated/sum_r4.c' || echo '$(srcdir)/'`generated/sum_r4.c
 
 sum_r8.lo: generated/sum_r8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_r8.lo `test -f 'generated/sum_r8.c' || echo '$(srcdir)/'`generated/sum_r8.c
 
+sum_r10.lo: generated/sum_r10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_r10.lo `test -f 'generated/sum_r10.c' || echo '$(srcdir)/'`generated/sum_r10.c
+
+sum_r16.lo: generated/sum_r16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_r16.lo `test -f 'generated/sum_r16.c' || echo '$(srcdir)/'`generated/sum_r16.c
+
 sum_c4.lo: generated/sum_c4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_c4.lo `test -f 'generated/sum_c4.c' || echo '$(srcdir)/'`generated/sum_c4.c
 
 sum_c8.lo: generated/sum_c8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_c8.lo `test -f 'generated/sum_c8.c' || echo '$(srcdir)/'`generated/sum_c8.c
 
+sum_c10.lo: generated/sum_c10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_c10.lo `test -f 'generated/sum_c10.c' || echo '$(srcdir)/'`generated/sum_c10.c
+
+sum_c16.lo: generated/sum_c16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_c16.lo `test -f 'generated/sum_c16.c' || echo '$(srcdir)/'`generated/sum_c16.c
+
 dotprod_i4.lo: generated/dotprod_i4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_i4.lo `test -f 'generated/dotprod_i4.c' || echo '$(srcdir)/'`generated/dotprod_i4.c
 
 dotprod_i8.lo: generated/dotprod_i8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_i8.lo `test -f 'generated/dotprod_i8.c' || echo '$(srcdir)/'`generated/dotprod_i8.c
 
+dotprod_i16.lo: generated/dotprod_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_i16.lo `test -f 'generated/dotprod_i16.c' || echo '$(srcdir)/'`generated/dotprod_i16.c
+
 dotprod_r4.lo: generated/dotprod_r4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_r4.lo `test -f 'generated/dotprod_r4.c' || echo '$(srcdir)/'`generated/dotprod_r4.c
 
 dotprod_r8.lo: generated/dotprod_r8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_r8.lo `test -f 'generated/dotprod_r8.c' || echo '$(srcdir)/'`generated/dotprod_r8.c
 
+dotprod_r10.lo: generated/dotprod_r10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_r10.lo `test -f 'generated/dotprod_r10.c' || echo '$(srcdir)/'`generated/dotprod_r10.c
+
+dotprod_r16.lo: generated/dotprod_r16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_r16.lo `test -f 'generated/dotprod_r16.c' || echo '$(srcdir)/'`generated/dotprod_r16.c
+
 dotprod_l4.lo: generated/dotprod_l4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_l4.lo `test -f 'generated/dotprod_l4.c' || echo '$(srcdir)/'`generated/dotprod_l4.c
 
 dotprod_l8.lo: generated/dotprod_l8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_l8.lo `test -f 'generated/dotprod_l8.c' || echo '$(srcdir)/'`generated/dotprod_l8.c
 
+dotprod_l16.lo: generated/dotprod_l16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_l16.lo `test -f 'generated/dotprod_l16.c' || echo '$(srcdir)/'`generated/dotprod_l16.c
+
 dotprod_c4.lo: generated/dotprod_c4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_c4.lo `test -f 'generated/dotprod_c4.c' || echo '$(srcdir)/'`generated/dotprod_c4.c
 
 dotprod_c8.lo: generated/dotprod_c8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_c8.lo `test -f 'generated/dotprod_c8.c' || echo '$(srcdir)/'`generated/dotprod_c8.c
 
+dotprod_c10.lo: generated/dotprod_c10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_c10.lo `test -f 'generated/dotprod_c10.c' || echo '$(srcdir)/'`generated/dotprod_c10.c
+
+dotprod_c16.lo: generated/dotprod_c16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dotprod_c16.lo `test -f 'generated/dotprod_c16.c' || echo '$(srcdir)/'`generated/dotprod_c16.c
+
 matmul_i4.lo: generated/matmul_i4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_i4.lo `test -f 'generated/matmul_i4.c' || echo '$(srcdir)/'`generated/matmul_i4.c
 
 matmul_i8.lo: generated/matmul_i8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_i8.lo `test -f 'generated/matmul_i8.c' || echo '$(srcdir)/'`generated/matmul_i8.c
 
+matmul_i16.lo: generated/matmul_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_i16.lo `test -f 'generated/matmul_i16.c' || echo '$(srcdir)/'`generated/matmul_i16.c
+
 matmul_r4.lo: generated/matmul_r4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_r4.lo `test -f 'generated/matmul_r4.c' || echo '$(srcdir)/'`generated/matmul_r4.c
 
 matmul_r8.lo: generated/matmul_r8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_r8.lo `test -f 'generated/matmul_r8.c' || echo '$(srcdir)/'`generated/matmul_r8.c
 
+matmul_r10.lo: generated/matmul_r10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_r10.lo `test -f 'generated/matmul_r10.c' || echo '$(srcdir)/'`generated/matmul_r10.c
+
+matmul_r16.lo: generated/matmul_r16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_r16.lo `test -f 'generated/matmul_r16.c' || echo '$(srcdir)/'`generated/matmul_r16.c
+
 matmul_c4.lo: generated/matmul_c4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_c4.lo `test -f 'generated/matmul_c4.c' || echo '$(srcdir)/'`generated/matmul_c4.c
 
 matmul_c8.lo: generated/matmul_c8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_c8.lo `test -f 'generated/matmul_c8.c' || echo '$(srcdir)/'`generated/matmul_c8.c
 
+matmul_c10.lo: generated/matmul_c10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_c10.lo `test -f 'generated/matmul_c10.c' || echo '$(srcdir)/'`generated/matmul_c10.c
+
+matmul_c16.lo: generated/matmul_c16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_c16.lo `test -f 'generated/matmul_c16.c' || echo '$(srcdir)/'`generated/matmul_c16.c
+
 matmul_l4.lo: generated/matmul_l4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_l4.lo `test -f 'generated/matmul_l4.c' || echo '$(srcdir)/'`generated/matmul_l4.c
 
 matmul_l8.lo: generated/matmul_l8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_l8.lo `test -f 'generated/matmul_l8.c' || echo '$(srcdir)/'`generated/matmul_l8.c
 
+matmul_l16.lo: generated/matmul_l16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_l16.lo `test -f 'generated/matmul_l16.c' || echo '$(srcdir)/'`generated/matmul_l16.c
+
 transpose_i4.lo: generated/transpose_i4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_i4.lo `test -f 'generated/transpose_i4.c' || echo '$(srcdir)/'`generated/transpose_i4.c
 
 transpose_i8.lo: generated/transpose_i8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_i8.lo `test -f 'generated/transpose_i8.c' || echo '$(srcdir)/'`generated/transpose_i8.c
 
+transpose_i16.lo: generated/transpose_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_i16.lo `test -f 'generated/transpose_i16.c' || echo '$(srcdir)/'`generated/transpose_i16.c
+
 transpose_c4.lo: generated/transpose_c4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_c4.lo `test -f 'generated/transpose_c4.c' || echo '$(srcdir)/'`generated/transpose_c4.c
 
 transpose_c8.lo: generated/transpose_c8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_c8.lo `test -f 'generated/transpose_c8.c' || echo '$(srcdir)/'`generated/transpose_c8.c
 
+transpose_c10.lo: generated/transpose_c10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_c10.lo `test -f 'generated/transpose_c10.c' || echo '$(srcdir)/'`generated/transpose_c10.c
+
+transpose_c16.lo: generated/transpose_c16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_c16.lo `test -f 'generated/transpose_c16.c' || echo '$(srcdir)/'`generated/transpose_c16.c
+
 shape_i4.lo: generated/shape_i4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o shape_i4.lo `test -f 'generated/shape_i4.c' || echo '$(srcdir)/'`generated/shape_i4.c
 
 shape_i8.lo: generated/shape_i8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o shape_i8.lo `test -f 'generated/shape_i8.c' || echo '$(srcdir)/'`generated/shape_i8.c
 
+shape_i16.lo: generated/shape_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o shape_i16.lo `test -f 'generated/shape_i16.c' || echo '$(srcdir)/'`generated/shape_i16.c
+
 eoshift1_4.lo: generated/eoshift1_4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift1_4.lo `test -f 'generated/eoshift1_4.c' || echo '$(srcdir)/'`generated/eoshift1_4.c
 
 eoshift1_8.lo: generated/eoshift1_8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift1_8.lo `test -f 'generated/eoshift1_8.c' || echo '$(srcdir)/'`generated/eoshift1_8.c
 
+eoshift1_16.lo: generated/eoshift1_16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift1_16.lo `test -f 'generated/eoshift1_16.c' || echo '$(srcdir)/'`generated/eoshift1_16.c
+
 eoshift3_4.lo: generated/eoshift3_4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift3_4.lo `test -f 'generated/eoshift3_4.c' || echo '$(srcdir)/'`generated/eoshift3_4.c
 
 eoshift3_8.lo: generated/eoshift3_8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift3_8.lo `test -f 'generated/eoshift3_8.c' || echo '$(srcdir)/'`generated/eoshift3_8.c
 
+eoshift3_16.lo: generated/eoshift3_16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift3_16.lo `test -f 'generated/eoshift3_16.c' || echo '$(srcdir)/'`generated/eoshift3_16.c
+
 cshift1_4.lo: generated/cshift1_4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift1_4.lo `test -f 'generated/cshift1_4.c' || echo '$(srcdir)/'`generated/cshift1_4.c
 
 cshift1_8.lo: generated/cshift1_8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift1_8.lo `test -f 'generated/cshift1_8.c' || echo '$(srcdir)/'`generated/cshift1_8.c
 
+cshift1_16.lo: generated/cshift1_16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift1_16.lo `test -f 'generated/cshift1_16.c' || echo '$(srcdir)/'`generated/cshift1_16.c
+
 reshape_i4.lo: generated/reshape_i4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_i4.lo `test -f 'generated/reshape_i4.c' || echo '$(srcdir)/'`generated/reshape_i4.c
 
 reshape_i8.lo: generated/reshape_i8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_i8.lo `test -f 'generated/reshape_i8.c' || echo '$(srcdir)/'`generated/reshape_i8.c
 
+reshape_i16.lo: generated/reshape_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_i16.lo `test -f 'generated/reshape_i16.c' || echo '$(srcdir)/'`generated/reshape_i16.c
+
 reshape_c4.lo: generated/reshape_c4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_c4.lo `test -f 'generated/reshape_c4.c' || echo '$(srcdir)/'`generated/reshape_c4.c
 
 reshape_c8.lo: generated/reshape_c8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_c8.lo `test -f 'generated/reshape_c8.c' || echo '$(srcdir)/'`generated/reshape_c8.c
 
+reshape_c10.lo: generated/reshape_c10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_c10.lo `test -f 'generated/reshape_c10.c' || echo '$(srcdir)/'`generated/reshape_c10.c
+
+reshape_c16.lo: generated/reshape_c16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_c16.lo `test -f 'generated/reshape_c16.c' || echo '$(srcdir)/'`generated/reshape_c16.c
+
 in_pack_i4.lo: generated/in_pack_i4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_i4.lo `test -f 'generated/in_pack_i4.c' || echo '$(srcdir)/'`generated/in_pack_i4.c
 
 in_pack_i8.lo: generated/in_pack_i8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_i8.lo `test -f 'generated/in_pack_i8.c' || echo '$(srcdir)/'`generated/in_pack_i8.c
 
+in_pack_i16.lo: generated/in_pack_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_i16.lo `test -f 'generated/in_pack_i16.c' || echo '$(srcdir)/'`generated/in_pack_i16.c
+
 in_pack_c4.lo: generated/in_pack_c4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c4.lo `test -f 'generated/in_pack_c4.c' || echo '$(srcdir)/'`generated/in_pack_c4.c
 
 in_pack_c8.lo: generated/in_pack_c8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c8.lo `test -f 'generated/in_pack_c8.c' || echo '$(srcdir)/'`generated/in_pack_c8.c
 
+in_pack_c10.lo: generated/in_pack_c10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c10.lo `test -f 'generated/in_pack_c10.c' || echo '$(srcdir)/'`generated/in_pack_c10.c
+
+in_pack_c16.lo: generated/in_pack_c16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c16.lo `test -f 'generated/in_pack_c16.c' || echo '$(srcdir)/'`generated/in_pack_c16.c
+
 in_unpack_i4.lo: generated/in_unpack_i4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i4.lo `test -f 'generated/in_unpack_i4.c' || echo '$(srcdir)/'`generated/in_unpack_i4.c
 
 in_unpack_i8.lo: generated/in_unpack_i8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i8.lo `test -f 'generated/in_unpack_i8.c' || echo '$(srcdir)/'`generated/in_unpack_i8.c
 
+in_unpack_i16.lo: generated/in_unpack_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i16.lo `test -f 'generated/in_unpack_i16.c' || echo '$(srcdir)/'`generated/in_unpack_i16.c
+
 in_unpack_c4.lo: generated/in_unpack_c4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_c4.lo `test -f 'generated/in_unpack_c4.c' || echo '$(srcdir)/'`generated/in_unpack_c4.c
 
 in_unpack_c8.lo: generated/in_unpack_c8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_c8.lo `test -f 'generated/in_unpack_c8.c' || echo '$(srcdir)/'`generated/in_unpack_c8.c
 
+in_unpack_c10.lo: generated/in_unpack_c10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_c10.lo `test -f 'generated/in_unpack_c10.c' || echo '$(srcdir)/'`generated/in_unpack_c10.c
+
+in_unpack_c16.lo: generated/in_unpack_c16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_c16.lo `test -f 'generated/in_unpack_c16.c' || echo '$(srcdir)/'`generated/in_unpack_c16.c
+
 exponent_r4.lo: generated/exponent_r4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exponent_r4.lo `test -f 'generated/exponent_r4.c' || echo '$(srcdir)/'`generated/exponent_r4.c
 
 exponent_r8.lo: generated/exponent_r8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exponent_r8.lo `test -f 'generated/exponent_r8.c' || echo '$(srcdir)/'`generated/exponent_r8.c
 
+exponent_r10.lo: generated/exponent_r10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exponent_r10.lo `test -f 'generated/exponent_r10.c' || echo '$(srcdir)/'`generated/exponent_r10.c
+
+exponent_r16.lo: generated/exponent_r16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exponent_r16.lo `test -f 'generated/exponent_r16.c' || echo '$(srcdir)/'`generated/exponent_r16.c
+
 fraction_r4.lo: generated/fraction_r4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fraction_r4.lo `test -f 'generated/fraction_r4.c' || echo '$(srcdir)/'`generated/fraction_r4.c
 
 fraction_r8.lo: generated/fraction_r8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fraction_r8.lo `test -f 'generated/fraction_r8.c' || echo '$(srcdir)/'`generated/fraction_r8.c
 
+fraction_r10.lo: generated/fraction_r10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fraction_r10.lo `test -f 'generated/fraction_r10.c' || echo '$(srcdir)/'`generated/fraction_r10.c
+
+fraction_r16.lo: generated/fraction_r16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fraction_r16.lo `test -f 'generated/fraction_r16.c' || echo '$(srcdir)/'`generated/fraction_r16.c
+
 nearest_r4.lo: generated/nearest_r4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o nearest_r4.lo `test -f 'generated/nearest_r4.c' || echo '$(srcdir)/'`generated/nearest_r4.c
 
 nearest_r8.lo: generated/nearest_r8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o nearest_r8.lo `test -f 'generated/nearest_r8.c' || echo '$(srcdir)/'`generated/nearest_r8.c
 
+nearest_r10.lo: generated/nearest_r10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o nearest_r10.lo `test -f 'generated/nearest_r10.c' || echo '$(srcdir)/'`generated/nearest_r10.c
+
+nearest_r16.lo: generated/nearest_r16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o nearest_r16.lo `test -f 'generated/nearest_r16.c' || echo '$(srcdir)/'`generated/nearest_r16.c
+
 set_exponent_r4.lo: generated/set_exponent_r4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o set_exponent_r4.lo `test -f 'generated/set_exponent_r4.c' || echo '$(srcdir)/'`generated/set_exponent_r4.c
 
 set_exponent_r8.lo: generated/set_exponent_r8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o set_exponent_r8.lo `test -f 'generated/set_exponent_r8.c' || echo '$(srcdir)/'`generated/set_exponent_r8.c
 
+set_exponent_r10.lo: generated/set_exponent_r10.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o set_exponent_r10.lo `test -f 'generated/set_exponent_r10.c' || echo '$(srcdir)/'`generated/set_exponent_r10.c
+
+set_exponent_r16.lo: generated/set_exponent_r16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o set_exponent_r16.lo `test -f 'generated/set_exponent_r16.c' || echo '$(srcdir)/'`generated/set_exponent_r16.c
+
 pow_i4_i4.lo: generated/pow_i4_i4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i4_i4.lo `test -f 'generated/pow_i4_i4.c' || echo '$(srcdir)/'`generated/pow_i4_i4.c
 
 pow_i8_i4.lo: generated/pow_i8_i4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i8_i4.lo `test -f 'generated/pow_i8_i4.c' || echo '$(srcdir)/'`generated/pow_i8_i4.c
 
+pow_i16_i4.lo: generated/pow_i16_i4.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i16_i4.lo `test -f 'generated/pow_i16_i4.c' || echo '$(srcdir)/'`generated/pow_i16_i4.c
+
 pow_r4_i4.lo: generated/pow_r4_i4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r4_i4.lo `test -f 'generated/pow_r4_i4.c' || echo '$(srcdir)/'`generated/pow_r4_i4.c
 
 pow_r8_i4.lo: generated/pow_r8_i4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r8_i4.lo `test -f 'generated/pow_r8_i4.c' || echo '$(srcdir)/'`generated/pow_r8_i4.c
 
+pow_r10_i4.lo: generated/pow_r10_i4.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r10_i4.lo `test -f 'generated/pow_r10_i4.c' || echo '$(srcdir)/'`generated/pow_r10_i4.c
+
+pow_r16_i4.lo: generated/pow_r16_i4.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r16_i4.lo `test -f 'generated/pow_r16_i4.c' || echo '$(srcdir)/'`generated/pow_r16_i4.c
+
 pow_c4_i4.lo: generated/pow_c4_i4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c4_i4.lo `test -f 'generated/pow_c4_i4.c' || echo '$(srcdir)/'`generated/pow_c4_i4.c
 
 pow_c8_i4.lo: generated/pow_c8_i4.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c8_i4.lo `test -f 'generated/pow_c8_i4.c' || echo '$(srcdir)/'`generated/pow_c8_i4.c
 
+pow_c10_i4.lo: generated/pow_c10_i4.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c10_i4.lo `test -f 'generated/pow_c10_i4.c' || echo '$(srcdir)/'`generated/pow_c10_i4.c
+
+pow_c16_i4.lo: generated/pow_c16_i4.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c16_i4.lo `test -f 'generated/pow_c16_i4.c' || echo '$(srcdir)/'`generated/pow_c16_i4.c
+
 pow_i4_i8.lo: generated/pow_i4_i8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i4_i8.lo `test -f 'generated/pow_i4_i8.c' || echo '$(srcdir)/'`generated/pow_i4_i8.c
 
 pow_i8_i8.lo: generated/pow_i8_i8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i8_i8.lo `test -f 'generated/pow_i8_i8.c' || echo '$(srcdir)/'`generated/pow_i8_i8.c
 
+pow_i16_i8.lo: generated/pow_i16_i8.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i16_i8.lo `test -f 'generated/pow_i16_i8.c' || echo '$(srcdir)/'`generated/pow_i16_i8.c
+
 pow_r4_i8.lo: generated/pow_r4_i8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r4_i8.lo `test -f 'generated/pow_r4_i8.c' || echo '$(srcdir)/'`generated/pow_r4_i8.c
 
 pow_r8_i8.lo: generated/pow_r8_i8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r8_i8.lo `test -f 'generated/pow_r8_i8.c' || echo '$(srcdir)/'`generated/pow_r8_i8.c
 
+pow_r10_i8.lo: generated/pow_r10_i8.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r10_i8.lo `test -f 'generated/pow_r10_i8.c' || echo '$(srcdir)/'`generated/pow_r10_i8.c
+
+pow_r16_i8.lo: generated/pow_r16_i8.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r16_i8.lo `test -f 'generated/pow_r16_i8.c' || echo '$(srcdir)/'`generated/pow_r16_i8.c
+
 pow_c4_i8.lo: generated/pow_c4_i8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c4_i8.lo `test -f 'generated/pow_c4_i8.c' || echo '$(srcdir)/'`generated/pow_c4_i8.c
 
 pow_c8_i8.lo: generated/pow_c8_i8.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c8_i8.lo `test -f 'generated/pow_c8_i8.c' || echo '$(srcdir)/'`generated/pow_c8_i8.c
 
+pow_c10_i8.lo: generated/pow_c10_i8.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c10_i8.lo `test -f 'generated/pow_c10_i8.c' || echo '$(srcdir)/'`generated/pow_c10_i8.c
+
+pow_c16_i8.lo: generated/pow_c16_i8.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c16_i8.lo `test -f 'generated/pow_c16_i8.c' || echo '$(srcdir)/'`generated/pow_c16_i8.c
+
+pow_i4_i16.lo: generated/pow_i4_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i4_i16.lo `test -f 'generated/pow_i4_i16.c' || echo '$(srcdir)/'`generated/pow_i4_i16.c
+
+pow_i8_i16.lo: generated/pow_i8_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i8_i16.lo `test -f 'generated/pow_i8_i16.c' || echo '$(srcdir)/'`generated/pow_i8_i16.c
+
+pow_i16_i16.lo: generated/pow_i16_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i16_i16.lo `test -f 'generated/pow_i16_i16.c' || echo '$(srcdir)/'`generated/pow_i16_i16.c
+
+pow_r4_i16.lo: generated/pow_r4_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r4_i16.lo `test -f 'generated/pow_r4_i16.c' || echo '$(srcdir)/'`generated/pow_r4_i16.c
+
+pow_r8_i16.lo: generated/pow_r8_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r8_i16.lo `test -f 'generated/pow_r8_i16.c' || echo '$(srcdir)/'`generated/pow_r8_i16.c
+
+pow_r10_i16.lo: generated/pow_r10_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r10_i16.lo `test -f 'generated/pow_r10_i16.c' || echo '$(srcdir)/'`generated/pow_r10_i16.c
+
+pow_r16_i16.lo: generated/pow_r16_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r16_i16.lo `test -f 'generated/pow_r16_i16.c' || echo '$(srcdir)/'`generated/pow_r16_i16.c
+
+pow_c4_i16.lo: generated/pow_c4_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c4_i16.lo `test -f 'generated/pow_c4_i16.c' || echo '$(srcdir)/'`generated/pow_c4_i16.c
+
+pow_c8_i16.lo: generated/pow_c8_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c8_i16.lo `test -f 'generated/pow_c8_i16.c' || echo '$(srcdir)/'`generated/pow_c8_i16.c
+
+pow_c10_i16.lo: generated/pow_c10_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c10_i16.lo `test -f 'generated/pow_c10_i16.c' || echo '$(srcdir)/'`generated/pow_c10_i16.c
+
+pow_c16_i16.lo: generated/pow_c16_i16.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c16_i16.lo `test -f 'generated/pow_c16_i16.c' || echo '$(srcdir)/'`generated/pow_c16_i16.c
+
 close.lo: io/close.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o close.lo `test -f 'io/close.c' || echo '$(srcdir)/'`io/close.c
 
@@ -1385,192 +2375,6 @@ selected_int_kind.lo: intrinsics/selected_int_kind.f90
 selected_real_kind.lo: intrinsics/selected_real_kind.f90
        $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o selected_real_kind.lo `test -f 'intrinsics/selected_real_kind.f90' || echo '$(srcdir)/'`intrinsics/selected_real_kind.f90
 
-_abs_c4.lo: generated/_abs_c4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_c4.lo `test -f 'generated/_abs_c4.f90' || echo '$(srcdir)/'`generated/_abs_c4.f90
-
-_abs_c8.lo: generated/_abs_c8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_c8.lo `test -f 'generated/_abs_c8.f90' || echo '$(srcdir)/'`generated/_abs_c8.f90
-
-_abs_i4.lo: generated/_abs_i4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_i4.lo `test -f 'generated/_abs_i4.f90' || echo '$(srcdir)/'`generated/_abs_i4.f90
-
-_abs_i8.lo: generated/_abs_i8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_i8.lo `test -f 'generated/_abs_i8.f90' || echo '$(srcdir)/'`generated/_abs_i8.f90
-
-_abs_r4.lo: generated/_abs_r4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_r4.lo `test -f 'generated/_abs_r4.f90' || echo '$(srcdir)/'`generated/_abs_r4.f90
-
-_abs_r8.lo: generated/_abs_r8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_r8.lo `test -f 'generated/_abs_r8.f90' || echo '$(srcdir)/'`generated/_abs_r8.f90
-
-_exp_r4.lo: generated/_exp_r4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_r4.lo `test -f 'generated/_exp_r4.f90' || echo '$(srcdir)/'`generated/_exp_r4.f90
-
-_exp_r8.lo: generated/_exp_r8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_r8.lo `test -f 'generated/_exp_r8.f90' || echo '$(srcdir)/'`generated/_exp_r8.f90
-
-_exp_c4.lo: generated/_exp_c4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_c4.lo `test -f 'generated/_exp_c4.f90' || echo '$(srcdir)/'`generated/_exp_c4.f90
-
-_exp_c8.lo: generated/_exp_c8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_c8.lo `test -f 'generated/_exp_c8.f90' || echo '$(srcdir)/'`generated/_exp_c8.f90
-
-_log_r4.lo: generated/_log_r4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_r4.lo `test -f 'generated/_log_r4.f90' || echo '$(srcdir)/'`generated/_log_r4.f90
-
-_log_r8.lo: generated/_log_r8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_r8.lo `test -f 'generated/_log_r8.f90' || echo '$(srcdir)/'`generated/_log_r8.f90
-
-_log_c4.lo: generated/_log_c4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_c4.lo `test -f 'generated/_log_c4.f90' || echo '$(srcdir)/'`generated/_log_c4.f90
-
-_log_c8.lo: generated/_log_c8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_c8.lo `test -f 'generated/_log_c8.f90' || echo '$(srcdir)/'`generated/_log_c8.f90
-
-_log10_r4.lo: generated/_log10_r4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log10_r4.lo `test -f 'generated/_log10_r4.f90' || echo '$(srcdir)/'`generated/_log10_r4.f90
-
-_log10_r8.lo: generated/_log10_r8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log10_r8.lo `test -f 'generated/_log10_r8.f90' || echo '$(srcdir)/'`generated/_log10_r8.f90
-
-_sqrt_r4.lo: generated/_sqrt_r4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_r4.lo `test -f 'generated/_sqrt_r4.f90' || echo '$(srcdir)/'`generated/_sqrt_r4.f90
-
-_sqrt_r8.lo: generated/_sqrt_r8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_r8.lo `test -f 'generated/_sqrt_r8.f90' || echo '$(srcdir)/'`generated/_sqrt_r8.f90
-
-_sqrt_c4.lo: generated/_sqrt_c4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_c4.lo `test -f 'generated/_sqrt_c4.f90' || echo '$(srcdir)/'`generated/_sqrt_c4.f90
-
-_sqrt_c8.lo: generated/_sqrt_c8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_c8.lo `test -f 'generated/_sqrt_c8.f90' || echo '$(srcdir)/'`generated/_sqrt_c8.f90
-
-_asin_r4.lo: generated/_asin_r4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asin_r4.lo `test -f 'generated/_asin_r4.f90' || echo '$(srcdir)/'`generated/_asin_r4.f90
-
-_asin_r8.lo: generated/_asin_r8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asin_r8.lo `test -f 'generated/_asin_r8.f90' || echo '$(srcdir)/'`generated/_asin_r8.f90
-
-_acos_r4.lo: generated/_acos_r4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acos_r4.lo `test -f 'generated/_acos_r4.f90' || echo '$(srcdir)/'`generated/_acos_r4.f90
-
-_acos_r8.lo: generated/_acos_r8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acos_r8.lo `test -f 'generated/_acos_r8.f90' || echo '$(srcdir)/'`generated/_acos_r8.f90
-
-_atan_r4.lo: generated/_atan_r4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan_r4.lo `test -f 'generated/_atan_r4.f90' || echo '$(srcdir)/'`generated/_atan_r4.f90
-
-_atan_r8.lo: generated/_atan_r8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan_r8.lo `test -f 'generated/_atan_r8.f90' || echo '$(srcdir)/'`generated/_atan_r8.f90
-
-_sin_r4.lo: generated/_sin_r4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_r4.lo `test -f 'generated/_sin_r4.f90' || echo '$(srcdir)/'`generated/_sin_r4.f90
-
-_sin_r8.lo: generated/_sin_r8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_r8.lo `test -f 'generated/_sin_r8.f90' || echo '$(srcdir)/'`generated/_sin_r8.f90
-
-_sin_c4.lo: generated/_sin_c4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_c4.lo `test -f 'generated/_sin_c4.f90' || echo '$(srcdir)/'`generated/_sin_c4.f90
-
-_sin_c8.lo: generated/_sin_c8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_c8.lo `test -f 'generated/_sin_c8.f90' || echo '$(srcdir)/'`generated/_sin_c8.f90
-
-_cos_r4.lo: generated/_cos_r4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_r4.lo `test -f 'generated/_cos_r4.f90' || echo '$(srcdir)/'`generated/_cos_r4.f90
-
-_cos_r8.lo: generated/_cos_r8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_r8.lo `test -f 'generated/_cos_r8.f90' || echo '$(srcdir)/'`generated/_cos_r8.f90
-
-_cos_c4.lo: generated/_cos_c4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_c4.lo `test -f 'generated/_cos_c4.f90' || echo '$(srcdir)/'`generated/_cos_c4.f90
-
-_cos_c8.lo: generated/_cos_c8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_c8.lo `test -f 'generated/_cos_c8.f90' || echo '$(srcdir)/'`generated/_cos_c8.f90
-
-_tan_r4.lo: generated/_tan_r4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tan_r4.lo `test -f 'generated/_tan_r4.f90' || echo '$(srcdir)/'`generated/_tan_r4.f90
-
-_tan_r8.lo: generated/_tan_r8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tan_r8.lo `test -f 'generated/_tan_r8.f90' || echo '$(srcdir)/'`generated/_tan_r8.f90
-
-_sinh_r4.lo: generated/_sinh_r4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sinh_r4.lo `test -f 'generated/_sinh_r4.f90' || echo '$(srcdir)/'`generated/_sinh_r4.f90
-
-_sinh_r8.lo: generated/_sinh_r8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sinh_r8.lo `test -f 'generated/_sinh_r8.f90' || echo '$(srcdir)/'`generated/_sinh_r8.f90
-
-_cosh_r4.lo: generated/_cosh_r4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cosh_r4.lo `test -f 'generated/_cosh_r4.f90' || echo '$(srcdir)/'`generated/_cosh_r4.f90
-
-_cosh_r8.lo: generated/_cosh_r8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cosh_r8.lo `test -f 'generated/_cosh_r8.f90' || echo '$(srcdir)/'`generated/_cosh_r8.f90
-
-_tanh_r4.lo: generated/_tanh_r4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tanh_r4.lo `test -f 'generated/_tanh_r4.f90' || echo '$(srcdir)/'`generated/_tanh_r4.f90
-
-_tanh_r8.lo: generated/_tanh_r8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tanh_r8.lo `test -f 'generated/_tanh_r8.f90' || echo '$(srcdir)/'`generated/_tanh_r8.f90
-
-_conjg_c4.lo: generated/_conjg_c4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _conjg_c4.lo `test -f 'generated/_conjg_c4.f90' || echo '$(srcdir)/'`generated/_conjg_c4.f90
-
-_conjg_c8.lo: generated/_conjg_c8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _conjg_c8.lo `test -f 'generated/_conjg_c8.f90' || echo '$(srcdir)/'`generated/_conjg_c8.f90
-
-_aint_r4.lo: generated/_aint_r4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aint_r4.lo `test -f 'generated/_aint_r4.f90' || echo '$(srcdir)/'`generated/_aint_r4.f90
-
-_aint_r8.lo: generated/_aint_r8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aint_r8.lo `test -f 'generated/_aint_r8.f90' || echo '$(srcdir)/'`generated/_aint_r8.f90
-
-_anint_r4.lo: generated/_anint_r4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _anint_r4.lo `test -f 'generated/_anint_r4.f90' || echo '$(srcdir)/'`generated/_anint_r4.f90
-
-_anint_r8.lo: generated/_anint_r8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _anint_r8.lo `test -f 'generated/_anint_r8.f90' || echo '$(srcdir)/'`generated/_anint_r8.f90
-
-_sign_i4.lo: generated/_sign_i4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_i4.lo `test -f 'generated/_sign_i4.f90' || echo '$(srcdir)/'`generated/_sign_i4.f90
-
-_sign_i8.lo: generated/_sign_i8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_i8.lo `test -f 'generated/_sign_i8.f90' || echo '$(srcdir)/'`generated/_sign_i8.f90
-
-_sign_r4.lo: generated/_sign_r4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_r4.lo `test -f 'generated/_sign_r4.f90' || echo '$(srcdir)/'`generated/_sign_r4.f90
-
-_sign_r8.lo: generated/_sign_r8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_r8.lo `test -f 'generated/_sign_r8.f90' || echo '$(srcdir)/'`generated/_sign_r8.f90
-
-_dim_i4.lo: generated/_dim_i4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_i4.lo `test -f 'generated/_dim_i4.f90' || echo '$(srcdir)/'`generated/_dim_i4.f90
-
-_dim_i8.lo: generated/_dim_i8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_i8.lo `test -f 'generated/_dim_i8.f90' || echo '$(srcdir)/'`generated/_dim_i8.f90
-
-_dim_r4.lo: generated/_dim_r4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_r4.lo `test -f 'generated/_dim_r4.f90' || echo '$(srcdir)/'`generated/_dim_r4.f90
-
-_dim_r8.lo: generated/_dim_r8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_r8.lo `test -f 'generated/_dim_r8.f90' || echo '$(srcdir)/'`generated/_dim_r8.f90
-
-_atan2_r4.lo: generated/_atan2_r4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan2_r4.lo `test -f 'generated/_atan2_r4.f90' || echo '$(srcdir)/'`generated/_atan2_r4.f90
-
-_atan2_r8.lo: generated/_atan2_r8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan2_r8.lo `test -f 'generated/_atan2_r8.f90' || echo '$(srcdir)/'`generated/_atan2_r8.f90
-
-_mod_i4.lo: generated/_mod_i4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_i4.lo `test -f 'generated/_mod_i4.f90' || echo '$(srcdir)/'`generated/_mod_i4.f90
-
-_mod_i8.lo: generated/_mod_i8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_i8.lo `test -f 'generated/_mod_i8.f90' || echo '$(srcdir)/'`generated/_mod_i8.f90
-
-_mod_r4.lo: generated/_mod_r4.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_r4.lo `test -f 'generated/_mod_r4.f90' || echo '$(srcdir)/'`generated/_mod_r4.f90
-
-_mod_r8.lo: generated/_mod_r8.f90
-       $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_r8.lo `test -f 'generated/_mod_r8.f90' || echo '$(srcdir)/'`generated/_mod_r8.f90
-
 dprod_r8.lo: intrinsics/dprod_r8.f90
        $(LIBTOOL) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o dprod_r8.lo `test -f 'intrinsics/dprod_r8.f90' || echo '$(srcdir)/'`intrinsics/dprod_r8.f90
 
@@ -1883,6 +2687,12 @@ uninstall-am: uninstall-info-am uninstall-toolexeclibLTLIBRARIES
 kinds.h: $(srcdir)/mk-kinds-h.sh
        $(SHELL) $(srcdir)/mk-kinds-h.sh '$(FCCOMPILE)' > $@
 
+kinds.inc: kinds.h
+       grep '^#' < kinds.h > $@
+
+c99_protos.inc: $(srcdir)/c99_protos.h
+       grep '^#' < $(srcdir)/c99_protos.h > $@
+
 selected_int_kind.inc: $(srcdir)/mk-sik-inc.sh
        $(SHELL) $(srcdir)/mk-sik-inc.sh '$(FCCOMPILE)' > $@
 
diff --git a/libgfortran/generated/_abs_c10.F90 b/libgfortran/generated/_abs_c10.F90
new file mode 100644 (file)
index 0000000..8e76b34
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+#ifdef HAVE_CABSL
+
+elemental function specific__abs_c10 (parm)
+   complex (kind=10), intent (in) :: parm
+   complex (kind=10) :: specific__abs_c10
+
+   specific__abs_c10 = abs (parm)
+end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_abs_c16.F90 b/libgfortran/generated/_abs_c16.F90
new file mode 100644 (file)
index 0000000..acc7f22
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+#ifdef HAVE_CABSL
+
+elemental function specific__abs_c16 (parm)
+   complex (kind=16), intent (in) :: parm
+   complex (kind=16) :: specific__abs_c16
+
+   specific__abs_c16 = abs (parm)
+end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_abs_c4.f90
rename to libgfortran/generated/_abs_c4.F90
index 342dc3d..a87fcf6 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_4)
+#ifdef HAVE_CABSF
+
 elemental function specific__abs_c4 (parm)
    complex (kind=4), intent (in) :: parm
    complex (kind=4) :: specific__abs_c4
 
    specific__abs_c4 = abs (parm)
 end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_abs_c8.f90
rename to libgfortran/generated/_abs_c8.F90
index e3e18d1..294c002 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_8)
+#ifdef HAVE_CABS
+
 elemental function specific__abs_c8 (parm)
    complex (kind=8), intent (in) :: parm
    complex (kind=8) :: specific__abs_c8
 
    specific__abs_c8 = abs (parm)
 end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_abs_i16.F90 b/libgfortran/generated/_abs_i16.F90
new file mode 100644 (file)
index 0000000..afbb67f
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+
+elemental function specific__abs_i16 (parm)
+   integer (kind=16), intent (in) :: parm
+   integer (kind=16) :: specific__abs_i16
+
+   specific__abs_i16 = abs (parm)
+end function
+
+
+#endif
similarity index 93%
rename from libgfortran/generated/_abs_i4.f90
rename to libgfortran/generated/_abs_i4.F90
index 97d94a1..4037d34 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_INTEGER_4)
+
+
 elemental function specific__abs_i4 (parm)
    integer (kind=4), intent (in) :: parm
    integer (kind=4) :: specific__abs_i4
 
    specific__abs_i4 = abs (parm)
 end function
+
+
+#endif
similarity index 93%
rename from libgfortran/generated/_abs_i8.f90
rename to libgfortran/generated/_abs_i8.F90
index 909cccf..1f2e424 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_INTEGER_8)
+
+
 elemental function specific__abs_i8 (parm)
    integer (kind=8), intent (in) :: parm
    integer (kind=8) :: specific__abs_i8
 
    specific__abs_i8 = abs (parm)
 end function
+
+
+#endif
diff --git a/libgfortran/generated/_abs_r10.F90 b/libgfortran/generated/_abs_r10.F90
new file mode 100644 (file)
index 0000000..4d76a1e
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_FABSL
+
+elemental function specific__abs_r10 (parm)
+   real (kind=10), intent (in) :: parm
+   real (kind=10) :: specific__abs_r10
+
+   specific__abs_r10 = abs (parm)
+end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_abs_r16.F90 b/libgfortran/generated/_abs_r16.F90
new file mode 100644 (file)
index 0000000..3c7d8a7
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_FABSL
+
+elemental function specific__abs_r16 (parm)
+   real (kind=16), intent (in) :: parm
+   real (kind=16) :: specific__abs_r16
+
+   specific__abs_r16 = abs (parm)
+end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_abs_r4.f90
rename to libgfortran/generated/_abs_r4.F90
index 52a5005..31ef426 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_FABSF
+
 elemental function specific__abs_r4 (parm)
    real (kind=4), intent (in) :: parm
    real (kind=4) :: specific__abs_r4
 
    specific__abs_r4 = abs (parm)
 end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_abs_r8.f90
rename to libgfortran/generated/_abs_r8.F90
index 0f137b6..c0b4ce1 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_FABS
+
 elemental function specific__abs_r8 (parm)
    real (kind=8), intent (in) :: parm
    real (kind=8) :: specific__abs_r8
 
    specific__abs_r8 = abs (parm)
 end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_acos_r10.F90 b/libgfortran/generated/_acos_r10.F90
new file mode 100644 (file)
index 0000000..d7be7c8
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_ACOSL
+
+elemental function specific__acos_r10 (parm)
+   real (kind=10), intent (in) :: parm
+   real (kind=10) :: specific__acos_r10
+
+   specific__acos_r10 = acos (parm)
+end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_acos_r16.F90 b/libgfortran/generated/_acos_r16.F90
new file mode 100644 (file)
index 0000000..f0c6dde
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_ACOSL
+
+elemental function specific__acos_r16 (parm)
+   real (kind=16), intent (in) :: parm
+   real (kind=16) :: specific__acos_r16
+
+   specific__acos_r16 = acos (parm)
+end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_acos_r4.f90
rename to libgfortran/generated/_acos_r4.F90
index 8163e38..9e1b97b 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_ACOSF
+
 elemental function specific__acos_r4 (parm)
    real (kind=4), intent (in) :: parm
    real (kind=4) :: specific__acos_r4
 
    specific__acos_r4 = acos (parm)
 end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_acos_r8.f90
rename to libgfortran/generated/_acos_r8.F90
index d257091..3bded77 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_ACOS
+
 elemental function specific__acos_r8 (parm)
    real (kind=8), intent (in) :: parm
    real (kind=8) :: specific__acos_r8
 
    specific__acos_r8 = acos (parm)
 end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_aint_r10.F90 b/libgfortran/generated/_aint_r10.F90
new file mode 100644 (file)
index 0000000..2448baa
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_TRUNCL
+
+elemental function specific__aint_r10 (parm)
+   real (kind=10), intent (in) :: parm
+   real (kind=10) :: specific__aint_r10
+
+   specific__aint_r10 = aint (parm)
+end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_aint_r16.F90 b/libgfortran/generated/_aint_r16.F90
new file mode 100644 (file)
index 0000000..9903ad4
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_TRUNCL
+
+elemental function specific__aint_r16 (parm)
+   real (kind=16), intent (in) :: parm
+   real (kind=16) :: specific__aint_r16
+
+   specific__aint_r16 = aint (parm)
+end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_aint_r4.f90
rename to libgfortran/generated/_aint_r4.F90
index a525748..4fb7145 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_TRUNCF
+
 elemental function specific__aint_r4 (parm)
    real (kind=4), intent (in) :: parm
    real (kind=4) :: specific__aint_r4
 
    specific__aint_r4 = aint (parm)
 end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_aint_r8.f90
rename to libgfortran/generated/_aint_r8.F90
index 0f6e5dd..f860c7a 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_TRUNC
+
 elemental function specific__aint_r8 (parm)
    real (kind=8), intent (in) :: parm
    real (kind=8) :: specific__aint_r8
 
    specific__aint_r8 = aint (parm)
 end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_anint_r10.F90 b/libgfortran/generated/_anint_r10.F90
new file mode 100644 (file)
index 0000000..1652417
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_ROUNDL
+
+elemental function specific__anint_r10 (parm)
+   real (kind=10), intent (in) :: parm
+   real (kind=10) :: specific__anint_r10
+
+   specific__anint_r10 = anint (parm)
+end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_anint_r16.F90 b/libgfortran/generated/_anint_r16.F90
new file mode 100644 (file)
index 0000000..48e1dff
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_ROUNDL
+
+elemental function specific__anint_r16 (parm)
+   real (kind=16), intent (in) :: parm
+   real (kind=16) :: specific__anint_r16
+
+   specific__anint_r16 = anint (parm)
+end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_anint_r4.f90
rename to libgfortran/generated/_anint_r4.F90
index 8b6d62a..c1c955c 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_ROUNDF
+
 elemental function specific__anint_r4 (parm)
    real (kind=4), intent (in) :: parm
    real (kind=4) :: specific__anint_r4
 
    specific__anint_r4 = anint (parm)
 end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_anint_r8.f90
rename to libgfortran/generated/_anint_r8.F90
index 4dc6ab1..6c72678 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_ROUND
+
 elemental function specific__anint_r8 (parm)
    real (kind=8), intent (in) :: parm
    real (kind=8) :: specific__anint_r8
 
    specific__anint_r8 = anint (parm)
 end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_asin_r10.F90 b/libgfortran/generated/_asin_r10.F90
new file mode 100644 (file)
index 0000000..80939fa
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_ASINL
+
+elemental function specific__asin_r10 (parm)
+   real (kind=10), intent (in) :: parm
+   real (kind=10) :: specific__asin_r10
+
+   specific__asin_r10 = asin (parm)
+end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_asin_r16.F90 b/libgfortran/generated/_asin_r16.F90
new file mode 100644 (file)
index 0000000..76e37b6
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_ASINL
+
+elemental function specific__asin_r16 (parm)
+   real (kind=16), intent (in) :: parm
+   real (kind=16) :: specific__asin_r16
+
+   specific__asin_r16 = asin (parm)
+end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_asin_r4.f90
rename to libgfortran/generated/_asin_r4.F90
index 907d495..cd77113 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_ASINF
+
 elemental function specific__asin_r4 (parm)
    real (kind=4), intent (in) :: parm
    real (kind=4) :: specific__asin_r4
 
    specific__asin_r4 = asin (parm)
 end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_asin_r8.f90
rename to libgfortran/generated/_asin_r8.F90
index af035a1..c31f2bc 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_ASIN
+
 elemental function specific__asin_r8 (parm)
    real (kind=8), intent (in) :: parm
    real (kind=8) :: specific__asin_r8
 
    specific__asin_r8 = asin (parm)
 end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_atan2_r10.F90 b/libgfortran/generated/_atan2_r10.F90
new file mode 100644 (file)
index 0000000..cc9a170
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+
+#ifdef HAVE_ATAN2L
+
+elemental function specific__atan2_r10 (p1, p2)
+   real (kind=10), intent (in) :: p1, p2
+   real (kind=10) :: specific__atan2_r10
+
+   specific__atan2_r10 = atan2 (p1, p2)
+end function
+
+#endif
+
+#endif
diff --git a/libgfortran/generated/_atan2_r16.F90 b/libgfortran/generated/_atan2_r16.F90
new file mode 100644 (file)
index 0000000..f56aabe
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+
+#ifdef HAVE_ATAN2L
+
+elemental function specific__atan2_r16 (p1, p2)
+   real (kind=16), intent (in) :: p1, p2
+   real (kind=16) :: specific__atan2_r16
+
+   specific__atan2_r16 = atan2 (p1, p2)
+end function
+
+#endif
+
+#endif
similarity index 92%
rename from libgfortran/generated/_atan2_r4.f90
rename to libgfortran/generated/_atan2_r4.F90
index 92fa2d1..52ecf79 100644 (file)
 !This file is machine generated.
 
 
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+
+#ifdef HAVE_ATAN2F
+
 elemental function specific__atan2_r4 (p1, p2)
    real (kind=4), intent (in) :: p1, p2
    real (kind=4) :: specific__atan2_r4
 
    specific__atan2_r4 = atan2 (p1, p2)
 end function
+
+#endif
+
+#endif
similarity index 92%
rename from libgfortran/generated/_atan2_r8.f90
rename to libgfortran/generated/_atan2_r8.F90
index ef35999..752b165 100644 (file)
 !This file is machine generated.
 
 
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+
+#ifdef HAVE_ATAN2
+
 elemental function specific__atan2_r8 (p1, p2)
    real (kind=8), intent (in) :: p1, p2
    real (kind=8) :: specific__atan2_r8
 
    specific__atan2_r8 = atan2 (p1, p2)
 end function
+
+#endif
+
+#endif
diff --git a/libgfortran/generated/_atan_r10.F90 b/libgfortran/generated/_atan_r10.F90
new file mode 100644 (file)
index 0000000..195d941
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_ATANL
+
+elemental function specific__atan_r10 (parm)
+   real (kind=10), intent (in) :: parm
+   real (kind=10) :: specific__atan_r10
+
+   specific__atan_r10 = atan (parm)
+end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_atan_r16.F90 b/libgfortran/generated/_atan_r16.F90
new file mode 100644 (file)
index 0000000..2691a34
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_ATANL
+
+elemental function specific__atan_r16 (parm)
+   real (kind=16), intent (in) :: parm
+   real (kind=16) :: specific__atan_r16
+
+   specific__atan_r16 = atan (parm)
+end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_atan_r4.f90
rename to libgfortran/generated/_atan_r4.F90
index e3410cf..4e88ab2 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_ATANF
+
 elemental function specific__atan_r4 (parm)
    real (kind=4), intent (in) :: parm
    real (kind=4) :: specific__atan_r4
 
    specific__atan_r4 = atan (parm)
 end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_atan_r8.f90
rename to libgfortran/generated/_atan_r8.F90
index 2e0b75b..a99de95 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_ATAN
+
 elemental function specific__atan_r8 (parm)
    real (kind=8), intent (in) :: parm
    real (kind=8) :: specific__atan_r8
 
    specific__atan_r8 = atan (parm)
 end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_conjg_c10.F90 b/libgfortran/generated/_conjg_c10.F90
new file mode 100644 (file)
index 0000000..1fa158d
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+
+
+elemental function specific__conjg_c10 (parm)
+   complex (kind=10), intent (in) :: parm
+   complex (kind=10) :: specific__conjg_c10
+
+   specific__conjg_c10 = conjg (parm)
+end function
+
+
+#endif
diff --git a/libgfortran/generated/_conjg_c16.F90 b/libgfortran/generated/_conjg_c16.F90
new file mode 100644 (file)
index 0000000..13c8e14
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+
+
+elemental function specific__conjg_c16 (parm)
+   complex (kind=16), intent (in) :: parm
+   complex (kind=16) :: specific__conjg_c16
+
+   specific__conjg_c16 = conjg (parm)
+end function
+
+
+#endif
similarity index 93%
rename from libgfortran/generated/_conjg_c4.f90
rename to libgfortran/generated/_conjg_c4.F90
index e5904db..a4409c9 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_4)
+
+
 elemental function specific__conjg_c4 (parm)
    complex (kind=4), intent (in) :: parm
    complex (kind=4) :: specific__conjg_c4
 
    specific__conjg_c4 = conjg (parm)
 end function
+
+
+#endif
similarity index 93%
rename from libgfortran/generated/_conjg_c8.f90
rename to libgfortran/generated/_conjg_c8.F90
index 5e6d35b..f1c1254 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_8)
+
+
 elemental function specific__conjg_c8 (parm)
    complex (kind=8), intent (in) :: parm
    complex (kind=8) :: specific__conjg_c8
 
    specific__conjg_c8 = conjg (parm)
 end function
+
+
+#endif
diff --git a/libgfortran/generated/_cos_c10.F90 b/libgfortran/generated/_cos_c10.F90
new file mode 100644 (file)
index 0000000..018394c
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+#ifdef HAVE_CCOSL
+
+elemental function specific__cos_c10 (parm)
+   complex (kind=10), intent (in) :: parm
+   complex (kind=10) :: specific__cos_c10
+
+   specific__cos_c10 = cos (parm)
+end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_cos_c16.F90 b/libgfortran/generated/_cos_c16.F90
new file mode 100644 (file)
index 0000000..ac6bc87
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+#ifdef HAVE_CCOSL
+
+elemental function specific__cos_c16 (parm)
+   complex (kind=16), intent (in) :: parm
+   complex (kind=16) :: specific__cos_c16
+
+   specific__cos_c16 = cos (parm)
+end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_cos_c4.f90
rename to libgfortran/generated/_cos_c4.F90
index 336f250..e494695 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_4)
+#ifdef HAVE_CCOSF
+
 elemental function specific__cos_c4 (parm)
    complex (kind=4), intent (in) :: parm
    complex (kind=4) :: specific__cos_c4
 
    specific__cos_c4 = cos (parm)
 end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_cos_c8.f90
rename to libgfortran/generated/_cos_c8.F90
index 68e1c70..d3daf6e 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_8)
+#ifdef HAVE_CCOS
+
 elemental function specific__cos_c8 (parm)
    complex (kind=8), intent (in) :: parm
    complex (kind=8) :: specific__cos_c8
 
    specific__cos_c8 = cos (parm)
 end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_cos_r10.F90 b/libgfortran/generated/_cos_r10.F90
new file mode 100644 (file)
index 0000000..142cb4b
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_COSL
+
+elemental function specific__cos_r10 (parm)
+   real (kind=10), intent (in) :: parm
+   real (kind=10) :: specific__cos_r10
+
+   specific__cos_r10 = cos (parm)
+end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_cos_r16.F90 b/libgfortran/generated/_cos_r16.F90
new file mode 100644 (file)
index 0000000..4346397
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_COSL
+
+elemental function specific__cos_r16 (parm)
+   real (kind=16), intent (in) :: parm
+   real (kind=16) :: specific__cos_r16
+
+   specific__cos_r16 = cos (parm)
+end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_cos_r4.f90
rename to libgfortran/generated/_cos_r4.F90
index 028c69d..ddf2509 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_COSF
+
 elemental function specific__cos_r4 (parm)
    real (kind=4), intent (in) :: parm
    real (kind=4) :: specific__cos_r4
 
    specific__cos_r4 = cos (parm)
 end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_cos_r8.f90
rename to libgfortran/generated/_cos_r8.F90
index 11edb56..d45a11a 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_COS
+
 elemental function specific__cos_r8 (parm)
    real (kind=8), intent (in) :: parm
    real (kind=8) :: specific__cos_r8
 
    specific__cos_r8 = cos (parm)
 end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_cosh_r10.F90 b/libgfortran/generated/_cosh_r10.F90
new file mode 100644 (file)
index 0000000..9c7d3fb
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_COSHL
+
+elemental function specific__cosh_r10 (parm)
+   real (kind=10), intent (in) :: parm
+   real (kind=10) :: specific__cosh_r10
+
+   specific__cosh_r10 = cosh (parm)
+end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_cosh_r16.F90 b/libgfortran/generated/_cosh_r16.F90
new file mode 100644 (file)
index 0000000..ac28f99
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_COSHL
+
+elemental function specific__cosh_r16 (parm)
+   real (kind=16), intent (in) :: parm
+   real (kind=16) :: specific__cosh_r16
+
+   specific__cosh_r16 = cosh (parm)
+end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_cosh_r4.f90
rename to libgfortran/generated/_cosh_r4.F90
index 7fab9fc..289c9bc 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_COSHF
+
 elemental function specific__cosh_r4 (parm)
    real (kind=4), intent (in) :: parm
    real (kind=4) :: specific__cosh_r4
 
    specific__cosh_r4 = cosh (parm)
 end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_cosh_r8.f90
rename to libgfortran/generated/_cosh_r8.F90
index 855ee48..6b47452 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_COSH
+
 elemental function specific__cosh_r8 (parm)
    real (kind=8), intent (in) :: parm
    real (kind=8) :: specific__cosh_r8
 
    specific__cosh_r8 = cosh (parm)
 end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_dim_i16.F90 b/libgfortran/generated/_dim_i16.F90
new file mode 100644 (file)
index 0000000..55a1a52
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+
+
+elemental function specific__dim_i16 (p1, p2)
+   integer (kind=16), intent (in) :: p1, p2
+   integer (kind=16) :: specific__dim_i16
+
+   specific__dim_i16 = dim (p1, p2)
+end function
+
+
+
+#endif
similarity index 93%
rename from libgfortran/generated/_dim_i4.f90
rename to libgfortran/generated/_dim_i4.F90
index 4396c66..2fd8658 100644 (file)
 !This file is machine generated.
 
 
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_INTEGER_4)
+
+
+
 elemental function specific__dim_i4 (p1, p2)
    integer (kind=4), intent (in) :: p1, p2
    integer (kind=4) :: specific__dim_i4
 
    specific__dim_i4 = dim (p1, p2)
 end function
+
+
+
+#endif
similarity index 93%
rename from libgfortran/generated/_dim_i8.f90
rename to libgfortran/generated/_dim_i8.F90
index 0584d1a..e861d9e 100644 (file)
 !This file is machine generated.
 
 
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_INTEGER_8)
+
+
+
 elemental function specific__dim_i8 (p1, p2)
    integer (kind=8), intent (in) :: p1, p2
    integer (kind=8) :: specific__dim_i8
 
    specific__dim_i8 = dim (p1, p2)
 end function
+
+
+
+#endif
diff --git a/libgfortran/generated/_dim_r10.F90 b/libgfortran/generated/_dim_r10.F90
new file mode 100644 (file)
index 0000000..1e7743d
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+
+
+
+elemental function specific__dim_r10 (p1, p2)
+   real (kind=10), intent (in) :: p1, p2
+   real (kind=10) :: specific__dim_r10
+
+   specific__dim_r10 = dim (p1, p2)
+end function
+
+
+
+#endif
diff --git a/libgfortran/generated/_dim_r16.F90 b/libgfortran/generated/_dim_r16.F90
new file mode 100644 (file)
index 0000000..97a0488
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+
+
+
+elemental function specific__dim_r16 (p1, p2)
+   real (kind=16), intent (in) :: p1, p2
+   real (kind=16) :: specific__dim_r16
+
+   specific__dim_r16 = dim (p1, p2)
+end function
+
+
+
+#endif
similarity index 93%
rename from libgfortran/generated/_dim_r4.f90
rename to libgfortran/generated/_dim_r4.F90
index 7fd1bc5..465b284 100644 (file)
 !This file is machine generated.
 
 
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+
+
+
 elemental function specific__dim_r4 (p1, p2)
    real (kind=4), intent (in) :: p1, p2
    real (kind=4) :: specific__dim_r4
 
    specific__dim_r4 = dim (p1, p2)
 end function
+
+
+
+#endif
similarity index 93%
rename from libgfortran/generated/_dim_r8.f90
rename to libgfortran/generated/_dim_r8.F90
index 3e43f11..3e6b337 100644 (file)
 !This file is machine generated.
 
 
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+
+
+
 elemental function specific__dim_r8 (p1, p2)
    real (kind=8), intent (in) :: p1, p2
    real (kind=8) :: specific__dim_r8
 
    specific__dim_r8 = dim (p1, p2)
 end function
+
+
+
+#endif
diff --git a/libgfortran/generated/_exp_c10.F90 b/libgfortran/generated/_exp_c10.F90
new file mode 100644 (file)
index 0000000..bcf1f2b
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+#ifdef HAVE_CEXPL
+
+elemental function specific__exp_c10 (parm)
+   complex (kind=10), intent (in) :: parm
+   complex (kind=10) :: specific__exp_c10
+
+   specific__exp_c10 = exp (parm)
+end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_exp_c16.F90 b/libgfortran/generated/_exp_c16.F90
new file mode 100644 (file)
index 0000000..58527bc
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+#ifdef HAVE_CEXPL
+
+elemental function specific__exp_c16 (parm)
+   complex (kind=16), intent (in) :: parm
+   complex (kind=16) :: specific__exp_c16
+
+   specific__exp_c16 = exp (parm)
+end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_exp_c4.f90
rename to libgfortran/generated/_exp_c4.F90
index 28044eb..6fba675 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_4)
+#ifdef HAVE_CEXPF
+
 elemental function specific__exp_c4 (parm)
    complex (kind=4), intent (in) :: parm
    complex (kind=4) :: specific__exp_c4
 
    specific__exp_c4 = exp (parm)
 end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_exp_c8.f90
rename to libgfortran/generated/_exp_c8.F90
index 17f1537..cbc82a1 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_8)
+#ifdef HAVE_CEXP
+
 elemental function specific__exp_c8 (parm)
    complex (kind=8), intent (in) :: parm
    complex (kind=8) :: specific__exp_c8
 
    specific__exp_c8 = exp (parm)
 end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_exp_r10.F90 b/libgfortran/generated/_exp_r10.F90
new file mode 100644 (file)
index 0000000..86bf749
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_EXPL
+
+elemental function specific__exp_r10 (parm)
+   real (kind=10), intent (in) :: parm
+   real (kind=10) :: specific__exp_r10
+
+   specific__exp_r10 = exp (parm)
+end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_exp_r16.F90 b/libgfortran/generated/_exp_r16.F90
new file mode 100644 (file)
index 0000000..4aaee9e
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_EXPL
+
+elemental function specific__exp_r16 (parm)
+   real (kind=16), intent (in) :: parm
+   real (kind=16) :: specific__exp_r16
+
+   specific__exp_r16 = exp (parm)
+end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_exp_r4.f90
rename to libgfortran/generated/_exp_r4.F90
index 261f6a0..d76fb14 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_EXPF
+
 elemental function specific__exp_r4 (parm)
    real (kind=4), intent (in) :: parm
    real (kind=4) :: specific__exp_r4
 
    specific__exp_r4 = exp (parm)
 end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_exp_r8.f90
rename to libgfortran/generated/_exp_r8.F90
index f525b41..d529810 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_EXP
+
 elemental function specific__exp_r8 (parm)
    real (kind=8), intent (in) :: parm
    real (kind=8) :: specific__exp_r8
 
    specific__exp_r8 = exp (parm)
 end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_log10_r10.F90 b/libgfortran/generated/_log10_r10.F90
new file mode 100644 (file)
index 0000000..19aeac5
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_LOG10L
+
+elemental function specific__log10_r10 (parm)
+   real (kind=10), intent (in) :: parm
+   real (kind=10) :: specific__log10_r10
+
+   specific__log10_r10 = log10 (parm)
+end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_log10_r16.F90 b/libgfortran/generated/_log10_r16.F90
new file mode 100644 (file)
index 0000000..c03002a
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_LOG10L
+
+elemental function specific__log10_r16 (parm)
+   real (kind=16), intent (in) :: parm
+   real (kind=16) :: specific__log10_r16
+
+   specific__log10_r16 = log10 (parm)
+end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_log10_r4.f90
rename to libgfortran/generated/_log10_r4.F90
index 712d56b..c772527 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_LOG10F
+
 elemental function specific__log10_r4 (parm)
    real (kind=4), intent (in) :: parm
    real (kind=4) :: specific__log10_r4
 
    specific__log10_r4 = log10 (parm)
 end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_log10_r8.f90
rename to libgfortran/generated/_log10_r8.F90
index 7c3f63d..3965709 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_LOG10
+
 elemental function specific__log10_r8 (parm)
    real (kind=8), intent (in) :: parm
    real (kind=8) :: specific__log10_r8
 
    specific__log10_r8 = log10 (parm)
 end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_log_c10.F90 b/libgfortran/generated/_log_c10.F90
new file mode 100644 (file)
index 0000000..e3f6934
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+#ifdef HAVE_CLOGL
+
+elemental function specific__log_c10 (parm)
+   complex (kind=10), intent (in) :: parm
+   complex (kind=10) :: specific__log_c10
+
+   specific__log_c10 = log (parm)
+end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_log_c16.F90 b/libgfortran/generated/_log_c16.F90
new file mode 100644 (file)
index 0000000..776140a
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+#ifdef HAVE_CLOGL
+
+elemental function specific__log_c16 (parm)
+   complex (kind=16), intent (in) :: parm
+   complex (kind=16) :: specific__log_c16
+
+   specific__log_c16 = log (parm)
+end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_log_c4.f90
rename to libgfortran/generated/_log_c4.F90
index 7f83e52..923bdd5 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_4)
+#ifdef HAVE_CLOGF
+
 elemental function specific__log_c4 (parm)
    complex (kind=4), intent (in) :: parm
    complex (kind=4) :: specific__log_c4
 
    specific__log_c4 = log (parm)
 end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_log_c8.f90
rename to libgfortran/generated/_log_c8.F90
index 92b267b..0df0dd8 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_8)
+#ifdef HAVE_CLOG
+
 elemental function specific__log_c8 (parm)
    complex (kind=8), intent (in) :: parm
    complex (kind=8) :: specific__log_c8
 
    specific__log_c8 = log (parm)
 end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_log_r10.F90 b/libgfortran/generated/_log_r10.F90
new file mode 100644 (file)
index 0000000..d893881
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_LOGL
+
+elemental function specific__log_r10 (parm)
+   real (kind=10), intent (in) :: parm
+   real (kind=10) :: specific__log_r10
+
+   specific__log_r10 = log (parm)
+end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_log_r16.F90 b/libgfortran/generated/_log_r16.F90
new file mode 100644 (file)
index 0000000..5013656
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_LOGL
+
+elemental function specific__log_r16 (parm)
+   real (kind=16), intent (in) :: parm
+   real (kind=16) :: specific__log_r16
+
+   specific__log_r16 = log (parm)
+end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_log_r4.f90
rename to libgfortran/generated/_log_r4.F90
index 6e667a0..6a74237 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_LOGF
+
 elemental function specific__log_r4 (parm)
    real (kind=4), intent (in) :: parm
    real (kind=4) :: specific__log_r4
 
    specific__log_r4 = log (parm)
 end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_log_r8.f90
rename to libgfortran/generated/_log_r8.F90
index 38a8628..8383bbf 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_LOG
+
 elemental function specific__log_r8 (parm)
    real (kind=8), intent (in) :: parm
    real (kind=8) :: specific__log_r8
 
    specific__log_r8 = log (parm)
 end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_mod_i16.F90 b/libgfortran/generated/_mod_i16.F90
new file mode 100644 (file)
index 0000000..571db40
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+
+
+elemental function specific__mod_i16 (p1, p2)
+   integer (kind=16), intent (in) :: p1, p2
+   integer (kind=16) :: specific__mod_i16
+
+   specific__mod_i16 = mod (p1, p2)
+end function
+
+
+
+#endif
similarity index 93%
rename from libgfortran/generated/_mod_i4.f90
rename to libgfortran/generated/_mod_i4.F90
index 3776e05..ec6f81d 100644 (file)
 !This file is machine generated.
 
 
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_INTEGER_4)
+
+
+
 elemental function specific__mod_i4 (p1, p2)
    integer (kind=4), intent (in) :: p1, p2
    integer (kind=4) :: specific__mod_i4
 
    specific__mod_i4 = mod (p1, p2)
 end function
+
+
+
+#endif
similarity index 93%
rename from libgfortran/generated/_mod_i8.f90
rename to libgfortran/generated/_mod_i8.F90
index 4dd2b52..e34278b 100644 (file)
 !This file is machine generated.
 
 
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_INTEGER_8)
+
+
+
 elemental function specific__mod_i8 (p1, p2)
    integer (kind=8), intent (in) :: p1, p2
    integer (kind=8) :: specific__mod_i8
 
    specific__mod_i8 = mod (p1, p2)
 end function
+
+
+
+#endif
similarity index 93%
rename from libgfortran/generated/_mod_r4.f90
rename to libgfortran/generated/_mod_r4.F90
index 20fb128..6742ee4 100644 (file)
 !This file is machine generated.
 
 
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+
+
+
 elemental function specific__mod_r4 (p1, p2)
    real (kind=4), intent (in) :: p1, p2
    real (kind=4) :: specific__mod_r4
 
    specific__mod_r4 = mod (p1, p2)
 end function
+
+
+
+#endif
similarity index 93%
rename from libgfortran/generated/_mod_r8.f90
rename to libgfortran/generated/_mod_r8.F90
index 25b90d4..3cc7e16 100644 (file)
 !This file is machine generated.
 
 
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+
+
+
 elemental function specific__mod_r8 (p1, p2)
    real (kind=8), intent (in) :: p1, p2
    real (kind=8) :: specific__mod_r8
 
    specific__mod_r8 = mod (p1, p2)
 end function
+
+
+
+#endif
diff --git a/libgfortran/generated/_sign_i16.F90 b/libgfortran/generated/_sign_i16.F90
new file mode 100644 (file)
index 0000000..50e492c
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+
+
+elemental function specific__sign_i16 (p1, p2)
+   integer (kind=16), intent (in) :: p1, p2
+   integer (kind=16) :: specific__sign_i16
+
+   specific__sign_i16 = sign (p1, p2)
+end function
+
+
+
+#endif
similarity index 93%
rename from libgfortran/generated/_sign_i4.f90
rename to libgfortran/generated/_sign_i4.F90
index 4203188..d9ea551 100644 (file)
 !This file is machine generated.
 
 
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_INTEGER_4)
+
+
+
 elemental function specific__sign_i4 (p1, p2)
    integer (kind=4), intent (in) :: p1, p2
    integer (kind=4) :: specific__sign_i4
 
    specific__sign_i4 = sign (p1, p2)
 end function
+
+
+
+#endif
similarity index 93%
rename from libgfortran/generated/_sign_i8.f90
rename to libgfortran/generated/_sign_i8.F90
index e3cd674..241fb8b 100644 (file)
 !This file is machine generated.
 
 
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_INTEGER_8)
+
+
+
 elemental function specific__sign_i8 (p1, p2)
    integer (kind=8), intent (in) :: p1, p2
    integer (kind=8) :: specific__sign_i8
 
    specific__sign_i8 = sign (p1, p2)
 end function
+
+
+
+#endif
diff --git a/libgfortran/generated/_sign_r10.F90 b/libgfortran/generated/_sign_r10.F90
new file mode 100644 (file)
index 0000000..002330f
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+
+
+
+elemental function specific__sign_r10 (p1, p2)
+   real (kind=10), intent (in) :: p1, p2
+   real (kind=10) :: specific__sign_r10
+
+   specific__sign_r10 = sign (p1, p2)
+end function
+
+
+
+#endif
diff --git a/libgfortran/generated/_sign_r16.F90 b/libgfortran/generated/_sign_r16.F90
new file mode 100644 (file)
index 0000000..8377969
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+
+
+
+elemental function specific__sign_r16 (p1, p2)
+   real (kind=16), intent (in) :: p1, p2
+   real (kind=16) :: specific__sign_r16
+
+   specific__sign_r16 = sign (p1, p2)
+end function
+
+
+
+#endif
similarity index 93%
rename from libgfortran/generated/_sign_r4.f90
rename to libgfortran/generated/_sign_r4.F90
index f5fef6a..e11f15d 100644 (file)
 !This file is machine generated.
 
 
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+
+
+
 elemental function specific__sign_r4 (p1, p2)
    real (kind=4), intent (in) :: p1, p2
    real (kind=4) :: specific__sign_r4
 
    specific__sign_r4 = sign (p1, p2)
 end function
+
+
+
+#endif
similarity index 93%
rename from libgfortran/generated/_sign_r8.f90
rename to libgfortran/generated/_sign_r8.F90
index b676205..66f8dee 100644 (file)
 !This file is machine generated.
 
 
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+
+
+
 elemental function specific__sign_r8 (p1, p2)
    real (kind=8), intent (in) :: p1, p2
    real (kind=8) :: specific__sign_r8
 
    specific__sign_r8 = sign (p1, p2)
 end function
+
+
+
+#endif
diff --git a/libgfortran/generated/_sin_c10.F90 b/libgfortran/generated/_sin_c10.F90
new file mode 100644 (file)
index 0000000..2c34b3c
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+#ifdef HAVE_CSINL
+
+elemental function specific__sin_c10 (parm)
+   complex (kind=10), intent (in) :: parm
+   complex (kind=10) :: specific__sin_c10
+
+   specific__sin_c10 = sin (parm)
+end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_sin_c16.F90 b/libgfortran/generated/_sin_c16.F90
new file mode 100644 (file)
index 0000000..75a7108
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+#ifdef HAVE_CSINL
+
+elemental function specific__sin_c16 (parm)
+   complex (kind=16), intent (in) :: parm
+   complex (kind=16) :: specific__sin_c16
+
+   specific__sin_c16 = sin (parm)
+end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_sin_c4.f90
rename to libgfortran/generated/_sin_c4.F90
index 059bd94..0efc127 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_4)
+#ifdef HAVE_CSINF
+
 elemental function specific__sin_c4 (parm)
    complex (kind=4), intent (in) :: parm
    complex (kind=4) :: specific__sin_c4
 
    specific__sin_c4 = sin (parm)
 end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_sin_c8.f90
rename to libgfortran/generated/_sin_c8.F90
index 56c4cfa..73a27a4 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_8)
+#ifdef HAVE_CSIN
+
 elemental function specific__sin_c8 (parm)
    complex (kind=8), intent (in) :: parm
    complex (kind=8) :: specific__sin_c8
 
    specific__sin_c8 = sin (parm)
 end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_sin_r10.F90 b/libgfortran/generated/_sin_r10.F90
new file mode 100644 (file)
index 0000000..55f5871
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_SINL
+
+elemental function specific__sin_r10 (parm)
+   real (kind=10), intent (in) :: parm
+   real (kind=10) :: specific__sin_r10
+
+   specific__sin_r10 = sin (parm)
+end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_sin_r16.F90 b/libgfortran/generated/_sin_r16.F90
new file mode 100644 (file)
index 0000000..3757cc0
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_SINL
+
+elemental function specific__sin_r16 (parm)
+   real (kind=16), intent (in) :: parm
+   real (kind=16) :: specific__sin_r16
+
+   specific__sin_r16 = sin (parm)
+end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_sin_r4.f90
rename to libgfortran/generated/_sin_r4.F90
index 4520ad7..4fea103 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_SINF
+
 elemental function specific__sin_r4 (parm)
    real (kind=4), intent (in) :: parm
    real (kind=4) :: specific__sin_r4
 
    specific__sin_r4 = sin (parm)
 end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_sin_r8.f90
rename to libgfortran/generated/_sin_r8.F90
index 20dd269..e35c3d1 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_SIN
+
 elemental function specific__sin_r8 (parm)
    real (kind=8), intent (in) :: parm
    real (kind=8) :: specific__sin_r8
 
    specific__sin_r8 = sin (parm)
 end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_sinh_r10.F90 b/libgfortran/generated/_sinh_r10.F90
new file mode 100644 (file)
index 0000000..7aa5e98
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_SINHL
+
+elemental function specific__sinh_r10 (parm)
+   real (kind=10), intent (in) :: parm
+   real (kind=10) :: specific__sinh_r10
+
+   specific__sinh_r10 = sinh (parm)
+end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_sinh_r16.F90 b/libgfortran/generated/_sinh_r16.F90
new file mode 100644 (file)
index 0000000..6ea6947
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_SINHL
+
+elemental function specific__sinh_r16 (parm)
+   real (kind=16), intent (in) :: parm
+   real (kind=16) :: specific__sinh_r16
+
+   specific__sinh_r16 = sinh (parm)
+end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_sinh_r4.f90
rename to libgfortran/generated/_sinh_r4.F90
index 545d0aa..1101deb 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_SINHF
+
 elemental function specific__sinh_r4 (parm)
    real (kind=4), intent (in) :: parm
    real (kind=4) :: specific__sinh_r4
 
    specific__sinh_r4 = sinh (parm)
 end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_sinh_r8.f90
rename to libgfortran/generated/_sinh_r8.F90
index b378839..63eb8d5 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_SINH
+
 elemental function specific__sinh_r8 (parm)
    real (kind=8), intent (in) :: parm
    real (kind=8) :: specific__sinh_r8
 
    specific__sinh_r8 = sinh (parm)
 end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_sqrt_c10.F90 b/libgfortran/generated/_sqrt_c10.F90
new file mode 100644 (file)
index 0000000..2159a6b
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+#ifdef HAVE_CSQRTL
+
+elemental function specific__sqrt_c10 (parm)
+   complex (kind=10), intent (in) :: parm
+   complex (kind=10) :: specific__sqrt_c10
+
+   specific__sqrt_c10 = sqrt (parm)
+end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_sqrt_c16.F90 b/libgfortran/generated/_sqrt_c16.F90
new file mode 100644 (file)
index 0000000..2ee9c83
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+#ifdef HAVE_CSQRTL
+
+elemental function specific__sqrt_c16 (parm)
+   complex (kind=16), intent (in) :: parm
+   complex (kind=16) :: specific__sqrt_c16
+
+   specific__sqrt_c16 = sqrt (parm)
+end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_sqrt_c4.f90
rename to libgfortran/generated/_sqrt_c4.F90
index 901f2d7..1e88a3d 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_4)
+#ifdef HAVE_CSQRTF
+
 elemental function specific__sqrt_c4 (parm)
    complex (kind=4), intent (in) :: parm
    complex (kind=4) :: specific__sqrt_c4
 
    specific__sqrt_c4 = sqrt (parm)
 end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_sqrt_c8.f90
rename to libgfortran/generated/_sqrt_c8.F90
index 023620f..edd5e39 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_COMPLEX_8)
+#ifdef HAVE_CSQRT
+
 elemental function specific__sqrt_c8 (parm)
    complex (kind=8), intent (in) :: parm
    complex (kind=8) :: specific__sqrt_c8
 
    specific__sqrt_c8 = sqrt (parm)
 end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_sqrt_r10.F90 b/libgfortran/generated/_sqrt_r10.F90
new file mode 100644 (file)
index 0000000..2ea81ba
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_SQRTL
+
+elemental function specific__sqrt_r10 (parm)
+   real (kind=10), intent (in) :: parm
+   real (kind=10) :: specific__sqrt_r10
+
+   specific__sqrt_r10 = sqrt (parm)
+end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_sqrt_r16.F90 b/libgfortran/generated/_sqrt_r16.F90
new file mode 100644 (file)
index 0000000..5ecd027
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_SQRTL
+
+elemental function specific__sqrt_r16 (parm)
+   real (kind=16), intent (in) :: parm
+   real (kind=16) :: specific__sqrt_r16
+
+   specific__sqrt_r16 = sqrt (parm)
+end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_sqrt_r4.f90
rename to libgfortran/generated/_sqrt_r4.F90
index d55cfa7..43c710f 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_SQRTF
+
 elemental function specific__sqrt_r4 (parm)
    real (kind=4), intent (in) :: parm
    real (kind=4) :: specific__sqrt_r4
 
    specific__sqrt_r4 = sqrt (parm)
 end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_sqrt_r8.f90
rename to libgfortran/generated/_sqrt_r8.F90
index 28c1d5d..2f71096 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_SQRT
+
 elemental function specific__sqrt_r8 (parm)
    real (kind=8), intent (in) :: parm
    real (kind=8) :: specific__sqrt_r8
 
    specific__sqrt_r8 = sqrt (parm)
 end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_tan_r10.F90 b/libgfortran/generated/_tan_r10.F90
new file mode 100644 (file)
index 0000000..d4c06ae
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_TANL
+
+elemental function specific__tan_r10 (parm)
+   real (kind=10), intent (in) :: parm
+   real (kind=10) :: specific__tan_r10
+
+   specific__tan_r10 = tan (parm)
+end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_tan_r16.F90 b/libgfortran/generated/_tan_r16.F90
new file mode 100644 (file)
index 0000000..5a6f61a
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_TANL
+
+elemental function specific__tan_r16 (parm)
+   real (kind=16), intent (in) :: parm
+   real (kind=16) :: specific__tan_r16
+
+   specific__tan_r16 = tan (parm)
+end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_tan_r4.f90
rename to libgfortran/generated/_tan_r4.F90
index 7e0fd55..ee8f438 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_TANF
+
 elemental function specific__tan_r4 (parm)
    real (kind=4), intent (in) :: parm
    real (kind=4) :: specific__tan_r4
 
    specific__tan_r4 = tan (parm)
 end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_tan_r8.f90
rename to libgfortran/generated/_tan_r8.F90
index 5a8716e..f2e357b 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_TAN
+
 elemental function specific__tan_r8 (parm)
    real (kind=8), intent (in) :: parm
    real (kind=8) :: specific__tan_r8
 
    specific__tan_r8 = tan (parm)
 end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_tanh_r10.F90 b/libgfortran/generated/_tanh_r10.F90
new file mode 100644 (file)
index 0000000..5d04f65
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_10)
+#ifdef HAVE_TANHL
+
+elemental function specific__tanh_r10 (parm)
+   real (kind=10), intent (in) :: parm
+   real (kind=10) :: specific__tanh_r10
+
+   specific__tanh_r10 = tanh (parm)
+end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/_tanh_r16.F90 b/libgfortran/generated/_tanh_r16.F90
new file mode 100644 (file)
index 0000000..9a858b5
--- /dev/null
@@ -0,0 +1,51 @@
+!   Copyright 2002 Free Software Foundation, Inc.
+!   Contributed by Paul Brook <paul@nowt.org>
+!
+!This file is part of the GNU Fortran 95 runtime library (libgfortran).
+!
+!GNU libgfortran is free software; you can redistribute it and/or
+!modify it under the terms of the GNU General Public
+!License as published by the Free Software Foundation; either
+!version 2 of the License, or (at your option) any later version.
+
+!In addition to the permissions in the GNU General Public License, the
+!Free Software Foundation gives you unlimited permission to link the
+!compiled version of this file into combinations with other programs,
+!and to distribute those combinations without any restriction coming
+!from the use of this file.  (The General Public License restrictions
+!do apply in other respects; for example, they cover modification of
+!the file, and distribution when not linked into a combine
+!executable.)
+!
+!GNU libgfortran is distributed in the hope that it will be useful,
+!but WITHOUT ANY WARRANTY; without even the implied warranty of
+!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!GNU General Public License for more details.
+!
+!You should have received a copy of the GNU General Public
+!License along with libgfortran; see the file COPYING.  If not,
+!write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+!Boston, MA 02110-1301, USA.
+!
+!This file is machine generated.
+
+
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_16)
+#ifdef HAVE_TANHL
+
+elemental function specific__tanh_r16 (parm)
+   real (kind=16), intent (in) :: parm
+   real (kind=16) :: specific__tanh_r16
+
+   specific__tanh_r16 = tanh (parm)
+end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_tanh_r4.f90
rename to libgfortran/generated/_tanh_r4.F90
index 0f3174b..0872fe6 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_4)
+#ifdef HAVE_TANHF
+
 elemental function specific__tanh_r4 (parm)
    real (kind=4), intent (in) :: parm
    real (kind=4) :: specific__tanh_r4
 
    specific__tanh_r4 = tanh (parm)
 end function
+
+#endif
+#endif
similarity index 92%
rename from libgfortran/generated/_tanh_r8.f90
rename to libgfortran/generated/_tanh_r8.F90
index 9d6ed77..40a6668 100644 (file)
 !This file is machine generated.
 
 
+
+
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+#if defined (HAVE_GFC_REAL_8)
+#ifdef HAVE_TANH
+
 elemental function specific__tanh_r8 (parm)
    real (kind=8), intent (in) :: parm
    real (kind=8) :: specific__tanh_r8
 
    specific__tanh_r8 = tanh (parm)
 end function
+
+#endif
+#endif
diff --git a/libgfortran/generated/all_l16.c b/libgfortran/generated/all_l16.c
new file mode 100644 (file)
index 0000000..40851eb
--- /dev/null
@@ -0,0 +1,177 @@
+/* Implementation of the ALL intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_LOGICAL_16)
+
+
+extern void all_l16 (gfc_array_l16 *, gfc_array_l16 *, index_type *);
+export_proto(all_l16);
+
+void
+all_l16 (gfc_array_l16 *retarray, gfc_array_l16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_LOGICAL_16 *base;
+  GFC_LOGICAL_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_LOGICAL_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_LOGICAL_16 *src;
+      GFC_LOGICAL_16 result;
+      src = base;
+      {
+
+  /* Return true only if all the elements are set.  */
+  result = 1;
+        if (len <= 0)
+         *dest = 1;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (! *src)
+    {
+      result = 0;
+      break;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index 82035f1..246ec07 100644 (file)
@@ -34,6 +34,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_LOGICAL_4)
+
+
 extern void all_l4 (gfc_array_l4 *, gfc_array_l4 *, index_type *);
 export_proto(all_l4);
 
@@ -171,3 +174,4 @@ all_l4 (gfc_array_l4 *retarray, gfc_array_l4 *array, index_type *pdim)
     }
 }
 
+#endif
index 41552d2..996ce35 100644 (file)
@@ -34,6 +34,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_LOGICAL_8)
+
+
 extern void all_l8 (gfc_array_l8 *, gfc_array_l8 *, index_type *);
 export_proto(all_l8);
 
@@ -171,3 +174,4 @@ all_l8 (gfc_array_l8 *retarray, gfc_array_l8 *array, index_type *pdim)
     }
 }
 
+#endif
diff --git a/libgfortran/generated/any_l16.c b/libgfortran/generated/any_l16.c
new file mode 100644 (file)
index 0000000..cf4798e
--- /dev/null
@@ -0,0 +1,177 @@
+/* Implementation of the ANY intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_LOGICAL_16)
+
+
+extern void any_l16 (gfc_array_l16 *, gfc_array_l16 *, index_type *);
+export_proto(any_l16);
+
+void
+any_l16 (gfc_array_l16 *retarray, gfc_array_l16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_LOGICAL_16 *base;
+  GFC_LOGICAL_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_LOGICAL_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_LOGICAL_16 *src;
+      GFC_LOGICAL_16 result;
+      src = base;
+      {
+
+  result = 0;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  /* Return true if any of the elements are set.  */
+  if (*src)
+    {
+      result = 1;
+      break;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index 4d3153e..994014a 100644 (file)
@@ -34,6 +34,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_LOGICAL_4)
+
+
 extern void any_l4 (gfc_array_l4 *, gfc_array_l4 *, index_type *);
 export_proto(any_l4);
 
@@ -171,3 +174,4 @@ any_l4 (gfc_array_l4 *retarray, gfc_array_l4 *array, index_type *pdim)
     }
 }
 
+#endif
index 29fdcd1..9d52b15 100644 (file)
@@ -34,6 +34,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_LOGICAL_8)
+
+
 extern void any_l8 (gfc_array_l8 *, gfc_array_l8 *, index_type *);
 export_proto(any_l8);
 
@@ -171,3 +174,4 @@ any_l8 (gfc_array_l8 *retarray, gfc_array_l8 *array, index_type *pdim)
     }
 }
 
+#endif
diff --git a/libgfortran/generated/count_16_l16.c b/libgfortran/generated/count_16_l16.c
new file mode 100644 (file)
index 0000000..8cb795f
--- /dev/null
@@ -0,0 +1,173 @@
+/* Implementation of the COUNT intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void count_16_l16 (gfc_array_i16 *, gfc_array_l16 *, index_type *);
+export_proto(count_16_l16);
+
+void
+count_16_l16 (gfc_array_i16 *retarray, gfc_array_l16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_LOGICAL_16 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_LOGICAL_16 *src;
+      GFC_INTEGER_16 result;
+      src = base;
+      {
+
+  result = 0;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src)
+    result++;
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/count_16_l4.c b/libgfortran/generated/count_16_l4.c
new file mode 100644 (file)
index 0000000..f4af5ba
--- /dev/null
@@ -0,0 +1,173 @@
+/* Implementation of the COUNT intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void count_16_l4 (gfc_array_i16 *, gfc_array_l4 *, index_type *);
+export_proto(count_16_l4);
+
+void
+count_16_l4 (gfc_array_i16 *retarray, gfc_array_l4 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_LOGICAL_4 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_LOGICAL_4 *src;
+      GFC_INTEGER_16 result;
+      src = base;
+      {
+
+  result = 0;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src)
+    result++;
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/count_16_l8.c b/libgfortran/generated/count_16_l8.c
new file mode 100644 (file)
index 0000000..6134f5b
--- /dev/null
@@ -0,0 +1,173 @@
+/* Implementation of the COUNT intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void count_16_l8 (gfc_array_i16 *, gfc_array_l8 *, index_type *);
+export_proto(count_16_l8);
+
+void
+count_16_l8 (gfc_array_i16 *retarray, gfc_array_l8 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_LOGICAL_8 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_LOGICAL_8 *src;
+      GFC_INTEGER_16 result;
+      src = base;
+      {
+
+  result = 0;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src)
+    result++;
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/count_4_l16.c b/libgfortran/generated/count_4_l16.c
new file mode 100644 (file)
index 0000000..cbd1717
--- /dev/null
@@ -0,0 +1,173 @@
+/* Implementation of the COUNT intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void count_4_l16 (gfc_array_i4 *, gfc_array_l16 *, index_type *);
+export_proto(count_4_l16);
+
+void
+count_4_l16 (gfc_array_i4 *retarray, gfc_array_l16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_LOGICAL_16 *base;
+  GFC_INTEGER_4 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_LOGICAL_16 *src;
+      GFC_INTEGER_4 result;
+      src = base;
+      {
+
+  result = 0;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src)
+    result++;
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index c2fdbf0..aa98bfc 100644 (file)
@@ -34,6 +34,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_INTEGER_4)
+
+
 extern void count_4_l4 (gfc_array_i4 *, gfc_array_l4 *, index_type *);
 export_proto(count_4_l4);
 
@@ -167,3 +170,4 @@ count_4_l4 (gfc_array_i4 *retarray, gfc_array_l4 *array, index_type *pdim)
     }
 }
 
+#endif
index 473483a..fe9eae5 100644 (file)
@@ -34,6 +34,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_INTEGER_4)
+
+
 extern void count_4_l8 (gfc_array_i4 *, gfc_array_l8 *, index_type *);
 export_proto(count_4_l8);
 
@@ -167,3 +170,4 @@ count_4_l8 (gfc_array_i4 *retarray, gfc_array_l8 *array, index_type *pdim)
     }
 }
 
+#endif
diff --git a/libgfortran/generated/count_8_l16.c b/libgfortran/generated/count_8_l16.c
new file mode 100644 (file)
index 0000000..4df2aeb
--- /dev/null
@@ -0,0 +1,173 @@
+/* Implementation of the COUNT intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void count_8_l16 (gfc_array_i8 *, gfc_array_l16 *, index_type *);
+export_proto(count_8_l16);
+
+void
+count_8_l16 (gfc_array_i8 *retarray, gfc_array_l16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_LOGICAL_16 *base;
+  GFC_INTEGER_8 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_LOGICAL_16 *src;
+      GFC_INTEGER_8 result;
+      src = base;
+      {
+
+  result = 0;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src)
+    result++;
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index 595cb40..b32b30e 100644 (file)
@@ -34,6 +34,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_INTEGER_8)
+
+
 extern void count_8_l4 (gfc_array_i8 *, gfc_array_l4 *, index_type *);
 export_proto(count_8_l4);
 
@@ -167,3 +170,4 @@ count_8_l4 (gfc_array_i8 *retarray, gfc_array_l4 *array, index_type *pdim)
     }
 }
 
+#endif
index 1e9bd61..670fc1d 100644 (file)
@@ -34,6 +34,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_INTEGER_8)
+
+
 extern void count_8_l8 (gfc_array_i8 *, gfc_array_l8 *, index_type *);
 export_proto(count_8_l8);
 
@@ -167,3 +170,4 @@ count_8_l8 (gfc_array_i8 *retarray, gfc_array_l8 *array, index_type *pdim)
     }
 }
 
+#endif
diff --git a/libgfortran/generated/cshift1_16.c b/libgfortran/generated/cshift1_16.c
new file mode 100644 (file)
index 0000000..bff20d3
--- /dev/null
@@ -0,0 +1,225 @@
+/* Implementation of the CSHIFT intrinsic
+   Copyright 2003 Free Software Foundation, Inc.
+   Contributed by Feng Wang <wf_cs@yahoo.com>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Ligbfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <string.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+static void
+cshift1 (gfc_array_char * ret, const gfc_array_char * array,
+        const gfc_array_i16 * h, const GFC_INTEGER_16 * pwhich, index_type size)
+{
+  /* r.* indicates the return array.  */
+  index_type rstride[GFC_MAX_DIMENSIONS];
+  index_type rstride0;
+  index_type roffset;
+  char *rptr;
+  char *dest;
+  /* s.* indicates the source array.  */
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type sstride0;
+  index_type soffset;
+  const char *sptr;
+  const char *src;
+  /* h.* indicates the  array.  */
+  index_type hstride[GFC_MAX_DIMENSIONS];
+  index_type hstride0;
+  const GFC_INTEGER_16 *hptr;
+
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type dim;
+  index_type len;
+  index_type n;
+  int which;
+  GFC_INTEGER_16 sh;
+
+  if (pwhich)
+    which = *pwhich - 1;
+  else
+    which = 0;
+
+  if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array))
+    runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'");
+
+  if (ret->data == NULL)
+    {
+      int i;
+
+      ret->data = internal_malloc_size (size * size0 ((array_t *)array));
+      ret->offset = 0;
+      ret->dtype = array->dtype;
+      for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
+        {
+          ret->dim[i].lbound = 0;
+          ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+
+          if (i == 0)
+            ret->dim[i].stride = 1;
+          else
+            ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
+        }
+    }
+
+  extent[0] = 1;
+  count[0] = 0;
+  n = 0;
+
+  /* Initialized for avoiding compiler warnings.  */
+  roffset = size;
+  soffset = size;
+  len = 0;
+
+  for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+    {
+      if (dim == which)
+        {
+          roffset = ret->dim[dim].stride * size;
+          if (roffset == 0)
+            roffset = size;
+          soffset = array->dim[dim].stride * size;
+          if (soffset == 0)
+            soffset = size;
+          len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+        }
+      else
+        {
+          count[n] = 0;
+          extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+          rstride[n] = ret->dim[dim].stride * size;
+          sstride[n] = array->dim[dim].stride * size;
+
+          hstride[n] = h->dim[n].stride;
+          n++;
+        }
+    }
+  if (sstride[0] == 0)
+    sstride[0] = size;
+  if (rstride[0] == 0)
+    rstride[0] = size;
+  if (hstride[0] == 0)
+    hstride[0] = 1;
+
+  dim = GFC_DESCRIPTOR_RANK (array);
+  rstride0 = rstride[0];
+  sstride0 = sstride[0];
+  hstride0 = hstride[0];
+  rptr = ret->data;
+  sptr = array->data;
+  hptr = h->data;
+
+  while (rptr)
+    {
+      /* Do the  for this dimension.  */
+      sh = *hptr;
+      sh = (div (sh, len)).rem;
+      if (sh < 0)
+        sh += len;
+
+      src = &sptr[sh * soffset];
+      dest = rptr;
+
+      for (n = 0; n < len; n++)
+        {
+          memcpy (dest, src, size);
+          dest += roffset;
+          if (n == len - sh - 1)
+            src = sptr;
+          else
+            src += soffset;
+        }
+
+      /* Advance to the next section.  */
+      rptr += rstride0;
+      sptr += sstride0;
+      hptr += hstride0;
+      count[0]++;
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          rptr -= rstride[n] * extent[n];
+          sptr -= sstride[n] * extent[n];
+         hptr -= hstride[n] * extent[n];
+          n++;
+          if (n >= dim - 1)
+            {
+              /* Break out of the loop.  */
+              rptr = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              rptr += rstride[n];
+              sptr += sstride[n];
+             hptr += hstride[n];
+            }
+        }
+    }
+}
+
+void cshift1_16 (gfc_array_char *, const gfc_array_char *,
+                          const gfc_array_i16 *, const GFC_INTEGER_16 *);
+export_proto(cshift1_16);
+
+void
+cshift1_16 (gfc_array_char * ret,
+                     const gfc_array_char * array,
+                     const gfc_array_i16 * h, const GFC_INTEGER_16 * pwhich)
+{
+  cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array));
+}
+
+void cshift1_16_char (gfc_array_char * ret, GFC_INTEGER_4,
+                                 const gfc_array_char * array,
+                                 const gfc_array_i16 * h, const GFC_INTEGER_16 * pwhich,
+                                 GFC_INTEGER_4);
+export_proto(cshift1_16_char);
+
+void
+cshift1_16_char (gfc_array_char * ret,
+                            GFC_INTEGER_4 ret_length __attribute__((unused)),
+                            const gfc_array_char * array,
+                            const gfc_array_i16 * h, const GFC_INTEGER_16 * pwhich,
+                            GFC_INTEGER_4 array_length)
+{
+  cshift1 (ret, array, h, pwhich, array_length);
+}
+
+#endif
index 1fe0e68..9f9bea0 100644 (file)
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, USA.  */
 #include <string.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_INTEGER_4)
+
 static void
 cshift1 (gfc_array_char * ret, const gfc_array_char * array,
         const gfc_array_i4 * h, const GFC_INTEGER_4 * pwhich, index_type size)
@@ -219,3 +221,5 @@ cshift1_4_char (gfc_array_char * ret,
 {
   cshift1 (ret, array, h, pwhich, array_length);
 }
+
+#endif
index 8b0cb03..3a7c509 100644 (file)
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, USA.  */
 #include <string.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_INTEGER_8)
+
 static void
 cshift1 (gfc_array_char * ret, const gfc_array_char * array,
         const gfc_array_i8 * h, const GFC_INTEGER_8 * pwhich, index_type size)
@@ -219,3 +221,5 @@ cshift1_8_char (gfc_array_char * ret,
 {
   cshift1 (ret, array, h, pwhich, array_length);
 }
+
+#endif
diff --git a/libgfortran/generated/dotprod_c10.c b/libgfortran/generated/dotprod_c10.c
new file mode 100644 (file)
index 0000000..3fa5955
--- /dev/null
@@ -0,0 +1,82 @@
+/* Implementation of the DOT_PRODUCT intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+   and Feng Wang <fengwang@nudt.edu.cn>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+
+typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
+
+extern GFC_COMPLEX_10 dot_product_c10 (gfc_array_c10 * a, gfc_array_c10 * b);
+export_proto(dot_product_c10);
+
+/* Both parameters will already have been converted to the result type.  */
+GFC_COMPLEX_10
+dot_product_c10 (gfc_array_c10 * a, gfc_array_c10 * b)
+{
+  GFC_COMPLEX_10 *pa;
+  GFC_COMPLEX_10 *pb;
+  GFC_COMPLEX_10 res;
+  GFC_COMPLEX_10 conjga;
+  index_type count;
+  index_type astride;
+  index_type bstride;
+
+  assert (GFC_DESCRIPTOR_RANK (a) == 1
+          && GFC_DESCRIPTOR_RANK (b) == 1);
+
+  if (a->dim[0].stride == 0)
+    a->dim[0].stride = 1;
+  if (b->dim[0].stride == 0)
+    b->dim[0].stride = 1;
+
+  astride = a->dim[0].stride;
+  bstride = b->dim[0].stride;
+  count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+  res = 0;
+  pa = a->data;
+  pb = b->data;
+
+  while (count--)
+    {
+      COMPLEX_ASSIGN(conjga, REALPART (*pa), -IMAGPART (*pa));
+      res += conjga * *pb;
+      pa += astride;
+      pb += bstride;
+    }
+
+  return res;
+}
+
+#endif
diff --git a/libgfortran/generated/dotprod_c16.c b/libgfortran/generated/dotprod_c16.c
new file mode 100644 (file)
index 0000000..a526b53
--- /dev/null
@@ -0,0 +1,82 @@
+/* Implementation of the DOT_PRODUCT intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+   and Feng Wang <fengwang@nudt.edu.cn>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+
+typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
+
+extern GFC_COMPLEX_16 dot_product_c16 (gfc_array_c16 * a, gfc_array_c16 * b);
+export_proto(dot_product_c16);
+
+/* Both parameters will already have been converted to the result type.  */
+GFC_COMPLEX_16
+dot_product_c16 (gfc_array_c16 * a, gfc_array_c16 * b)
+{
+  GFC_COMPLEX_16 *pa;
+  GFC_COMPLEX_16 *pb;
+  GFC_COMPLEX_16 res;
+  GFC_COMPLEX_16 conjga;
+  index_type count;
+  index_type astride;
+  index_type bstride;
+
+  assert (GFC_DESCRIPTOR_RANK (a) == 1
+          && GFC_DESCRIPTOR_RANK (b) == 1);
+
+  if (a->dim[0].stride == 0)
+    a->dim[0].stride = 1;
+  if (b->dim[0].stride == 0)
+    b->dim[0].stride = 1;
+
+  astride = a->dim[0].stride;
+  bstride = b->dim[0].stride;
+  count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+  res = 0;
+  pa = a->data;
+  pb = b->data;
+
+  while (count--)
+    {
+      COMPLEX_ASSIGN(conjga, REALPART (*pa), -IMAGPART (*pa));
+      res += conjga * *pb;
+      pa += astride;
+      pb += bstride;
+    }
+
+  return res;
+}
+
+#endif
index e047a90..ea27dd8 100644 (file)
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_COMPLEX_4)
+
 typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
 
 extern GFC_COMPLEX_4 dot_product_c4 (gfc_array_c4 * a, gfc_array_c4 * b);
@@ -76,3 +78,5 @@ dot_product_c4 (gfc_array_c4 * a, gfc_array_c4 * b)
 
   return res;
 }
+
+#endif
index 747d3a1..aec5fb5 100644 (file)
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_COMPLEX_8)
+
 typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
 
 extern GFC_COMPLEX_8 dot_product_c8 (gfc_array_c8 * a, gfc_array_c8 * b);
@@ -76,3 +78,5 @@ dot_product_c8 (gfc_array_c8 * a, gfc_array_c8 * b)
 
   return res;
 }
+
+#endif
diff --git a/libgfortran/generated/dotprod_i16.c b/libgfortran/generated/dotprod_i16.c
new file mode 100644 (file)
index 0000000..1c3e582
--- /dev/null
@@ -0,0 +1,79 @@
+/* Implementation of the DOT_PRODUCT intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
+
+extern GFC_INTEGER_16 dot_product_i16 (gfc_array_i16 * a, gfc_array_i16 * b);
+export_proto(dot_product_i16);
+
+/* Both parameters will already have been converted to the result type.  */
+GFC_INTEGER_16
+dot_product_i16 (gfc_array_i16 * a, gfc_array_i16 * b)
+{
+  GFC_INTEGER_16 *pa;
+  GFC_INTEGER_16 *pb;
+  GFC_INTEGER_16 res;
+  index_type count;
+  index_type astride;
+  index_type bstride;
+
+  assert (GFC_DESCRIPTOR_RANK (a) == 1
+          && GFC_DESCRIPTOR_RANK (b) == 1);
+
+  if (a->dim[0].stride == 0)
+    a->dim[0].stride = 1;
+  if (b->dim[0].stride == 0)
+    b->dim[0].stride = 1;
+
+  astride = a->dim[0].stride;
+  bstride = b->dim[0].stride;
+  count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+  res = 0;
+  pa = a->data;
+  pb = b->data;
+
+  while (count--)
+    {
+      res += *pa * *pb;
+      pa += astride;
+      pb += bstride;
+    }
+
+  return res;
+}
+
+#endif
index 65245ab..aaf8b8d 100644 (file)
@@ -33,6 +33,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_INTEGER_4)
+
 typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
 
 extern GFC_INTEGER_4 dot_product_i4 (gfc_array_i4 * a, gfc_array_i4 * b);
@@ -73,3 +75,5 @@ dot_product_i4 (gfc_array_i4 * a, gfc_array_i4 * b)
 
   return res;
 }
+
+#endif
index 3c857e2..44af1f1 100644 (file)
@@ -33,6 +33,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_INTEGER_8)
+
 typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
 
 extern GFC_INTEGER_8 dot_product_i8 (gfc_array_i8 * a, gfc_array_i8 * b);
@@ -73,3 +75,5 @@ dot_product_i8 (gfc_array_i8 * a, gfc_array_i8 * b)
 
   return res;
 }
+
+#endif
diff --git a/libgfortran/generated/dotprod_l16.c b/libgfortran/generated/dotprod_l16.c
new file mode 100644 (file)
index 0000000..977eb4a
--- /dev/null
@@ -0,0 +1,89 @@
+/* Implementation of the DOT_PRODUCT intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_LOGICAL_16)
+
+extern GFC_LOGICAL_16 dot_product_l16 (gfc_array_l4 *, gfc_array_l4 *);
+export_proto(dot_product_l16);
+
+GFC_LOGICAL_16
+dot_product_l16 (gfc_array_l4 * a, gfc_array_l4 * b)
+{
+  GFC_LOGICAL_4 *pa;
+  GFC_LOGICAL_4 *pb;
+  index_type count;
+  index_type astride;
+  index_type bstride;
+
+  assert (GFC_DESCRIPTOR_RANK (a) == 1
+          && GFC_DESCRIPTOR_RANK (b) == 1);
+
+  if (a->dim[0].stride == 0)
+    a->dim[0].stride = 1;
+  if (b->dim[0].stride == 0)
+    b->dim[0].stride = 1;
+
+  astride = a->dim[0].stride;
+  bstride = b->dim[0].stride;
+  count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+
+  pa = a->data;
+  if (GFC_DESCRIPTOR_SIZE (a) != 4)
+    {
+      assert (GFC_DESCRIPTOR_SIZE (a) == 8);
+      pa = GFOR_POINTER_L8_TO_L4 (pa);
+      astride <<= 1;
+    }
+  pb = b->data;
+  if (GFC_DESCRIPTOR_SIZE (b) != 4)
+    {
+      assert (GFC_DESCRIPTOR_SIZE (b) == 8);
+      pb = GFOR_POINTER_L8_TO_L4 (pb);
+      bstride <<= 1;
+    }
+
+  while (count--)
+    {
+      if (*pa && *pb)
+        return 1;
+
+      pa += astride;
+      pb += bstride;
+    }
+
+  return 0;
+}
+
+#endif
index a8fdf95..50db398 100644 (file)
@@ -33,6 +33,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_LOGICAL_4)
+
 extern GFC_LOGICAL_4 dot_product_l4 (gfc_array_l4 *, gfc_array_l4 *);
 export_proto(dot_product_l4);
 
@@ -83,3 +85,5 @@ dot_product_l4 (gfc_array_l4 * a, gfc_array_l4 * b)
 
   return 0;
 }
+
+#endif
index cbb2961..f857d08 100644 (file)
@@ -33,6 +33,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_LOGICAL_8)
+
 extern GFC_LOGICAL_8 dot_product_l8 (gfc_array_l4 *, gfc_array_l4 *);
 export_proto(dot_product_l8);
 
@@ -83,3 +85,5 @@ dot_product_l8 (gfc_array_l4 * a, gfc_array_l4 * b)
 
   return 0;
 }
+
+#endif
diff --git a/libgfortran/generated/dotprod_r10.c b/libgfortran/generated/dotprod_r10.c
new file mode 100644 (file)
index 0000000..055c288
--- /dev/null
@@ -0,0 +1,79 @@
+/* Implementation of the DOT_PRODUCT intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_REAL_10)
+
+typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
+
+extern GFC_REAL_10 dot_product_r10 (gfc_array_r10 * a, gfc_array_r10 * b);
+export_proto(dot_product_r10);
+
+/* Both parameters will already have been converted to the result type.  */
+GFC_REAL_10
+dot_product_r10 (gfc_array_r10 * a, gfc_array_r10 * b)
+{
+  GFC_REAL_10 *pa;
+  GFC_REAL_10 *pb;
+  GFC_REAL_10 res;
+  index_type count;
+  index_type astride;
+  index_type bstride;
+
+  assert (GFC_DESCRIPTOR_RANK (a) == 1
+          && GFC_DESCRIPTOR_RANK (b) == 1);
+
+  if (a->dim[0].stride == 0)
+    a->dim[0].stride = 1;
+  if (b->dim[0].stride == 0)
+    b->dim[0].stride = 1;
+
+  astride = a->dim[0].stride;
+  bstride = b->dim[0].stride;
+  count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+  res = 0;
+  pa = a->data;
+  pb = b->data;
+
+  while (count--)
+    {
+      res += *pa * *pb;
+      pa += astride;
+      pb += bstride;
+    }
+
+  return res;
+}
+
+#endif
diff --git a/libgfortran/generated/dotprod_r16.c b/libgfortran/generated/dotprod_r16.c
new file mode 100644 (file)
index 0000000..e14eaac
--- /dev/null
@@ -0,0 +1,79 @@
+/* Implementation of the DOT_PRODUCT intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_REAL_16)
+
+typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
+
+extern GFC_REAL_16 dot_product_r16 (gfc_array_r16 * a, gfc_array_r16 * b);
+export_proto(dot_product_r16);
+
+/* Both parameters will already have been converted to the result type.  */
+GFC_REAL_16
+dot_product_r16 (gfc_array_r16 * a, gfc_array_r16 * b)
+{
+  GFC_REAL_16 *pa;
+  GFC_REAL_16 *pb;
+  GFC_REAL_16 res;
+  index_type count;
+  index_type astride;
+  index_type bstride;
+
+  assert (GFC_DESCRIPTOR_RANK (a) == 1
+          && GFC_DESCRIPTOR_RANK (b) == 1);
+
+  if (a->dim[0].stride == 0)
+    a->dim[0].stride = 1;
+  if (b->dim[0].stride == 0)
+    b->dim[0].stride = 1;
+
+  astride = a->dim[0].stride;
+  bstride = b->dim[0].stride;
+  count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+  res = 0;
+  pa = a->data;
+  pb = b->data;
+
+  while (count--)
+    {
+      res += *pa * *pb;
+      pa += astride;
+      pb += bstride;
+    }
+
+  return res;
+}
+
+#endif
index 28f8fcd..bae99ab 100644 (file)
@@ -33,6 +33,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_REAL_4)
+
 typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
 
 extern GFC_REAL_4 dot_product_r4 (gfc_array_r4 * a, gfc_array_r4 * b);
@@ -73,3 +75,5 @@ dot_product_r4 (gfc_array_r4 * a, gfc_array_r4 * b)
 
   return res;
 }
+
+#endif
index b0e704e..84a6aaa 100644 (file)
@@ -33,6 +33,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_REAL_8)
+
 typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
 
 extern GFC_REAL_8 dot_product_r8 (gfc_array_r8 * a, gfc_array_r8 * b);
@@ -73,3 +75,5 @@ dot_product_r8 (gfc_array_r8 * a, gfc_array_r8 * b)
 
   return res;
 }
+
+#endif
diff --git a/libgfortran/generated/eoshift1_16.c b/libgfortran/generated/eoshift1_16.c
new file mode 100644 (file)
index 0000000..c548fef
--- /dev/null
@@ -0,0 +1,251 @@
+/* Implementation of the EOSHIFT intrinsic
+   Copyright 2002, 2005 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <string.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+static void
+eoshift1 (gfc_array_char *ret, const gfc_array_char *array, const gfc_array_i16 *h,
+         const char *pbound, const GFC_INTEGER_16 *pwhich, index_type size,
+         char filler)
+{
+  /* r.* indicates the return array.  */
+  index_type rstride[GFC_MAX_DIMENSIONS];
+  index_type rstride0;
+  index_type roffset;
+  char *rptr;
+  char *dest;
+  /* s.* indicates the source array.  */
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type sstride0;
+  index_type soffset;
+  const char *sptr;
+  const char *src;
+  /* h.* indicates the shift array.  */
+  index_type hstride[GFC_MAX_DIMENSIONS];
+  index_type hstride0;
+  const GFC_INTEGER_16 *hptr;
+
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type dim;
+  index_type len;
+  index_type n;
+  int which;
+  GFC_INTEGER_16 sh;
+  GFC_INTEGER_16 delta;
+
+  /* The compiler cannot figure out that these are set, initialize
+     them to avoid warnings.  */
+  len = 0;
+  soffset = 0;
+  roffset = 0;
+
+  if (pwhich)
+    which = *pwhich - 1;
+  else
+    which = 0;
+
+  extent[0] = 1;
+  count[0] = 0;
+
+  if (ret->data == NULL)
+    {
+      int i;
+
+      ret->data = internal_malloc_size (size * size0 ((array_t *)array));
+      ret->offset = 0;
+      ret->dtype = array->dtype;
+      for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
+        {
+          ret->dim[i].lbound = 0;
+          ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+
+          if (i == 0)
+            ret->dim[i].stride = 1;
+          else
+            ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
+        }
+    }
+
+  n = 0;
+  for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+    {
+      if (dim == which)
+        {
+          roffset = ret->dim[dim].stride * size;
+          if (roffset == 0)
+            roffset = size;
+          soffset = array->dim[dim].stride * size;
+          if (soffset == 0)
+            soffset = size;
+          len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+        }
+      else
+        {
+          count[n] = 0;
+          extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+          rstride[n] = ret->dim[dim].stride * size;
+          sstride[n] = array->dim[dim].stride * size;
+
+          hstride[n] = h->dim[n].stride;
+          n++;
+        }
+    }
+  if (sstride[0] == 0)
+    sstride[0] = size;
+  if (rstride[0] == 0)
+    rstride[0] = size;
+  if (hstride[0] == 0)
+    hstride[0] = 1;
+
+  dim = GFC_DESCRIPTOR_RANK (array);
+  rstride0 = rstride[0];
+  sstride0 = sstride[0];
+  hstride0 = hstride[0];
+  rptr = ret->data;
+  sptr = array->data;
+  hptr = h->data;
+
+  while (rptr)
+    {
+      /* Do the shift for this dimension.  */
+      sh = *hptr;
+      if (( sh >= 0 ? sh : -sh ) > len)
+       {
+         delta = len;
+         sh = len;
+       }
+      else
+       delta = (sh >= 0) ? sh: -sh;
+
+      if (sh > 0)
+        {
+          src = &sptr[delta * soffset];
+          dest = rptr;
+        }
+      else
+        {
+          src = sptr;
+          dest = &rptr[delta * roffset];
+        }
+      for (n = 0; n < len - delta; n++)
+        {
+          memcpy (dest, src, size);
+          dest += roffset;
+          src += soffset;
+        }
+      if (sh < 0)
+        dest = rptr;
+      n = delta;
+
+      if (pbound)
+       while (n--)
+         {
+           memcpy (dest, pbound, size);
+           dest += roffset;
+         }
+      else
+       while (n--)
+         {
+           memset (dest, filler, size);
+           dest += roffset;
+         }
+
+      /* Advance to the next section.  */
+      rptr += rstride0;
+      sptr += sstride0;
+      hptr += hstride0;
+      count[0]++;
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          rptr -= rstride[n] * extent[n];
+          sptr -= sstride[n] * extent[n];
+         hptr -= hstride[n] * extent[n];
+          n++;
+          if (n >= dim - 1)
+            {
+              /* Break out of the loop.  */
+              rptr = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              rptr += rstride[n];
+              sptr += sstride[n];
+             hptr += hstride[n];
+            }
+        }
+    }
+}
+
+void eoshift1_16 (gfc_array_char *, const gfc_array_char *,
+                           const gfc_array_i16 *, const char *, const GFC_INTEGER_16 *);
+export_proto(eoshift1_16);
+
+void
+eoshift1_16 (gfc_array_char *ret, const gfc_array_char *array,
+                      const gfc_array_i16 *h, const char *pbound,
+                      const GFC_INTEGER_16 *pwhich)
+{
+  eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0);
+}
+
+void eoshift1_16_char (gfc_array_char *, GFC_INTEGER_4,
+                                  const gfc_array_char *, const gfc_array_i16 *,
+                                  const char *, const GFC_INTEGER_16 *,
+                                  GFC_INTEGER_4, GFC_INTEGER_4);
+export_proto(eoshift1_16_char);
+
+void
+eoshift1_16_char (gfc_array_char *ret,
+                             GFC_INTEGER_4 ret_length __attribute__((unused)),
+                             const gfc_array_char *array, const gfc_array_i16 *h,
+                             const char *pbound, const GFC_INTEGER_16 *pwhich,
+                             GFC_INTEGER_4 array_length,
+                             GFC_INTEGER_4 bound_length
+                               __attribute__((unused)))
+{
+  eoshift1 (ret, array, h, pbound, pwhich, array_length, ' ');
+}
+
+#endif
index e08042a..8045679 100644 (file)
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, USA.  */
 #include <string.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_INTEGER_4)
+
 static void
 eoshift1 (gfc_array_char *ret, const gfc_array_char *array, const gfc_array_i4 *h,
          const char *pbound, const GFC_INTEGER_4 *pwhich, index_type size,
@@ -245,3 +247,5 @@ eoshift1_4_char (gfc_array_char *ret,
 {
   eoshift1 (ret, array, h, pbound, pwhich, array_length, ' ');
 }
+
+#endif
index f375a82..bcc53ab 100644 (file)
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, USA.  */
 #include <string.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_INTEGER_8)
+
 static void
 eoshift1 (gfc_array_char *ret, const gfc_array_char *array, const gfc_array_i8 *h,
          const char *pbound, const GFC_INTEGER_8 *pwhich, index_type size,
@@ -245,3 +247,5 @@ eoshift1_8_char (gfc_array_char *ret,
 {
   eoshift1 (ret, array, h, pbound, pwhich, array_length, ' ');
 }
+
+#endif
diff --git a/libgfortran/generated/eoshift3_16.c b/libgfortran/generated/eoshift3_16.c
new file mode 100644 (file)
index 0000000..d03c1c7
--- /dev/null
@@ -0,0 +1,273 @@
+/* Implementation of the EOSHIFT intrinsic
+   Copyright 2002, 2005 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <string.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+static void
+eoshift3 (gfc_array_char *ret, const gfc_array_char *array, const gfc_array_i16 *h,
+         const gfc_array_char *bound, const GFC_INTEGER_16 *pwhich,
+         index_type size, char filler)
+{
+  /* r.* indicates the return array.  */
+  index_type rstride[GFC_MAX_DIMENSIONS];
+  index_type rstride0;
+  index_type roffset;
+  char *rptr;
+  char *dest;
+  /* s.* indicates the source array.  */
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type sstride0;
+  index_type soffset;
+  const char *sptr;
+  const char *src;
+  /* h.* indicates the shift array.  */
+  index_type hstride[GFC_MAX_DIMENSIONS];
+  index_type hstride0;
+  const GFC_INTEGER_16 *hptr;
+  /* b.* indicates the bound array.  */
+  index_type bstride[GFC_MAX_DIMENSIONS];
+  index_type bstride0;
+  const char *bptr;
+
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type dim;
+  index_type len;
+  index_type n;
+  int which;
+  GFC_INTEGER_16 sh;
+  GFC_INTEGER_16 delta;
+
+  /* The compiler cannot figure out that these are set, initialize
+     them to avoid warnings.  */
+  len = 0;
+  soffset = 0;
+  roffset = 0;
+
+  if (pwhich)
+    which = *pwhich - 1;
+  else
+    which = 0;
+
+  if (ret->data == NULL)
+    {
+      int i;
+
+      ret->data = internal_malloc_size (size * size0 ((array_t *)array));
+      ret->offset = 0;
+      ret->dtype = array->dtype;
+      for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
+        {
+          ret->dim[i].lbound = 0;
+          ret->dim[i].ubound = array->dim[i].ubound - array->dim[i].lbound;
+
+          if (i == 0)
+            ret->dim[i].stride = 1;
+          else
+            ret->dim[i].stride = (ret->dim[i-1].ubound + 1) * ret->dim[i-1].stride;
+        }
+    }
+
+
+  extent[0] = 1;
+  count[0] = 0;
+  n = 0;
+  for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
+    {
+      if (dim == which)
+        {
+          roffset = ret->dim[dim].stride * size;
+          if (roffset == 0)
+            roffset = size;
+          soffset = array->dim[dim].stride * size;
+          if (soffset == 0)
+            soffset = size;
+          len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+        }
+      else
+        {
+          count[n] = 0;
+          extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+          rstride[n] = ret->dim[dim].stride * size;
+          sstride[n] = array->dim[dim].stride * size;
+
+          hstride[n] = h->dim[n].stride;
+          if (bound)
+            bstride[n] = bound->dim[n].stride * size;
+          else
+            bstride[n] = 0;
+          n++;
+        }
+    }
+  if (sstride[0] == 0)
+    sstride[0] = size;
+  if (rstride[0] == 0)
+    rstride[0] = size;
+  if (hstride[0] == 0)
+    hstride[0] = 1;
+  if (bound && bstride[0] == 0)
+    bstride[0] = size;
+
+  dim = GFC_DESCRIPTOR_RANK (array);
+  rstride0 = rstride[0];
+  sstride0 = sstride[0];
+  hstride0 = hstride[0];
+  bstride0 = bstride[0];
+  rptr = ret->data;
+  sptr = array->data;
+  hptr = h->data;
+  if (bound)
+    bptr = bound->data;
+  else
+    bptr = NULL;
+
+  while (rptr)
+    {
+      /* Do the shift for this dimension.  */
+      sh = *hptr;
+      if (( sh >= 0 ? sh : -sh ) > len)
+       {
+         delta = len;
+         sh = len;
+       }
+      else
+       delta = (sh >= 0) ? sh: -sh;
+
+      if (sh > 0)
+        {
+          src = &sptr[delta * soffset];
+          dest = rptr;
+        }
+      else
+        {
+          src = sptr;
+          dest = &rptr[delta * roffset];
+        }
+      for (n = 0; n < len - delta; n++)
+        {
+          memcpy (dest, src, size);
+          dest += roffset;
+          src += soffset;
+        }
+      if (sh < 0)
+        dest = rptr;
+      n = delta;
+
+      if (bptr)
+       while (n--)
+         {
+           memcpy (dest, bptr, size);
+           dest += roffset;
+         }
+      else
+       while (n--)
+         {
+           memset (dest, filler, size);
+           dest += roffset;
+         }
+
+      /* Advance to the next section.  */
+      rptr += rstride0;
+      sptr += sstride0;
+      hptr += hstride0;
+      bptr += bstride0;
+      count[0]++;
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          rptr -= rstride[n] * extent[n];
+          sptr -= sstride[n] * extent[n];
+         hptr -= hstride[n] * extent[n];
+          bptr -= bstride[n] * extent[n];
+          n++;
+          if (n >= dim - 1)
+            {
+              /* Break out of the loop.  */
+              rptr = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              rptr += rstride[n];
+              sptr += sstride[n];
+             hptr += hstride[n];
+              bptr += bstride[n];
+            }
+        }
+    }
+}
+
+extern void eoshift3_16 (gfc_array_char *, const gfc_array_char *,
+                                  const gfc_array_i16 *, const gfc_array_char *,
+                                  const GFC_INTEGER_16 *);
+export_proto(eoshift3_16);
+
+void
+eoshift3_16 (gfc_array_char *ret, const gfc_array_char *array,
+                      const gfc_array_i16 *h, const gfc_array_char *bound,
+                      const GFC_INTEGER_16 *pwhich)
+{
+  eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0);
+}
+
+extern void eoshift3_16_char (gfc_array_char *, GFC_INTEGER_4,
+                                         const gfc_array_char *,
+                                         const gfc_array_i16 *,
+                                         const gfc_array_char *,
+                                         const GFC_INTEGER_16 *, GFC_INTEGER_4,
+                                         GFC_INTEGER_4);
+export_proto(eoshift3_16_char);
+
+void
+eoshift3_16_char (gfc_array_char *ret,
+                             GFC_INTEGER_4 ret_length __attribute__((unused)),
+                             const gfc_array_char *array, const gfc_array_i16 *h,
+                             const gfc_array_char *bound,
+                             const GFC_INTEGER_16 *pwhich,
+                             GFC_INTEGER_4 array_length,
+                             GFC_INTEGER_4 bound_length
+                               __attribute__((unused)))
+{
+  eoshift3 (ret, array, h, bound, pwhich, array_length, ' ');
+}
+
+#endif
index 09e0207..2b84ece 100644 (file)
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, USA.  */
 #include <string.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_INTEGER_4)
+
 static void
 eoshift3 (gfc_array_char *ret, const gfc_array_char *array, const gfc_array_i4 *h,
          const gfc_array_char *bound, const GFC_INTEGER_4 *pwhich,
@@ -267,3 +269,5 @@ eoshift3_4_char (gfc_array_char *ret,
 {
   eoshift3 (ret, array, h, bound, pwhich, array_length, ' ');
 }
+
+#endif
index c652d98..ba2ef1f 100644 (file)
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, USA.  */
 #include <string.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_INTEGER_8)
+
 static void
 eoshift3 (gfc_array_char *ret, const gfc_array_char *array, const gfc_array_i8 *h,
          const gfc_array_char *bound, const GFC_INTEGER_8 *pwhich,
@@ -267,3 +269,5 @@ eoshift3_8_char (gfc_array_char *ret,
 {
   eoshift3 (ret, array, h, bound, pwhich, array_length, ' ');
 }
+
+#endif
diff --git a/libgfortran/generated/exponent_r10.c b/libgfortran/generated/exponent_r10.c
new file mode 100644 (file)
index 0000000..da2d33b
--- /dev/null
@@ -0,0 +1,49 @@
+/* Implementation of the EXPONENT intrinsic
+   Copyright 2003 Free Software Foundation, Inc.
+   Contributed by Richard Henderson <rth@redhat.com>.
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <math.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_FREXPL)
+
+extern GFC_INTEGER_4 exponent_r10 (GFC_REAL_10 s);
+export_proto(exponent_r10);
+
+GFC_INTEGER_4
+exponent_r10 (GFC_REAL_10 s)
+{
+  int ret;
+  frexpl (s, &ret);
+  return ret;
+}
+
+#endif
diff --git a/libgfortran/generated/exponent_r16.c b/libgfortran/generated/exponent_r16.c
new file mode 100644 (file)
index 0000000..de1769e
--- /dev/null
@@ -0,0 +1,49 @@
+/* Implementation of the EXPONENT intrinsic
+   Copyright 2003 Free Software Foundation, Inc.
+   Contributed by Richard Henderson <rth@redhat.com>.
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <math.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_FREXPL)
+
+extern GFC_INTEGER_4 exponent_r16 (GFC_REAL_16 s);
+export_proto(exponent_r16);
+
+GFC_INTEGER_4
+exponent_r16 (GFC_REAL_16 s)
+{
+  int ret;
+  frexpl (s, &ret);
+  return ret;
+}
+
+#endif
index 3d0ffb3..9a9c7eb 100644 (file)
@@ -27,10 +27,14 @@ You should have received a copy of the GNU General Public
 License along with libgfortran; see the file COPYING.  If not,
 write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
 #include <math.h>
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_FREXPF)
+
 extern GFC_INTEGER_4 exponent_r4 (GFC_REAL_4 s);
 export_proto(exponent_r4);
 
@@ -41,3 +45,5 @@ exponent_r4 (GFC_REAL_4 s)
   frexpf (s, &ret);
   return ret;
 }
+
+#endif
index 9fc8bff..d41bf9a 100644 (file)
@@ -27,10 +27,14 @@ You should have received a copy of the GNU General Public
 License along with libgfortran; see the file COPYING.  If not,
 write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
 #include <math.h>
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_FREXP)
+
 extern GFC_INTEGER_4 exponent_r8 (GFC_REAL_8 s);
 export_proto(exponent_r8);
 
@@ -41,3 +45,5 @@ exponent_r8 (GFC_REAL_8 s)
   frexp (s, &ret);
   return ret;
 }
+
+#endif
diff --git a/libgfortran/generated/fraction_r10.c b/libgfortran/generated/fraction_r10.c
new file mode 100644 (file)
index 0000000..aac9811
--- /dev/null
@@ -0,0 +1,48 @@
+/* Implementation of the FRACTION intrinsic
+   Copyright 2003 Free Software Foundation, Inc.
+   Contributed by Richard Henderson <rth@redhat.com>.
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <math.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_FREXPL)
+
+extern GFC_REAL_10 fraction_r10 (GFC_REAL_10 s);
+export_proto(fraction_r10);
+
+GFC_REAL_10
+fraction_r10 (GFC_REAL_10 s)
+{
+  int dummy_exp;
+  return frexpl (s, &dummy_exp);
+}
+
+#endif
diff --git a/libgfortran/generated/fraction_r16.c b/libgfortran/generated/fraction_r16.c
new file mode 100644 (file)
index 0000000..399682a
--- /dev/null
@@ -0,0 +1,48 @@
+/* Implementation of the FRACTION intrinsic
+   Copyright 2003 Free Software Foundation, Inc.
+   Contributed by Richard Henderson <rth@redhat.com>.
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <math.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_FREXPL)
+
+extern GFC_REAL_16 fraction_r16 (GFC_REAL_16 s);
+export_proto(fraction_r16);
+
+GFC_REAL_16
+fraction_r16 (GFC_REAL_16 s)
+{
+  int dummy_exp;
+  return frexpl (s, &dummy_exp);
+}
+
+#endif
index d7ca25f..2523350 100644 (file)
@@ -27,10 +27,14 @@ You should have received a copy of the GNU General Public
 License along with libgfortran; see the file COPYING.  If not,
 write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
 #include <math.h>
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_FREXPF)
+
 extern GFC_REAL_4 fraction_r4 (GFC_REAL_4 s);
 export_proto(fraction_r4);
 
@@ -40,3 +44,5 @@ fraction_r4 (GFC_REAL_4 s)
   int dummy_exp;
   return frexpf (s, &dummy_exp);
 }
+
+#endif
index d9b6c44..492e454 100644 (file)
@@ -27,10 +27,14 @@ You should have received a copy of the GNU General Public
 License along with libgfortran; see the file COPYING.  If not,
 write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
 #include <math.h>
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_FREXP)
+
 extern GFC_REAL_8 fraction_r8 (GFC_REAL_8 s);
 export_proto(fraction_r8);
 
@@ -40,3 +44,5 @@ fraction_r8 (GFC_REAL_8 s)
   int dummy_exp;
   return frexp (s, &dummy_exp);
 }
+
+#endif
diff --git a/libgfortran/generated/in_pack_c10.c b/libgfortran/generated/in_pack_c10.c
new file mode 100644 (file)
index 0000000..5a91d97
--- /dev/null
@@ -0,0 +1,126 @@
+/* Helper function for repacking arrays.
+   Copyright 2003 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+
+/* Allocates a block of memory with internal_malloc if the array needs
+   repacking.  */
+
+GFC_COMPLEX_10 *
+internal_pack_c10 (gfc_array_c10 * source)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type stride[GFC_MAX_DIMENSIONS];
+  index_type stride0;
+  index_type dim;
+  index_type ssize;
+  const GFC_COMPLEX_10 *src;
+  GFC_COMPLEX_10 *dest;
+  GFC_COMPLEX_10 *destptr;
+  int n;
+  int packed;
+
+  if (source->dim[0].stride == 0)
+    {
+      source->dim[0].stride = 1;
+      return source->data;
+    }
+
+  dim = GFC_DESCRIPTOR_RANK (source);
+  ssize = 1;
+  packed = 1;
+  for (n = 0; n < dim; n++)
+    {
+      count[n] = 0;
+      stride[n] = source->dim[n].stride;
+      extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+      if (extent[n] <= 0)
+        {
+          /* Do nothing.  */
+          packed = 1;
+          break;
+        }
+
+      if (ssize != stride[n])
+        packed = 0;
+
+      ssize *= extent[n];
+    }
+
+  if (packed)
+    return source->data;
+
+  /* Allocate storage for the destination.  */
+  destptr = (GFC_COMPLEX_10 *)internal_malloc_size (ssize * sizeof (GFC_COMPLEX_10));
+  dest = destptr;
+  src = source->data;
+  stride0 = stride[0];
+
+
+  while (src)
+    {
+      /* Copy the data.  */
+      *(dest++) = *src;
+      /* Advance to the next element.  */
+      src += stride0;
+      count[0]++;
+      /* Advance to the next source element.  */
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          src -= stride[n] * extent[n];
+          n++;
+          if (n == dim)
+            {
+              src = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              src += stride[n];
+            }
+        }
+    }
+  return destptr;
+}
+
+#endif
diff --git a/libgfortran/generated/in_pack_c16.c b/libgfortran/generated/in_pack_c16.c
new file mode 100644 (file)
index 0000000..d52249b
--- /dev/null
@@ -0,0 +1,126 @@
+/* Helper function for repacking arrays.
+   Copyright 2003 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+
+/* Allocates a block of memory with internal_malloc if the array needs
+   repacking.  */
+
+GFC_COMPLEX_16 *
+internal_pack_c16 (gfc_array_c16 * source)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type stride[GFC_MAX_DIMENSIONS];
+  index_type stride0;
+  index_type dim;
+  index_type ssize;
+  const GFC_COMPLEX_16 *src;
+  GFC_COMPLEX_16 *dest;
+  GFC_COMPLEX_16 *destptr;
+  int n;
+  int packed;
+
+  if (source->dim[0].stride == 0)
+    {
+      source->dim[0].stride = 1;
+      return source->data;
+    }
+
+  dim = GFC_DESCRIPTOR_RANK (source);
+  ssize = 1;
+  packed = 1;
+  for (n = 0; n < dim; n++)
+    {
+      count[n] = 0;
+      stride[n] = source->dim[n].stride;
+      extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+      if (extent[n] <= 0)
+        {
+          /* Do nothing.  */
+          packed = 1;
+          break;
+        }
+
+      if (ssize != stride[n])
+        packed = 0;
+
+      ssize *= extent[n];
+    }
+
+  if (packed)
+    return source->data;
+
+  /* Allocate storage for the destination.  */
+  destptr = (GFC_COMPLEX_16 *)internal_malloc_size (ssize * sizeof (GFC_COMPLEX_16));
+  dest = destptr;
+  src = source->data;
+  stride0 = stride[0];
+
+
+  while (src)
+    {
+      /* Copy the data.  */
+      *(dest++) = *src;
+      /* Advance to the next element.  */
+      src += stride0;
+      count[0]++;
+      /* Advance to the next source element.  */
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          src -= stride[n] * extent[n];
+          n++;
+          if (n == dim)
+            {
+              src = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              src += stride[n];
+            }
+        }
+    }
+  return destptr;
+}
+
+#endif
index c1446ad..a4fd709 100644 (file)
@@ -33,6 +33,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_COMPLEX_4)
+
 /* Allocates a block of memory with internal_malloc if the array needs
    repacking.  */
 
@@ -121,3 +123,4 @@ internal_pack_c4 (gfc_array_c4 * source)
   return destptr;
 }
 
+#endif
index 6665859..a3c6214 100644 (file)
@@ -33,6 +33,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_COMPLEX_8)
+
 /* Allocates a block of memory with internal_malloc if the array needs
    repacking.  */
 
@@ -121,3 +123,4 @@ internal_pack_c8 (gfc_array_c8 * source)
   return destptr;
 }
 
+#endif
diff --git a/libgfortran/generated/in_pack_i16.c b/libgfortran/generated/in_pack_i16.c
new file mode 100644 (file)
index 0000000..b8c6c29
--- /dev/null
@@ -0,0 +1,126 @@
+/* Helper function for repacking arrays.
+   Copyright 2003 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+/* Allocates a block of memory with internal_malloc if the array needs
+   repacking.  */
+
+GFC_INTEGER_16 *
+internal_pack_16 (gfc_array_i16 * source)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type stride[GFC_MAX_DIMENSIONS];
+  index_type stride0;
+  index_type dim;
+  index_type ssize;
+  const GFC_INTEGER_16 *src;
+  GFC_INTEGER_16 *dest;
+  GFC_INTEGER_16 *destptr;
+  int n;
+  int packed;
+
+  if (source->dim[0].stride == 0)
+    {
+      source->dim[0].stride = 1;
+      return source->data;
+    }
+
+  dim = GFC_DESCRIPTOR_RANK (source);
+  ssize = 1;
+  packed = 1;
+  for (n = 0; n < dim; n++)
+    {
+      count[n] = 0;
+      stride[n] = source->dim[n].stride;
+      extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+      if (extent[n] <= 0)
+        {
+          /* Do nothing.  */
+          packed = 1;
+          break;
+        }
+
+      if (ssize != stride[n])
+        packed = 0;
+
+      ssize *= extent[n];
+    }
+
+  if (packed)
+    return source->data;
+
+  /* Allocate storage for the destination.  */
+  destptr = (GFC_INTEGER_16 *)internal_malloc_size (ssize * sizeof (GFC_INTEGER_16));
+  dest = destptr;
+  src = source->data;
+  stride0 = stride[0];
+
+
+  while (src)
+    {
+      /* Copy the data.  */
+      *(dest++) = *src;
+      /* Advance to the next element.  */
+      src += stride0;
+      count[0]++;
+      /* Advance to the next source element.  */
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          src -= stride[n] * extent[n];
+          n++;
+          if (n == dim)
+            {
+              src = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              src += stride[n];
+            }
+        }
+    }
+  return destptr;
+}
+
+#endif
index 1034bde..4452c64 100644 (file)
@@ -33,6 +33,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_INTEGER_4)
+
 /* Allocates a block of memory with internal_malloc if the array needs
    repacking.  */
 
@@ -121,3 +123,4 @@ internal_pack_4 (gfc_array_i4 * source)
   return destptr;
 }
 
+#endif
index aa7e98c..35e4842 100644 (file)
@@ -33,6 +33,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_INTEGER_8)
+
 /* Allocates a block of memory with internal_malloc if the array needs
    repacking.  */
 
@@ -121,3 +123,4 @@ internal_pack_8 (gfc_array_i8 * source)
   return destptr;
 }
 
+#endif
diff --git a/libgfortran/generated/in_unpack_c10.c b/libgfortran/generated/in_unpack_c10.c
new file mode 100644 (file)
index 0000000..d7983f9
--- /dev/null
@@ -0,0 +1,114 @@
+/* Helper function for repacking arrays.
+   Copyright 2003 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <string.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+
+void
+internal_unpack_c10 (gfc_array_c10 * d, const GFC_COMPLEX_10 * src)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type stride[GFC_MAX_DIMENSIONS];
+  index_type stride0;
+  index_type dim;
+  index_type dsize;
+  GFC_COMPLEX_10 *dest;
+  int n;
+
+  dest = d->data;
+  if (src == dest || !src)
+    return;
+
+  if (d->dim[0].stride == 0)
+    d->dim[0].stride = 1;
+
+  dim = GFC_DESCRIPTOR_RANK (d);
+  dsize = 1;
+  for (n = 0; n < dim; n++)
+    {
+      count[n] = 0;
+      stride[n] = d->dim[n].stride;
+      extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound;
+      if (extent[n] <= 0)
+        abort ();
+
+      if (dsize == stride[n])
+        dsize *= extent[n];
+      else
+        dsize = 0;
+    }
+
+  if (dsize != 0)
+    {
+      memcpy (dest, src, dsize * sizeof (GFC_COMPLEX_10));
+      return;
+    }
+
+  stride0 = stride[0];
+
+  while (dest)
+    {
+      /* Copy the data.  */
+      *dest = *(src++);
+      /* Advance to the next element.  */
+      dest += stride0;
+      count[0]++;
+      /* Advance to the next source element.  */
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          dest -= stride[n] * extent[n];
+          n++;
+          if (n == dim)
+            {
+              dest = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              dest += stride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/in_unpack_c16.c b/libgfortran/generated/in_unpack_c16.c
new file mode 100644 (file)
index 0000000..9f1baf2
--- /dev/null
@@ -0,0 +1,114 @@
+/* Helper function for repacking arrays.
+   Copyright 2003 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <string.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+
+void
+internal_unpack_c16 (gfc_array_c16 * d, const GFC_COMPLEX_16 * src)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type stride[GFC_MAX_DIMENSIONS];
+  index_type stride0;
+  index_type dim;
+  index_type dsize;
+  GFC_COMPLEX_16 *dest;
+  int n;
+
+  dest = d->data;
+  if (src == dest || !src)
+    return;
+
+  if (d->dim[0].stride == 0)
+    d->dim[0].stride = 1;
+
+  dim = GFC_DESCRIPTOR_RANK (d);
+  dsize = 1;
+  for (n = 0; n < dim; n++)
+    {
+      count[n] = 0;
+      stride[n] = d->dim[n].stride;
+      extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound;
+      if (extent[n] <= 0)
+        abort ();
+
+      if (dsize == stride[n])
+        dsize *= extent[n];
+      else
+        dsize = 0;
+    }
+
+  if (dsize != 0)
+    {
+      memcpy (dest, src, dsize * sizeof (GFC_COMPLEX_16));
+      return;
+    }
+
+  stride0 = stride[0];
+
+  while (dest)
+    {
+      /* Copy the data.  */
+      *dest = *(src++);
+      /* Advance to the next element.  */
+      dest += stride0;
+      count[0]++;
+      /* Advance to the next source element.  */
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          dest -= stride[n] * extent[n];
+          n++;
+          if (n == dim)
+            {
+              dest = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              dest += stride[n];
+            }
+        }
+    }
+}
+
+#endif
index 7388ec9..965b53a 100644 (file)
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, USA.  */
 #include <string.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_COMPLEX_4)
+
 void
 internal_unpack_c4 (gfc_array_c4 * d, const GFC_COMPLEX_4 * src)
 {
@@ -109,3 +111,4 @@ internal_unpack_c4 (gfc_array_c4 * d, const GFC_COMPLEX_4 * src)
     }
 }
 
+#endif
index dc0e20d..b5d747a 100644 (file)
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, USA.  */
 #include <string.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_COMPLEX_8)
+
 void
 internal_unpack_c8 (gfc_array_c8 * d, const GFC_COMPLEX_8 * src)
 {
@@ -109,3 +111,4 @@ internal_unpack_c8 (gfc_array_c8 * d, const GFC_COMPLEX_8 * src)
     }
 }
 
+#endif
diff --git a/libgfortran/generated/in_unpack_i16.c b/libgfortran/generated/in_unpack_i16.c
new file mode 100644 (file)
index 0000000..680b5dd
--- /dev/null
@@ -0,0 +1,114 @@
+/* Helper function for repacking arrays.
+   Copyright 2003 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <string.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+void
+internal_unpack_16 (gfc_array_i16 * d, const GFC_INTEGER_16 * src)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type stride[GFC_MAX_DIMENSIONS];
+  index_type stride0;
+  index_type dim;
+  index_type dsize;
+  GFC_INTEGER_16 *dest;
+  int n;
+
+  dest = d->data;
+  if (src == dest || !src)
+    return;
+
+  if (d->dim[0].stride == 0)
+    d->dim[0].stride = 1;
+
+  dim = GFC_DESCRIPTOR_RANK (d);
+  dsize = 1;
+  for (n = 0; n < dim; n++)
+    {
+      count[n] = 0;
+      stride[n] = d->dim[n].stride;
+      extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound;
+      if (extent[n] <= 0)
+        abort ();
+
+      if (dsize == stride[n])
+        dsize *= extent[n];
+      else
+        dsize = 0;
+    }
+
+  if (dsize != 0)
+    {
+      memcpy (dest, src, dsize * sizeof (GFC_INTEGER_16));
+      return;
+    }
+
+  stride0 = stride[0];
+
+  while (dest)
+    {
+      /* Copy the data.  */
+      *dest = *(src++);
+      /* Advance to the next element.  */
+      dest += stride0;
+      count[0]++;
+      /* Advance to the next source element.  */
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          dest -= stride[n] * extent[n];
+          n++;
+          if (n == dim)
+            {
+              dest = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              dest += stride[n];
+            }
+        }
+    }
+}
+
+#endif
index 8664b8c..6cf7bd2 100644 (file)
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, USA.  */
 #include <string.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_INTEGER_4)
+
 void
 internal_unpack_4 (gfc_array_i4 * d, const GFC_INTEGER_4 * src)
 {
@@ -109,3 +111,4 @@ internal_unpack_4 (gfc_array_i4 * d, const GFC_INTEGER_4 * src)
     }
 }
 
+#endif
index 8117c2c..1d4f0e4 100644 (file)
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, USA.  */
 #include <string.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_INTEGER_8)
+
 void
 internal_unpack_8 (gfc_array_i8 * d, const GFC_INTEGER_8 * src)
 {
@@ -109,3 +111,4 @@ internal_unpack_8 (gfc_array_i8 * d, const GFC_INTEGER_8 * src)
     }
 }
 
+#endif
diff --git a/libgfortran/generated/matmul_c10.c b/libgfortran/generated/matmul_c10.c
new file mode 100644 (file)
index 0000000..801649a
--- /dev/null
@@ -0,0 +1,221 @@
+/* Implementation of the MATMUL intrinsic
+   Copyright 2002, 2005 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+
+/* This is a C version of the following fortran pseudo-code. The key
+   point is the loop order -- we access all arrays column-first, which
+   improves the performance enough to boost galgel spec score by 50%.
+
+   DIMENSION A(M,COUNT), B(COUNT,N), C(M,N)
+   C = 0
+   DO J=1,N
+     DO K=1,COUNT
+       DO I=1,M
+         C(I,J) = C(I,J)+A(I,K)*B(K,J)
+*/
+
+extern void matmul_c10 (gfc_array_c10 * retarray, gfc_array_c10 * a, gfc_array_c10 * b);
+export_proto(matmul_c10);
+
+void
+matmul_c10 (gfc_array_c10 * retarray, gfc_array_c10 * a, gfc_array_c10 * b)
+{
+  GFC_COMPLEX_10 *abase;
+  GFC_COMPLEX_10 *bbase;
+  GFC_COMPLEX_10 *dest;
+
+  index_type rxstride, rystride, axstride, aystride, bxstride, bystride;
+  index_type x, y, n, count, xcount, ycount;
+
+  assert (GFC_DESCRIPTOR_RANK (a) == 2
+          || GFC_DESCRIPTOR_RANK (b) == 2);
+
+/* C[xcount,ycount] = A[xcount, count] * B[count,ycount]
+
+   Either A or B (but not both) can be rank 1:
+
+   o One-dimensional argument A is implicitly treated as a row matrix
+     dimensioned [1,count], so xcount=1.
+
+   o One-dimensional argument B is implicitly treated as a column matrix
+     dimensioned [count, 1], so ycount=1.
+  */
+
+  if (retarray->data == NULL)
+    {
+      if (GFC_DESCRIPTOR_RANK (a) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else if (GFC_DESCRIPTOR_RANK (b) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+
+          retarray->dim[1].lbound = 0;
+          retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[1].stride = retarray->dim[0].ubound+1;
+        }
+
+      retarray->data
+       = internal_malloc_size (sizeof (GFC_COMPLEX_10) * size0 ((array_t *) retarray));
+      retarray->offset = 0;
+    }
+
+  abase = a->data;
+  bbase = b->data;
+  dest = retarray->data;
+
+  if (retarray->dim[0].stride == 0)
+    retarray->dim[0].stride = 1;
+  if (a->dim[0].stride == 0)
+    a->dim[0].stride = 1;
+  if (b->dim[0].stride == 0)
+    b->dim[0].stride = 1;
+
+
+  if (GFC_DESCRIPTOR_RANK (retarray) == 1)
+    {
+      /* One-dimensional result may be addressed in the code below
+        either as a row or a column matrix. We want both cases to
+        work. */
+      rxstride = rystride = retarray->dim[0].stride;
+    }
+  else
+    {
+      rxstride = retarray->dim[0].stride;
+      rystride = retarray->dim[1].stride;
+    }
+
+
+  if (GFC_DESCRIPTOR_RANK (a) == 1)
+    {
+      /* Treat it as a a row matrix A[1,count]. */
+      axstride = a->dim[0].stride;
+      aystride = 1;
+
+      xcount = 1;
+      count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+    }
+  else
+    {
+      axstride = a->dim[0].stride;
+      aystride = a->dim[1].stride;
+
+      count = a->dim[1].ubound + 1 - a->dim[1].lbound;
+      xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+    }
+
+  assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
+
+  if (GFC_DESCRIPTOR_RANK (b) == 1)
+    {
+      /* Treat it as a column matrix B[count,1] */
+      bxstride = b->dim[0].stride;
+
+      /* bystride should never be used for 1-dimensional b.
+        in case it is we want it to cause a segfault, rather than
+        an incorrect result. */
+      bystride = 0xDEADBEEF;
+      ycount = 1;
+    }
+  else
+    {
+      bxstride = b->dim[0].stride;
+      bystride = b->dim[1].stride;
+      ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+    }
+
+  abase = a->data;
+  bbase = b->data;
+  dest = retarray->data;
+
+  if (rxstride == 1 && axstride == 1 && bxstride == 1)
+    {
+      GFC_COMPLEX_10 *bbase_y;
+      GFC_COMPLEX_10 *dest_y;
+      GFC_COMPLEX_10 *abase_n;
+      GFC_COMPLEX_10 bbase_yn;
+
+      if (rystride == ycount)
+       memset (dest, 0, (sizeof (GFC_COMPLEX_10) * size0((array_t *) retarray)));
+      else
+       {
+         for (y = 0; y < ycount; y++)
+           for (x = 0; x < xcount; x++)
+             dest[x + y*rystride] = (GFC_COMPLEX_10)0;
+       }
+
+      for (y = 0; y < ycount; y++)
+       {
+         bbase_y = bbase + y*bystride;
+         dest_y = dest + y*rystride;
+         for (n = 0; n < count; n++)
+           {
+             abase_n = abase + n*aystride;
+             bbase_yn = bbase_y[n];
+             for (x = 0; x < xcount; x++)
+               {
+                 dest_y[x] += abase_n[x] * bbase_yn;
+               }
+           }
+       }
+    }
+  else
+    {
+      for (y = 0; y < ycount; y++)
+       for (x = 0; x < xcount; x++)
+         dest[x*rxstride + y*rystride] = (GFC_COMPLEX_10)0;
+
+      for (y = 0; y < ycount; y++)
+       for (n = 0; n < count; n++)
+         for (x = 0; x < xcount; x++)
+           /* dest[x,y] += a[x,n] * b[n,y] */
+           dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/matmul_c16.c b/libgfortran/generated/matmul_c16.c
new file mode 100644 (file)
index 0000000..fb4870c
--- /dev/null
@@ -0,0 +1,221 @@
+/* Implementation of the MATMUL intrinsic
+   Copyright 2002, 2005 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+
+/* This is a C version of the following fortran pseudo-code. The key
+   point is the loop order -- we access all arrays column-first, which
+   improves the performance enough to boost galgel spec score by 50%.
+
+   DIMENSION A(M,COUNT), B(COUNT,N), C(M,N)
+   C = 0
+   DO J=1,N
+     DO K=1,COUNT
+       DO I=1,M
+         C(I,J) = C(I,J)+A(I,K)*B(K,J)
+*/
+
+extern void matmul_c16 (gfc_array_c16 * retarray, gfc_array_c16 * a, gfc_array_c16 * b);
+export_proto(matmul_c16);
+
+void
+matmul_c16 (gfc_array_c16 * retarray, gfc_array_c16 * a, gfc_array_c16 * b)
+{
+  GFC_COMPLEX_16 *abase;
+  GFC_COMPLEX_16 *bbase;
+  GFC_COMPLEX_16 *dest;
+
+  index_type rxstride, rystride, axstride, aystride, bxstride, bystride;
+  index_type x, y, n, count, xcount, ycount;
+
+  assert (GFC_DESCRIPTOR_RANK (a) == 2
+          || GFC_DESCRIPTOR_RANK (b) == 2);
+
+/* C[xcount,ycount] = A[xcount, count] * B[count,ycount]
+
+   Either A or B (but not both) can be rank 1:
+
+   o One-dimensional argument A is implicitly treated as a row matrix
+     dimensioned [1,count], so xcount=1.
+
+   o One-dimensional argument B is implicitly treated as a column matrix
+     dimensioned [count, 1], so ycount=1.
+  */
+
+  if (retarray->data == NULL)
+    {
+      if (GFC_DESCRIPTOR_RANK (a) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else if (GFC_DESCRIPTOR_RANK (b) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+
+          retarray->dim[1].lbound = 0;
+          retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[1].stride = retarray->dim[0].ubound+1;
+        }
+
+      retarray->data
+       = internal_malloc_size (sizeof (GFC_COMPLEX_16) * size0 ((array_t *) retarray));
+      retarray->offset = 0;
+    }
+
+  abase = a->data;
+  bbase = b->data;
+  dest = retarray->data;
+
+  if (retarray->dim[0].stride == 0)
+    retarray->dim[0].stride = 1;
+  if (a->dim[0].stride == 0)
+    a->dim[0].stride = 1;
+  if (b->dim[0].stride == 0)
+    b->dim[0].stride = 1;
+
+
+  if (GFC_DESCRIPTOR_RANK (retarray) == 1)
+    {
+      /* One-dimensional result may be addressed in the code below
+        either as a row or a column matrix. We want both cases to
+        work. */
+      rxstride = rystride = retarray->dim[0].stride;
+    }
+  else
+    {
+      rxstride = retarray->dim[0].stride;
+      rystride = retarray->dim[1].stride;
+    }
+
+
+  if (GFC_DESCRIPTOR_RANK (a) == 1)
+    {
+      /* Treat it as a a row matrix A[1,count]. */
+      axstride = a->dim[0].stride;
+      aystride = 1;
+
+      xcount = 1;
+      count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+    }
+  else
+    {
+      axstride = a->dim[0].stride;
+      aystride = a->dim[1].stride;
+
+      count = a->dim[1].ubound + 1 - a->dim[1].lbound;
+      xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+    }
+
+  assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
+
+  if (GFC_DESCRIPTOR_RANK (b) == 1)
+    {
+      /* Treat it as a column matrix B[count,1] */
+      bxstride = b->dim[0].stride;
+
+      /* bystride should never be used for 1-dimensional b.
+        in case it is we want it to cause a segfault, rather than
+        an incorrect result. */
+      bystride = 0xDEADBEEF;
+      ycount = 1;
+    }
+  else
+    {
+      bxstride = b->dim[0].stride;
+      bystride = b->dim[1].stride;
+      ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+    }
+
+  abase = a->data;
+  bbase = b->data;
+  dest = retarray->data;
+
+  if (rxstride == 1 && axstride == 1 && bxstride == 1)
+    {
+      GFC_COMPLEX_16 *bbase_y;
+      GFC_COMPLEX_16 *dest_y;
+      GFC_COMPLEX_16 *abase_n;
+      GFC_COMPLEX_16 bbase_yn;
+
+      if (rystride == ycount)
+       memset (dest, 0, (sizeof (GFC_COMPLEX_16) * size0((array_t *) retarray)));
+      else
+       {
+         for (y = 0; y < ycount; y++)
+           for (x = 0; x < xcount; x++)
+             dest[x + y*rystride] = (GFC_COMPLEX_16)0;
+       }
+
+      for (y = 0; y < ycount; y++)
+       {
+         bbase_y = bbase + y*bystride;
+         dest_y = dest + y*rystride;
+         for (n = 0; n < count; n++)
+           {
+             abase_n = abase + n*aystride;
+             bbase_yn = bbase_y[n];
+             for (x = 0; x < xcount; x++)
+               {
+                 dest_y[x] += abase_n[x] * bbase_yn;
+               }
+           }
+       }
+    }
+  else
+    {
+      for (y = 0; y < ycount; y++)
+       for (x = 0; x < xcount; x++)
+         dest[x*rxstride + y*rystride] = (GFC_COMPLEX_16)0;
+
+      for (y = 0; y < ycount; y++)
+       for (n = 0; n < count; n++)
+         for (x = 0; x < xcount; x++)
+           /* dest[x,y] += a[x,n] * b[n,y] */
+           dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
+    }
+}
+
+#endif
index 8d13bb9..8c9a710 100644 (file)
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_COMPLEX_4)
+
 /* This is a C version of the following fortran pseudo-code. The key
    point is the loop order -- we access all arrays column-first, which
    improves the performance enough to boost galgel spec score by 50%.
@@ -215,3 +217,5 @@ matmul_c4 (gfc_array_c4 * retarray, gfc_array_c4 * a, gfc_array_c4 * b)
            dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
     }
 }
+
+#endif
index ada73eb..7b713f1 100644 (file)
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_COMPLEX_8)
+
 /* This is a C version of the following fortran pseudo-code. The key
    point is the loop order -- we access all arrays column-first, which
    improves the performance enough to boost galgel spec score by 50%.
@@ -215,3 +217,5 @@ matmul_c8 (gfc_array_c8 * retarray, gfc_array_c8 * a, gfc_array_c8 * b)
            dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
     }
 }
+
+#endif
diff --git a/libgfortran/generated/matmul_i16.c b/libgfortran/generated/matmul_i16.c
new file mode 100644 (file)
index 0000000..adbfbed
--- /dev/null
@@ -0,0 +1,221 @@
+/* Implementation of the MATMUL intrinsic
+   Copyright 2002, 2005 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+/* This is a C version of the following fortran pseudo-code. The key
+   point is the loop order -- we access all arrays column-first, which
+   improves the performance enough to boost galgel spec score by 50%.
+
+   DIMENSION A(M,COUNT), B(COUNT,N), C(M,N)
+   C = 0
+   DO J=1,N
+     DO K=1,COUNT
+       DO I=1,M
+         C(I,J) = C(I,J)+A(I,K)*B(K,J)
+*/
+
+extern void matmul_i16 (gfc_array_i16 * retarray, gfc_array_i16 * a, gfc_array_i16 * b);
+export_proto(matmul_i16);
+
+void
+matmul_i16 (gfc_array_i16 * retarray, gfc_array_i16 * a, gfc_array_i16 * b)
+{
+  GFC_INTEGER_16 *abase;
+  GFC_INTEGER_16 *bbase;
+  GFC_INTEGER_16 *dest;
+
+  index_type rxstride, rystride, axstride, aystride, bxstride, bystride;
+  index_type x, y, n, count, xcount, ycount;
+
+  assert (GFC_DESCRIPTOR_RANK (a) == 2
+          || GFC_DESCRIPTOR_RANK (b) == 2);
+
+/* C[xcount,ycount] = A[xcount, count] * B[count,ycount]
+
+   Either A or B (but not both) can be rank 1:
+
+   o One-dimensional argument A is implicitly treated as a row matrix
+     dimensioned [1,count], so xcount=1.
+
+   o One-dimensional argument B is implicitly treated as a column matrix
+     dimensioned [count, 1], so ycount=1.
+  */
+
+  if (retarray->data == NULL)
+    {
+      if (GFC_DESCRIPTOR_RANK (a) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else if (GFC_DESCRIPTOR_RANK (b) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+
+          retarray->dim[1].lbound = 0;
+          retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[1].stride = retarray->dim[0].ubound+1;
+        }
+
+      retarray->data
+       = internal_malloc_size (sizeof (GFC_INTEGER_16) * size0 ((array_t *) retarray));
+      retarray->offset = 0;
+    }
+
+  abase = a->data;
+  bbase = b->data;
+  dest = retarray->data;
+
+  if (retarray->dim[0].stride == 0)
+    retarray->dim[0].stride = 1;
+  if (a->dim[0].stride == 0)
+    a->dim[0].stride = 1;
+  if (b->dim[0].stride == 0)
+    b->dim[0].stride = 1;
+
+
+  if (GFC_DESCRIPTOR_RANK (retarray) == 1)
+    {
+      /* One-dimensional result may be addressed in the code below
+        either as a row or a column matrix. We want both cases to
+        work. */
+      rxstride = rystride = retarray->dim[0].stride;
+    }
+  else
+    {
+      rxstride = retarray->dim[0].stride;
+      rystride = retarray->dim[1].stride;
+    }
+
+
+  if (GFC_DESCRIPTOR_RANK (a) == 1)
+    {
+      /* Treat it as a a row matrix A[1,count]. */
+      axstride = a->dim[0].stride;
+      aystride = 1;
+
+      xcount = 1;
+      count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+    }
+  else
+    {
+      axstride = a->dim[0].stride;
+      aystride = a->dim[1].stride;
+
+      count = a->dim[1].ubound + 1 - a->dim[1].lbound;
+      xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+    }
+
+  assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
+
+  if (GFC_DESCRIPTOR_RANK (b) == 1)
+    {
+      /* Treat it as a column matrix B[count,1] */
+      bxstride = b->dim[0].stride;
+
+      /* bystride should never be used for 1-dimensional b.
+        in case it is we want it to cause a segfault, rather than
+        an incorrect result. */
+      bystride = 0xDEADBEEF;
+      ycount = 1;
+    }
+  else
+    {
+      bxstride = b->dim[0].stride;
+      bystride = b->dim[1].stride;
+      ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+    }
+
+  abase = a->data;
+  bbase = b->data;
+  dest = retarray->data;
+
+  if (rxstride == 1 && axstride == 1 && bxstride == 1)
+    {
+      GFC_INTEGER_16 *bbase_y;
+      GFC_INTEGER_16 *dest_y;
+      GFC_INTEGER_16 *abase_n;
+      GFC_INTEGER_16 bbase_yn;
+
+      if (rystride == ycount)
+       memset (dest, 0, (sizeof (GFC_INTEGER_16) * size0((array_t *) retarray)));
+      else
+       {
+         for (y = 0; y < ycount; y++)
+           for (x = 0; x < xcount; x++)
+             dest[x + y*rystride] = (GFC_INTEGER_16)0;
+       }
+
+      for (y = 0; y < ycount; y++)
+       {
+         bbase_y = bbase + y*bystride;
+         dest_y = dest + y*rystride;
+         for (n = 0; n < count; n++)
+           {
+             abase_n = abase + n*aystride;
+             bbase_yn = bbase_y[n];
+             for (x = 0; x < xcount; x++)
+               {
+                 dest_y[x] += abase_n[x] * bbase_yn;
+               }
+           }
+       }
+    }
+  else
+    {
+      for (y = 0; y < ycount; y++)
+       for (x = 0; x < xcount; x++)
+         dest[x*rxstride + y*rystride] = (GFC_INTEGER_16)0;
+
+      for (y = 0; y < ycount; y++)
+       for (n = 0; n < count; n++)
+         for (x = 0; x < xcount; x++)
+           /* dest[x,y] += a[x,n] * b[n,y] */
+           dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
+    }
+}
+
+#endif
index 16c376f..abace32 100644 (file)
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_INTEGER_4)
+
 /* This is a C version of the following fortran pseudo-code. The key
    point is the loop order -- we access all arrays column-first, which
    improves the performance enough to boost galgel spec score by 50%.
@@ -215,3 +217,5 @@ matmul_i4 (gfc_array_i4 * retarray, gfc_array_i4 * a, gfc_array_i4 * b)
            dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
     }
 }
+
+#endif
index 0e29d07..9820e40 100644 (file)
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_INTEGER_8)
+
 /* This is a C version of the following fortran pseudo-code. The key
    point is the loop order -- we access all arrays column-first, which
    improves the performance enough to boost galgel spec score by 50%.
@@ -215,3 +217,5 @@ matmul_i8 (gfc_array_i8 * retarray, gfc_array_i8 * a, gfc_array_i8 * b)
            dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
     }
 }
+
+#endif
diff --git a/libgfortran/generated/matmul_l16.c b/libgfortran/generated/matmul_l16.c
new file mode 100644 (file)
index 0000000..28dce3a
--- /dev/null
@@ -0,0 +1,196 @@
+/* Implementation of the MATMUL intrinsic
+   Copyright 2002, 2005 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_LOGICAL_16)
+
+/* Dimensions: retarray(x,y) a(x, count) b(count,y).
+   Either a or b can be rank 1.  In this case x or y is 1.  */
+
+extern void matmul_l16 (gfc_array_l16 *, gfc_array_l4 *, gfc_array_l4 *);
+export_proto(matmul_l16);
+
+void
+matmul_l16 (gfc_array_l16 * retarray, gfc_array_l4 * a, gfc_array_l4 * b)
+{
+  GFC_INTEGER_4 *abase;
+  GFC_INTEGER_4 *bbase;
+  GFC_LOGICAL_16 *dest;
+  index_type rxstride;
+  index_type rystride;
+  index_type xcount;
+  index_type ycount;
+  index_type xstride;
+  index_type ystride;
+  index_type x;
+  index_type y;
+
+  GFC_INTEGER_4 *pa;
+  GFC_INTEGER_4 *pb;
+  index_type astride;
+  index_type bstride;
+  index_type count;
+  index_type n;
+
+  assert (GFC_DESCRIPTOR_RANK (a) == 2
+          || GFC_DESCRIPTOR_RANK (b) == 2);
+
+  if (retarray->data == NULL)
+    {
+      if (GFC_DESCRIPTOR_RANK (a) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else if (GFC_DESCRIPTOR_RANK (b) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+          
+          retarray->dim[1].lbound = 0;
+          retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[1].stride = retarray->dim[0].ubound+1;
+        }
+          
+      retarray->data
+       = internal_malloc_size (sizeof (GFC_LOGICAL_16) * size0 ((array_t *) retarray));
+      retarray->offset = 0;
+    }
+
+  abase = a->data;
+  if (GFC_DESCRIPTOR_SIZE (a) != 4)
+    {
+      assert (GFC_DESCRIPTOR_SIZE (a) == 8);
+      abase = GFOR_POINTER_L8_TO_L4 (abase);
+    }
+  bbase = b->data;
+  if (GFC_DESCRIPTOR_SIZE (b) != 4)
+    {
+      assert (GFC_DESCRIPTOR_SIZE (b) == 8);
+      bbase = GFOR_POINTER_L8_TO_L4 (bbase);
+    }
+  dest = retarray->data;
+
+  if (retarray->dim[0].stride == 0)
+    retarray->dim[0].stride = 1;
+  if (a->dim[0].stride == 0)
+    a->dim[0].stride = 1;
+  if (b->dim[0].stride == 0)
+    b->dim[0].stride = 1;
+
+
+  if (GFC_DESCRIPTOR_RANK (retarray) == 1)
+    {
+      rxstride = retarray->dim[0].stride;
+      rystride = rxstride;
+    }
+  else
+    {
+      rxstride = retarray->dim[0].stride;
+      rystride = retarray->dim[1].stride;
+    }
+
+  /* If we have rank 1 parameters, zero the absent stride, and set the size to
+     one.  */
+  if (GFC_DESCRIPTOR_RANK (a) == 1)
+    {
+      astride = a->dim[0].stride;
+      count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+      xstride = 0;
+      rxstride = 0;
+      xcount = 1;
+    }
+  else
+    {
+      astride = a->dim[1].stride;
+      count = a->dim[1].ubound + 1 - a->dim[1].lbound;
+      xstride = a->dim[0].stride;
+      xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+    }
+  if (GFC_DESCRIPTOR_RANK (b) == 1)
+    {
+      bstride = b->dim[0].stride;
+      assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
+      ystride = 0;
+      rystride = 0;
+      ycount = 1;
+    }
+  else
+    {
+      bstride = b->dim[0].stride;
+      assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
+      ystride = b->dim[1].stride;
+      ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+    }
+
+  for (y = 0; y < ycount; y++)
+    {
+      for (x = 0; x < xcount; x++)
+        {
+          /* Do the summation for this element.  For real and integer types
+             this is the same as DOT_PRODUCT.  For complex types we use do
+             a*b, not conjg(a)*b.  */
+          pa = abase;
+          pb = bbase;
+          *dest = 0;
+
+          for (n = 0; n < count; n++)
+            {
+              if (*pa && *pb)
+                {
+                  *dest = 1;
+                  break;
+                }
+              pa += astride;
+              pb += bstride;
+            }
+
+          dest += rxstride;
+          abase += xstride;
+        }
+      abase -= xstride * xcount;
+      bbase += ystride;
+      dest += rystride - (rxstride * xcount);
+    }
+}
+
+#endif
index ff32eb4..da66814 100644 (file)
@@ -33,6 +33,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_LOGICAL_4)
+
 /* Dimensions: retarray(x,y) a(x, count) b(count,y).
    Either a or b can be rank 1.  In this case x or y is 1.  */
 
@@ -190,3 +192,5 @@ matmul_l4 (gfc_array_l4 * retarray, gfc_array_l4 * a, gfc_array_l4 * b)
       dest += rystride - (rxstride * xcount);
     }
 }
+
+#endif
index b726a70..22c1a66 100644 (file)
@@ -33,6 +33,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_LOGICAL_8)
+
 /* Dimensions: retarray(x,y) a(x, count) b(count,y).
    Either a or b can be rank 1.  In this case x or y is 1.  */
 
@@ -190,3 +192,5 @@ matmul_l8 (gfc_array_l8 * retarray, gfc_array_l4 * a, gfc_array_l4 * b)
       dest += rystride - (rxstride * xcount);
     }
 }
+
+#endif
diff --git a/libgfortran/generated/matmul_r10.c b/libgfortran/generated/matmul_r10.c
new file mode 100644 (file)
index 0000000..8aa342d
--- /dev/null
@@ -0,0 +1,221 @@
+/* Implementation of the MATMUL intrinsic
+   Copyright 2002, 2005 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_REAL_10)
+
+/* This is a C version of the following fortran pseudo-code. The key
+   point is the loop order -- we access all arrays column-first, which
+   improves the performance enough to boost galgel spec score by 50%.
+
+   DIMENSION A(M,COUNT), B(COUNT,N), C(M,N)
+   C = 0
+   DO J=1,N
+     DO K=1,COUNT
+       DO I=1,M
+         C(I,J) = C(I,J)+A(I,K)*B(K,J)
+*/
+
+extern void matmul_r10 (gfc_array_r10 * retarray, gfc_array_r10 * a, gfc_array_r10 * b);
+export_proto(matmul_r10);
+
+void
+matmul_r10 (gfc_array_r10 * retarray, gfc_array_r10 * a, gfc_array_r10 * b)
+{
+  GFC_REAL_10 *abase;
+  GFC_REAL_10 *bbase;
+  GFC_REAL_10 *dest;
+
+  index_type rxstride, rystride, axstride, aystride, bxstride, bystride;
+  index_type x, y, n, count, xcount, ycount;
+
+  assert (GFC_DESCRIPTOR_RANK (a) == 2
+          || GFC_DESCRIPTOR_RANK (b) == 2);
+
+/* C[xcount,ycount] = A[xcount, count] * B[count,ycount]
+
+   Either A or B (but not both) can be rank 1:
+
+   o One-dimensional argument A is implicitly treated as a row matrix
+     dimensioned [1,count], so xcount=1.
+
+   o One-dimensional argument B is implicitly treated as a column matrix
+     dimensioned [count, 1], so ycount=1.
+  */
+
+  if (retarray->data == NULL)
+    {
+      if (GFC_DESCRIPTOR_RANK (a) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else if (GFC_DESCRIPTOR_RANK (b) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+
+          retarray->dim[1].lbound = 0;
+          retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[1].stride = retarray->dim[0].ubound+1;
+        }
+
+      retarray->data
+       = internal_malloc_size (sizeof (GFC_REAL_10) * size0 ((array_t *) retarray));
+      retarray->offset = 0;
+    }
+
+  abase = a->data;
+  bbase = b->data;
+  dest = retarray->data;
+
+  if (retarray->dim[0].stride == 0)
+    retarray->dim[0].stride = 1;
+  if (a->dim[0].stride == 0)
+    a->dim[0].stride = 1;
+  if (b->dim[0].stride == 0)
+    b->dim[0].stride = 1;
+
+
+  if (GFC_DESCRIPTOR_RANK (retarray) == 1)
+    {
+      /* One-dimensional result may be addressed in the code below
+        either as a row or a column matrix. We want both cases to
+        work. */
+      rxstride = rystride = retarray->dim[0].stride;
+    }
+  else
+    {
+      rxstride = retarray->dim[0].stride;
+      rystride = retarray->dim[1].stride;
+    }
+
+
+  if (GFC_DESCRIPTOR_RANK (a) == 1)
+    {
+      /* Treat it as a a row matrix A[1,count]. */
+      axstride = a->dim[0].stride;
+      aystride = 1;
+
+      xcount = 1;
+      count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+    }
+  else
+    {
+      axstride = a->dim[0].stride;
+      aystride = a->dim[1].stride;
+
+      count = a->dim[1].ubound + 1 - a->dim[1].lbound;
+      xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+    }
+
+  assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
+
+  if (GFC_DESCRIPTOR_RANK (b) == 1)
+    {
+      /* Treat it as a column matrix B[count,1] */
+      bxstride = b->dim[0].stride;
+
+      /* bystride should never be used for 1-dimensional b.
+        in case it is we want it to cause a segfault, rather than
+        an incorrect result. */
+      bystride = 0xDEADBEEF;
+      ycount = 1;
+    }
+  else
+    {
+      bxstride = b->dim[0].stride;
+      bystride = b->dim[1].stride;
+      ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+    }
+
+  abase = a->data;
+  bbase = b->data;
+  dest = retarray->data;
+
+  if (rxstride == 1 && axstride == 1 && bxstride == 1)
+    {
+      GFC_REAL_10 *bbase_y;
+      GFC_REAL_10 *dest_y;
+      GFC_REAL_10 *abase_n;
+      GFC_REAL_10 bbase_yn;
+
+      if (rystride == ycount)
+       memset (dest, 0, (sizeof (GFC_REAL_10) * size0((array_t *) retarray)));
+      else
+       {
+         for (y = 0; y < ycount; y++)
+           for (x = 0; x < xcount; x++)
+             dest[x + y*rystride] = (GFC_REAL_10)0;
+       }
+
+      for (y = 0; y < ycount; y++)
+       {
+         bbase_y = bbase + y*bystride;
+         dest_y = dest + y*rystride;
+         for (n = 0; n < count; n++)
+           {
+             abase_n = abase + n*aystride;
+             bbase_yn = bbase_y[n];
+             for (x = 0; x < xcount; x++)
+               {
+                 dest_y[x] += abase_n[x] * bbase_yn;
+               }
+           }
+       }
+    }
+  else
+    {
+      for (y = 0; y < ycount; y++)
+       for (x = 0; x < xcount; x++)
+         dest[x*rxstride + y*rystride] = (GFC_REAL_10)0;
+
+      for (y = 0; y < ycount; y++)
+       for (n = 0; n < count; n++)
+         for (x = 0; x < xcount; x++)
+           /* dest[x,y] += a[x,n] * b[n,y] */
+           dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/matmul_r16.c b/libgfortran/generated/matmul_r16.c
new file mode 100644 (file)
index 0000000..549f39e
--- /dev/null
@@ -0,0 +1,221 @@
+/* Implementation of the MATMUL intrinsic
+   Copyright 2002, 2005 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_REAL_16)
+
+/* This is a C version of the following fortran pseudo-code. The key
+   point is the loop order -- we access all arrays column-first, which
+   improves the performance enough to boost galgel spec score by 50%.
+
+   DIMENSION A(M,COUNT), B(COUNT,N), C(M,N)
+   C = 0
+   DO J=1,N
+     DO K=1,COUNT
+       DO I=1,M
+         C(I,J) = C(I,J)+A(I,K)*B(K,J)
+*/
+
+extern void matmul_r16 (gfc_array_r16 * retarray, gfc_array_r16 * a, gfc_array_r16 * b);
+export_proto(matmul_r16);
+
+void
+matmul_r16 (gfc_array_r16 * retarray, gfc_array_r16 * a, gfc_array_r16 * b)
+{
+  GFC_REAL_16 *abase;
+  GFC_REAL_16 *bbase;
+  GFC_REAL_16 *dest;
+
+  index_type rxstride, rystride, axstride, aystride, bxstride, bystride;
+  index_type x, y, n, count, xcount, ycount;
+
+  assert (GFC_DESCRIPTOR_RANK (a) == 2
+          || GFC_DESCRIPTOR_RANK (b) == 2);
+
+/* C[xcount,ycount] = A[xcount, count] * B[count,ycount]
+
+   Either A or B (but not both) can be rank 1:
+
+   o One-dimensional argument A is implicitly treated as a row matrix
+     dimensioned [1,count], so xcount=1.
+
+   o One-dimensional argument B is implicitly treated as a column matrix
+     dimensioned [count, 1], so ycount=1.
+  */
+
+  if (retarray->data == NULL)
+    {
+      if (GFC_DESCRIPTOR_RANK (a) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else if (GFC_DESCRIPTOR_RANK (b) == 1)
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+        }
+      else
+        {
+          retarray->dim[0].lbound = 0;
+          retarray->dim[0].ubound = a->dim[0].ubound - a->dim[0].lbound;
+          retarray->dim[0].stride = 1;
+
+          retarray->dim[1].lbound = 0;
+          retarray->dim[1].ubound = b->dim[1].ubound - b->dim[1].lbound;
+          retarray->dim[1].stride = retarray->dim[0].ubound+1;
+        }
+
+      retarray->data
+       = internal_malloc_size (sizeof (GFC_REAL_16) * size0 ((array_t *) retarray));
+      retarray->offset = 0;
+    }
+
+  abase = a->data;
+  bbase = b->data;
+  dest = retarray->data;
+
+  if (retarray->dim[0].stride == 0)
+    retarray->dim[0].stride = 1;
+  if (a->dim[0].stride == 0)
+    a->dim[0].stride = 1;
+  if (b->dim[0].stride == 0)
+    b->dim[0].stride = 1;
+
+
+  if (GFC_DESCRIPTOR_RANK (retarray) == 1)
+    {
+      /* One-dimensional result may be addressed in the code below
+        either as a row or a column matrix. We want both cases to
+        work. */
+      rxstride = rystride = retarray->dim[0].stride;
+    }
+  else
+    {
+      rxstride = retarray->dim[0].stride;
+      rystride = retarray->dim[1].stride;
+    }
+
+
+  if (GFC_DESCRIPTOR_RANK (a) == 1)
+    {
+      /* Treat it as a a row matrix A[1,count]. */
+      axstride = a->dim[0].stride;
+      aystride = 1;
+
+      xcount = 1;
+      count = a->dim[0].ubound + 1 - a->dim[0].lbound;
+    }
+  else
+    {
+      axstride = a->dim[0].stride;
+      aystride = a->dim[1].stride;
+
+      count = a->dim[1].ubound + 1 - a->dim[1].lbound;
+      xcount = a->dim[0].ubound + 1 - a->dim[0].lbound;
+    }
+
+  assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound);
+
+  if (GFC_DESCRIPTOR_RANK (b) == 1)
+    {
+      /* Treat it as a column matrix B[count,1] */
+      bxstride = b->dim[0].stride;
+
+      /* bystride should never be used for 1-dimensional b.
+        in case it is we want it to cause a segfault, rather than
+        an incorrect result. */
+      bystride = 0xDEADBEEF;
+      ycount = 1;
+    }
+  else
+    {
+      bxstride = b->dim[0].stride;
+      bystride = b->dim[1].stride;
+      ycount = b->dim[1].ubound + 1 - b->dim[1].lbound;
+    }
+
+  abase = a->data;
+  bbase = b->data;
+  dest = retarray->data;
+
+  if (rxstride == 1 && axstride == 1 && bxstride == 1)
+    {
+      GFC_REAL_16 *bbase_y;
+      GFC_REAL_16 *dest_y;
+      GFC_REAL_16 *abase_n;
+      GFC_REAL_16 bbase_yn;
+
+      if (rystride == ycount)
+       memset (dest, 0, (sizeof (GFC_REAL_16) * size0((array_t *) retarray)));
+      else
+       {
+         for (y = 0; y < ycount; y++)
+           for (x = 0; x < xcount; x++)
+             dest[x + y*rystride] = (GFC_REAL_16)0;
+       }
+
+      for (y = 0; y < ycount; y++)
+       {
+         bbase_y = bbase + y*bystride;
+         dest_y = dest + y*rystride;
+         for (n = 0; n < count; n++)
+           {
+             abase_n = abase + n*aystride;
+             bbase_yn = bbase_y[n];
+             for (x = 0; x < xcount; x++)
+               {
+                 dest_y[x] += abase_n[x] * bbase_yn;
+               }
+           }
+       }
+    }
+  else
+    {
+      for (y = 0; y < ycount; y++)
+       for (x = 0; x < xcount; x++)
+         dest[x*rxstride + y*rystride] = (GFC_REAL_16)0;
+
+      for (y = 0; y < ycount; y++)
+       for (n = 0; n < count; n++)
+         for (x = 0; x < xcount; x++)
+           /* dest[x,y] += a[x,n] * b[n,y] */
+           dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
+    }
+}
+
+#endif
index 91311ce..b1d3eb7 100644 (file)
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_REAL_4)
+
 /* This is a C version of the following fortran pseudo-code. The key
    point is the loop order -- we access all arrays column-first, which
    improves the performance enough to boost galgel spec score by 50%.
@@ -215,3 +217,5 @@ matmul_r4 (gfc_array_r4 * retarray, gfc_array_r4 * a, gfc_array_r4 * b)
            dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
     }
 }
+
+#endif
index 3748731..df9fc3e 100644 (file)
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_REAL_8)
+
 /* This is a C version of the following fortran pseudo-code. The key
    point is the loop order -- we access all arrays column-first, which
    improves the performance enough to boost galgel spec score by 50%.
@@ -215,3 +217,5 @@ matmul_r8 (gfc_array_r8 * retarray, gfc_array_r8 * a, gfc_array_r8 * b)
            dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
     }
 }
+
+#endif
diff --git a/libgfortran/generated/maxloc0_16_i16.c b/libgfortran/generated/maxloc0_16_i16.c
new file mode 100644 (file)
index 0000000..ca934a1
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array);
+export_proto(maxloc0_16_i16);
+
+void
+maxloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_INTEGER_16 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_INTEGER_16 maxval;
+
+  maxval = -GFC_INTEGER_16_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mmaxloc0_16_i16 (gfc_array_i16 *, gfc_array_i16 *, gfc_array_l4 *);
+export_proto(mmaxloc0_16_i16);
+
+void
+mmaxloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_16 *dest;
+  GFC_INTEGER_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_INTEGER_16 maxval;
+
+  maxval = -GFC_INTEGER_16_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
diff --git a/libgfortran/generated/maxloc0_16_i4.c b/libgfortran/generated/maxloc0_16_i4.c
new file mode 100644 (file)
index 0000000..9dcd7b4
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc0_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 *array);
+export_proto(maxloc0_16_i4);
+
+void
+maxloc0_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_INTEGER_4 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_INTEGER_4 maxval;
+
+  maxval = -GFC_INTEGER_4_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mmaxloc0_16_i4 (gfc_array_i16 *, gfc_array_i4 *, gfc_array_l4 *);
+export_proto(mmaxloc0_16_i4);
+
+void
+mmaxloc0_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_16 *dest;
+  GFC_INTEGER_4 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_INTEGER_4 maxval;
+
+  maxval = -GFC_INTEGER_4_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
diff --git a/libgfortran/generated/maxloc0_16_i8.c b/libgfortran/generated/maxloc0_16_i8.c
new file mode 100644 (file)
index 0000000..d8a6261
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc0_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 *array);
+export_proto(maxloc0_16_i8);
+
+void
+maxloc0_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_INTEGER_8 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_INTEGER_8 maxval;
+
+  maxval = -GFC_INTEGER_8_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mmaxloc0_16_i8 (gfc_array_i16 *, gfc_array_i8 *, gfc_array_l4 *);
+export_proto(mmaxloc0_16_i8);
+
+void
+mmaxloc0_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_16 *dest;
+  GFC_INTEGER_8 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_INTEGER_8 maxval;
+
+  maxval = -GFC_INTEGER_8_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
diff --git a/libgfortran/generated/maxloc0_16_r10.c b/libgfortran/generated/maxloc0_16_r10.c
new file mode 100644 (file)
index 0000000..1f0dfb0
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc0_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 *array);
+export_proto(maxloc0_16_r10);
+
+void
+maxloc0_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_REAL_10 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_10 maxval;
+
+  maxval = -GFC_REAL_10_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mmaxloc0_16_r10 (gfc_array_i16 *, gfc_array_r10 *, gfc_array_l4 *);
+export_proto(mmaxloc0_16_r10);
+
+void
+mmaxloc0_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_16 *dest;
+  GFC_REAL_10 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_10 maxval;
+
+  maxval = -GFC_REAL_10_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
diff --git a/libgfortran/generated/maxloc0_16_r16.c b/libgfortran/generated/maxloc0_16_r16.c
new file mode 100644 (file)
index 0000000..d9e3780
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc0_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 *array);
+export_proto(maxloc0_16_r16);
+
+void
+maxloc0_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_REAL_16 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_16 maxval;
+
+  maxval = -GFC_REAL_16_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mmaxloc0_16_r16 (gfc_array_i16 *, gfc_array_r16 *, gfc_array_l4 *);
+export_proto(mmaxloc0_16_r16);
+
+void
+mmaxloc0_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_16 *dest;
+  GFC_REAL_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_16 maxval;
+
+  maxval = -GFC_REAL_16_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
diff --git a/libgfortran/generated/maxloc0_16_r4.c b/libgfortran/generated/maxloc0_16_r4.c
new file mode 100644 (file)
index 0000000..6e0e92a
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc0_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 *array);
+export_proto(maxloc0_16_r4);
+
+void
+maxloc0_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_REAL_4 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_4 maxval;
+
+  maxval = -GFC_REAL_4_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mmaxloc0_16_r4 (gfc_array_i16 *, gfc_array_r4 *, gfc_array_l4 *);
+export_proto(mmaxloc0_16_r4);
+
+void
+mmaxloc0_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_16 *dest;
+  GFC_REAL_4 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_4 maxval;
+
+  maxval = -GFC_REAL_4_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
diff --git a/libgfortran/generated/maxloc0_16_r8.c b/libgfortran/generated/maxloc0_16_r8.c
new file mode 100644 (file)
index 0000000..878e21e
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc0_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 *array);
+export_proto(maxloc0_16_r8);
+
+void
+maxloc0_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_REAL_8 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_8 maxval;
+
+  maxval = -GFC_REAL_8_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mmaxloc0_16_r8 (gfc_array_i16 *, gfc_array_r8 *, gfc_array_l4 *);
+export_proto(mmaxloc0_16_r8);
+
+void
+mmaxloc0_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_16 *dest;
+  GFC_REAL_8 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_8 maxval;
+
+  maxval = -GFC_REAL_8_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
diff --git a/libgfortran/generated/maxloc0_4_i16.c b/libgfortran/generated/maxloc0_4_i16.c
new file mode 100644 (file)
index 0000000..e419530
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void maxloc0_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 *array);
+export_proto(maxloc0_4_i16);
+
+void
+maxloc0_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_INTEGER_16 *base;
+  GFC_INTEGER_4 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_INTEGER_16 maxval;
+
+  maxval = -GFC_INTEGER_16_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mmaxloc0_4_i16 (gfc_array_i4 *, gfc_array_i16 *, gfc_array_l4 *);
+export_proto(mmaxloc0_4_i16);
+
+void
+mmaxloc0_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_4 *dest;
+  GFC_INTEGER_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_INTEGER_16 maxval;
+
+  maxval = -GFC_INTEGER_16_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
index 5821e38..d882124 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
 
 extern void maxloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array);
 export_proto(maxloc0_4_i4);
@@ -286,3 +288,5 @@ mmaxloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array,
     }
   }
 }
+
+#endif
index ae93566..e709d83 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_4)
+
 
 extern void maxloc0_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array);
 export_proto(maxloc0_4_i8);
@@ -286,3 +288,5 @@ mmaxloc0_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array,
     }
   }
 }
+
+#endif
diff --git a/libgfortran/generated/maxloc0_4_r10.c b/libgfortran/generated/maxloc0_4_r10.c
new file mode 100644 (file)
index 0000000..63b4ab3
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void maxloc0_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 *array);
+export_proto(maxloc0_4_r10);
+
+void
+maxloc0_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_REAL_10 *base;
+  GFC_INTEGER_4 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_10 maxval;
+
+  maxval = -GFC_REAL_10_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mmaxloc0_4_r10 (gfc_array_i4 *, gfc_array_r10 *, gfc_array_l4 *);
+export_proto(mmaxloc0_4_r10);
+
+void
+mmaxloc0_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_4 *dest;
+  GFC_REAL_10 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_10 maxval;
+
+  maxval = -GFC_REAL_10_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
diff --git a/libgfortran/generated/maxloc0_4_r16.c b/libgfortran/generated/maxloc0_4_r16.c
new file mode 100644 (file)
index 0000000..41cecaf
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void maxloc0_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 *array);
+export_proto(maxloc0_4_r16);
+
+void
+maxloc0_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_REAL_16 *base;
+  GFC_INTEGER_4 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_16 maxval;
+
+  maxval = -GFC_REAL_16_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mmaxloc0_4_r16 (gfc_array_i4 *, gfc_array_r16 *, gfc_array_l4 *);
+export_proto(mmaxloc0_4_r16);
+
+void
+mmaxloc0_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_4 *dest;
+  GFC_REAL_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_16 maxval;
+
+  maxval = -GFC_REAL_16_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
index a5e8c74..3eba4f2 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_4)
+
 
 extern void maxloc0_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 *array);
 export_proto(maxloc0_4_r4);
@@ -286,3 +288,5 @@ mmaxloc0_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 *array,
     }
   }
 }
+
+#endif
index e1ac5d7..3a5f3f2 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_4)
+
 
 extern void maxloc0_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 *array);
 export_proto(maxloc0_4_r8);
@@ -286,3 +288,5 @@ mmaxloc0_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 *array,
     }
   }
 }
+
+#endif
diff --git a/libgfortran/generated/maxloc0_8_i16.c b/libgfortran/generated/maxloc0_8_i16.c
new file mode 100644 (file)
index 0000000..52316ed
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void maxloc0_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 *array);
+export_proto(maxloc0_8_i16);
+
+void
+maxloc0_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_INTEGER_16 *base;
+  GFC_INTEGER_8 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_INTEGER_16 maxval;
+
+  maxval = -GFC_INTEGER_16_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mmaxloc0_8_i16 (gfc_array_i8 *, gfc_array_i16 *, gfc_array_l4 *);
+export_proto(mmaxloc0_8_i16);
+
+void
+mmaxloc0_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_8 *dest;
+  GFC_INTEGER_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_INTEGER_16 maxval;
+
+  maxval = -GFC_INTEGER_16_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
index 1372077..aa37b6d 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
+
 
 extern void maxloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array);
 export_proto(maxloc0_8_i4);
@@ -286,3 +288,5 @@ mmaxloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array,
     }
   }
 }
+
+#endif
index 83d17cc..8c825c4 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
+
 
 extern void maxloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array);
 export_proto(maxloc0_8_i8);
@@ -286,3 +288,5 @@ mmaxloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array,
     }
   }
 }
+
+#endif
diff --git a/libgfortran/generated/maxloc0_8_r10.c b/libgfortran/generated/maxloc0_8_r10.c
new file mode 100644 (file)
index 0000000..6add177
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void maxloc0_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 *array);
+export_proto(maxloc0_8_r10);
+
+void
+maxloc0_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_REAL_10 *base;
+  GFC_INTEGER_8 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_10 maxval;
+
+  maxval = -GFC_REAL_10_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mmaxloc0_8_r10 (gfc_array_i8 *, gfc_array_r10 *, gfc_array_l4 *);
+export_proto(mmaxloc0_8_r10);
+
+void
+mmaxloc0_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_8 *dest;
+  GFC_REAL_10 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_10 maxval;
+
+  maxval = -GFC_REAL_10_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
diff --git a/libgfortran/generated/maxloc0_8_r16.c b/libgfortran/generated/maxloc0_8_r16.c
new file mode 100644 (file)
index 0000000..92f0884
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void maxloc0_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 *array);
+export_proto(maxloc0_8_r16);
+
+void
+maxloc0_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_REAL_16 *base;
+  GFC_INTEGER_8 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_16 maxval;
+
+  maxval = -GFC_REAL_16_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mmaxloc0_8_r16 (gfc_array_i8 *, gfc_array_r16 *, gfc_array_l4 *);
+export_proto(mmaxloc0_8_r16);
+
+void
+mmaxloc0_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_8 *dest;
+  GFC_REAL_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_16 maxval;
+
+  maxval = -GFC_REAL_16_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base > maxval)
+    {
+      maxval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
index 8eede40..07cebb3 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_8)
+
 
 extern void maxloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array);
 export_proto(maxloc0_8_r4);
@@ -286,3 +288,5 @@ mmaxloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array,
     }
   }
 }
+
+#endif
index 55ed45f..92f2805 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_8)
+
 
 extern void maxloc0_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array);
 export_proto(maxloc0_8_r8);
@@ -286,3 +288,5 @@ mmaxloc0_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array,
     }
   }
 }
+
+#endif
diff --git a/libgfortran/generated/maxloc1_16_i16.c b/libgfortran/generated/maxloc1_16_i16.c
new file mode 100644 (file)
index 0000000..d9666bd
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc1_16_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *);
+export_proto(maxloc1_16_i16);
+
+void
+maxloc1_16_i16 (gfc_array_i16 *retarray, gfc_array_i16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_INTEGER_16 *src;
+      GFC_INTEGER_16 result;
+      src = base;
+      {
+
+  GFC_INTEGER_16 maxval;
+  maxval = -GFC_INTEGER_16_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mmaxloc1_16_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mmaxloc1_16_i16);
+
+void
+mmaxloc1_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *dest;
+  GFC_INTEGER_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_INTEGER_16 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_INTEGER_16 maxval;
+  maxval = -GFC_INTEGER_16_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/maxloc1_16_i4.c b/libgfortran/generated/maxloc1_16_i4.c
new file mode 100644 (file)
index 0000000..9df85ec
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc1_16_i4 (gfc_array_i16 *, gfc_array_i4 *, index_type *);
+export_proto(maxloc1_16_i4);
+
+void
+maxloc1_16_i4 (gfc_array_i16 *retarray, gfc_array_i4 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_4 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_INTEGER_4 *src;
+      GFC_INTEGER_16 result;
+      src = base;
+      {
+
+  GFC_INTEGER_4 maxval;
+  maxval = -GFC_INTEGER_4_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mmaxloc1_16_i4 (gfc_array_i16 *, gfc_array_i4 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mmaxloc1_16_i4);
+
+void
+mmaxloc1_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *dest;
+  GFC_INTEGER_4 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_INTEGER_4 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_INTEGER_4 maxval;
+  maxval = -GFC_INTEGER_4_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/maxloc1_16_i8.c b/libgfortran/generated/maxloc1_16_i8.c
new file mode 100644 (file)
index 0000000..8d6e003
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc1_16_i8 (gfc_array_i16 *, gfc_array_i8 *, index_type *);
+export_proto(maxloc1_16_i8);
+
+void
+maxloc1_16_i8 (gfc_array_i16 *retarray, gfc_array_i8 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_8 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_INTEGER_8 *src;
+      GFC_INTEGER_16 result;
+      src = base;
+      {
+
+  GFC_INTEGER_8 maxval;
+  maxval = -GFC_INTEGER_8_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mmaxloc1_16_i8 (gfc_array_i16 *, gfc_array_i8 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mmaxloc1_16_i8);
+
+void
+mmaxloc1_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *dest;
+  GFC_INTEGER_8 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_INTEGER_8 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_INTEGER_8 maxval;
+  maxval = -GFC_INTEGER_8_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/maxloc1_16_r10.c b/libgfortran/generated/maxloc1_16_r10.c
new file mode 100644 (file)
index 0000000..64b2770
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc1_16_r10 (gfc_array_i16 *, gfc_array_r10 *, index_type *);
+export_proto(maxloc1_16_r10);
+
+void
+maxloc1_16_r10 (gfc_array_i16 *retarray, gfc_array_r10 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_10 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_REAL_10 *src;
+      GFC_INTEGER_16 result;
+      src = base;
+      {
+
+  GFC_REAL_10 maxval;
+  maxval = -GFC_REAL_10_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mmaxloc1_16_r10 (gfc_array_i16 *, gfc_array_r10 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mmaxloc1_16_r10);
+
+void
+mmaxloc1_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *dest;
+  GFC_REAL_10 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_REAL_10 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_REAL_10 maxval;
+  maxval = -GFC_REAL_10_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/maxloc1_16_r16.c b/libgfortran/generated/maxloc1_16_r16.c
new file mode 100644 (file)
index 0000000..f671808
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc1_16_r16 (gfc_array_i16 *, gfc_array_r16 *, index_type *);
+export_proto(maxloc1_16_r16);
+
+void
+maxloc1_16_r16 (gfc_array_i16 *retarray, gfc_array_r16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_16 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_REAL_16 *src;
+      GFC_INTEGER_16 result;
+      src = base;
+      {
+
+  GFC_REAL_16 maxval;
+  maxval = -GFC_REAL_16_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mmaxloc1_16_r16 (gfc_array_i16 *, gfc_array_r16 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mmaxloc1_16_r16);
+
+void
+mmaxloc1_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *dest;
+  GFC_REAL_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_REAL_16 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_REAL_16 maxval;
+  maxval = -GFC_REAL_16_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/maxloc1_16_r4.c b/libgfortran/generated/maxloc1_16_r4.c
new file mode 100644 (file)
index 0000000..902e97c
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc1_16_r4 (gfc_array_i16 *, gfc_array_r4 *, index_type *);
+export_proto(maxloc1_16_r4);
+
+void
+maxloc1_16_r4 (gfc_array_i16 *retarray, gfc_array_r4 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_4 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_REAL_4 *src;
+      GFC_INTEGER_16 result;
+      src = base;
+      {
+
+  GFC_REAL_4 maxval;
+  maxval = -GFC_REAL_4_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mmaxloc1_16_r4 (gfc_array_i16 *, gfc_array_r4 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mmaxloc1_16_r4);
+
+void
+mmaxloc1_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *dest;
+  GFC_REAL_4 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_REAL_4 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_REAL_4 maxval;
+  maxval = -GFC_REAL_4_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/maxloc1_16_r8.c b/libgfortran/generated/maxloc1_16_r8.c
new file mode 100644 (file)
index 0000000..3e28d67
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxloc1_16_r8 (gfc_array_i16 *, gfc_array_r8 *, index_type *);
+export_proto(maxloc1_16_r8);
+
+void
+maxloc1_16_r8 (gfc_array_i16 *retarray, gfc_array_r8 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_8 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_REAL_8 *src;
+      GFC_INTEGER_16 result;
+      src = base;
+      {
+
+  GFC_REAL_8 maxval;
+  maxval = -GFC_REAL_8_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mmaxloc1_16_r8 (gfc_array_i16 *, gfc_array_r8 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mmaxloc1_16_r8);
+
+void
+mmaxloc1_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *dest;
+  GFC_REAL_8 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_REAL_8 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_REAL_8 maxval;
+  maxval = -GFC_REAL_8_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/maxloc1_4_i16.c b/libgfortran/generated/maxloc1_4_i16.c
new file mode 100644 (file)
index 0000000..8ca2cf1
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void maxloc1_4_i16 (gfc_array_i4 *, gfc_array_i16 *, index_type *);
+export_proto(maxloc1_4_i16);
+
+void
+maxloc1_4_i16 (gfc_array_i4 *retarray, gfc_array_i16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *base;
+  GFC_INTEGER_4 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_INTEGER_16 *src;
+      GFC_INTEGER_4 result;
+      src = base;
+      {
+
+  GFC_INTEGER_16 maxval;
+  maxval = -GFC_INTEGER_16_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_4)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mmaxloc1_4_i16 (gfc_array_i4 *, gfc_array_i16 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mmaxloc1_4_i16);
+
+void
+mmaxloc1_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_4 *dest;
+  GFC_INTEGER_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_INTEGER_16 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_4 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_INTEGER_16 maxval;
+  maxval = -GFC_INTEGER_16_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_4)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index bfa721d..06a657c 100644 (file)
@@ -36,6 +36,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
+
 extern void maxloc1_4_i4 (gfc_array_i4 *, gfc_array_i4 *, index_type *);
 export_proto(maxloc1_4_i4);
 
@@ -341,3 +344,4 @@ mmaxloc1_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array,
     }
 }
 
+#endif
index 81a09ba..f03b36c 100644 (file)
@@ -36,6 +36,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_4)
+
+
 extern void maxloc1_4_i8 (gfc_array_i4 *, gfc_array_i8 *, index_type *);
 export_proto(maxloc1_4_i8);
 
@@ -341,3 +344,4 @@ mmaxloc1_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 * array,
     }
 }
 
+#endif
diff --git a/libgfortran/generated/maxloc1_4_r10.c b/libgfortran/generated/maxloc1_4_r10.c
new file mode 100644 (file)
index 0000000..854b0b8
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void maxloc1_4_r10 (gfc_array_i4 *, gfc_array_r10 *, index_type *);
+export_proto(maxloc1_4_r10);
+
+void
+maxloc1_4_r10 (gfc_array_i4 *retarray, gfc_array_r10 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_10 *base;
+  GFC_INTEGER_4 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_REAL_10 *src;
+      GFC_INTEGER_4 result;
+      src = base;
+      {
+
+  GFC_REAL_10 maxval;
+  maxval = -GFC_REAL_10_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_4)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mmaxloc1_4_r10 (gfc_array_i4 *, gfc_array_r10 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mmaxloc1_4_r10);
+
+void
+mmaxloc1_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_4 *dest;
+  GFC_REAL_10 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_REAL_10 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_4 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_REAL_10 maxval;
+  maxval = -GFC_REAL_10_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_4)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/maxloc1_4_r16.c b/libgfortran/generated/maxloc1_4_r16.c
new file mode 100644 (file)
index 0000000..fdabd1a
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void maxloc1_4_r16 (gfc_array_i4 *, gfc_array_r16 *, index_type *);
+export_proto(maxloc1_4_r16);
+
+void
+maxloc1_4_r16 (gfc_array_i4 *retarray, gfc_array_r16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_16 *base;
+  GFC_INTEGER_4 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_REAL_16 *src;
+      GFC_INTEGER_4 result;
+      src = base;
+      {
+
+  GFC_REAL_16 maxval;
+  maxval = -GFC_REAL_16_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_4)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mmaxloc1_4_r16 (gfc_array_i4 *, gfc_array_r16 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mmaxloc1_4_r16);
+
+void
+mmaxloc1_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_4 *dest;
+  GFC_REAL_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_REAL_16 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_4 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_REAL_16 maxval;
+  maxval = -GFC_REAL_16_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_4)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index d955b77..34510e7 100644 (file)
@@ -36,6 +36,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_4)
+
+
 extern void maxloc1_4_r4 (gfc_array_i4 *, gfc_array_r4 *, index_type *);
 export_proto(maxloc1_4_r4);
 
@@ -341,3 +344,4 @@ mmaxloc1_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 * array,
     }
 }
 
+#endif
index c2a2ec4..ea67079 100644 (file)
@@ -36,6 +36,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_4)
+
+
 extern void maxloc1_4_r8 (gfc_array_i4 *, gfc_array_r8 *, index_type *);
 export_proto(maxloc1_4_r8);
 
@@ -341,3 +344,4 @@ mmaxloc1_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 * array,
     }
 }
 
+#endif
diff --git a/libgfortran/generated/maxloc1_8_i16.c b/libgfortran/generated/maxloc1_8_i16.c
new file mode 100644 (file)
index 0000000..f3ba50b
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void maxloc1_8_i16 (gfc_array_i8 *, gfc_array_i16 *, index_type *);
+export_proto(maxloc1_8_i16);
+
+void
+maxloc1_8_i16 (gfc_array_i8 *retarray, gfc_array_i16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *base;
+  GFC_INTEGER_8 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_INTEGER_16 *src;
+      GFC_INTEGER_8 result;
+      src = base;
+      {
+
+  GFC_INTEGER_16 maxval;
+  maxval = -GFC_INTEGER_16_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_8)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mmaxloc1_8_i16 (gfc_array_i8 *, gfc_array_i16 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mmaxloc1_8_i16);
+
+void
+mmaxloc1_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_8 *dest;
+  GFC_INTEGER_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_INTEGER_16 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_8 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_INTEGER_16 maxval;
+  maxval = -GFC_INTEGER_16_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_8)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index 344c13b..1c095ff 100644 (file)
@@ -36,6 +36,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
+
+
 extern void maxloc1_8_i4 (gfc_array_i8 *, gfc_array_i4 *, index_type *);
 export_proto(maxloc1_8_i4);
 
@@ -341,3 +344,4 @@ mmaxloc1_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 * array,
     }
 }
 
+#endif
index 763667b..ee6d269 100644 (file)
@@ -36,6 +36,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
+
+
 extern void maxloc1_8_i8 (gfc_array_i8 *, gfc_array_i8 *, index_type *);
 export_proto(maxloc1_8_i8);
 
@@ -341,3 +344,4 @@ mmaxloc1_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array,
     }
 }
 
+#endif
diff --git a/libgfortran/generated/maxloc1_8_r10.c b/libgfortran/generated/maxloc1_8_r10.c
new file mode 100644 (file)
index 0000000..67c7733
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void maxloc1_8_r10 (gfc_array_i8 *, gfc_array_r10 *, index_type *);
+export_proto(maxloc1_8_r10);
+
+void
+maxloc1_8_r10 (gfc_array_i8 *retarray, gfc_array_r10 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_10 *base;
+  GFC_INTEGER_8 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_REAL_10 *src;
+      GFC_INTEGER_8 result;
+      src = base;
+      {
+
+  GFC_REAL_10 maxval;
+  maxval = -GFC_REAL_10_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_8)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mmaxloc1_8_r10 (gfc_array_i8 *, gfc_array_r10 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mmaxloc1_8_r10);
+
+void
+mmaxloc1_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_8 *dest;
+  GFC_REAL_10 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_REAL_10 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_8 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_REAL_10 maxval;
+  maxval = -GFC_REAL_10_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_8)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/maxloc1_8_r16.c b/libgfortran/generated/maxloc1_8_r16.c
new file mode 100644 (file)
index 0000000..d0b607f
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MAXLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void maxloc1_8_r16 (gfc_array_i8 *, gfc_array_r16 *, index_type *);
+export_proto(maxloc1_8_r16);
+
+void
+maxloc1_8_r16 (gfc_array_i8 *retarray, gfc_array_r16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_16 *base;
+  GFC_INTEGER_8 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_REAL_16 *src;
+      GFC_INTEGER_8 result;
+      src = base;
+      {
+
+  GFC_REAL_16 maxval;
+  maxval = -GFC_REAL_16_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_8)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mmaxloc1_8_r16 (gfc_array_i8 *, gfc_array_r16 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mmaxloc1_8_r16);
+
+void
+mmaxloc1_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_8 *dest;
+  GFC_REAL_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_REAL_16 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_8 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_REAL_16 maxval;
+  maxval = -GFC_REAL_16_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src > maxval)
+    {
+      maxval = *src;
+      result = (GFC_INTEGER_8)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index 8de42df..a7dd5ca 100644 (file)
@@ -36,6 +36,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_8)
+
+
 extern void maxloc1_8_r4 (gfc_array_i8 *, gfc_array_r4 *, index_type *);
 export_proto(maxloc1_8_r4);
 
@@ -341,3 +344,4 @@ mmaxloc1_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 * array,
     }
 }
 
+#endif
index 8b22fdb..188a410 100644 (file)
@@ -36,6 +36,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_8)
+
+
 extern void maxloc1_8_r8 (gfc_array_i8 *, gfc_array_r8 *, index_type *);
 export_proto(maxloc1_8_r8);
 
@@ -341,3 +344,4 @@ mmaxloc1_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 * array,
     }
 }
 
+#endif
diff --git a/libgfortran/generated/maxval_i16.c b/libgfortran/generated/maxval_i16.c
new file mode 100644 (file)
index 0000000..cdcfe02
--- /dev/null
@@ -0,0 +1,336 @@
+/* Implementation of the MAXVAL intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void maxval_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *);
+export_proto(maxval_i16);
+
+void
+maxval_i16 (gfc_array_i16 *retarray, gfc_array_i16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_INTEGER_16 *src;
+      GFC_INTEGER_16 result;
+      src = base;
+      {
+
+  result = -GFC_INTEGER_16_HUGE;
+        if (len <= 0)
+         *dest = -GFC_INTEGER_16_HUGE;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src > result)
+    result = *src;
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mmaxval_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mmaxval_i16);
+
+void
+mmaxval_i16 (gfc_array_i16 * retarray, gfc_array_i16 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *dest;
+  GFC_INTEGER_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_INTEGER_16 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = -GFC_INTEGER_16_HUGE;
+        if (len <= 0)
+         *dest = -GFC_INTEGER_16_HUGE;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src > result)
+    result = *src;
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index 2c82e33..5f1ba4d 100644 (file)
@@ -35,6 +35,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
+
 extern void maxval_i4 (gfc_array_i4 *, gfc_array_i4 *, index_type *);
 export_proto(maxval_i4);
 
@@ -330,3 +333,4 @@ mmaxval_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array,
     }
 }
 
+#endif
index 9410326..f1d16f3 100644 (file)
@@ -35,6 +35,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
+
+
 extern void maxval_i8 (gfc_array_i8 *, gfc_array_i8 *, index_type *);
 export_proto(maxval_i8);
 
@@ -330,3 +333,4 @@ mmaxval_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array,
     }
 }
 
+#endif
diff --git a/libgfortran/generated/maxval_r10.c b/libgfortran/generated/maxval_r10.c
new file mode 100644 (file)
index 0000000..07c7d7d
--- /dev/null
@@ -0,0 +1,336 @@
+/* Implementation of the MAXVAL intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_REAL_10)
+
+
+extern void maxval_r10 (gfc_array_r10 *, gfc_array_r10 *, index_type *);
+export_proto(maxval_r10);
+
+void
+maxval_r10 (gfc_array_r10 *retarray, gfc_array_r10 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_10 *base;
+  GFC_REAL_10 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_REAL_10)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_REAL_10 *src;
+      GFC_REAL_10 result;
+      src = base;
+      {
+
+  result = -GFC_REAL_10_HUGE;
+        if (len <= 0)
+         *dest = -GFC_REAL_10_HUGE;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src > result)
+    result = *src;
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mmaxval_r10 (gfc_array_r10 *, gfc_array_r10 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mmaxval_r10);
+
+void
+mmaxval_r10 (gfc_array_r10 * retarray, gfc_array_r10 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_10 *dest;
+  GFC_REAL_10 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_REAL_10)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_REAL_10 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_REAL_10 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = -GFC_REAL_10_HUGE;
+        if (len <= 0)
+         *dest = -GFC_REAL_10_HUGE;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src > result)
+    result = *src;
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/maxval_r16.c b/libgfortran/generated/maxval_r16.c
new file mode 100644 (file)
index 0000000..0f8f246
--- /dev/null
@@ -0,0 +1,336 @@
+/* Implementation of the MAXVAL intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_REAL_16)
+
+
+extern void maxval_r16 (gfc_array_r16 *, gfc_array_r16 *, index_type *);
+export_proto(maxval_r16);
+
+void
+maxval_r16 (gfc_array_r16 *retarray, gfc_array_r16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_16 *base;
+  GFC_REAL_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_REAL_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_REAL_16 *src;
+      GFC_REAL_16 result;
+      src = base;
+      {
+
+  result = -GFC_REAL_16_HUGE;
+        if (len <= 0)
+         *dest = -GFC_REAL_16_HUGE;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src > result)
+    result = *src;
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mmaxval_r16 (gfc_array_r16 *, gfc_array_r16 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mmaxval_r16);
+
+void
+mmaxval_r16 (gfc_array_r16 * retarray, gfc_array_r16 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_16 *dest;
+  GFC_REAL_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_REAL_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_REAL_16 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_REAL_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = -GFC_REAL_16_HUGE;
+        if (len <= 0)
+         *dest = -GFC_REAL_16_HUGE;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src > result)
+    result = *src;
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index 6e4236c..4d56bbf 100644 (file)
@@ -35,6 +35,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_REAL_4)
+
+
 extern void maxval_r4 (gfc_array_r4 *, gfc_array_r4 *, index_type *);
 export_proto(maxval_r4);
 
@@ -330,3 +333,4 @@ mmaxval_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array,
     }
 }
 
+#endif
index 2d8eb2d..d84e18c 100644 (file)
@@ -35,6 +35,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_REAL_8)
+
+
 extern void maxval_r8 (gfc_array_r8 *, gfc_array_r8 *, index_type *);
 export_proto(maxval_r8);
 
@@ -330,3 +333,4 @@ mmaxval_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array,
     }
 }
 
+#endif
diff --git a/libgfortran/generated/minloc0_16_i16.c b/libgfortran/generated/minloc0_16_i16.c
new file mode 100644 (file)
index 0000000..af097fa
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array);
+export_proto(minloc0_16_i16);
+
+void
+minloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_INTEGER_16 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_INTEGER_16 minval;
+
+  minval = GFC_INTEGER_16_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mminloc0_16_i16 (gfc_array_i16 *, gfc_array_i16 *, gfc_array_l4 *);
+export_proto(mminloc0_16_i16);
+
+void
+mminloc0_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_16 *dest;
+  GFC_INTEGER_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_INTEGER_16 minval;
+
+  minval = GFC_INTEGER_16_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
diff --git a/libgfortran/generated/minloc0_16_i4.c b/libgfortran/generated/minloc0_16_i4.c
new file mode 100644 (file)
index 0000000..1569381
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc0_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 *array);
+export_proto(minloc0_16_i4);
+
+void
+minloc0_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_INTEGER_4 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_INTEGER_4 minval;
+
+  minval = GFC_INTEGER_4_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mminloc0_16_i4 (gfc_array_i16 *, gfc_array_i4 *, gfc_array_l4 *);
+export_proto(mminloc0_16_i4);
+
+void
+mminloc0_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_16 *dest;
+  GFC_INTEGER_4 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_INTEGER_4 minval;
+
+  minval = GFC_INTEGER_4_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
diff --git a/libgfortran/generated/minloc0_16_i8.c b/libgfortran/generated/minloc0_16_i8.c
new file mode 100644 (file)
index 0000000..57af892
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc0_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 *array);
+export_proto(minloc0_16_i8);
+
+void
+minloc0_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_INTEGER_8 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_INTEGER_8 minval;
+
+  minval = GFC_INTEGER_8_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mminloc0_16_i8 (gfc_array_i16 *, gfc_array_i8 *, gfc_array_l4 *);
+export_proto(mminloc0_16_i8);
+
+void
+mminloc0_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_16 *dest;
+  GFC_INTEGER_8 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_INTEGER_8 minval;
+
+  minval = GFC_INTEGER_8_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
diff --git a/libgfortran/generated/minloc0_16_r10.c b/libgfortran/generated/minloc0_16_r10.c
new file mode 100644 (file)
index 0000000..58ed79d
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc0_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 *array);
+export_proto(minloc0_16_r10);
+
+void
+minloc0_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_REAL_10 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_10 minval;
+
+  minval = GFC_REAL_10_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mminloc0_16_r10 (gfc_array_i16 *, gfc_array_r10 *, gfc_array_l4 *);
+export_proto(mminloc0_16_r10);
+
+void
+mminloc0_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_16 *dest;
+  GFC_REAL_10 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_10 minval;
+
+  minval = GFC_REAL_10_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
diff --git a/libgfortran/generated/minloc0_16_r16.c b/libgfortran/generated/minloc0_16_r16.c
new file mode 100644 (file)
index 0000000..90c8c31
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc0_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 *array);
+export_proto(minloc0_16_r16);
+
+void
+minloc0_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_REAL_16 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_16 minval;
+
+  minval = GFC_REAL_16_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mminloc0_16_r16 (gfc_array_i16 *, gfc_array_r16 *, gfc_array_l4 *);
+export_proto(mminloc0_16_r16);
+
+void
+mminloc0_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_16 *dest;
+  GFC_REAL_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_16 minval;
+
+  minval = GFC_REAL_16_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
diff --git a/libgfortran/generated/minloc0_16_r4.c b/libgfortran/generated/minloc0_16_r4.c
new file mode 100644 (file)
index 0000000..6fba3dd
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc0_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 *array);
+export_proto(minloc0_16_r4);
+
+void
+minloc0_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_REAL_4 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_4 minval;
+
+  minval = GFC_REAL_4_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mminloc0_16_r4 (gfc_array_i16 *, gfc_array_r4 *, gfc_array_l4 *);
+export_proto(mminloc0_16_r4);
+
+void
+mminloc0_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_16 *dest;
+  GFC_REAL_4 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_4 minval;
+
+  minval = GFC_REAL_4_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
diff --git a/libgfortran/generated/minloc0_16_r8.c b/libgfortran/generated/minloc0_16_r8.c
new file mode 100644 (file)
index 0000000..37b9e17
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc0_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 *array);
+export_proto(minloc0_16_r8);
+
+void
+minloc0_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_REAL_8 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_8 minval;
+
+  minval = GFC_REAL_8_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mminloc0_16_r8 (gfc_array_i16 *, gfc_array_r8 *, gfc_array_l4 *);
+export_proto(mminloc0_16_r8);
+
+void
+mminloc0_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_16 *dest;
+  GFC_REAL_8 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_8 minval;
+
+  minval = GFC_REAL_8_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
diff --git a/libgfortran/generated/minloc0_4_i16.c b/libgfortran/generated/minloc0_4_i16.c
new file mode 100644 (file)
index 0000000..068bbd5
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void minloc0_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 *array);
+export_proto(minloc0_4_i16);
+
+void
+minloc0_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_INTEGER_16 *base;
+  GFC_INTEGER_4 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_INTEGER_16 minval;
+
+  minval = GFC_INTEGER_16_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mminloc0_4_i16 (gfc_array_i4 *, gfc_array_i16 *, gfc_array_l4 *);
+export_proto(mminloc0_4_i16);
+
+void
+mminloc0_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_4 *dest;
+  GFC_INTEGER_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_INTEGER_16 minval;
+
+  minval = GFC_INTEGER_16_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
index 3b82c89..e3b15ae 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
 
 extern void minloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array);
 export_proto(minloc0_4_i4);
@@ -286,3 +288,5 @@ mminloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array,
     }
   }
 }
+
+#endif
index 98c5649..a021491 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_4)
+
 
 extern void minloc0_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array);
 export_proto(minloc0_4_i8);
@@ -286,3 +288,5 @@ mminloc0_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array,
     }
   }
 }
+
+#endif
diff --git a/libgfortran/generated/minloc0_4_r10.c b/libgfortran/generated/minloc0_4_r10.c
new file mode 100644 (file)
index 0000000..3f5ddd9
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void minloc0_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 *array);
+export_proto(minloc0_4_r10);
+
+void
+minloc0_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_REAL_10 *base;
+  GFC_INTEGER_4 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_10 minval;
+
+  minval = GFC_REAL_10_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mminloc0_4_r10 (gfc_array_i4 *, gfc_array_r10 *, gfc_array_l4 *);
+export_proto(mminloc0_4_r10);
+
+void
+mminloc0_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_4 *dest;
+  GFC_REAL_10 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_10 minval;
+
+  minval = GFC_REAL_10_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
diff --git a/libgfortran/generated/minloc0_4_r16.c b/libgfortran/generated/minloc0_4_r16.c
new file mode 100644 (file)
index 0000000..82c5f6a
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void minloc0_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 *array);
+export_proto(minloc0_4_r16);
+
+void
+minloc0_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_REAL_16 *base;
+  GFC_INTEGER_4 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_16 minval;
+
+  minval = GFC_REAL_16_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mminloc0_4_r16 (gfc_array_i4 *, gfc_array_r16 *, gfc_array_l4 *);
+export_proto(mminloc0_4_r16);
+
+void
+mminloc0_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_4 *dest;
+  GFC_REAL_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_16 minval;
+
+  minval = GFC_REAL_16_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
index c5f9a37..f8cce29 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_4)
+
 
 extern void minloc0_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 *array);
 export_proto(minloc0_4_r4);
@@ -286,3 +288,5 @@ mminloc0_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 *array,
     }
   }
 }
+
+#endif
index d9d51b2..dbfa667 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_4)
+
 
 extern void minloc0_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 *array);
 export_proto(minloc0_4_r8);
@@ -286,3 +288,5 @@ mminloc0_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 *array,
     }
   }
 }
+
+#endif
diff --git a/libgfortran/generated/minloc0_8_i16.c b/libgfortran/generated/minloc0_8_i16.c
new file mode 100644 (file)
index 0000000..8fabf52
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void minloc0_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 *array);
+export_proto(minloc0_8_i16);
+
+void
+minloc0_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_INTEGER_16 *base;
+  GFC_INTEGER_8 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_INTEGER_16 minval;
+
+  minval = GFC_INTEGER_16_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mminloc0_8_i16 (gfc_array_i8 *, gfc_array_i16 *, gfc_array_l4 *);
+export_proto(mminloc0_8_i16);
+
+void
+mminloc0_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_8 *dest;
+  GFC_INTEGER_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_INTEGER_16 minval;
+
+  minval = GFC_INTEGER_16_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
index 9d7abfa..49fe0f4 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
+
 
 extern void minloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array);
 export_proto(minloc0_8_i4);
@@ -286,3 +288,5 @@ mminloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array,
     }
   }
 }
+
+#endif
index bfeda26..d4327f0 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
+
 
 extern void minloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array);
 export_proto(minloc0_8_i8);
@@ -286,3 +288,5 @@ mminloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array,
     }
   }
 }
+
+#endif
diff --git a/libgfortran/generated/minloc0_8_r10.c b/libgfortran/generated/minloc0_8_r10.c
new file mode 100644 (file)
index 0000000..2cd231b
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void minloc0_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 *array);
+export_proto(minloc0_8_r10);
+
+void
+minloc0_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_REAL_10 *base;
+  GFC_INTEGER_8 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_10 minval;
+
+  minval = GFC_REAL_10_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mminloc0_8_r10 (gfc_array_i8 *, gfc_array_r10 *, gfc_array_l4 *);
+export_proto(mminloc0_8_r10);
+
+void
+mminloc0_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_8 *dest;
+  GFC_REAL_10 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_10 minval;
+
+  minval = GFC_REAL_10_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
diff --git a/libgfortran/generated/minloc0_8_r16.c b/libgfortran/generated/minloc0_8_r16.c
new file mode 100644 (file)
index 0000000..ff5925b
--- /dev/null
@@ -0,0 +1,292 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void minloc0_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 *array);
+export_proto(minloc0_8_r16);
+
+void
+minloc0_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 *array)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride;
+  GFC_REAL_16 *base;
+  GFC_INTEGER_8 *dest;
+  index_type rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_16 minval;
+
+  minval = GFC_REAL_16_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+            }
+        }
+    }
+  }
+}
+
+
+extern void mminloc0_8_r16 (gfc_array_i8 *, gfc_array_r16 *, gfc_array_l4 *);
+export_proto(mminloc0_8_r16);
+
+void
+mminloc0_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 *array,
+                                 gfc_array_l4 * mask)
+{
+  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_INTEGER_8 *dest;
+  GFC_REAL_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  index_type n;
+
+  rank = GFC_DESCRIPTOR_RANK (array);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->offset = 0;
+      retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+       runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+    }
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  dstride = retarray->dim[0].stride;
+  dest = retarray->data;
+  for (n = 0; n < rank; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      count[n] = 0;
+      if (extent[n] <= 0)
+       {
+         /* Set the return value.  */
+         for (n = 0; n < rank; n++)
+           dest[n * dstride] = 0;
+         return;
+       }
+    }
+
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+
+  /* Initialize the return value.  */
+  for (n = 0; n < rank; n++)
+    dest[n * dstride] = 1;
+  {
+
+  GFC_REAL_16 minval;
+
+  minval = GFC_REAL_16_HUGE;
+
+  while (base)
+    {
+      {
+        /* Implementation start.  */
+
+  if (*mbase && *base < minval)
+    {
+      minval = *base;
+      for (n = 0; n < rank; n++)
+        dest[n * dstride] = count[n] + 1;
+    }
+        /* Implementation end.  */
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the loop.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+            }
+        }
+    }
+  }
+}
+
+#endif
index 1b1d57b..a522c75 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_8)
+
 
 extern void minloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array);
 export_proto(minloc0_8_r4);
@@ -286,3 +288,5 @@ mminloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array,
     }
   }
 }
+
+#endif
index c7a2769..ba3cfe6 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_8)
+
 
 extern void minloc0_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array);
 export_proto(minloc0_8_r8);
@@ -286,3 +288,5 @@ mminloc0_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array,
     }
   }
 }
+
+#endif
diff --git a/libgfortran/generated/minloc1_16_i16.c b/libgfortran/generated/minloc1_16_i16.c
new file mode 100644 (file)
index 0000000..906030c
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc1_16_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *);
+export_proto(minloc1_16_i16);
+
+void
+minloc1_16_i16 (gfc_array_i16 *retarray, gfc_array_i16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_INTEGER_16 *src;
+      GFC_INTEGER_16 result;
+      src = base;
+      {
+
+  GFC_INTEGER_16 minval;
+  minval = GFC_INTEGER_16_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mminloc1_16_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mminloc1_16_i16);
+
+void
+mminloc1_16_i16 (gfc_array_i16 * retarray, gfc_array_i16 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *dest;
+  GFC_INTEGER_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_INTEGER_16 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_INTEGER_16 minval;
+  minval = GFC_INTEGER_16_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/minloc1_16_i4.c b/libgfortran/generated/minloc1_16_i4.c
new file mode 100644 (file)
index 0000000..b7fe1a0
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc1_16_i4 (gfc_array_i16 *, gfc_array_i4 *, index_type *);
+export_proto(minloc1_16_i4);
+
+void
+minloc1_16_i4 (gfc_array_i16 *retarray, gfc_array_i4 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_4 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_INTEGER_4 *src;
+      GFC_INTEGER_16 result;
+      src = base;
+      {
+
+  GFC_INTEGER_4 minval;
+  minval = GFC_INTEGER_4_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mminloc1_16_i4 (gfc_array_i16 *, gfc_array_i4 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mminloc1_16_i4);
+
+void
+mminloc1_16_i4 (gfc_array_i16 * retarray, gfc_array_i4 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *dest;
+  GFC_INTEGER_4 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_INTEGER_4 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_INTEGER_4 minval;
+  minval = GFC_INTEGER_4_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/minloc1_16_i8.c b/libgfortran/generated/minloc1_16_i8.c
new file mode 100644 (file)
index 0000000..20c17f2
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc1_16_i8 (gfc_array_i16 *, gfc_array_i8 *, index_type *);
+export_proto(minloc1_16_i8);
+
+void
+minloc1_16_i8 (gfc_array_i16 *retarray, gfc_array_i8 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_8 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_INTEGER_8 *src;
+      GFC_INTEGER_16 result;
+      src = base;
+      {
+
+  GFC_INTEGER_8 minval;
+  minval = GFC_INTEGER_8_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mminloc1_16_i8 (gfc_array_i16 *, gfc_array_i8 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mminloc1_16_i8);
+
+void
+mminloc1_16_i8 (gfc_array_i16 * retarray, gfc_array_i8 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *dest;
+  GFC_INTEGER_8 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_INTEGER_8 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_INTEGER_8 minval;
+  minval = GFC_INTEGER_8_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/minloc1_16_r10.c b/libgfortran/generated/minloc1_16_r10.c
new file mode 100644 (file)
index 0000000..48519c2
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc1_16_r10 (gfc_array_i16 *, gfc_array_r10 *, index_type *);
+export_proto(minloc1_16_r10);
+
+void
+minloc1_16_r10 (gfc_array_i16 *retarray, gfc_array_r10 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_10 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_REAL_10 *src;
+      GFC_INTEGER_16 result;
+      src = base;
+      {
+
+  GFC_REAL_10 minval;
+  minval = GFC_REAL_10_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mminloc1_16_r10 (gfc_array_i16 *, gfc_array_r10 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mminloc1_16_r10);
+
+void
+mminloc1_16_r10 (gfc_array_i16 * retarray, gfc_array_r10 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *dest;
+  GFC_REAL_10 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_REAL_10 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_REAL_10 minval;
+  minval = GFC_REAL_10_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/minloc1_16_r16.c b/libgfortran/generated/minloc1_16_r16.c
new file mode 100644 (file)
index 0000000..41fed8a
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc1_16_r16 (gfc_array_i16 *, gfc_array_r16 *, index_type *);
+export_proto(minloc1_16_r16);
+
+void
+minloc1_16_r16 (gfc_array_i16 *retarray, gfc_array_r16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_16 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_REAL_16 *src;
+      GFC_INTEGER_16 result;
+      src = base;
+      {
+
+  GFC_REAL_16 minval;
+  minval = GFC_REAL_16_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mminloc1_16_r16 (gfc_array_i16 *, gfc_array_r16 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mminloc1_16_r16);
+
+void
+mminloc1_16_r16 (gfc_array_i16 * retarray, gfc_array_r16 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *dest;
+  GFC_REAL_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_REAL_16 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_REAL_16 minval;
+  minval = GFC_REAL_16_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/minloc1_16_r4.c b/libgfortran/generated/minloc1_16_r4.c
new file mode 100644 (file)
index 0000000..b3a4017
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc1_16_r4 (gfc_array_i16 *, gfc_array_r4 *, index_type *);
+export_proto(minloc1_16_r4);
+
+void
+minloc1_16_r4 (gfc_array_i16 *retarray, gfc_array_r4 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_4 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_REAL_4 *src;
+      GFC_INTEGER_16 result;
+      src = base;
+      {
+
+  GFC_REAL_4 minval;
+  minval = GFC_REAL_4_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mminloc1_16_r4 (gfc_array_i16 *, gfc_array_r4 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mminloc1_16_r4);
+
+void
+mminloc1_16_r4 (gfc_array_i16 * retarray, gfc_array_r4 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *dest;
+  GFC_REAL_4 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_REAL_4 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_REAL_4 minval;
+  minval = GFC_REAL_4_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/minloc1_16_r8.c b/libgfortran/generated/minloc1_16_r8.c
new file mode 100644 (file)
index 0000000..a9a0267
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minloc1_16_r8 (gfc_array_i16 *, gfc_array_r8 *, index_type *);
+export_proto(minloc1_16_r8);
+
+void
+minloc1_16_r8 (gfc_array_i16 *retarray, gfc_array_r8 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_8 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_REAL_8 *src;
+      GFC_INTEGER_16 result;
+      src = base;
+      {
+
+  GFC_REAL_8 minval;
+  minval = GFC_REAL_8_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mminloc1_16_r8 (gfc_array_i16 *, gfc_array_r8 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mminloc1_16_r8);
+
+void
+mminloc1_16_r8 (gfc_array_i16 * retarray, gfc_array_r8 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *dest;
+  GFC_REAL_8 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_REAL_8 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_REAL_8 minval;
+  minval = GFC_REAL_8_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_16)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/minloc1_4_i16.c b/libgfortran/generated/minloc1_4_i16.c
new file mode 100644 (file)
index 0000000..3446a1a
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void minloc1_4_i16 (gfc_array_i4 *, gfc_array_i16 *, index_type *);
+export_proto(minloc1_4_i16);
+
+void
+minloc1_4_i16 (gfc_array_i4 *retarray, gfc_array_i16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *base;
+  GFC_INTEGER_4 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_INTEGER_16 *src;
+      GFC_INTEGER_4 result;
+      src = base;
+      {
+
+  GFC_INTEGER_16 minval;
+  minval = GFC_INTEGER_16_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_4)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mminloc1_4_i16 (gfc_array_i4 *, gfc_array_i16 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mminloc1_4_i16);
+
+void
+mminloc1_4_i16 (gfc_array_i4 * retarray, gfc_array_i16 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_4 *dest;
+  GFC_INTEGER_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_INTEGER_16 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_4 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_INTEGER_16 minval;
+  minval = GFC_INTEGER_16_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_4)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index 2aa1d4d..f720719 100644 (file)
@@ -36,6 +36,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
+
 extern void minloc1_4_i4 (gfc_array_i4 *, gfc_array_i4 *, index_type *);
 export_proto(minloc1_4_i4);
 
@@ -341,3 +344,4 @@ mminloc1_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array,
     }
 }
 
+#endif
index 08a74c7..b049b19 100644 (file)
@@ -36,6 +36,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_4)
+
+
 extern void minloc1_4_i8 (gfc_array_i4 *, gfc_array_i8 *, index_type *);
 export_proto(minloc1_4_i8);
 
@@ -341,3 +344,4 @@ mminloc1_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 * array,
     }
 }
 
+#endif
diff --git a/libgfortran/generated/minloc1_4_r10.c b/libgfortran/generated/minloc1_4_r10.c
new file mode 100644 (file)
index 0000000..983db75
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void minloc1_4_r10 (gfc_array_i4 *, gfc_array_r10 *, index_type *);
+export_proto(minloc1_4_r10);
+
+void
+minloc1_4_r10 (gfc_array_i4 *retarray, gfc_array_r10 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_10 *base;
+  GFC_INTEGER_4 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_REAL_10 *src;
+      GFC_INTEGER_4 result;
+      src = base;
+      {
+
+  GFC_REAL_10 minval;
+  minval = GFC_REAL_10_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_4)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mminloc1_4_r10 (gfc_array_i4 *, gfc_array_r10 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mminloc1_4_r10);
+
+void
+mminloc1_4_r10 (gfc_array_i4 * retarray, gfc_array_r10 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_4 *dest;
+  GFC_REAL_10 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_REAL_10 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_4 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_REAL_10 minval;
+  minval = GFC_REAL_10_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_4)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/minloc1_4_r16.c b/libgfortran/generated/minloc1_4_r16.c
new file mode 100644 (file)
index 0000000..68f1421
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_4)
+
+
+extern void minloc1_4_r16 (gfc_array_i4 *, gfc_array_r16 *, index_type *);
+export_proto(minloc1_4_r16);
+
+void
+minloc1_4_r16 (gfc_array_i4 *retarray, gfc_array_r16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_16 *base;
+  GFC_INTEGER_4 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_REAL_16 *src;
+      GFC_INTEGER_4 result;
+      src = base;
+      {
+
+  GFC_REAL_16 minval;
+  minval = GFC_REAL_16_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_4)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mminloc1_4_r16 (gfc_array_i4 *, gfc_array_r16 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mminloc1_4_r16);
+
+void
+mminloc1_4_r16 (gfc_array_i4 * retarray, gfc_array_r16 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_4 *dest;
+  GFC_REAL_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_4)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_REAL_16 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_4 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_REAL_16 minval;
+  minval = GFC_REAL_16_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_4)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index 9d0af3b..e7191fd 100644 (file)
@@ -36,6 +36,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_4)
+
+
 extern void minloc1_4_r4 (gfc_array_i4 *, gfc_array_r4 *, index_type *);
 export_proto(minloc1_4_r4);
 
@@ -341,3 +344,4 @@ mminloc1_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 * array,
     }
 }
 
+#endif
index de5440b..9d4c981 100644 (file)
@@ -36,6 +36,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_4)
+
+
 extern void minloc1_4_r8 (gfc_array_i4 *, gfc_array_r8 *, index_type *);
 export_proto(minloc1_4_r8);
 
@@ -341,3 +344,4 @@ mminloc1_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 * array,
     }
 }
 
+#endif
diff --git a/libgfortran/generated/minloc1_8_i16.c b/libgfortran/generated/minloc1_8_i16.c
new file mode 100644 (file)
index 0000000..13c2cb7
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void minloc1_8_i16 (gfc_array_i8 *, gfc_array_i16 *, index_type *);
+export_proto(minloc1_8_i16);
+
+void
+minloc1_8_i16 (gfc_array_i8 *retarray, gfc_array_i16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *base;
+  GFC_INTEGER_8 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_INTEGER_16 *src;
+      GFC_INTEGER_8 result;
+      src = base;
+      {
+
+  GFC_INTEGER_16 minval;
+  minval = GFC_INTEGER_16_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_8)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mminloc1_8_i16 (gfc_array_i8 *, gfc_array_i16 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mminloc1_8_i16);
+
+void
+mminloc1_8_i16 (gfc_array_i8 * retarray, gfc_array_i16 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_8 *dest;
+  GFC_INTEGER_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_INTEGER_16 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_8 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_INTEGER_16 minval;
+  minval = GFC_INTEGER_16_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_8)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index 6669988..f682c10 100644 (file)
@@ -36,6 +36,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
+
+
 extern void minloc1_8_i4 (gfc_array_i8 *, gfc_array_i4 *, index_type *);
 export_proto(minloc1_8_i4);
 
@@ -341,3 +344,4 @@ mminloc1_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 * array,
     }
 }
 
+#endif
index 4adb149..9a2a523 100644 (file)
@@ -36,6 +36,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
+
+
 extern void minloc1_8_i8 (gfc_array_i8 *, gfc_array_i8 *, index_type *);
 export_proto(minloc1_8_i8);
 
@@ -341,3 +344,4 @@ mminloc1_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array,
     }
 }
 
+#endif
diff --git a/libgfortran/generated/minloc1_8_r10.c b/libgfortran/generated/minloc1_8_r10.c
new file mode 100644 (file)
index 0000000..2058453
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void minloc1_8_r10 (gfc_array_i8 *, gfc_array_r10 *, index_type *);
+export_proto(minloc1_8_r10);
+
+void
+minloc1_8_r10 (gfc_array_i8 *retarray, gfc_array_r10 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_10 *base;
+  GFC_INTEGER_8 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_REAL_10 *src;
+      GFC_INTEGER_8 result;
+      src = base;
+      {
+
+  GFC_REAL_10 minval;
+  minval = GFC_REAL_10_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_8)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mminloc1_8_r10 (gfc_array_i8 *, gfc_array_r10 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mminloc1_8_r10);
+
+void
+mminloc1_8_r10 (gfc_array_i8 * retarray, gfc_array_r10 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_8 *dest;
+  GFC_REAL_10 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_REAL_10 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_8 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_REAL_10 minval;
+  minval = GFC_REAL_10_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_8)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/minloc1_8_r16.c b/libgfortran/generated/minloc1_8_r16.c
new file mode 100644 (file)
index 0000000..e417f62
--- /dev/null
@@ -0,0 +1,347 @@
+/* Implementation of the MINLOC intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include <limits.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_8)
+
+
+extern void minloc1_8_r16 (gfc_array_i8 *, gfc_array_r16 *, index_type *);
+export_proto(minloc1_8_r16);
+
+void
+minloc1_8_r16 (gfc_array_i8 *retarray, gfc_array_r16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_16 *base;
+  GFC_INTEGER_8 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_REAL_16 *src;
+      GFC_INTEGER_8 result;
+      src = base;
+      {
+
+  GFC_REAL_16 minval;
+  minval = GFC_REAL_16_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_8)n + 1;
+    }
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mminloc1_8_r16 (gfc_array_i8 *, gfc_array_r16 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mminloc1_8_r16);
+
+void
+mminloc1_8_r16 (gfc_array_i8 * retarray, gfc_array_r16 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_8 *dest;
+  GFC_REAL_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_8)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_REAL_16 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_8 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  GFC_REAL_16 minval;
+  minval = GFC_REAL_16_HUGE;
+  result = 1;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src < minval)
+    {
+      minval = *src;
+      result = (GFC_INTEGER_8)n + 1;
+    }
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index 45cb834..8f154dc 100644 (file)
@@ -36,6 +36,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_8)
+
+
 extern void minloc1_8_r4 (gfc_array_i8 *, gfc_array_r4 *, index_type *);
 export_proto(minloc1_8_r4);
 
@@ -341,3 +344,4 @@ mminloc1_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 * array,
     }
 }
 
+#endif
index f6c72e4..20a757a 100644 (file)
@@ -36,6 +36,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_8)
+
+
 extern void minloc1_8_r8 (gfc_array_i8 *, gfc_array_r8 *, index_type *);
 export_proto(minloc1_8_r8);
 
@@ -341,3 +344,4 @@ mminloc1_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 * array,
     }
 }
 
+#endif
diff --git a/libgfortran/generated/minval_i16.c b/libgfortran/generated/minval_i16.c
new file mode 100644 (file)
index 0000000..34963ae
--- /dev/null
@@ -0,0 +1,336 @@
+/* Implementation of the MINVAL intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void minval_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *);
+export_proto(minval_i16);
+
+void
+minval_i16 (gfc_array_i16 *retarray, gfc_array_i16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_INTEGER_16 *src;
+      GFC_INTEGER_16 result;
+      src = base;
+      {
+
+  result = GFC_INTEGER_16_HUGE;
+        if (len <= 0)
+         *dest = GFC_INTEGER_16_HUGE;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src < result)
+    result = *src;
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mminval_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mminval_i16);
+
+void
+mminval_i16 (gfc_array_i16 * retarray, gfc_array_i16 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *dest;
+  GFC_INTEGER_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_INTEGER_16 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = GFC_INTEGER_16_HUGE;
+        if (len <= 0)
+         *dest = GFC_INTEGER_16_HUGE;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src < result)
+    result = *src;
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index 01ef023..826d2e9 100644 (file)
@@ -35,6 +35,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
+
 extern void minval_i4 (gfc_array_i4 *, gfc_array_i4 *, index_type *);
 export_proto(minval_i4);
 
@@ -330,3 +333,4 @@ mminval_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array,
     }
 }
 
+#endif
index 1d76903..e58a97b 100644 (file)
@@ -35,6 +35,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
+
+
 extern void minval_i8 (gfc_array_i8 *, gfc_array_i8 *, index_type *);
 export_proto(minval_i8);
 
@@ -330,3 +333,4 @@ mminval_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array,
     }
 }
 
+#endif
diff --git a/libgfortran/generated/minval_r10.c b/libgfortran/generated/minval_r10.c
new file mode 100644 (file)
index 0000000..ec494fb
--- /dev/null
@@ -0,0 +1,336 @@
+/* Implementation of the MINVAL intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_REAL_10)
+
+
+extern void minval_r10 (gfc_array_r10 *, gfc_array_r10 *, index_type *);
+export_proto(minval_r10);
+
+void
+minval_r10 (gfc_array_r10 *retarray, gfc_array_r10 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_10 *base;
+  GFC_REAL_10 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_REAL_10)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_REAL_10 *src;
+      GFC_REAL_10 result;
+      src = base;
+      {
+
+  result = GFC_REAL_10_HUGE;
+        if (len <= 0)
+         *dest = GFC_REAL_10_HUGE;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src < result)
+    result = *src;
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mminval_r10 (gfc_array_r10 *, gfc_array_r10 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mminval_r10);
+
+void
+mminval_r10 (gfc_array_r10 * retarray, gfc_array_r10 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_10 *dest;
+  GFC_REAL_10 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_REAL_10)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_REAL_10 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_REAL_10 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = GFC_REAL_10_HUGE;
+        if (len <= 0)
+         *dest = GFC_REAL_10_HUGE;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src < result)
+    result = *src;
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/minval_r16.c b/libgfortran/generated/minval_r16.c
new file mode 100644 (file)
index 0000000..d71b007
--- /dev/null
@@ -0,0 +1,336 @@
+/* Implementation of the MINVAL intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include <float.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_REAL_16)
+
+
+extern void minval_r16 (gfc_array_r16 *, gfc_array_r16 *, index_type *);
+export_proto(minval_r16);
+
+void
+minval_r16 (gfc_array_r16 *retarray, gfc_array_r16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_16 *base;
+  GFC_REAL_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_REAL_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_REAL_16 *src;
+      GFC_REAL_16 result;
+      src = base;
+      {
+
+  result = GFC_REAL_16_HUGE;
+        if (len <= 0)
+         *dest = GFC_REAL_16_HUGE;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  if (*src < result)
+    result = *src;
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mminval_r16 (gfc_array_r16 *, gfc_array_r16 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mminval_r16);
+
+void
+mminval_r16 (gfc_array_r16 * retarray, gfc_array_r16 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_16 *dest;
+  GFC_REAL_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_REAL_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_REAL_16 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_REAL_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = GFC_REAL_16_HUGE;
+        if (len <= 0)
+         *dest = GFC_REAL_16_HUGE;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc && *src < result)
+    result = *src;
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index c4e3039..8228f99 100644 (file)
@@ -35,6 +35,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_REAL_4)
+
+
 extern void minval_r4 (gfc_array_r4 *, gfc_array_r4 *, index_type *);
 export_proto(minval_r4);
 
@@ -330,3 +333,4 @@ mminval_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array,
     }
 }
 
+#endif
index de6eea1..81a8b21 100644 (file)
@@ -35,6 +35,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_REAL_8)
+
+
 extern void minval_r8 (gfc_array_r8 *, gfc_array_r8 *, index_type *);
 export_proto(minval_r8);
 
@@ -330,3 +333,4 @@ mminval_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array,
     }
 }
 
+#endif
diff --git a/libgfortran/generated/nearest_r10.c b/libgfortran/generated/nearest_r10.c
new file mode 100644 (file)
index 0000000..5a02d74
--- /dev/null
@@ -0,0 +1,56 @@
+/* Implementation of the NEAREST intrinsic
+   Copyright 2003 Free Software Foundation, Inc.
+   Contributed by Richard Henderson <rth@redhat.com>.
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <math.h>
+#include <float.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_COPYSIGNL) && defined (HAVE_NEXTAFTERL)
+
+extern GFC_REAL_10 nearest_r10 (GFC_REAL_10 s, GFC_REAL_10 dir);
+export_proto(nearest_r10);
+
+GFC_REAL_10
+nearest_r10 (GFC_REAL_10 s, GFC_REAL_10 dir)
+{
+  dir = copysignl (__builtin_infl (), dir);
+  if (FLT_EVAL_METHOD != 0)
+    {
+      /* ??? Work around glibc bug on x86.  */
+      volatile GFC_REAL_10 r = nextafterl (s, dir);
+      return r;
+    }
+  else
+    return nextafterl (s, dir);
+}
+
+#endif
diff --git a/libgfortran/generated/nearest_r16.c b/libgfortran/generated/nearest_r16.c
new file mode 100644 (file)
index 0000000..eeb532a
--- /dev/null
@@ -0,0 +1,56 @@
+/* Implementation of the NEAREST intrinsic
+   Copyright 2003 Free Software Foundation, Inc.
+   Contributed by Richard Henderson <rth@redhat.com>.
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <math.h>
+#include <float.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_COPYSIGNL) && defined (HAVE_NEXTAFTERL)
+
+extern GFC_REAL_16 nearest_r16 (GFC_REAL_16 s, GFC_REAL_16 dir);
+export_proto(nearest_r16);
+
+GFC_REAL_16
+nearest_r16 (GFC_REAL_16 s, GFC_REAL_16 dir)
+{
+  dir = copysignl (__builtin_infl (), dir);
+  if (FLT_EVAL_METHOD != 0)
+    {
+      /* ??? Work around glibc bug on x86.  */
+      volatile GFC_REAL_16 r = nextafterl (s, dir);
+      return r;
+    }
+  else
+    return nextafterl (s, dir);
+}
+
+#endif
index 265b649..02fd6aa 100644 (file)
@@ -27,11 +27,15 @@ You should have received a copy of the GNU General Public
 License along with libgfortran; see the file COPYING.  If not,
 write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
 #include <math.h>
 #include <float.h>
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_COPYSIGNF) && defined (HAVE_NEXTAFTERF)
+
 extern GFC_REAL_4 nearest_r4 (GFC_REAL_4 s, GFC_REAL_4 dir);
 export_proto(nearest_r4);
 
@@ -48,3 +52,5 @@ nearest_r4 (GFC_REAL_4 s, GFC_REAL_4 dir)
   else
     return nextafterf (s, dir);
 }
+
+#endif
index 337cce6..e050f74 100644 (file)
@@ -27,11 +27,15 @@ You should have received a copy of the GNU General Public
 License along with libgfortran; see the file COPYING.  If not,
 write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
 #include <math.h>
 #include <float.h>
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_COPYSIGN) && defined (HAVE_NEXTAFTER)
+
 extern GFC_REAL_8 nearest_r8 (GFC_REAL_8 s, GFC_REAL_8 dir);
 export_proto(nearest_r8);
 
@@ -48,3 +52,5 @@ nearest_r8 (GFC_REAL_8 s, GFC_REAL_8 dir)
   else
     return nextafter (s, dir);
 }
+
+#endif
diff --git a/libgfortran/generated/pow_c10_i16.c b/libgfortran/generated/pow_c10_i16.c
new file mode 100644 (file)
index 0000000..6332013
--- /dev/null
@@ -0,0 +1,76 @@
+/* Support routines for the intrinsic power (**) operator.
+   Copyright 2004 Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+   a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+   Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+   of Computer Programming", 3rd Edition, 1998.  */
+
+#if defined (HAVE_GFC_COMPLEX_10) && defined (HAVE_GFC_INTEGER_16)
+
+GFC_COMPLEX_10 pow_c10_i16 (GFC_COMPLEX_10 a, GFC_INTEGER_16 b);
+export_proto(pow_c10_i16);
+
+GFC_COMPLEX_10
+pow_c10_i16 (GFC_COMPLEX_10 a, GFC_INTEGER_16 b)
+{
+  GFC_COMPLEX_10 pow, x;
+  GFC_INTEGER_16 n, u;
+  
+  n = b;
+  x = a;
+  pow = 1;
+  if (n != 0)
+    {
+      if (n < 0)
+       {
+
+         n = -n;
+         x = pow / x;
+       }
+      u = n;
+      for (;;)
+       {
+         if (u & 1)
+           pow *= x;
+         u >>= 1;
+         if (u)
+           x *= x;
+         else
+           break;
+       }
+    }
+  return pow;
+}
+
+#endif
diff --git a/libgfortran/generated/pow_c10_i4.c b/libgfortran/generated/pow_c10_i4.c
new file mode 100644 (file)
index 0000000..ccb1a0c
--- /dev/null
@@ -0,0 +1,76 @@
+/* Support routines for the intrinsic power (**) operator.
+   Copyright 2004 Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+   a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+   Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+   of Computer Programming", 3rd Edition, 1998.  */
+
+#if defined (HAVE_GFC_COMPLEX_10) && defined (HAVE_GFC_INTEGER_4)
+
+GFC_COMPLEX_10 pow_c10_i4 (GFC_COMPLEX_10 a, GFC_INTEGER_4 b);
+export_proto(pow_c10_i4);
+
+GFC_COMPLEX_10
+pow_c10_i4 (GFC_COMPLEX_10 a, GFC_INTEGER_4 b)
+{
+  GFC_COMPLEX_10 pow, x;
+  GFC_INTEGER_4 n, u;
+  
+  n = b;
+  x = a;
+  pow = 1;
+  if (n != 0)
+    {
+      if (n < 0)
+       {
+
+         n = -n;
+         x = pow / x;
+       }
+      u = n;
+      for (;;)
+       {
+         if (u & 1)
+           pow *= x;
+         u >>= 1;
+         if (u)
+           x *= x;
+         else
+           break;
+       }
+    }
+  return pow;
+}
+
+#endif
diff --git a/libgfortran/generated/pow_c10_i8.c b/libgfortran/generated/pow_c10_i8.c
new file mode 100644 (file)
index 0000000..0f2b242
--- /dev/null
@@ -0,0 +1,76 @@
+/* Support routines for the intrinsic power (**) operator.
+   Copyright 2004 Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+   a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+   Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+   of Computer Programming", 3rd Edition, 1998.  */
+
+#if defined (HAVE_GFC_COMPLEX_10) && defined (HAVE_GFC_INTEGER_8)
+
+GFC_COMPLEX_10 pow_c10_i8 (GFC_COMPLEX_10 a, GFC_INTEGER_8 b);
+export_proto(pow_c10_i8);
+
+GFC_COMPLEX_10
+pow_c10_i8 (GFC_COMPLEX_10 a, GFC_INTEGER_8 b)
+{
+  GFC_COMPLEX_10 pow, x;
+  GFC_INTEGER_8 n, u;
+  
+  n = b;
+  x = a;
+  pow = 1;
+  if (n != 0)
+    {
+      if (n < 0)
+       {
+
+         n = -n;
+         x = pow / x;
+       }
+      u = n;
+      for (;;)
+       {
+         if (u & 1)
+           pow *= x;
+         u >>= 1;
+         if (u)
+           x *= x;
+         else
+           break;
+       }
+    }
+  return pow;
+}
+
+#endif
diff --git a/libgfortran/generated/pow_c16_i16.c b/libgfortran/generated/pow_c16_i16.c
new file mode 100644 (file)
index 0000000..a6d8883
--- /dev/null
@@ -0,0 +1,76 @@
+/* Support routines for the intrinsic power (**) operator.
+   Copyright 2004 Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+   a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+   Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+   of Computer Programming", 3rd Edition, 1998.  */
+
+#if defined (HAVE_GFC_COMPLEX_16) && defined (HAVE_GFC_INTEGER_16)
+
+GFC_COMPLEX_16 pow_c16_i16 (GFC_COMPLEX_16 a, GFC_INTEGER_16 b);
+export_proto(pow_c16_i16);
+
+GFC_COMPLEX_16
+pow_c16_i16 (GFC_COMPLEX_16 a, GFC_INTEGER_16 b)
+{
+  GFC_COMPLEX_16 pow, x;
+  GFC_INTEGER_16 n, u;
+  
+  n = b;
+  x = a;
+  pow = 1;
+  if (n != 0)
+    {
+      if (n < 0)
+       {
+
+         n = -n;
+         x = pow / x;
+       }
+      u = n;
+      for (;;)
+       {
+         if (u & 1)
+           pow *= x;
+         u >>= 1;
+         if (u)
+           x *= x;
+         else
+           break;
+       }
+    }
+  return pow;
+}
+
+#endif
diff --git a/libgfortran/generated/pow_c16_i4.c b/libgfortran/generated/pow_c16_i4.c
new file mode 100644 (file)
index 0000000..d396052
--- /dev/null
@@ -0,0 +1,76 @@
+/* Support routines for the intrinsic power (**) operator.
+   Copyright 2004 Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+   a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+   Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+   of Computer Programming", 3rd Edition, 1998.  */
+
+#if defined (HAVE_GFC_COMPLEX_16) && defined (HAVE_GFC_INTEGER_4)
+
+GFC_COMPLEX_16 pow_c16_i4 (GFC_COMPLEX_16 a, GFC_INTEGER_4 b);
+export_proto(pow_c16_i4);
+
+GFC_COMPLEX_16
+pow_c16_i4 (GFC_COMPLEX_16 a, GFC_INTEGER_4 b)
+{
+  GFC_COMPLEX_16 pow, x;
+  GFC_INTEGER_4 n, u;
+  
+  n = b;
+  x = a;
+  pow = 1;
+  if (n != 0)
+    {
+      if (n < 0)
+       {
+
+         n = -n;
+         x = pow / x;
+       }
+      u = n;
+      for (;;)
+       {
+         if (u & 1)
+           pow *= x;
+         u >>= 1;
+         if (u)
+           x *= x;
+         else
+           break;
+       }
+    }
+  return pow;
+}
+
+#endif
diff --git a/libgfortran/generated/pow_c16_i8.c b/libgfortran/generated/pow_c16_i8.c
new file mode 100644 (file)
index 0000000..0a0e94d
--- /dev/null
@@ -0,0 +1,76 @@
+/* Support routines for the intrinsic power (**) operator.
+   Copyright 2004 Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+   a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+   Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+   of Computer Programming", 3rd Edition, 1998.  */
+
+#if defined (HAVE_GFC_COMPLEX_16) && defined (HAVE_GFC_INTEGER_8)
+
+GFC_COMPLEX_16 pow_c16_i8 (GFC_COMPLEX_16 a, GFC_INTEGER_8 b);
+export_proto(pow_c16_i8);
+
+GFC_COMPLEX_16
+pow_c16_i8 (GFC_COMPLEX_16 a, GFC_INTEGER_8 b)
+{
+  GFC_COMPLEX_16 pow, x;
+  GFC_INTEGER_8 n, u;
+  
+  n = b;
+  x = a;
+  pow = 1;
+  if (n != 0)
+    {
+      if (n < 0)
+       {
+
+         n = -n;
+         x = pow / x;
+       }
+      u = n;
+      for (;;)
+       {
+         if (u & 1)
+           pow *= x;
+         u >>= 1;
+         if (u)
+           x *= x;
+         else
+           break;
+       }
+    }
+  return pow;
+}
+
+#endif
diff --git a/libgfortran/generated/pow_c4_i16.c b/libgfortran/generated/pow_c4_i16.c
new file mode 100644 (file)
index 0000000..1085ad2
--- /dev/null
@@ -0,0 +1,76 @@
+/* Support routines for the intrinsic power (**) operator.
+   Copyright 2004 Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+   a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+   Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+   of Computer Programming", 3rd Edition, 1998.  */
+
+#if defined (HAVE_GFC_COMPLEX_4) && defined (HAVE_GFC_INTEGER_16)
+
+GFC_COMPLEX_4 pow_c4_i16 (GFC_COMPLEX_4 a, GFC_INTEGER_16 b);
+export_proto(pow_c4_i16);
+
+GFC_COMPLEX_4
+pow_c4_i16 (GFC_COMPLEX_4 a, GFC_INTEGER_16 b)
+{
+  GFC_COMPLEX_4 pow, x;
+  GFC_INTEGER_16 n, u;
+  
+  n = b;
+  x = a;
+  pow = 1;
+  if (n != 0)
+    {
+      if (n < 0)
+       {
+
+         n = -n;
+         x = pow / x;
+       }
+      u = n;
+      for (;;)
+       {
+         if (u & 1)
+           pow *= x;
+         u >>= 1;
+         if (u)
+           x *= x;
+         else
+           break;
+       }
+    }
+  return pow;
+}
+
+#endif
index a25607e..ca37671 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
    Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
    of Computer Programming", 3rd Edition, 1998.  */
 
+#if defined (HAVE_GFC_COMPLEX_4) && defined (HAVE_GFC_INTEGER_4)
+
 GFC_COMPLEX_4 pow_c4_i4 (GFC_COMPLEX_4 a, GFC_INTEGER_4 b);
 export_proto(pow_c4_i4);
 
@@ -70,3 +72,5 @@ pow_c4_i4 (GFC_COMPLEX_4 a, GFC_INTEGER_4 b)
     }
   return pow;
 }
+
+#endif
index a609836..f9fc849 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
    Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
    of Computer Programming", 3rd Edition, 1998.  */
 
+#if defined (HAVE_GFC_COMPLEX_4) && defined (HAVE_GFC_INTEGER_8)
+
 GFC_COMPLEX_4 pow_c4_i8 (GFC_COMPLEX_4 a, GFC_INTEGER_8 b);
 export_proto(pow_c4_i8);
 
@@ -70,3 +72,5 @@ pow_c4_i8 (GFC_COMPLEX_4 a, GFC_INTEGER_8 b)
     }
   return pow;
 }
+
+#endif
diff --git a/libgfortran/generated/pow_c8_i16.c b/libgfortran/generated/pow_c8_i16.c
new file mode 100644 (file)
index 0000000..0fc162b
--- /dev/null
@@ -0,0 +1,76 @@
+/* Support routines for the intrinsic power (**) operator.
+   Copyright 2004 Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+   a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+   Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+   of Computer Programming", 3rd Edition, 1998.  */
+
+#if defined (HAVE_GFC_COMPLEX_8) && defined (HAVE_GFC_INTEGER_16)
+
+GFC_COMPLEX_8 pow_c8_i16 (GFC_COMPLEX_8 a, GFC_INTEGER_16 b);
+export_proto(pow_c8_i16);
+
+GFC_COMPLEX_8
+pow_c8_i16 (GFC_COMPLEX_8 a, GFC_INTEGER_16 b)
+{
+  GFC_COMPLEX_8 pow, x;
+  GFC_INTEGER_16 n, u;
+  
+  n = b;
+  x = a;
+  pow = 1;
+  if (n != 0)
+    {
+      if (n < 0)
+       {
+
+         n = -n;
+         x = pow / x;
+       }
+      u = n;
+      for (;;)
+       {
+         if (u & 1)
+           pow *= x;
+         u >>= 1;
+         if (u)
+           x *= x;
+         else
+           break;
+       }
+    }
+  return pow;
+}
+
+#endif
index e205998..64b4b3c 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
    Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
    of Computer Programming", 3rd Edition, 1998.  */
 
+#if defined (HAVE_GFC_COMPLEX_8) && defined (HAVE_GFC_INTEGER_4)
+
 GFC_COMPLEX_8 pow_c8_i4 (GFC_COMPLEX_8 a, GFC_INTEGER_4 b);
 export_proto(pow_c8_i4);
 
@@ -70,3 +72,5 @@ pow_c8_i4 (GFC_COMPLEX_8 a, GFC_INTEGER_4 b)
     }
   return pow;
 }
+
+#endif
index 922fbff..39a5d6b 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
    Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
    of Computer Programming", 3rd Edition, 1998.  */
 
+#if defined (HAVE_GFC_COMPLEX_8) && defined (HAVE_GFC_INTEGER_8)
+
 GFC_COMPLEX_8 pow_c8_i8 (GFC_COMPLEX_8 a, GFC_INTEGER_8 b);
 export_proto(pow_c8_i8);
 
@@ -70,3 +72,5 @@ pow_c8_i8 (GFC_COMPLEX_8 a, GFC_INTEGER_8 b)
     }
   return pow;
 }
+
+#endif
diff --git a/libgfortran/generated/pow_i16_i16.c b/libgfortran/generated/pow_i16_i16.c
new file mode 100644 (file)
index 0000000..eda2fb6
--- /dev/null
@@ -0,0 +1,78 @@
+/* Support routines for the intrinsic power (**) operator.
+   Copyright 2004 Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+   a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+   Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+   of Computer Programming", 3rd Edition, 1998.  */
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
+
+GFC_INTEGER_16 pow_i16_i16 (GFC_INTEGER_16 a, GFC_INTEGER_16 b);
+export_proto(pow_i16_i16);
+
+GFC_INTEGER_16
+pow_i16_i16 (GFC_INTEGER_16 a, GFC_INTEGER_16 b)
+{
+  GFC_INTEGER_16 pow, x;
+  GFC_INTEGER_16 n, u;
+  
+  n = b;
+  x = a;
+  pow = 1;
+  if (n != 0)
+    {
+      if (n < 0)
+       {
+         if (x == 1)
+           return 1;
+         if (x == -1)
+           return (n & 1) ? -1 : 1;
+         return (x == 0) ? 1 / x : 0;
+       }
+      u = n;
+      for (;;)
+       {
+         if (u & 1)
+           pow *= x;
+         u >>= 1;
+         if (u)
+           x *= x;
+         else
+           break;
+       }
+    }
+  return pow;
+}
+
+#endif
diff --git a/libgfortran/generated/pow_i16_i4.c b/libgfortran/generated/pow_i16_i4.c
new file mode 100644 (file)
index 0000000..6e4d65c
--- /dev/null
@@ -0,0 +1,78 @@
+/* Support routines for the intrinsic power (**) operator.
+   Copyright 2004 Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+   a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+   Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+   of Computer Programming", 3rd Edition, 1998.  */
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_4)
+
+GFC_INTEGER_16 pow_i16_i4 (GFC_INTEGER_16 a, GFC_INTEGER_4 b);
+export_proto(pow_i16_i4);
+
+GFC_INTEGER_16
+pow_i16_i4 (GFC_INTEGER_16 a, GFC_INTEGER_4 b)
+{
+  GFC_INTEGER_16 pow, x;
+  GFC_INTEGER_4 n, u;
+  
+  n = b;
+  x = a;
+  pow = 1;
+  if (n != 0)
+    {
+      if (n < 0)
+       {
+         if (x == 1)
+           return 1;
+         if (x == -1)
+           return (n & 1) ? -1 : 1;
+         return (x == 0) ? 1 / x : 0;
+       }
+      u = n;
+      for (;;)
+       {
+         if (u & 1)
+           pow *= x;
+         u >>= 1;
+         if (u)
+           x *= x;
+         else
+           break;
+       }
+    }
+  return pow;
+}
+
+#endif
diff --git a/libgfortran/generated/pow_i16_i8.c b/libgfortran/generated/pow_i16_i8.c
new file mode 100644 (file)
index 0000000..d184951
--- /dev/null
@@ -0,0 +1,78 @@
+/* Support routines for the intrinsic power (**) operator.
+   Copyright 2004 Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+   a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+   Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+   of Computer Programming", 3rd Edition, 1998.  */
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_8)
+
+GFC_INTEGER_16 pow_i16_i8 (GFC_INTEGER_16 a, GFC_INTEGER_8 b);
+export_proto(pow_i16_i8);
+
+GFC_INTEGER_16
+pow_i16_i8 (GFC_INTEGER_16 a, GFC_INTEGER_8 b)
+{
+  GFC_INTEGER_16 pow, x;
+  GFC_INTEGER_8 n, u;
+  
+  n = b;
+  x = a;
+  pow = 1;
+  if (n != 0)
+    {
+      if (n < 0)
+       {
+         if (x == 1)
+           return 1;
+         if (x == -1)
+           return (n & 1) ? -1 : 1;
+         return (x == 0) ? 1 / x : 0;
+       }
+      u = n;
+      for (;;)
+       {
+         if (u & 1)
+           pow *= x;
+         u >>= 1;
+         if (u)
+           x *= x;
+         else
+           break;
+       }
+    }
+  return pow;
+}
+
+#endif
diff --git a/libgfortran/generated/pow_i4_i16.c b/libgfortran/generated/pow_i4_i16.c
new file mode 100644 (file)
index 0000000..f515f80
--- /dev/null
@@ -0,0 +1,78 @@
+/* Support routines for the intrinsic power (**) operator.
+   Copyright 2004 Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+   a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+   Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+   of Computer Programming", 3rd Edition, 1998.  */
+
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16)
+
+GFC_INTEGER_4 pow_i4_i16 (GFC_INTEGER_4 a, GFC_INTEGER_16 b);
+export_proto(pow_i4_i16);
+
+GFC_INTEGER_4
+pow_i4_i16 (GFC_INTEGER_4 a, GFC_INTEGER_16 b)
+{
+  GFC_INTEGER_4 pow, x;
+  GFC_INTEGER_16 n, u;
+  
+  n = b;
+  x = a;
+  pow = 1;
+  if (n != 0)
+    {
+      if (n < 0)
+       {
+         if (x == 1)
+           return 1;
+         if (x == -1)
+           return (n & 1) ? -1 : 1;
+         return (x == 0) ? 1 / x : 0;
+       }
+      u = n;
+      for (;;)
+       {
+         if (u & 1)
+           pow *= x;
+         u >>= 1;
+         if (u)
+           x *= x;
+         else
+           break;
+       }
+    }
+  return pow;
+}
+
+#endif
index 86b49f7..184fe6d 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
    Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
    of Computer Programming", 3rd Edition, 1998.  */
 
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
 GFC_INTEGER_4 pow_i4_i4 (GFC_INTEGER_4 a, GFC_INTEGER_4 b);
 export_proto(pow_i4_i4);
 
@@ -72,3 +74,5 @@ pow_i4_i4 (GFC_INTEGER_4 a, GFC_INTEGER_4 b)
     }
   return pow;
 }
+
+#endif
index 5353f78..ae24ceb 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
    Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
    of Computer Programming", 3rd Edition, 1998.  */
 
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8)
+
 GFC_INTEGER_4 pow_i4_i8 (GFC_INTEGER_4 a, GFC_INTEGER_8 b);
 export_proto(pow_i4_i8);
 
@@ -72,3 +74,5 @@ pow_i4_i8 (GFC_INTEGER_4 a, GFC_INTEGER_8 b)
     }
   return pow;
 }
+
+#endif
diff --git a/libgfortran/generated/pow_i8_i16.c b/libgfortran/generated/pow_i8_i16.c
new file mode 100644 (file)
index 0000000..456c28a
--- /dev/null
@@ -0,0 +1,78 @@
+/* Support routines for the intrinsic power (**) operator.
+   Copyright 2004 Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+   a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+   Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+   of Computer Programming", 3rd Edition, 1998.  */
+
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16)
+
+GFC_INTEGER_8 pow_i8_i16 (GFC_INTEGER_8 a, GFC_INTEGER_16 b);
+export_proto(pow_i8_i16);
+
+GFC_INTEGER_8
+pow_i8_i16 (GFC_INTEGER_8 a, GFC_INTEGER_16 b)
+{
+  GFC_INTEGER_8 pow, x;
+  GFC_INTEGER_16 n, u;
+  
+  n = b;
+  x = a;
+  pow = 1;
+  if (n != 0)
+    {
+      if (n < 0)
+       {
+         if (x == 1)
+           return 1;
+         if (x == -1)
+           return (n & 1) ? -1 : 1;
+         return (x == 0) ? 1 / x : 0;
+       }
+      u = n;
+      for (;;)
+       {
+         if (u & 1)
+           pow *= x;
+         u >>= 1;
+         if (u)
+           x *= x;
+         else
+           break;
+       }
+    }
+  return pow;
+}
+
+#endif
index e0b6320..8f85a80 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
    Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
    of Computer Programming", 3rd Edition, 1998.  */
 
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_4)
+
 GFC_INTEGER_8 pow_i8_i4 (GFC_INTEGER_8 a, GFC_INTEGER_4 b);
 export_proto(pow_i8_i4);
 
@@ -72,3 +74,5 @@ pow_i8_i4 (GFC_INTEGER_8 a, GFC_INTEGER_4 b)
     }
   return pow;
 }
+
+#endif
index 5468259..8c8f52e 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
    Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
    of Computer Programming", 3rd Edition, 1998.  */
 
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
+
 GFC_INTEGER_8 pow_i8_i8 (GFC_INTEGER_8 a, GFC_INTEGER_8 b);
 export_proto(pow_i8_i8);
 
@@ -72,3 +74,5 @@ pow_i8_i8 (GFC_INTEGER_8 a, GFC_INTEGER_8 b)
     }
   return pow;
 }
+
+#endif
diff --git a/libgfortran/generated/pow_r10_i16.c b/libgfortran/generated/pow_r10_i16.c
new file mode 100644 (file)
index 0000000..ad73664
--- /dev/null
@@ -0,0 +1,76 @@
+/* Support routines for the intrinsic power (**) operator.
+   Copyright 2004 Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+   a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+   Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+   of Computer Programming", 3rd Edition, 1998.  */
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_16)
+
+GFC_REAL_10 pow_r10_i16 (GFC_REAL_10 a, GFC_INTEGER_16 b);
+export_proto(pow_r10_i16);
+
+GFC_REAL_10
+pow_r10_i16 (GFC_REAL_10 a, GFC_INTEGER_16 b)
+{
+  GFC_REAL_10 pow, x;
+  GFC_INTEGER_16 n, u;
+  
+  n = b;
+  x = a;
+  pow = 1;
+  if (n != 0)
+    {
+      if (n < 0)
+       {
+
+         n = -n;
+         x = pow / x;
+       }
+      u = n;
+      for (;;)
+       {
+         if (u & 1)
+           pow *= x;
+         u >>= 1;
+         if (u)
+           x *= x;
+         else
+           break;
+       }
+    }
+  return pow;
+}
+
+#endif
diff --git a/libgfortran/generated/pow_r10_i4.c b/libgfortran/generated/pow_r10_i4.c
new file mode 100644 (file)
index 0000000..3f23732
--- /dev/null
@@ -0,0 +1,76 @@
+/* Support routines for the intrinsic power (**) operator.
+   Copyright 2004 Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+   a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+   Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+   of Computer Programming", 3rd Edition, 1998.  */
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_4)
+
+GFC_REAL_10 pow_r10_i4 (GFC_REAL_10 a, GFC_INTEGER_4 b);
+export_proto(pow_r10_i4);
+
+GFC_REAL_10
+pow_r10_i4 (GFC_REAL_10 a, GFC_INTEGER_4 b)
+{
+  GFC_REAL_10 pow, x;
+  GFC_INTEGER_4 n, u;
+  
+  n = b;
+  x = a;
+  pow = 1;
+  if (n != 0)
+    {
+      if (n < 0)
+       {
+
+         n = -n;
+         x = pow / x;
+       }
+      u = n;
+      for (;;)
+       {
+         if (u & 1)
+           pow *= x;
+         u >>= 1;
+         if (u)
+           x *= x;
+         else
+           break;
+       }
+    }
+  return pow;
+}
+
+#endif
diff --git a/libgfortran/generated/pow_r10_i8.c b/libgfortran/generated/pow_r10_i8.c
new file mode 100644 (file)
index 0000000..2e99c60
--- /dev/null
@@ -0,0 +1,76 @@
+/* Support routines for the intrinsic power (**) operator.
+   Copyright 2004 Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+   a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+   Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+   of Computer Programming", 3rd Edition, 1998.  */
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_8)
+
+GFC_REAL_10 pow_r10_i8 (GFC_REAL_10 a, GFC_INTEGER_8 b);
+export_proto(pow_r10_i8);
+
+GFC_REAL_10
+pow_r10_i8 (GFC_REAL_10 a, GFC_INTEGER_8 b)
+{
+  GFC_REAL_10 pow, x;
+  GFC_INTEGER_8 n, u;
+  
+  n = b;
+  x = a;
+  pow = 1;
+  if (n != 0)
+    {
+      if (n < 0)
+       {
+
+         n = -n;
+         x = pow / x;
+       }
+      u = n;
+      for (;;)
+       {
+         if (u & 1)
+           pow *= x;
+         u >>= 1;
+         if (u)
+           x *= x;
+         else
+           break;
+       }
+    }
+  return pow;
+}
+
+#endif
diff --git a/libgfortran/generated/pow_r16_i16.c b/libgfortran/generated/pow_r16_i16.c
new file mode 100644 (file)
index 0000000..63d6fa8
--- /dev/null
@@ -0,0 +1,76 @@
+/* Support routines for the intrinsic power (**) operator.
+   Copyright 2004 Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+   a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+   Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+   of Computer Programming", 3rd Edition, 1998.  */
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_16)
+
+GFC_REAL_16 pow_r16_i16 (GFC_REAL_16 a, GFC_INTEGER_16 b);
+export_proto(pow_r16_i16);
+
+GFC_REAL_16
+pow_r16_i16 (GFC_REAL_16 a, GFC_INTEGER_16 b)
+{
+  GFC_REAL_16 pow, x;
+  GFC_INTEGER_16 n, u;
+  
+  n = b;
+  x = a;
+  pow = 1;
+  if (n != 0)
+    {
+      if (n < 0)
+       {
+
+         n = -n;
+         x = pow / x;
+       }
+      u = n;
+      for (;;)
+       {
+         if (u & 1)
+           pow *= x;
+         u >>= 1;
+         if (u)
+           x *= x;
+         else
+           break;
+       }
+    }
+  return pow;
+}
+
+#endif
diff --git a/libgfortran/generated/pow_r16_i4.c b/libgfortran/generated/pow_r16_i4.c
new file mode 100644 (file)
index 0000000..949f237
--- /dev/null
@@ -0,0 +1,76 @@
+/* Support routines for the intrinsic power (**) operator.
+   Copyright 2004 Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+   a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+   Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+   of Computer Programming", 3rd Edition, 1998.  */
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_4)
+
+GFC_REAL_16 pow_r16_i4 (GFC_REAL_16 a, GFC_INTEGER_4 b);
+export_proto(pow_r16_i4);
+
+GFC_REAL_16
+pow_r16_i4 (GFC_REAL_16 a, GFC_INTEGER_4 b)
+{
+  GFC_REAL_16 pow, x;
+  GFC_INTEGER_4 n, u;
+  
+  n = b;
+  x = a;
+  pow = 1;
+  if (n != 0)
+    {
+      if (n < 0)
+       {
+
+         n = -n;
+         x = pow / x;
+       }
+      u = n;
+      for (;;)
+       {
+         if (u & 1)
+           pow *= x;
+         u >>= 1;
+         if (u)
+           x *= x;
+         else
+           break;
+       }
+    }
+  return pow;
+}
+
+#endif
diff --git a/libgfortran/generated/pow_r16_i8.c b/libgfortran/generated/pow_r16_i8.c
new file mode 100644 (file)
index 0000000..37649d8
--- /dev/null
@@ -0,0 +1,76 @@
+/* Support routines for the intrinsic power (**) operator.
+   Copyright 2004 Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+   a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+   Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+   of Computer Programming", 3rd Edition, 1998.  */
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_8)
+
+GFC_REAL_16 pow_r16_i8 (GFC_REAL_16 a, GFC_INTEGER_8 b);
+export_proto(pow_r16_i8);
+
+GFC_REAL_16
+pow_r16_i8 (GFC_REAL_16 a, GFC_INTEGER_8 b)
+{
+  GFC_REAL_16 pow, x;
+  GFC_INTEGER_8 n, u;
+  
+  n = b;
+  x = a;
+  pow = 1;
+  if (n != 0)
+    {
+      if (n < 0)
+       {
+
+         n = -n;
+         x = pow / x;
+       }
+      u = n;
+      for (;;)
+       {
+         if (u & 1)
+           pow *= x;
+         u >>= 1;
+         if (u)
+           x *= x;
+         else
+           break;
+       }
+    }
+  return pow;
+}
+
+#endif
diff --git a/libgfortran/generated/pow_r4_i16.c b/libgfortran/generated/pow_r4_i16.c
new file mode 100644 (file)
index 0000000..635e627
--- /dev/null
@@ -0,0 +1,76 @@
+/* Support routines for the intrinsic power (**) operator.
+   Copyright 2004 Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+   a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+   Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+   of Computer Programming", 3rd Edition, 1998.  */
+
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_16)
+
+GFC_REAL_4 pow_r4_i16 (GFC_REAL_4 a, GFC_INTEGER_16 b);
+export_proto(pow_r4_i16);
+
+GFC_REAL_4
+pow_r4_i16 (GFC_REAL_4 a, GFC_INTEGER_16 b)
+{
+  GFC_REAL_4 pow, x;
+  GFC_INTEGER_16 n, u;
+  
+  n = b;
+  x = a;
+  pow = 1;
+  if (n != 0)
+    {
+      if (n < 0)
+       {
+
+         n = -n;
+         x = pow / x;
+       }
+      u = n;
+      for (;;)
+       {
+         if (u & 1)
+           pow *= x;
+         u >>= 1;
+         if (u)
+           x *= x;
+         else
+           break;
+       }
+    }
+  return pow;
+}
+
+#endif
index 48c4f42..ff0045f 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
    Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
    of Computer Programming", 3rd Edition, 1998.  */
 
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_4)
+
 GFC_REAL_4 pow_r4_i4 (GFC_REAL_4 a, GFC_INTEGER_4 b);
 export_proto(pow_r4_i4);
 
@@ -70,3 +72,5 @@ pow_r4_i4 (GFC_REAL_4 a, GFC_INTEGER_4 b)
     }
   return pow;
 }
+
+#endif
index f5a8ba2..8c6b2ba 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
    Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
    of Computer Programming", 3rd Edition, 1998.  */
 
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_8)
+
 GFC_REAL_4 pow_r4_i8 (GFC_REAL_4 a, GFC_INTEGER_8 b);
 export_proto(pow_r4_i8);
 
@@ -70,3 +72,5 @@ pow_r4_i8 (GFC_REAL_4 a, GFC_INTEGER_8 b)
     }
   return pow;
 }
+
+#endif
diff --git a/libgfortran/generated/pow_r8_i16.c b/libgfortran/generated/pow_r8_i16.c
new file mode 100644 (file)
index 0000000..9fdcf75
--- /dev/null
@@ -0,0 +1,76 @@
+/* Support routines for the intrinsic power (**) operator.
+   Copyright 2004 Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+/* Use Binary Method to calculate the powi. This is not an optimal but
+   a simple and reasonable arithmetic. See section 4.6.3, "Evaluation of
+   Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
+   of Computer Programming", 3rd Edition, 1998.  */
+
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_16)
+
+GFC_REAL_8 pow_r8_i16 (GFC_REAL_8 a, GFC_INTEGER_16 b);
+export_proto(pow_r8_i16);
+
+GFC_REAL_8
+pow_r8_i16 (GFC_REAL_8 a, GFC_INTEGER_16 b)
+{
+  GFC_REAL_8 pow, x;
+  GFC_INTEGER_16 n, u;
+  
+  n = b;
+  x = a;
+  pow = 1;
+  if (n != 0)
+    {
+      if (n < 0)
+       {
+
+         n = -n;
+         x = pow / x;
+       }
+      u = n;
+      for (;;)
+       {
+         if (u & 1)
+           pow *= x;
+         u >>= 1;
+         if (u)
+           x *= x;
+         else
+           break;
+       }
+    }
+  return pow;
+}
+
+#endif
index 20622c6..a6afcbe 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
    Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
    of Computer Programming", 3rd Edition, 1998.  */
 
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_4)
+
 GFC_REAL_8 pow_r8_i4 (GFC_REAL_8 a, GFC_INTEGER_4 b);
 export_proto(pow_r8_i4);
 
@@ -70,3 +72,5 @@ pow_r8_i4 (GFC_REAL_8 a, GFC_INTEGER_4 b)
     }
   return pow;
 }
+
+#endif
index 3f6002d..3b650f2 100644 (file)
@@ -36,6 +36,8 @@ Boston, MA 02110-1301, USA.  */
    Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
    of Computer Programming", 3rd Edition, 1998.  */
 
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_8)
+
 GFC_REAL_8 pow_r8_i8 (GFC_REAL_8 a, GFC_INTEGER_8 b);
 export_proto(pow_r8_i8);
 
@@ -70,3 +72,5 @@ pow_r8_i8 (GFC_REAL_8 a, GFC_INTEGER_8 b)
     }
   return pow;
 }
+
+#endif
diff --git a/libgfortran/generated/product_c10.c b/libgfortran/generated/product_c10.c
new file mode 100644 (file)
index 0000000..0313c71
--- /dev/null
@@ -0,0 +1,334 @@
+/* Implementation of the PRODUCT intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_COMPLEX_10) && defined (HAVE_GFC_COMPLEX_10)
+
+
+extern void product_c10 (gfc_array_c10 *, gfc_array_c10 *, index_type *);
+export_proto(product_c10);
+
+void
+product_c10 (gfc_array_c10 *retarray, gfc_array_c10 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_COMPLEX_10 *base;
+  GFC_COMPLEX_10 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_COMPLEX_10)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_COMPLEX_10 *src;
+      GFC_COMPLEX_10 result;
+      src = base;
+      {
+
+  result = 1;
+        if (len <= 0)
+         *dest = 1;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  result *= *src;
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mproduct_c10 (gfc_array_c10 *, gfc_array_c10 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mproduct_c10);
+
+void
+mproduct_c10 (gfc_array_c10 * retarray, gfc_array_c10 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_COMPLEX_10 *dest;
+  GFC_COMPLEX_10 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_COMPLEX_10)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_COMPLEX_10 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_COMPLEX_10 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = 1;
+        if (len <= 0)
+         *dest = 1;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc)
+    result *= *src;
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/product_c16.c b/libgfortran/generated/product_c16.c
new file mode 100644 (file)
index 0000000..866ed45
--- /dev/null
@@ -0,0 +1,334 @@
+/* Implementation of the PRODUCT intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_COMPLEX_16) && defined (HAVE_GFC_COMPLEX_16)
+
+
+extern void product_c16 (gfc_array_c16 *, gfc_array_c16 *, index_type *);
+export_proto(product_c16);
+
+void
+product_c16 (gfc_array_c16 *retarray, gfc_array_c16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_COMPLEX_16 *base;
+  GFC_COMPLEX_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_COMPLEX_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_COMPLEX_16 *src;
+      GFC_COMPLEX_16 result;
+      src = base;
+      {
+
+  result = 1;
+        if (len <= 0)
+         *dest = 1;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  result *= *src;
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mproduct_c16 (gfc_array_c16 *, gfc_array_c16 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mproduct_c16);
+
+void
+mproduct_c16 (gfc_array_c16 * retarray, gfc_array_c16 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_COMPLEX_16 *dest;
+  GFC_COMPLEX_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_COMPLEX_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_COMPLEX_16 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_COMPLEX_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = 1;
+        if (len <= 0)
+         *dest = 1;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc)
+    result *= *src;
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index e2bae08..42fb1ed 100644 (file)
@@ -34,6 +34,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_COMPLEX_4) && defined (HAVE_GFC_COMPLEX_4)
+
+
 extern void product_c4 (gfc_array_c4 *, gfc_array_c4 *, index_type *);
 export_proto(product_c4);
 
@@ -328,3 +331,4 @@ mproduct_c4 (gfc_array_c4 * retarray, gfc_array_c4 * array,
     }
 }
 
+#endif
index a5dee48..c554c51 100644 (file)
@@ -34,6 +34,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_COMPLEX_8) && defined (HAVE_GFC_COMPLEX_8)
+
+
 extern void product_c8 (gfc_array_c8 *, gfc_array_c8 *, index_type *);
 export_proto(product_c8);
 
@@ -328,3 +331,4 @@ mproduct_c8 (gfc_array_c8 * retarray, gfc_array_c8 * array,
     }
 }
 
+#endif
diff --git a/libgfortran/generated/product_i16.c b/libgfortran/generated/product_i16.c
new file mode 100644 (file)
index 0000000..3c2aa9e
--- /dev/null
@@ -0,0 +1,334 @@
+/* Implementation of the PRODUCT intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void product_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *);
+export_proto(product_i16);
+
+void
+product_i16 (gfc_array_i16 *retarray, gfc_array_i16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_INTEGER_16 *src;
+      GFC_INTEGER_16 result;
+      src = base;
+      {
+
+  result = 1;
+        if (len <= 0)
+         *dest = 1;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  result *= *src;
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mproduct_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mproduct_i16);
+
+void
+mproduct_i16 (gfc_array_i16 * retarray, gfc_array_i16 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *dest;
+  GFC_INTEGER_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_INTEGER_16 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = 1;
+        if (len <= 0)
+         *dest = 1;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc)
+    result *= *src;
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index acc6886..3620d8d 100644 (file)
@@ -34,6 +34,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
+
 extern void product_i4 (gfc_array_i4 *, gfc_array_i4 *, index_type *);
 export_proto(product_i4);
 
@@ -328,3 +331,4 @@ mproduct_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array,
     }
 }
 
+#endif
index d41269b..65b0bb0 100644 (file)
@@ -34,6 +34,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
+
+
 extern void product_i8 (gfc_array_i8 *, gfc_array_i8 *, index_type *);
 export_proto(product_i8);
 
@@ -328,3 +331,4 @@ mproduct_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array,
     }
 }
 
+#endif
diff --git a/libgfortran/generated/product_r10.c b/libgfortran/generated/product_r10.c
new file mode 100644 (file)
index 0000000..292bbaa
--- /dev/null
@@ -0,0 +1,334 @@
+/* Implementation of the PRODUCT intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_REAL_10)
+
+
+extern void product_r10 (gfc_array_r10 *, gfc_array_r10 *, index_type *);
+export_proto(product_r10);
+
+void
+product_r10 (gfc_array_r10 *retarray, gfc_array_r10 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_10 *base;
+  GFC_REAL_10 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_REAL_10)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_REAL_10 *src;
+      GFC_REAL_10 result;
+      src = base;
+      {
+
+  result = 1;
+        if (len <= 0)
+         *dest = 1;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  result *= *src;
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mproduct_r10 (gfc_array_r10 *, gfc_array_r10 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mproduct_r10);
+
+void
+mproduct_r10 (gfc_array_r10 * retarray, gfc_array_r10 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_10 *dest;
+  GFC_REAL_10 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_REAL_10)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_REAL_10 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_REAL_10 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = 1;
+        if (len <= 0)
+         *dest = 1;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc)
+    result *= *src;
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/product_r16.c b/libgfortran/generated/product_r16.c
new file mode 100644 (file)
index 0000000..f0a2c98
--- /dev/null
@@ -0,0 +1,334 @@
+/* Implementation of the PRODUCT intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_REAL_16)
+
+
+extern void product_r16 (gfc_array_r16 *, gfc_array_r16 *, index_type *);
+export_proto(product_r16);
+
+void
+product_r16 (gfc_array_r16 *retarray, gfc_array_r16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_16 *base;
+  GFC_REAL_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_REAL_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_REAL_16 *src;
+      GFC_REAL_16 result;
+      src = base;
+      {
+
+  result = 1;
+        if (len <= 0)
+         *dest = 1;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  result *= *src;
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void mproduct_r16 (gfc_array_r16 *, gfc_array_r16 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(mproduct_r16);
+
+void
+mproduct_r16 (gfc_array_r16 * retarray, gfc_array_r16 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_16 *dest;
+  GFC_REAL_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_REAL_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_REAL_16 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_REAL_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = 1;
+        if (len <= 0)
+         *dest = 1;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc)
+    result *= *src;
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index 46814d7..6ca9ff8 100644 (file)
@@ -34,6 +34,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_REAL_4)
+
+
 extern void product_r4 (gfc_array_r4 *, gfc_array_r4 *, index_type *);
 export_proto(product_r4);
 
@@ -328,3 +331,4 @@ mproduct_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array,
     }
 }
 
+#endif
index 891ca5d..d73ccc7 100644 (file)
@@ -34,6 +34,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_REAL_8)
+
+
 extern void product_r8 (gfc_array_r8 *, gfc_array_r8 *, index_type *);
 export_proto(product_r8);
 
@@ -328,3 +331,4 @@ mproduct_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array,
     }
 }
 
+#endif
diff --git a/libgfortran/generated/reshape_c10.c b/libgfortran/generated/reshape_c10.c
new file mode 100644 (file)
index 0000000..30988e8
--- /dev/null
@@ -0,0 +1,262 @@
+/* Implementation of the RESHAPE
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+
+typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
+
+/* The shape parameter is ignored. We can currently deduce the shape from the
+   return array.  */
+
+extern void reshape_c10 (gfc_array_c10 *, gfc_array_c10 *, shape_type *,
+                                   gfc_array_c10 *, shape_type *);
+export_proto(reshape_c10);
+
+void
+reshape_c10 (gfc_array_c10 * ret, gfc_array_c10 * source, shape_type * shape,
+                      gfc_array_c10 * pad, shape_type * order)
+{
+  /* r.* indicates the return array.  */
+  index_type rcount[GFC_MAX_DIMENSIONS];
+  index_type rextent[GFC_MAX_DIMENSIONS];
+  index_type rstride[GFC_MAX_DIMENSIONS];
+  index_type rstride0;
+  index_type rdim;
+  index_type rsize;
+  index_type rs;
+  index_type rex;
+  GFC_COMPLEX_10 *rptr;
+  /* s.* indicates the source array.  */
+  index_type scount[GFC_MAX_DIMENSIONS];
+  index_type sextent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type sstride0;
+  index_type sdim;
+  index_type ssize;
+  const GFC_COMPLEX_10 *sptr;
+  /* p.* indicates the pad array.  */
+  index_type pcount[GFC_MAX_DIMENSIONS];
+  index_type pextent[GFC_MAX_DIMENSIONS];
+  index_type pstride[GFC_MAX_DIMENSIONS];
+  index_type pdim;
+  index_type psize;
+  const GFC_COMPLEX_10 *pptr;
+
+  const GFC_COMPLEX_10 *src;
+  int n;
+  int dim;
+
+  if (source->dim[0].stride == 0)
+    source->dim[0].stride = 1;
+  if (shape->dim[0].stride == 0)
+    shape->dim[0].stride = 1;
+  if (pad && pad->dim[0].stride == 0)
+    pad->dim[0].stride = 1;
+  if (order && order->dim[0].stride == 0)
+    order->dim[0].stride = 1;
+
+  if (ret->data == NULL)
+    {
+      rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+      rs = 1;
+      for (n=0; n < rdim; n++)
+       {
+         ret->dim[n].lbound = 0;
+         rex = shape->data[n * shape->dim[0].stride];
+         ret->dim[n].ubound =  rex - 1;
+         ret->dim[n].stride = rs;
+         rs *= rex;
+       }
+      ret->offset = 0;
+      ret->data = internal_malloc_size ( rs * sizeof (GFC_COMPLEX_10));
+      ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim;
+    }
+  else
+    {
+      rdim = GFC_DESCRIPTOR_RANK (ret);
+      if (ret->dim[0].stride == 0)
+       ret->dim[0].stride = 1;
+    }
+
+  rsize = 1;
+  for (n = 0; n < rdim; n++)
+    {
+      if (order)
+        dim = order->data[n * order->dim[0].stride] - 1;
+      else
+        dim = n;
+
+      rcount[n] = 0;
+      rstride[n] = ret->dim[dim].stride;
+      rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+
+      if (rextent[n] != shape->data[dim * shape->dim[0].stride])
+        runtime_error ("shape and target do not conform");
+
+      if (rsize == rstride[n])
+        rsize *= rextent[n];
+      else
+        rsize = 0;
+      if (rextent[n] <= 0)
+        return;
+    }
+
+  sdim = GFC_DESCRIPTOR_RANK (source);
+  ssize = 1;
+  for (n = 0; n < sdim; n++)
+    {
+      scount[n] = 0;
+      sstride[n] = source->dim[n].stride;
+      sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+      if (sextent[n] <= 0)
+        abort ();
+
+      if (ssize == sstride[n])
+        ssize *= sextent[n];
+      else
+        ssize = 0;
+    }
+
+  if (pad)
+    {
+      pdim = GFC_DESCRIPTOR_RANK (pad);
+      psize = 1;
+      for (n = 0; n < pdim; n++)
+        {
+          pcount[n] = 0;
+          pstride[n] = pad->dim[n].stride;
+          pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
+          if (pextent[n] <= 0)
+            abort ();
+          if (psize == pstride[n])
+            psize *= pextent[n];
+          else
+            psize = 0;
+        }
+      pptr = pad->data;
+    }
+  else
+    {
+      pdim = 0;
+      psize = 1;
+      pptr = NULL;
+    }
+
+  if (rsize != 0 && ssize != 0 && psize != 0)
+    {
+      rsize *= sizeof (GFC_COMPLEX_10);
+      ssize *= sizeof (GFC_COMPLEX_10);
+      psize *= sizeof (GFC_COMPLEX_10);
+      reshape_packed ((char *)ret->data, rsize, (char *)source->data,
+                     ssize, pad ? (char *)pad->data : NULL, psize);
+      return;
+    }
+  rptr = ret->data;
+  src = sptr = source->data;
+  rstride0 = rstride[0];
+  sstride0 = sstride[0];
+
+  while (rptr)
+    {
+      /* Select between the source and pad arrays.  */
+      *rptr = *src;
+      /* Advance to the next element.  */
+      rptr += rstride0;
+      src += sstride0;
+      rcount[0]++;
+      scount[0]++;
+      /* Advance to the next destination element.  */
+      n = 0;
+      while (rcount[n] == rextent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          rcount[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          rptr -= rstride[n] * rextent[n];
+          n++;
+          if (n == rdim)
+            {
+              /* Break out of the loop.  */
+              rptr = NULL;
+              break;
+            }
+          else
+            {
+              rcount[n]++;
+              rptr += rstride[n];
+            }
+        }
+      /* Advance to the next source element.  */
+      n = 0;
+      while (scount[n] == sextent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          scount[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          src -= sstride[n] * sextent[n];
+          n++;
+          if (n == sdim)
+            {
+              if (sptr && pad)
+                {
+                  /* Switch to the pad array.  */
+                  sptr = NULL;
+                  sdim = pdim;
+                  for (dim = 0; dim < pdim; dim++)
+                    {
+                      scount[dim] = pcount[dim];
+                      sextent[dim] = pextent[dim];
+                      sstride[dim] = pstride[dim];
+                      sstride0 = sstride[0];
+                    }
+                }
+              /* We now start again from the beginning of the pad array.  */
+              src = pptr;
+              break;
+            }
+          else
+            {
+              scount[n]++;
+              src += sstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/reshape_c16.c b/libgfortran/generated/reshape_c16.c
new file mode 100644 (file)
index 0000000..1c238de
--- /dev/null
@@ -0,0 +1,262 @@
+/* Implementation of the RESHAPE
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+
+typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
+
+/* The shape parameter is ignored. We can currently deduce the shape from the
+   return array.  */
+
+extern void reshape_c16 (gfc_array_c16 *, gfc_array_c16 *, shape_type *,
+                                   gfc_array_c16 *, shape_type *);
+export_proto(reshape_c16);
+
+void
+reshape_c16 (gfc_array_c16 * ret, gfc_array_c16 * source, shape_type * shape,
+                      gfc_array_c16 * pad, shape_type * order)
+{
+  /* r.* indicates the return array.  */
+  index_type rcount[GFC_MAX_DIMENSIONS];
+  index_type rextent[GFC_MAX_DIMENSIONS];
+  index_type rstride[GFC_MAX_DIMENSIONS];
+  index_type rstride0;
+  index_type rdim;
+  index_type rsize;
+  index_type rs;
+  index_type rex;
+  GFC_COMPLEX_16 *rptr;
+  /* s.* indicates the source array.  */
+  index_type scount[GFC_MAX_DIMENSIONS];
+  index_type sextent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type sstride0;
+  index_type sdim;
+  index_type ssize;
+  const GFC_COMPLEX_16 *sptr;
+  /* p.* indicates the pad array.  */
+  index_type pcount[GFC_MAX_DIMENSIONS];
+  index_type pextent[GFC_MAX_DIMENSIONS];
+  index_type pstride[GFC_MAX_DIMENSIONS];
+  index_type pdim;
+  index_type psize;
+  const GFC_COMPLEX_16 *pptr;
+
+  const GFC_COMPLEX_16 *src;
+  int n;
+  int dim;
+
+  if (source->dim[0].stride == 0)
+    source->dim[0].stride = 1;
+  if (shape->dim[0].stride == 0)
+    shape->dim[0].stride = 1;
+  if (pad && pad->dim[0].stride == 0)
+    pad->dim[0].stride = 1;
+  if (order && order->dim[0].stride == 0)
+    order->dim[0].stride = 1;
+
+  if (ret->data == NULL)
+    {
+      rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+      rs = 1;
+      for (n=0; n < rdim; n++)
+       {
+         ret->dim[n].lbound = 0;
+         rex = shape->data[n * shape->dim[0].stride];
+         ret->dim[n].ubound =  rex - 1;
+         ret->dim[n].stride = rs;
+         rs *= rex;
+       }
+      ret->offset = 0;
+      ret->data = internal_malloc_size ( rs * sizeof (GFC_COMPLEX_16));
+      ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim;
+    }
+  else
+    {
+      rdim = GFC_DESCRIPTOR_RANK (ret);
+      if (ret->dim[0].stride == 0)
+       ret->dim[0].stride = 1;
+    }
+
+  rsize = 1;
+  for (n = 0; n < rdim; n++)
+    {
+      if (order)
+        dim = order->data[n * order->dim[0].stride] - 1;
+      else
+        dim = n;
+
+      rcount[n] = 0;
+      rstride[n] = ret->dim[dim].stride;
+      rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+
+      if (rextent[n] != shape->data[dim * shape->dim[0].stride])
+        runtime_error ("shape and target do not conform");
+
+      if (rsize == rstride[n])
+        rsize *= rextent[n];
+      else
+        rsize = 0;
+      if (rextent[n] <= 0)
+        return;
+    }
+
+  sdim = GFC_DESCRIPTOR_RANK (source);
+  ssize = 1;
+  for (n = 0; n < sdim; n++)
+    {
+      scount[n] = 0;
+      sstride[n] = source->dim[n].stride;
+      sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+      if (sextent[n] <= 0)
+        abort ();
+
+      if (ssize == sstride[n])
+        ssize *= sextent[n];
+      else
+        ssize = 0;
+    }
+
+  if (pad)
+    {
+      pdim = GFC_DESCRIPTOR_RANK (pad);
+      psize = 1;
+      for (n = 0; n < pdim; n++)
+        {
+          pcount[n] = 0;
+          pstride[n] = pad->dim[n].stride;
+          pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
+          if (pextent[n] <= 0)
+            abort ();
+          if (psize == pstride[n])
+            psize *= pextent[n];
+          else
+            psize = 0;
+        }
+      pptr = pad->data;
+    }
+  else
+    {
+      pdim = 0;
+      psize = 1;
+      pptr = NULL;
+    }
+
+  if (rsize != 0 && ssize != 0 && psize != 0)
+    {
+      rsize *= sizeof (GFC_COMPLEX_16);
+      ssize *= sizeof (GFC_COMPLEX_16);
+      psize *= sizeof (GFC_COMPLEX_16);
+      reshape_packed ((char *)ret->data, rsize, (char *)source->data,
+                     ssize, pad ? (char *)pad->data : NULL, psize);
+      return;
+    }
+  rptr = ret->data;
+  src = sptr = source->data;
+  rstride0 = rstride[0];
+  sstride0 = sstride[0];
+
+  while (rptr)
+    {
+      /* Select between the source and pad arrays.  */
+      *rptr = *src;
+      /* Advance to the next element.  */
+      rptr += rstride0;
+      src += sstride0;
+      rcount[0]++;
+      scount[0]++;
+      /* Advance to the next destination element.  */
+      n = 0;
+      while (rcount[n] == rextent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          rcount[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          rptr -= rstride[n] * rextent[n];
+          n++;
+          if (n == rdim)
+            {
+              /* Break out of the loop.  */
+              rptr = NULL;
+              break;
+            }
+          else
+            {
+              rcount[n]++;
+              rptr += rstride[n];
+            }
+        }
+      /* Advance to the next source element.  */
+      n = 0;
+      while (scount[n] == sextent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          scount[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          src -= sstride[n] * sextent[n];
+          n++;
+          if (n == sdim)
+            {
+              if (sptr && pad)
+                {
+                  /* Switch to the pad array.  */
+                  sptr = NULL;
+                  sdim = pdim;
+                  for (dim = 0; dim < pdim; dim++)
+                    {
+                      scount[dim] = pcount[dim];
+                      sextent[dim] = pextent[dim];
+                      sstride[dim] = pstride[dim];
+                      sstride0 = sstride[0];
+                    }
+                }
+              /* We now start again from the beginning of the pad array.  */
+              src = pptr;
+              break;
+            }
+          else
+            {
+              scount[n]++;
+              src += sstride[n];
+            }
+        }
+    }
+}
+
+#endif
index f1be185..4416b90 100644 (file)
@@ -33,6 +33,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_COMPLEX_4)
+
 typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
 
 /* The shape parameter is ignored. We can currently deduce the shape from the
@@ -256,3 +258,5 @@ reshape_c4 (gfc_array_c4 * ret, gfc_array_c4 * source, shape_type * shape,
         }
     }
 }
+
+#endif
index 7d853f6..425c6eb 100644 (file)
@@ -33,6 +33,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_COMPLEX_8)
+
 typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
 
 /* The shape parameter is ignored. We can currently deduce the shape from the
@@ -256,3 +258,5 @@ reshape_c8 (gfc_array_c8 * ret, gfc_array_c8 * source, shape_type * shape,
         }
     }
 }
+
+#endif
diff --git a/libgfortran/generated/reshape_i16.c b/libgfortran/generated/reshape_i16.c
new file mode 100644 (file)
index 0000000..2d793e2
--- /dev/null
@@ -0,0 +1,262 @@
+/* Implementation of the RESHAPE
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
+
+/* The shape parameter is ignored. We can currently deduce the shape from the
+   return array.  */
+
+extern void reshape_16 (gfc_array_i16 *, gfc_array_i16 *, shape_type *,
+                                   gfc_array_i16 *, shape_type *);
+export_proto(reshape_16);
+
+void
+reshape_16 (gfc_array_i16 * ret, gfc_array_i16 * source, shape_type * shape,
+                      gfc_array_i16 * pad, shape_type * order)
+{
+  /* r.* indicates the return array.  */
+  index_type rcount[GFC_MAX_DIMENSIONS];
+  index_type rextent[GFC_MAX_DIMENSIONS];
+  index_type rstride[GFC_MAX_DIMENSIONS];
+  index_type rstride0;
+  index_type rdim;
+  index_type rsize;
+  index_type rs;
+  index_type rex;
+  GFC_INTEGER_16 *rptr;
+  /* s.* indicates the source array.  */
+  index_type scount[GFC_MAX_DIMENSIONS];
+  index_type sextent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type sstride0;
+  index_type sdim;
+  index_type ssize;
+  const GFC_INTEGER_16 *sptr;
+  /* p.* indicates the pad array.  */
+  index_type pcount[GFC_MAX_DIMENSIONS];
+  index_type pextent[GFC_MAX_DIMENSIONS];
+  index_type pstride[GFC_MAX_DIMENSIONS];
+  index_type pdim;
+  index_type psize;
+  const GFC_INTEGER_16 *pptr;
+
+  const GFC_INTEGER_16 *src;
+  int n;
+  int dim;
+
+  if (source->dim[0].stride == 0)
+    source->dim[0].stride = 1;
+  if (shape->dim[0].stride == 0)
+    shape->dim[0].stride = 1;
+  if (pad && pad->dim[0].stride == 0)
+    pad->dim[0].stride = 1;
+  if (order && order->dim[0].stride == 0)
+    order->dim[0].stride = 1;
+
+  if (ret->data == NULL)
+    {
+      rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
+      rs = 1;
+      for (n=0; n < rdim; n++)
+       {
+         ret->dim[n].lbound = 0;
+         rex = shape->data[n * shape->dim[0].stride];
+         ret->dim[n].ubound =  rex - 1;
+         ret->dim[n].stride = rs;
+         rs *= rex;
+       }
+      ret->offset = 0;
+      ret->data = internal_malloc_size ( rs * sizeof (GFC_INTEGER_16));
+      ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim;
+    }
+  else
+    {
+      rdim = GFC_DESCRIPTOR_RANK (ret);
+      if (ret->dim[0].stride == 0)
+       ret->dim[0].stride = 1;
+    }
+
+  rsize = 1;
+  for (n = 0; n < rdim; n++)
+    {
+      if (order)
+        dim = order->data[n * order->dim[0].stride] - 1;
+      else
+        dim = n;
+
+      rcount[n] = 0;
+      rstride[n] = ret->dim[dim].stride;
+      rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
+
+      if (rextent[n] != shape->data[dim * shape->dim[0].stride])
+        runtime_error ("shape and target do not conform");
+
+      if (rsize == rstride[n])
+        rsize *= rextent[n];
+      else
+        rsize = 0;
+      if (rextent[n] <= 0)
+        return;
+    }
+
+  sdim = GFC_DESCRIPTOR_RANK (source);
+  ssize = 1;
+  for (n = 0; n < sdim; n++)
+    {
+      scount[n] = 0;
+      sstride[n] = source->dim[n].stride;
+      sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
+      if (sextent[n] <= 0)
+        abort ();
+
+      if (ssize == sstride[n])
+        ssize *= sextent[n];
+      else
+        ssize = 0;
+    }
+
+  if (pad)
+    {
+      pdim = GFC_DESCRIPTOR_RANK (pad);
+      psize = 1;
+      for (n = 0; n < pdim; n++)
+        {
+          pcount[n] = 0;
+          pstride[n] = pad->dim[n].stride;
+          pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
+          if (pextent[n] <= 0)
+            abort ();
+          if (psize == pstride[n])
+            psize *= pextent[n];
+          else
+            psize = 0;
+        }
+      pptr = pad->data;
+    }
+  else
+    {
+      pdim = 0;
+      psize = 1;
+      pptr = NULL;
+    }
+
+  if (rsize != 0 && ssize != 0 && psize != 0)
+    {
+      rsize *= sizeof (GFC_INTEGER_16);
+      ssize *= sizeof (GFC_INTEGER_16);
+      psize *= sizeof (GFC_INTEGER_16);
+      reshape_packed ((char *)ret->data, rsize, (char *)source->data,
+                     ssize, pad ? (char *)pad->data : NULL, psize);
+      return;
+    }
+  rptr = ret->data;
+  src = sptr = source->data;
+  rstride0 = rstride[0];
+  sstride0 = sstride[0];
+
+  while (rptr)
+    {
+      /* Select between the source and pad arrays.  */
+      *rptr = *src;
+      /* Advance to the next element.  */
+      rptr += rstride0;
+      src += sstride0;
+      rcount[0]++;
+      scount[0]++;
+      /* Advance to the next destination element.  */
+      n = 0;
+      while (rcount[n] == rextent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          rcount[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          rptr -= rstride[n] * rextent[n];
+          n++;
+          if (n == rdim)
+            {
+              /* Break out of the loop.  */
+              rptr = NULL;
+              break;
+            }
+          else
+            {
+              rcount[n]++;
+              rptr += rstride[n];
+            }
+        }
+      /* Advance to the next source element.  */
+      n = 0;
+      while (scount[n] == sextent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          scount[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          src -= sstride[n] * sextent[n];
+          n++;
+          if (n == sdim)
+            {
+              if (sptr && pad)
+                {
+                  /* Switch to the pad array.  */
+                  sptr = NULL;
+                  sdim = pdim;
+                  for (dim = 0; dim < pdim; dim++)
+                    {
+                      scount[dim] = pcount[dim];
+                      sextent[dim] = pextent[dim];
+                      sstride[dim] = pstride[dim];
+                      sstride0 = sstride[0];
+                    }
+                }
+              /* We now start again from the beginning of the pad array.  */
+              src = pptr;
+              break;
+            }
+          else
+            {
+              scount[n]++;
+              src += sstride[n];
+            }
+        }
+    }
+}
+
+#endif
index bf7bba3..565d79c 100644 (file)
@@ -33,6 +33,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_INTEGER_4)
+
 typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
 
 /* The shape parameter is ignored. We can currently deduce the shape from the
@@ -256,3 +258,5 @@ reshape_4 (gfc_array_i4 * ret, gfc_array_i4 * source, shape_type * shape,
         }
     }
 }
+
+#endif
index 5f17a5f..465d532 100644 (file)
@@ -33,6 +33,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_INTEGER_8)
+
 typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
 
 /* The shape parameter is ignored. We can currently deduce the shape from the
@@ -256,3 +258,5 @@ reshape_8 (gfc_array_i8 * ret, gfc_array_i8 * source, shape_type * shape,
         }
     }
 }
+
+#endif
diff --git a/libgfortran/generated/set_exponent_r10.c b/libgfortran/generated/set_exponent_r10.c
new file mode 100644 (file)
index 0000000..49a0a6e
--- /dev/null
@@ -0,0 +1,48 @@
+/* Implementation of the SET_EXPONENT intrinsic
+   Copyright 2003 Free Software Foundation, Inc.
+   Contributed by Richard Henderson <rth@redhat.com>.
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <math.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_SCALBNL) && defined (HAVE_FREXPL)
+
+extern GFC_REAL_10 set_exponent_r10 (GFC_REAL_10 s, GFC_INTEGER_4 i);
+export_proto(set_exponent_r10);
+
+GFC_REAL_10
+set_exponent_r10 (GFC_REAL_10 s, GFC_INTEGER_4 i)
+{
+  int dummy_exp;
+  return scalbnl (frexpl (s, &dummy_exp), i);
+}
+
+#endif
diff --git a/libgfortran/generated/set_exponent_r16.c b/libgfortran/generated/set_exponent_r16.c
new file mode 100644 (file)
index 0000000..ddc1fc6
--- /dev/null
@@ -0,0 +1,48 @@
+/* Implementation of the SET_EXPONENT intrinsic
+   Copyright 2003 Free Software Foundation, Inc.
+   Contributed by Richard Henderson <rth@redhat.com>.
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <math.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_SCALBNL) && defined (HAVE_FREXPL)
+
+extern GFC_REAL_16 set_exponent_r16 (GFC_REAL_16 s, GFC_INTEGER_4 i);
+export_proto(set_exponent_r16);
+
+GFC_REAL_16
+set_exponent_r16 (GFC_REAL_16 s, GFC_INTEGER_4 i)
+{
+  int dummy_exp;
+  return scalbnl (frexpl (s, &dummy_exp), i);
+}
+
+#endif
index e646176..6b1be5d 100644 (file)
@@ -27,10 +27,14 @@ You should have received a copy of the GNU General Public
 License along with libgfortran; see the file COPYING.  If not,
 write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
 #include <math.h>
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_SCALBNF) && defined (HAVE_FREXPF)
+
 extern GFC_REAL_4 set_exponent_r4 (GFC_REAL_4 s, GFC_INTEGER_4 i);
 export_proto(set_exponent_r4);
 
@@ -40,3 +44,5 @@ set_exponent_r4 (GFC_REAL_4 s, GFC_INTEGER_4 i)
   int dummy_exp;
   return scalbnf (frexpf (s, &dummy_exp), i);
 }
+
+#endif
index 482e018..1707a90 100644 (file)
@@ -27,10 +27,14 @@ You should have received a copy of the GNU General Public
 License along with libgfortran; see the file COPYING.  If not,
 write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
 #include <math.h>
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_SCALBN) && defined (HAVE_FREXP)
+
 extern GFC_REAL_8 set_exponent_r8 (GFC_REAL_8 s, GFC_INTEGER_4 i);
 export_proto(set_exponent_r8);
 
@@ -40,3 +44,5 @@ set_exponent_r8 (GFC_REAL_8 s, GFC_INTEGER_4 i)
   int dummy_exp;
   return scalbn (frexp (s, &dummy_exp), i);
 }
+
+#endif
diff --git a/libgfortran/generated/shape_i16.c b/libgfortran/generated/shape_i16.c
new file mode 100644 (file)
index 0000000..87a58ff
--- /dev/null
@@ -0,0 +1,58 @@
+/* Implementation of the SHAPE intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+extern void shape_16 (gfc_array_i16 * ret, const gfc_array_i16 * array);
+export_proto(shape_16);
+
+void
+shape_16 (gfc_array_i16 * ret, const gfc_array_i16 * array)
+{
+  int n;
+  index_type stride;
+
+  stride = ret->dim[0].stride;
+  if (stride == 0)
+    stride = 1;
+
+  for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++)
+    {
+      ret->data[n * stride] =
+        array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+}
+
+#endif
index c6b4f7f..7a56eee 100644 (file)
@@ -33,6 +33,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_INTEGER_4)
+
 extern void shape_4 (gfc_array_i4 * ret, const gfc_array_i4 * array);
 export_proto(shape_4);
 
@@ -52,3 +54,5 @@ shape_4 (gfc_array_i4 * ret, const gfc_array_i4 * array)
         array->dim[n].ubound + 1 - array->dim[n].lbound;
     }
 }
+
+#endif
index 84011b1..2e696c2 100644 (file)
@@ -33,6 +33,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_INTEGER_8)
+
 extern void shape_8 (gfc_array_i8 * ret, const gfc_array_i8 * array);
 export_proto(shape_8);
 
@@ -52,3 +54,5 @@ shape_8 (gfc_array_i8 * ret, const gfc_array_i8 * array)
         array->dim[n].ubound + 1 - array->dim[n].lbound;
     }
 }
+
+#endif
diff --git a/libgfortran/generated/sum_c10.c b/libgfortran/generated/sum_c10.c
new file mode 100644 (file)
index 0000000..655529a
--- /dev/null
@@ -0,0 +1,334 @@
+/* Implementation of the SUM intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_COMPLEX_10) && defined (HAVE_GFC_COMPLEX_10)
+
+
+extern void sum_c10 (gfc_array_c10 *, gfc_array_c10 *, index_type *);
+export_proto(sum_c10);
+
+void
+sum_c10 (gfc_array_c10 *retarray, gfc_array_c10 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_COMPLEX_10 *base;
+  GFC_COMPLEX_10 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_COMPLEX_10)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_COMPLEX_10 *src;
+      GFC_COMPLEX_10 result;
+      src = base;
+      {
+
+  result = 0;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  result += *src;
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void msum_c10 (gfc_array_c10 *, gfc_array_c10 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(msum_c10);
+
+void
+msum_c10 (gfc_array_c10 * retarray, gfc_array_c10 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_COMPLEX_10 *dest;
+  GFC_COMPLEX_10 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_COMPLEX_10)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_COMPLEX_10 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_COMPLEX_10 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = 0;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc)
+    result += *src;
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/sum_c16.c b/libgfortran/generated/sum_c16.c
new file mode 100644 (file)
index 0000000..ee40ba5
--- /dev/null
@@ -0,0 +1,334 @@
+/* Implementation of the SUM intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_COMPLEX_16) && defined (HAVE_GFC_COMPLEX_16)
+
+
+extern void sum_c16 (gfc_array_c16 *, gfc_array_c16 *, index_type *);
+export_proto(sum_c16);
+
+void
+sum_c16 (gfc_array_c16 *retarray, gfc_array_c16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_COMPLEX_16 *base;
+  GFC_COMPLEX_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_COMPLEX_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_COMPLEX_16 *src;
+      GFC_COMPLEX_16 result;
+      src = base;
+      {
+
+  result = 0;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  result += *src;
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void msum_c16 (gfc_array_c16 *, gfc_array_c16 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(msum_c16);
+
+void
+msum_c16 (gfc_array_c16 * retarray, gfc_array_c16 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_COMPLEX_16 *dest;
+  GFC_COMPLEX_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_COMPLEX_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_COMPLEX_16 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_COMPLEX_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = 0;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc)
+    result += *src;
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index 88bd14d..bb08a4b 100644 (file)
@@ -34,6 +34,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_COMPLEX_4) && defined (HAVE_GFC_COMPLEX_4)
+
+
 extern void sum_c4 (gfc_array_c4 *, gfc_array_c4 *, index_type *);
 export_proto(sum_c4);
 
@@ -327,3 +330,5 @@ msum_c4 (gfc_array_c4 * retarray, gfc_array_c4 * array,
         }
     }
 }
+
+#endif
index c532e2a..fd8e356 100644 (file)
@@ -34,6 +34,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_COMPLEX_8) && defined (HAVE_GFC_COMPLEX_8)
+
+
 extern void sum_c8 (gfc_array_c8 *, gfc_array_c8 *, index_type *);
 export_proto(sum_c8);
 
@@ -327,3 +330,5 @@ msum_c8 (gfc_array_c8 * retarray, gfc_array_c8 * array,
         }
     }
 }
+
+#endif
diff --git a/libgfortran/generated/sum_i16.c b/libgfortran/generated/sum_i16.c
new file mode 100644 (file)
index 0000000..b1ba235
--- /dev/null
@@ -0,0 +1,334 @@
+/* Implementation of the SUM intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16)
+
+
+extern void sum_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *);
+export_proto(sum_i16);
+
+void
+sum_i16 (gfc_array_i16 *retarray, gfc_array_i16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *base;
+  GFC_INTEGER_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_INTEGER_16 *src;
+      GFC_INTEGER_16 result;
+      src = base;
+      {
+
+  result = 0;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  result += *src;
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void msum_i16 (gfc_array_i16 *, gfc_array_i16 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(msum_i16);
+
+void
+msum_i16 (gfc_array_i16 * retarray, gfc_array_i16 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_INTEGER_16 *dest;
+  GFC_INTEGER_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_INTEGER_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_INTEGER_16 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_INTEGER_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = 0;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc)
+    result += *src;
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index 6fd750e..1efb59e 100644 (file)
@@ -34,6 +34,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4)
+
+
 extern void sum_i4 (gfc_array_i4 *, gfc_array_i4 *, index_type *);
 export_proto(sum_i4);
 
@@ -327,3 +330,5 @@ msum_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array,
         }
     }
 }
+
+#endif
index 8b7ea07..a7c3d2f 100644 (file)
@@ -34,6 +34,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8)
+
+
 extern void sum_i8 (gfc_array_i8 *, gfc_array_i8 *, index_type *);
 export_proto(sum_i8);
 
@@ -327,3 +330,5 @@ msum_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array,
         }
     }
 }
+
+#endif
diff --git a/libgfortran/generated/sum_r10.c b/libgfortran/generated/sum_r10.c
new file mode 100644 (file)
index 0000000..e0231ca
--- /dev/null
@@ -0,0 +1,334 @@
+/* Implementation of the SUM intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_REAL_10)
+
+
+extern void sum_r10 (gfc_array_r10 *, gfc_array_r10 *, index_type *);
+export_proto(sum_r10);
+
+void
+sum_r10 (gfc_array_r10 *retarray, gfc_array_r10 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_10 *base;
+  GFC_REAL_10 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_REAL_10)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_REAL_10 *src;
+      GFC_REAL_10 result;
+      src = base;
+      {
+
+  result = 0;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  result += *src;
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void msum_r10 (gfc_array_r10 *, gfc_array_r10 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(msum_r10);
+
+void
+msum_r10 (gfc_array_r10 * retarray, gfc_array_r10 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_10 *dest;
+  GFC_REAL_10 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_REAL_10)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_REAL_10 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_REAL_10 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = 0;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc)
+    result += *src;
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/sum_r16.c b/libgfortran/generated/sum_r16.c
new file mode 100644 (file)
index 0000000..4168f8c
--- /dev/null
@@ -0,0 +1,334 @@
+/* Implementation of the SUM intrinsic
+   Copyright 2002 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <stdlib.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+
+#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_REAL_16)
+
+
+extern void sum_r16 (gfc_array_r16 *, gfc_array_r16 *, index_type *);
+export_proto(sum_r16);
+
+void
+sum_r16 (gfc_array_r16 *retarray, gfc_array_r16 *array, index_type *pdim)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_16 *base;
+  GFC_REAL_16 *dest;
+  index_type rank;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type dim;
+
+  /* Make dim zero based to avoid confusion.  */
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  delta = array->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_REAL_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        len = 0;
+    }
+
+  base = array->data;
+  dest = retarray->data;
+
+  while (base)
+    {
+      GFC_REAL_16 *src;
+      GFC_REAL_16 result;
+      src = base;
+      {
+
+  result = 0;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta)
+             {
+
+  result += *src;
+          }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+
+extern void msum_r16 (gfc_array_r16 *, gfc_array_r16 *, index_type *,
+                                              gfc_array_l4 *);
+export_proto(msum_r16);
+
+void
+msum_r16 (gfc_array_r16 * retarray, gfc_array_r16 * array,
+                                 index_type *pdim, gfc_array_l4 * mask)
+{
+  index_type count[GFC_MAX_DIMENSIONS];
+  index_type extent[GFC_MAX_DIMENSIONS];
+  index_type sstride[GFC_MAX_DIMENSIONS];
+  index_type dstride[GFC_MAX_DIMENSIONS];
+  index_type mstride[GFC_MAX_DIMENSIONS];
+  GFC_REAL_16 *dest;
+  GFC_REAL_16 *base;
+  GFC_LOGICAL_4 *mbase;
+  int rank;
+  int dim;
+  index_type n;
+  index_type len;
+  index_type delta;
+  index_type mdelta;
+
+  dim = (*pdim) - 1;
+  rank = GFC_DESCRIPTOR_RANK (array) - 1;
+
+  /* TODO:  It should be a front end job to correctly set the strides.  */
+
+  if (array->dim[0].stride == 0)
+    array->dim[0].stride = 1;
+
+  if (mask->dim[0].stride == 0)
+    mask->dim[0].stride = 1;
+
+  len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
+  if (len <= 0)
+    return;
+  delta = array->dim[dim].stride;
+  mdelta = mask->dim[dim].stride;
+
+  for (n = 0; n < dim; n++)
+    {
+      sstride[n] = array->dim[n].stride;
+      mstride[n] = mask->dim[n].stride;
+      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+    }
+  for (n = dim; n < rank; n++)
+    {
+      sstride[n] = array->dim[n + 1].stride;
+      mstride[n] = mask->dim[n + 1].stride;
+      extent[n] =
+        array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
+    }
+
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+        = internal_malloc_size (sizeof (GFC_REAL_16)
+                                * retarray->dim[rank-1].stride
+                                * extent[rank-1]);
+      retarray->offset = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+       retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+       runtime_error ("rank of return array incorrect");
+    }
+
+  for (n = 0; n < rank; n++)
+    {
+      count[n] = 0;
+      dstride[n] = retarray->dim[n].stride;
+      if (extent[n] <= 0)
+        return;
+    }
+
+  dest = retarray->data;
+  base = array->data;
+  mbase = mask->data;
+
+  if (GFC_DESCRIPTOR_SIZE (mask) != 4)
+    {
+      /* This allows the same loop to be used for all logical types.  */
+      assert (GFC_DESCRIPTOR_SIZE (mask) == 8);
+      for (n = 0; n < rank; n++)
+        mstride[n] <<= 1;
+      mdelta <<= 1;
+      mbase = (GFOR_POINTER_L8_TO_L4 (mbase));
+    }
+
+  while (base)
+    {
+      GFC_REAL_16 *src;
+      GFC_LOGICAL_4 *msrc;
+      GFC_REAL_16 result;
+      src = base;
+      msrc = mbase;
+      {
+
+  result = 0;
+        if (len <= 0)
+         *dest = 0;
+       else
+         {
+           for (n = 0; n < len; n++, src += delta, msrc += mdelta)
+             {
+
+  if (*msrc)
+    result += *src;
+              }
+           *dest = result;
+         }
+      }
+      /* Advance to the next element.  */
+      count[0]++;
+      base += sstride[0];
+      mbase += mstride[0];
+      dest += dstride[0];
+      n = 0;
+      while (count[n] == extent[n])
+        {
+          /* When we get to the end of a dimension, reset it and increment
+             the next dimension.  */
+          count[n] = 0;
+          /* We could precalculate these products, but this is a less
+             frequently used path so proabably not worth it.  */
+          base -= sstride[n] * extent[n];
+          mbase -= mstride[n] * extent[n];
+          dest -= dstride[n] * extent[n];
+          n++;
+          if (n == rank)
+            {
+              /* Break out of the look.  */
+              base = NULL;
+              break;
+            }
+          else
+            {
+              count[n]++;
+              base += sstride[n];
+              mbase += mstride[n];
+              dest += dstride[n];
+            }
+        }
+    }
+}
+
+#endif
index 1419f2f..bf76631 100644 (file)
@@ -34,6 +34,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_REAL_4)
+
+
 extern void sum_r4 (gfc_array_r4 *, gfc_array_r4 *, index_type *);
 export_proto(sum_r4);
 
@@ -327,3 +330,5 @@ msum_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array,
         }
     }
 }
+
+#endif
index 6dbd656..c6d0546 100644 (file)
@@ -34,6 +34,9 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"
 
 
+#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_REAL_8)
+
+
 extern void sum_r8 (gfc_array_r8 *, gfc_array_r8 *, index_type *);
 export_proto(sum_r8);
 
@@ -327,3 +330,5 @@ msum_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array,
         }
     }
 }
+
+#endif
diff --git a/libgfortran/generated/transpose_c10.c b/libgfortran/generated/transpose_c10.c
new file mode 100644 (file)
index 0000000..cb2f992
--- /dev/null
@@ -0,0 +1,102 @@
+/* Implementation of the TRANSPOSE intrinsic
+   Copyright 2003, 2005 Free Software Foundation, Inc.
+   Contributed by Tobias Schlüter
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_COMPLEX_10)
+
+extern void transpose_c10 (gfc_array_c10 * ret, gfc_array_c10 * source);
+export_proto(transpose_c10);
+
+void
+transpose_c10 (gfc_array_c10 * ret, gfc_array_c10 * source)
+{
+  /* r.* indicates the return array.  */
+  index_type rxstride, rystride;
+  GFC_COMPLEX_10 *rptr;
+  /* s.* indicates the source array.  */
+  index_type sxstride, systride;
+  const GFC_COMPLEX_10 *sptr;
+
+  index_type xcount, ycount;
+  index_type x, y;
+
+  assert (GFC_DESCRIPTOR_RANK (source) == 2);
+
+  if (ret->data == NULL)
+    {
+      assert (GFC_DESCRIPTOR_RANK (ret) == 2);
+      assert (ret->dtype == source->dtype);
+
+      ret->dim[0].lbound = 0;
+      ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
+      ret->dim[0].stride = 1;
+
+      ret->dim[1].lbound = 0;
+      ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
+      ret->dim[1].stride = ret->dim[0].ubound+1;
+
+      ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_10) * size0 ((array_t *) ret));
+      ret->offset = 0;
+    }
+
+  if (ret->dim[0].stride == 0)
+    ret->dim[0].stride = 1;
+  if (source->dim[0].stride == 0)
+    source->dim[0].stride = 1;
+
+  sxstride = source->dim[0].stride;
+  systride = source->dim[1].stride;
+  xcount = source->dim[0].ubound + 1 - source->dim[0].lbound;
+  ycount = source->dim[1].ubound + 1 - source->dim[1].lbound;
+
+  rxstride = ret->dim[0].stride;
+  rystride = ret->dim[1].stride;
+
+  rptr = ret->data;
+  sptr = source->data;
+
+  for (y=0; y < ycount; y++)
+    {
+      for (x=0; x < xcount; x++)
+        {
+          *rptr = *sptr;
+
+          sptr += sxstride;
+          rptr += rystride;
+        }
+        sptr += systride - (sxstride * xcount);
+        rptr += rxstride - (rystride * xcount);
+    }
+}
+
+#endif
diff --git a/libgfortran/generated/transpose_c16.c b/libgfortran/generated/transpose_c16.c
new file mode 100644 (file)
index 0000000..4c39c58
--- /dev/null
@@ -0,0 +1,102 @@
+/* Implementation of the TRANSPOSE intrinsic
+   Copyright 2003, 2005 Free Software Foundation, Inc.
+   Contributed by Tobias Schlüter
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_COMPLEX_16)
+
+extern void transpose_c16 (gfc_array_c16 * ret, gfc_array_c16 * source);
+export_proto(transpose_c16);
+
+void
+transpose_c16 (gfc_array_c16 * ret, gfc_array_c16 * source)
+{
+  /* r.* indicates the return array.  */
+  index_type rxstride, rystride;
+  GFC_COMPLEX_16 *rptr;
+  /* s.* indicates the source array.  */
+  index_type sxstride, systride;
+  const GFC_COMPLEX_16 *sptr;
+
+  index_type xcount, ycount;
+  index_type x, y;
+
+  assert (GFC_DESCRIPTOR_RANK (source) == 2);
+
+  if (ret->data == NULL)
+    {
+      assert (GFC_DESCRIPTOR_RANK (ret) == 2);
+      assert (ret->dtype == source->dtype);
+
+      ret->dim[0].lbound = 0;
+      ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
+      ret->dim[0].stride = 1;
+
+      ret->dim[1].lbound = 0;
+      ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
+      ret->dim[1].stride = ret->dim[0].ubound+1;
+
+      ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_16) * size0 ((array_t *) ret));
+      ret->offset = 0;
+    }
+
+  if (ret->dim[0].stride == 0)
+    ret->dim[0].stride = 1;
+  if (source->dim[0].stride == 0)
+    source->dim[0].stride = 1;
+
+  sxstride = source->dim[0].stride;
+  systride = source->dim[1].stride;
+  xcount = source->dim[0].ubound + 1 - source->dim[0].lbound;
+  ycount = source->dim[1].ubound + 1 - source->dim[1].lbound;
+
+  rxstride = ret->dim[0].stride;
+  rystride = ret->dim[1].stride;
+
+  rptr = ret->data;
+  sptr = source->data;
+
+  for (y=0; y < ycount; y++)
+    {
+      for (x=0; x < xcount; x++)
+        {
+          *rptr = *sptr;
+
+          sptr += sxstride;
+          rptr += rystride;
+        }
+        sptr += systride - (sxstride * xcount);
+        rptr += rxstride - (rystride * xcount);
+    }
+}
+
+#endif
index 374efed..a8e22c9 100644 (file)
@@ -32,6 +32,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_COMPLEX_4)
+
 extern void transpose_c4 (gfc_array_c4 * ret, gfc_array_c4 * source);
 export_proto(transpose_c4);
 
@@ -96,3 +98,5 @@ transpose_c4 (gfc_array_c4 * ret, gfc_array_c4 * source)
         rptr += rxstride - (rystride * xcount);
     }
 }
+
+#endif
index a878542..a61ecc4 100644 (file)
@@ -32,6 +32,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_COMPLEX_8)
+
 extern void transpose_c8 (gfc_array_c8 * ret, gfc_array_c8 * source);
 export_proto(transpose_c8);
 
@@ -96,3 +98,5 @@ transpose_c8 (gfc_array_c8 * ret, gfc_array_c8 * source)
         rptr += rxstride - (rystride * xcount);
     }
 }
+
+#endif
diff --git a/libgfortran/generated/transpose_i16.c b/libgfortran/generated/transpose_i16.c
new file mode 100644 (file)
index 0000000..fcebdf3
--- /dev/null
@@ -0,0 +1,102 @@
+/* Implementation of the TRANSPOSE intrinsic
+   Copyright 2003, 2005 Free Software Foundation, Inc.
+   Contributed by Tobias Schlüter
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include <assert.h>
+#include "libgfortran.h"
+
+#if defined (HAVE_GFC_INTEGER_16)
+
+extern void transpose_i16 (gfc_array_i16 * ret, gfc_array_i16 * source);
+export_proto(transpose_i16);
+
+void
+transpose_i16 (gfc_array_i16 * ret, gfc_array_i16 * source)
+{
+  /* r.* indicates the return array.  */
+  index_type rxstride, rystride;
+  GFC_INTEGER_16 *rptr;
+  /* s.* indicates the source array.  */
+  index_type sxstride, systride;
+  const GFC_INTEGER_16 *sptr;
+
+  index_type xcount, ycount;
+  index_type x, y;
+
+  assert (GFC_DESCRIPTOR_RANK (source) == 2);
+
+  if (ret->data == NULL)
+    {
+      assert (GFC_DESCRIPTOR_RANK (ret) == 2);
+      assert (ret->dtype == source->dtype);
+
+      ret->dim[0].lbound = 0;
+      ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
+      ret->dim[0].stride = 1;
+
+      ret->dim[1].lbound = 0;
+      ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
+      ret->dim[1].stride = ret->dim[0].ubound+1;
+
+      ret->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * size0 ((array_t *) ret));
+      ret->offset = 0;
+    }
+
+  if (ret->dim[0].stride == 0)
+    ret->dim[0].stride = 1;
+  if (source->dim[0].stride == 0)
+    source->dim[0].stride = 1;
+
+  sxstride = source->dim[0].stride;
+  systride = source->dim[1].stride;
+  xcount = source->dim[0].ubound + 1 - source->dim[0].lbound;
+  ycount = source->dim[1].ubound + 1 - source->dim[1].lbound;
+
+  rxstride = ret->dim[0].stride;
+  rystride = ret->dim[1].stride;
+
+  rptr = ret->data;
+  sptr = source->data;
+
+  for (y=0; y < ycount; y++)
+    {
+      for (x=0; x < xcount; x++)
+        {
+          *rptr = *sptr;
+
+          sptr += sxstride;
+          rptr += rystride;
+        }
+        sptr += systride - (sxstride * xcount);
+        rptr += rxstride - (rystride * xcount);
+    }
+}
+
+#endif
index c99ef48..b3979a8 100644 (file)
@@ -32,6 +32,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_INTEGER_4)
+
 extern void transpose_i4 (gfc_array_i4 * ret, gfc_array_i4 * source);
 export_proto(transpose_i4);
 
@@ -96,3 +98,5 @@ transpose_i4 (gfc_array_i4 * ret, gfc_array_i4 * source)
         rptr += rxstride - (rystride * xcount);
     }
 }
+
+#endif
index 75aa035..e195d59 100644 (file)
@@ -32,6 +32,8 @@ Boston, MA 02110-1301, USA.  */
 #include <assert.h>
 #include "libgfortran.h"
 
+#if defined (HAVE_GFC_INTEGER_8)
+
 extern void transpose_i8 (gfc_array_i8 * ret, gfc_array_i8 * source);
 export_proto(transpose_i8);
 
@@ -96,3 +98,5 @@ transpose_i8 (gfc_array_i8 * ret, gfc_array_i8 * source)
         rptr += rxstride - (rystride * xcount);
     }
 }
+
+#endif
index f5e7493..a147b96 100644 (file)
@@ -69,3 +69,25 @@ ishftc8 (GFC_INTEGER_8 i, GFC_INTEGER_4 shift, GFC_INTEGER_4 size)
   bits = i & ~mask;
   return (i & mask) | (bits >> (size - shift)) | ((i << shift) & ~mask);
 }
+
+#ifdef HAVE_GFC_INTEGER_16
+extern GFC_INTEGER_16 ishftc16 (GFC_INTEGER_16, GFC_INTEGER_4, GFC_INTEGER_4);
+export_proto(ishftc16);
+
+GFC_INTEGER_16
+ishftc16 (GFC_INTEGER_16 i, GFC_INTEGER_4 shift, GFC_INTEGER_4 size)
+{
+  GFC_INTEGER_16 mask;
+  GFC_UINTEGER_16 bits;
+
+  if (shift < 0)
+    shift = shift + size;
+
+  if (shift == 0 || shift == size)
+    return i;
+
+  mask = (~(GFC_INTEGER_16)0) << size;
+  bits = i & ~mask;
+  return (i & mask) | (bits >> (size - shift)) | ((i << shift) & ~mask);
+}
+#endif
index 49d2c61..174873b 100644 (file)
@@ -231,8 +231,19 @@ internal_proto(l8_to_l4_offset);
   (GFC_INTEGER_4)((((GFC_UINTEGER_4)1) << 31) - 1)
 #define GFC_INTEGER_8_HUGE \
   (GFC_INTEGER_8)((((GFC_UINTEGER_8)1) << 63) - 1)
+#ifdef HAVE_GFC_INTEGER_16
+#define GFC_INTEGER_16_HUGE \
+  (GFC_INTEGER_16)((((GFC_UINTEGER_16)1) << 127) - 1)
+#endif
+
 #define GFC_REAL_4_HUGE FLT_MAX
 #define GFC_REAL_8_HUGE DBL_MAX
+#ifdef HAVE_GFC_REAL_10
+#define GFC_REAL_10_HUGE LDBL_MAX
+#endif
+#ifdef HAVE_GFC_REAL_16
+#define GFC_REAL_16_HUGE LDBL_MAX
+#endif
 
 #ifndef GFC_MAX_DIMENSIONS
 #define GFC_MAX_DIMENSIONS 7
@@ -259,12 +270,30 @@ typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, void) gfc_array_void;
 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, char) gfc_array_char;
 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_4) gfc_array_i4;
 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_8) gfc_array_i8;
+#ifdef HAVE_GFC_INTEGER_16
+typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_16) gfc_array_i16;
+#endif
 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_4) gfc_array_r4;
 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_8) gfc_array_r8;
+#ifdef HAVE_GFC_REAL_10
+typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_10) gfc_array_r10;
+#endif
+#ifdef HAVE_GFC_REAL_16
+typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_16) gfc_array_r16;
+#endif
 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_4) gfc_array_c4;
 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_8) gfc_array_c8;
+#ifdef HAVE_GFC_COMPLEX_10
+typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_10) gfc_array_c10;
+#endif
+#ifdef HAVE_GFC_COMPLEX_16
+typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_16) gfc_array_c16;
+#endif
 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_4) gfc_array_l4;
 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_8) gfc_array_l8;
+#ifdef HAVE_GFC_LOGICAL_16
+typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_16) gfc_array_l16;
+#endif
 
 #define GFC_DTYPE_RANK_MASK 0x07
 #define GFC_DTYPE_TYPE_SHIFT 3
index 5e20473..3af1955 100644 (file)
@@ -35,6 +35,9 @@ Boston, MA 02110-1301, USA.  */
 
 include(iparm.m4)dnl
 include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
 ARRAY_FUNCTION(1,
 `  /* Return true only if all the elements are set.  */
   result = 1;',
@@ -44,3 +47,4 @@ ARRAY_FUNCTION(1,
       break;
     }')
 
+#endif
index 8c78b34..918c9f0 100644 (file)
@@ -35,6 +35,9 @@ Boston, MA 02110-1301, USA.  */
 
 include(iparm.m4)dnl
 include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
 ARRAY_FUNCTION(0,
 `  result = 0;',
 `  /* Return true if any of the elements are set.  */
@@ -44,3 +47,4 @@ ARRAY_FUNCTION(0,
       break;
     }')
 
+#endif
index 59580fe..983dbb7 100644 (file)
@@ -35,8 +35,12 @@ Boston, MA 02110-1301, USA.  */
 
 include(iparm.m4)dnl
 include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
 ARRAY_FUNCTION(0,
 `  result = 0;',
 `  if (*src)
     result++;')
 
+#endif
index 5c3d0b0..28494d8 100644 (file)
@@ -35,6 +35,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"'
 include(iparm.m4)dnl
 
+`#if defined (HAVE_'atype_name`)'
+
 static void
 cshift1 (gfc_array_char * ret, const gfc_array_char * array,
         const atype * h, const atype_name * pwhich, index_type size)
@@ -220,3 +222,5 @@ cshift1_`'atype_kind`'_char (gfc_array_char * ret,
 {
   cshift1 (ret, array, h, pwhich, array_length);
 }
+
+#endif
index 1410a1a..af41fcc 100644 (file)
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"'
 include(iparm.m4)dnl
 
+`#if defined (HAVE_'rtype_name`)'
+
 typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
 
 extern rtype_name dot_product_`'rtype_code (rtype * a, rtype * b);
@@ -75,3 +77,5 @@ sinclude(`dotprod_asm_'rtype_code`.m4')dnl
 
   return res;
 }
+
+#endif
index 806dd79..36740b0 100644 (file)
@@ -35,6 +35,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"'
 include(iparm.m4)dnl
 
+`#if defined (HAVE_'rtype_name`)'
+
 typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;
 
 extern rtype_name dot_product_`'rtype_code (rtype * a, rtype * b);
@@ -78,3 +80,5 @@ sinclude(`dotprod_asm_'rtype_code`.m4')dnl
 
   return res;
 }
+
+#endif
index 56365f0..946fe22 100644 (file)
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"'
 include(iparm.m4)dnl
 
+`#if defined (HAVE_'rtype_name`)'
+
 extern rtype_name dot_product_`'rtype_code (gfc_array_l4 *, gfc_array_l4 *);
 export_proto(dot_product_`'rtype_code);
 
@@ -84,3 +86,5 @@ dot_product_`'rtype_code (gfc_array_l4 * a, gfc_array_l4 * b)
 
   return 0;
 }
+
+#endif
index b5245ee..cd7a1d8 100644 (file)
@@ -35,6 +35,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"'
 include(iparm.m4)dnl
 
+`#if defined (HAVE_'atype_name`)'
+
 static void
 eoshift1 (gfc_array_char *ret, const gfc_array_char *array, const atype *h,
          const char *pbound, const atype_name *pwhich, index_type size,
@@ -246,3 +248,5 @@ eoshift1_`'atype_kind`'_char (gfc_array_char *ret,
 {
   eoshift1 (ret, array, h, pbound, pwhich, array_length, ' ');
 }
+
+#endif
index aa4d8dd..318d67f 100644 (file)
@@ -35,6 +35,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"'
 include(iparm.m4)dnl
 
+`#if defined (HAVE_'atype_name`)'
+
 static void
 eoshift3 (gfc_array_char *ret, const gfc_array_char *array, const atype *h,
          const gfc_array_char *bound, const atype_name *pwhich,
@@ -268,3 +270,5 @@ eoshift3_`'atype_kind`'_char (gfc_array_char *ret,
 {
   eoshift3 (ret, array, h, bound, pwhich, array_length, ' ');
 }
+
+#endif
index 6221793..ca0d130 100644 (file)
@@ -27,11 +27,15 @@ You should have received a copy of the GNU General Public
 License along with libgfortran; see the file COPYING.  If not,
 write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
 #include <math.h>
 #include "libgfortran.h"'
 
 include(`mtype.m4')dnl
 
+`#if defined (HAVE_'real_type`) && defined (HAVE_FREXP'Q`)'
+
 extern GFC_INTEGER_4 exponent_r`'kind (real_type s);
 export_proto(exponent_r`'kind);
 
@@ -42,3 +46,5 @@ exponent_r`'kind (real_type s)
   frexp`'q (s, &ret);
   return ret;
 }
+
+#endif
index 9f33c59..07f8337 100644 (file)
@@ -27,11 +27,15 @@ You should have received a copy of the GNU General Public
 License along with libgfortran; see the file COPYING.  If not,
 write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
 #include <math.h>
 #include "libgfortran.h"'
 
 include(`mtype.m4')dnl
 
+`#if defined (HAVE_'real_type`) && defined (HAVE_FREXP'Q`)'
+
 extern real_type fraction_r`'kind (real_type s);
 export_proto(fraction_r`'kind);
 
@@ -41,3 +45,5 @@ fraction_r`'kind (real_type s)
   int dummy_exp;
   return frexp`'q (s, &dummy_exp);
 }
+
+#endif
index 1e6fdf5..cb5be52 100644 (file)
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"'
 include(iparm.m4)dnl
 
+`#if defined (HAVE_'rtype_name`)'
+
 /* Allocates a block of memory with internal_malloc if the array needs
    repacking.  */
 
@@ -124,3 +126,4 @@ rtype_name *
   return destptr;
 }
 
+#endif
index 1d2a609..131eb5d 100644 (file)
@@ -35,6 +35,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"'
 include(iparm.m4)dnl
 
+`#if defined (HAVE_'rtype_name`)'
+
 dnl Only the kind (ie size) is used to name the function for integers,
 dnl reals and logicals.  For complex, it's c4 and c8.
 void
@@ -112,3 +114,4 @@ void
     }
 }
 
+#endif
index 02297b9..aca2da0 100644 (file)
@@ -35,6 +35,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"'
 include(iparm.m4)dnl
 
+`#if defined (HAVE_'rtype_name`)'
+
 /* This is a C version of the following fortran pseudo-code. The key
    point is the loop order -- we access all arrays column-first, which
    improves the performance enough to boost galgel spec score by 50%.
@@ -217,3 +219,5 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
            dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
     }
 }
+
+#endif
index c36949c..9632a6a 100644 (file)
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"'
 include(iparm.m4)dnl
 
+`#if defined (HAVE_'rtype_name`)'
+
 /* Dimensions: retarray(x,y) a(x, count) b(count,y).
    Either a or b can be rank 1.  In this case x or y is 1.  */
 
@@ -192,3 +194,5 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
       dest += rystride - (rxstride * xcount);
     }
 }
+
+#endif
index e0ea061..8708a78 100644 (file)
@@ -38,6 +38,8 @@ Boston, MA 02110-1301, USA.  */
 include(iparm.m4)dnl
 include(iforeach.m4)dnl
 
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
 FOREACH_FUNCTION(
 `  atype_name maxval;
 
@@ -61,3 +63,5 @@ MASKED_FOREACH_FUNCTION(
       for (n = 0; n < rank; n++)
         dest[n * dstride] = count[n] + 1;
     }')
+
+#endif
index 103e15a..d1ea9dc 100644 (file)
@@ -37,6 +37,9 @@ Boston, MA 02110-1301, USA.  */
 
 include(iparm.m4)dnl
 include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
 ARRAY_FUNCTION(0,
 `  atype_name maxval;
   maxval = atype_min;
@@ -57,3 +60,4 @@ MASKED_ARRAY_FUNCTION(0,
       result = (rtype_name)n + 1;
     }')
 
+#endif
index be0613c..9bdf0d0 100644 (file)
@@ -36,6 +36,9 @@ Boston, MA 02110-1301, USA.  */
 
 include(iparm.m4)dnl
 include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
 ARRAY_FUNCTION(atype_min,
 `  result = atype_min;',
 `  if (*src > result)
@@ -46,3 +49,4 @@ MASKED_ARRAY_FUNCTION(atype_min,
 `  if (*msrc && *src > result)
     result = *src;')
 
+#endif
index d218667..10fb3a9 100644 (file)
@@ -38,6 +38,8 @@ Boston, MA 02110-1301, USA.  */
 include(iparm.m4)dnl
 include(iforeach.m4)dnl
 
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
 FOREACH_FUNCTION(
 `  atype_name minval;
 
@@ -61,3 +63,5 @@ MASKED_FOREACH_FUNCTION(
       for (n = 0; n < rank; n++)
         dest[n * dstride] = count[n] + 1;
     }')
+
+#endif
index d2eaff9..a224b73 100644 (file)
@@ -37,6 +37,9 @@ Boston, MA 02110-1301, USA.  */
 
 include(iparm.m4)dnl
 include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
 ARRAY_FUNCTION(0,
 `  atype_name minval;
   minval = atype_max;
@@ -57,3 +60,4 @@ MASKED_ARRAY_FUNCTION(0,
       result = (rtype_name)n + 1;
     }')
 
+#endif
index 2fea1cd..9bd37f4 100644 (file)
@@ -36,6 +36,9 @@ Boston, MA 02110-1301, USA.  */
 
 include(iparm.m4)dnl
 include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
 ARRAY_FUNCTION(atype_max,
 `  result = atype_max;',
 `  if (*src < result)
@@ -46,3 +49,4 @@ MASKED_ARRAY_FUNCTION(atype_max,
 `  if (*msrc && *src < result)
     result = *src;')
 
+#endif
index 84bf39f..8e7e889 100644 (file)
@@ -2,4 +2,5 @@ dnl Get type kind from filename.
 define(kind,regexp(file, `_.\([0-9]+\).c$', `\1'))dnl
 define(complex_type, `GFC_COMPLEX_'kind)dnl
 define(real_type, `GFC_REAL_'kind)dnl
-define(q,ifelse(kind,4,f,ifelse(kind,8,`',`_'kind)))dnl
+define(q,ifelse(kind,4,f,ifelse(kind,8,`',ifelse(kind,10,l,ifelse(kind,16,l,`_'kind)))))dnl
+define(Q,translit(q,`a-z',`A-Z'))dnl
index ce83dc5..598ba4e 100644 (file)
@@ -27,12 +27,16 @@ You should have received a copy of the GNU General Public
 License along with libgfortran; see the file COPYING.  If not,
 write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
 #include <math.h>
 #include <float.h>
 #include "libgfortran.h"'
 
 include(`mtype.m4')dnl
 
+`#if defined (HAVE_'real_type`) && defined (HAVE_COPYSIGN'Q`) && defined (HAVE_NEXTAFTER'Q`)'
+
 extern real_type nearest_r`'kind (real_type s, real_type dir);
 export_proto(nearest_r`'kind);
 
@@ -49,3 +53,5 @@ nearest_r`'kind (real_type s, real_type dir)
   else
     return nextafter`'q (s, dir);
 }
+
+#endif
index c7ed766..ae49004 100644 (file)
@@ -37,6 +37,8 @@ include(iparm.m4)dnl
    Powers" of Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art
    of Computer Programming", 3rd Edition, 1998.  */
 
+`#if defined (HAVE_'rtype_name`) && defined (HAVE_'atype_name`)'
+
 rtype_name `pow_'rtype_code`_'atype_code (rtype_name a, atype_name b);
 export_proto(pow_`'rtype_code`_'atype_code);
 
@@ -78,3 +80,5 @@ ifelse(rtype_letter,i,`dnl
     }
   return pow;
 }
+
+#endif
index 6e9581d..df77372 100644 (file)
@@ -35,6 +35,9 @@ Boston, MA 02110-1301, USA.  */
 
 include(iparm.m4)dnl
 include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
 ARRAY_FUNCTION(1,
 `  result = 1;',
 `  result *= *src;')
@@ -44,3 +47,4 @@ MASKED_ARRAY_FUNCTION(1,
 `  if (*msrc)
     result *= *src;')
 
+#endif
index adc6df0..c43828c 100644 (file)
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"'
 include(iparm.m4)dnl
 
+`#if defined (HAVE_'rtype_name`)'
+
 typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
 
 /* The shape parameter is ignored. We can currently deduce the shape from the
@@ -258,3 +260,5 @@ reshape_`'rtype_ccode (rtype * ret, rtype * source, shape_type * shape,
         }
     }
 }
+
+#endif
index 797906c..91ba952 100644 (file)
@@ -27,11 +27,15 @@ You should have received a copy of the GNU General Public
 License along with libgfortran; see the file COPYING.  If not,
 write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
 #include <math.h>
 #include "libgfortran.h"'
 
 include(`mtype.m4')dnl
 
+`#if defined (HAVE_'real_type`) && defined (HAVE_SCALBN'Q`) && defined (HAVE_FREXP'Q`)'
+
 extern real_type set_exponent_r`'kind (real_type s, GFC_INTEGER_4 i);
 export_proto(set_exponent_r`'kind);
 
@@ -41,3 +45,5 @@ set_exponent_r`'kind (real_type s, GFC_INTEGER_4 i)
   int dummy_exp;
   return scalbn`'q (frexp`'q (s, &dummy_exp), i);
 }
+
+#endif
index 5481ba0..1b9e100 100644 (file)
@@ -34,6 +34,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"'
 include(iparm.m4)dnl
 
+`#if defined (HAVE_'rtype_name`)'
+
 extern void shape_`'rtype_kind (rtype * ret, const rtype * array);
 export_proto(shape_`'rtype_kind);
 
@@ -53,3 +55,5 @@ shape_`'rtype_kind (rtype * ret, const rtype * array)
         array->dim[n].ubound + 1 - array->dim[n].lbound;
     }
 }
+
+#endif
index a6cea73..e473eff 100644 (file)
@@ -1,5 +1,5 @@
 include(head.m4)
-define(atype_code,regexp(file,`_\([ircl][0-9]+\).f90',`\1'))dnl
+define(atype_code,regexp(file,`_\([ircl][0-9]+\).[fF]90',`\1'))dnl
 define(atype_letter,substr(atype_code, 0, 1))dnl
 define(atype_kind,substr(atype_code, 1))dnl
 define(get_typename2, `$1 (kind=$2)')dnl
@@ -8,9 +8,35 @@ define(atype_name, get_typename(atype_letter,atype_kind))dnl
 define(name, regexp(regexp(file, `[^/]*$', `\&'), `^_\([^_]*\)_', `\1'))dnl
 define(function_name,`specific__'name`_'atype_code)dnl
 
+define(type,ifelse(atype_letter,l,LOGICAL,ifelse(atype_letter,i,INTEGER,ifelse(atype_letter,r,REAL,ifelse(atype_letter,c,COMPLEX,UNKNOW)))))dnl
+define(Q,ifelse(atype_kind,4,F,ifelse(atype_kind,8,`',ifelse(atype_kind,10,L,ifelse(atype_kind,16,L,`_'atype_kind)))))dnl
+
+dnl A few specifics require a function other than their name, or
+dnl nothing. The list is currently:
+dnl    - integer and logical specifics require no libm function
+dnl    - AINT requires the trunc() family functions
+dnl    - ANINT requires round()
+dnl    - CONJG, DIM, SIGN require no libm function
+define(needed,ifelse(atype_letter,i,`none',ifelse(atype_letter,l,`none',ifelse(name,aint,trunc,ifelse(name,anint,round,ifelse(name,conjg,none,ifelse(name,dim,none,ifelse(name,sign,none,ifelse(name,abs,fabs,name)))))))))dnl
+define(prefix,ifelse(atype_letter,c,C,`'))dnl
+
+dnl Special case for fabs, for which the corresponding complex function
+dnl is not cfabs but cabs.
+define(NEEDED,translit(ifelse(prefix`'needed,`Cfabs',`abs',needed),`a-z',`A-Z'))dnl
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+`#if defined (HAVE_GFC_'type`_'atype_kind`)'
+ifelse(NEEDED,NONE,`',`#ifdef HAVE_'prefix`'NEEDED`'Q)
+
 elemental function function_name (parm)
    atype_name, intent (in) :: parm
    atype_name :: function_name
 
    function_name = name (parm)
 end function
+
+ifelse(NEEDED,NONE,`',`#endif')
+#endif
index dab90b0..fa26f39 100644 (file)
@@ -1,5 +1,5 @@
 include(head.m4)
-define(atype_code,regexp(file,`_\([ircl][0-9]+\).f90',`\1'))dnl
+define(atype_code,regexp(file,`_\([ircl][0-9]+\).[fF]90',`\1'))dnl
 define(atype_letter,substr(atype_code, 0, 1))dnl
 define(atype_kind,substr(atype_code, 1))dnl
 define(get_typename2, `$1 (kind=$2)')dnl
@@ -8,9 +8,23 @@ define(atype_name, get_typename(atype_letter,atype_kind))dnl
 define(name, regexp(regexp(file, `[^/]*$', `\&'), `^_\([^_]*\)_', `\1'))dnl
 define(function_name,`specific__'name`_'atype_code)dnl
 
+define(Q,ifelse(atype_kind,4,F,ifelse(atype_kind,8,`',ifelse(atype_kind,10,L,ifelse(atype_kind,16,L,`_'atype_kind)))))dnl
+
+#include "config.h"
+#include "kinds.inc"
+#include "c99_protos.inc"
+
+`#if defined (HAVE_GFC_'ifelse(atype_letter,l,LOGICAL,ifelse(atype_letter,i,INTEGER,ifelse(atype_letter,r,REAL,ifelse(atype_letter,c,COMPLEX,UNKNOW))))`_'atype_kind`)'
+
+ifelse(name,atan2,`#ifdef HAVE_ATAN2'Q,)
+
 elemental function function_name (p1, p2)
    atype_name, intent (in) :: p1, p2
    atype_name :: function_name
 
    function_name = name (p1, p2)
 end function
+
+ifelse(name,atan2,`#endif',)
+
+#endif
index 8dcc7aa..1d91c0d 100644 (file)
@@ -35,6 +35,9 @@ Boston, MA 02110-1301, USA.  */
 
 include(iparm.m4)dnl
 include(ifunction.m4)dnl
+
+`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
+
 ARRAY_FUNCTION(0,
 `  result = 0;',
 `  result += *src;')
@@ -43,3 +46,5 @@ MASKED_ARRAY_FUNCTION(0,
 `  result = 0;',
 `  if (*msrc)
     result += *src;')
+
+#endif
index cfd8175..56669ce 100644 (file)
@@ -33,6 +33,8 @@ Boston, MA 02110-1301, USA.  */
 #include "libgfortran.h"'
 include(iparm.m4)dnl
 
+`#if defined (HAVE_'rtype_name`)'
+
 extern void transpose_`'rtype_code (rtype * ret, rtype * source);
 export_proto(transpose_`'rtype_code);
 
@@ -97,3 +99,5 @@ transpose_`'rtype_code (rtype * ret, rtype * source)
         rptr += rxstride - (rystride * xcount);
     }
 }
+
+#endif
index 6f292bf..98328b6 100755 (executable)
@@ -24,6 +24,7 @@ for k in $possible_integer_kinds; do
     echo "typedef ${prefix}int${s}_t GFC_INTEGER_${k};"
     echo "typedef ${prefix}uint${s}_t GFC_UINTEGER_${k};"
     echo "typedef GFC_INTEGER_${k} GFC_LOGICAL_${k};"
+    echo "#define HAVE_GFC_LOGICAL_${k}"
     echo "#define HAVE_GFC_INTEGER_${k}"
   fi
   rm -f tmp$$.*
@@ -50,6 +51,7 @@ for k in $possible_real_kinds; do
     echo "typedef ${ctype} GFC_REAL_${k};"
     echo "typedef complex ${ctype} GFC_COMPLEX_${k};"
     echo "#define HAVE_GFC_REAL_${k}"
+    echo "#define HAVE_GFC_COMPLEX_${k}"
   fi
   rm -f tmp$$.*
 done